git.sur5r.net Git - bacula/bacula/blob - gui/bweb/lib/Bconsole.pm

   1 use strict;
   2
   3 =head1 LICENSE
   4
   5    Bweb - A Bacula web interface
   6    Bacula® - The Network Backup Solution
   7
   8    Copyright (C) 2000-2006 Free Software Foundation Europe e.V.
   9
  10    The main author of Bweb is Eric Bollengier.
  11    The main author of Bacula is Kern Sibbald, with contributions from
  12    many others, a complete list can be found in the file AUTHORS.
  13
  14    This program is Free Software; you can redistribute it and/or
  15    modify it under the terms of version two of the GNU General Public
  16    License as published by the Free Software Foundation plus additions
  17    that are listed in the file LICENSE.
  18
  19    This program is distributed in the hope that it will be useful, but
  20    WITHOUT ANY WARRANTY; without even the implied warranty of
  21    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  22    General Public License for more details.
  23
  24    You should have received a copy of the GNU General Public License
  25    along with this program; if not, write to the Free Software
  26    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  27    02110-1301, USA.
  28
  29    Bacula® is a registered trademark of John Walker.
  30    The licensor of Bacula is the Free Software Foundation Europe
  31    (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
  32    Switzerland, email:ftf@fsfeurope.org.
  33
  34 =head1 VERSION
  35
  36     $Id$
  37
  38 =cut
  39
  40
  41 ################################################################
  42 # Manage with Expect the bconsole tool
  43 package Bconsole;
  44 use Expect;
  45 use POSIX qw/_exit/;
  46
  47 # my $pref = new Pref(config_file => 'brestore.conf');
  48 # my $bconsole = new Bconsole(pref => $pref);
  49 sub new
  50 {
  51     my ($class, %arg) = @_;
  52
  53     my $self = bless {
  54         pref => $arg{pref},     # Pref object
  55         bconsole => undef,      # Expect object
  56         log_stdout => $arg{log_stdout} || 0,
  57         timeout => $arg{timeout} || 20,
  58         debug   => $arg{debug} || 0,
  59     };
  60
  61     return $self;
  62 }
  63
  64 sub run
  65 {
  66     my ($self, %arg) = @_;
  67
  68     my $cmd = 'run ';
  69     for my $key (keys %arg) {
  70         if ($arg{$key}) {
  71             $arg{$key} =~ tr/""/  /;
  72             $cmd .= "$key=\"$arg{$key}\" ";
  73         }
  74     }
  75
  76     unless ($self->connect()) {
  77         return 0;
  78     }
  79
  80     print STDERR "===> $cmd yes\n";
  81     $self->{bconsole}->clear_accum();
  82     $self->send("$cmd yes\n");
  83     $self->expect_it('-re',qr/^[*]/);
  84     my $ret = $self->before();
  85     if ($ret =~ /jobid=(\d+)/is) {
  86         return $1;
  87     } else {
  88         return 0;
  89     }
  90 }
  91
  92 # for brestore.pl::BwebConsole
  93 sub prepare
  94 {
  95     # do nothing
  96 }
  97
  98 sub send
  99 {
 100     my ($self, $what) = @_;
 101     $self->{bconsole}->send($what);
 102 }
 103
 104 sub expect_it
 105 {
 106     my ($self, @what) = @_;
 107     unless ($self->{bconsole}->expect($self->{timeout}, @what)) {
 108         $self->{error} = $!;
 109         return 0;
 110     }
 111     return 1;
 112 }
 113
 114 sub log_stdout
 115 {
 116     my ($self, $how) = @_;
 117
 118     if ($self->{bconsole}) {
 119        $self->{bconsole}->log_stdout($how);
 120     }
 121
 122     $self->{log_stdout} = $how;
 123 }
 124
 125 sub connect
 126 {
 127     my ($self) = @_;
 128
 129     if ($self->{error}) {
 130         return 0 ;
 131     }
 132
 133     unless ($self->{bconsole}) {
 134         my @cmd = split(/\s+/, $self->{pref}->{bconsole}) ;
 135         unless (@cmd) {
 136             $self->{error} = "bconsole string not found";
 137             return 0;
 138         }
 139         $self->{bconsole} = new Expect;
 140         $self->{bconsole}->raw_pty(0);
 141         $self->{bconsole}->debug($self->{debug});
 142         $self->{bconsole}->log_stdout($self->{debug} || $self->{log_stdout});
 143
 144         # WARNING : die is trapped by gtk_main_loop()
 145         # and exit() closes DBI connection
 146         my $ret;
 147         {
 148             my $sav = $SIG{__DIE__};
 149             $SIG{__DIE__} = sub {  _exit 1 ;};
 150             my $old = $ENV{COLUMNS};
 151             $ENV{COLUMNS} = 300;
 152             $ret = $self->{bconsole}->spawn(@cmd) ;
 153             $ENV{COLUMNS} = $old;
 154             $SIG{__DIE__} = $sav;
 155         }
 156
 157         unless ($ret) {
 158             $self->{error} = $!;
 159             return 0;
 160         }
 161
 162         # TODO : we must verify that expect return the good value
 163
 164         $self->expect_it('*');
 165         $self->send_cmd('gui on');
 166     }
 167     return 1 ;
 168 }
 169
 170 sub cancel
 171 {
 172     my ($self, $jobid) = @_;
 173     return $self->send_cmd("cancel jobid=$jobid");
 174 }
 175
 176 # get text between to expect
 177 sub before
 178 {
 179     my ($self) = @_;
 180     return $self->{bconsole}->before();
 181 }
 182
 183 sub send_cmd
 184 {
 185     my ($self, $cmd) = @_;
 186     unless ($self->connect()) {
 187         return '';
 188     }
 189     $self->send("$cmd\n");
 190     $self->expect_it($cmd);
 191     $self->{bconsole}->clear_accum();
 192     $self->expect_it('-re',qr/^[*]/);
 193     return $self->before();
 194 }
 195
 196 sub send_cmd_yes
 197 {
 198     my ($self, $cmd) = @_;
 199     unless ($self->connect()) {
 200         return '';
 201     }
 202     $self->send("$cmd\n");
 203     $self->expect_it('-re', '[?].+:');
 204
 205     $self->send("yes\n");
 206     $self->expect_it("yes");
 207     $self->{bconsole}->clear_accum();
 208     $self->expect_it('-re',qr/^[*]/);
 209     return $self->before();
 210 }
 211
 212 sub label_barcodes
 213 {
 214     my ($self, %arg) = @_;
 215
 216     unless ($arg{storage}) {
 217         return '';
 218     }
 219
 220     unless ($self->connect()) {
 221         return '';
 222     }
 223
 224     $arg{drive} = $arg{drive} || '0' ;
 225     $arg{pool} = $arg{pool} || 'Scratch';
 226
 227     my $cmd = "label barcodes drive=$arg{drive} pool=\"$arg{pool}\" storage=\"$arg{storage}\"";
 228
 229     if ($arg{slots}) {
 230         $cmd .= " slots=$arg{slots}";
 231     }
 232
 233     $self->send("$cmd\n");
 234     $self->expect_it('-re', '[?].+\).*:');
 235     my $res = $self->before();
 236     $self->send("yes\n");
 237     $self->expect_it("yes");
 238     $res .= $self->before();
 239     $self->expect_it('-re',qr/^[*]/);
 240     $res .= $self->before();
 241     return $res;
 242 }
 243
 244 #
 245 # return [ { name => 'test1', vol => '00001', ... },
 246 #          { name => 'test2', vol => '00002', ... }... ]
 247 #
 248 sub director_get_sched
 249 {
 250     my ($self, $days) = @_ ;
 251
 252     $days = $days || 1;
 253
 254     unless ($self->connect()) {
 255         return '';
 256     }
 257
 258     my $status = $self->send_cmd("st director days=$days") ;
 259
 260     my @ret;
 261     foreach my $l (split(/\r?\n/, $status)) {
 262         #Level          Type     Pri  Scheduled        Name       Volume
 263         #Incremental    Backup    11  03-ao-06 23:05  TEST_DATA  000001
 264         if ($l =~ /^(I|F|Di)\w+\s+\w+\s+\d+/i) {
 265             my ($level, $type, $pri, $d, $h, @name_vol) = split(/\s+/, $l);
 266
 267             my $vol = pop @name_vol; # last element
 268             my $name = join(" ", @name_vol); # can contains space
 269
 270             push @ret, {
 271                 level => $level,
 272                 type  => $type,
 273                 priority => $pri,
 274                 date  => "$d $h",
 275                 name  => $name,
 276                 volume => $vol,
 277             };
 278         }
 279
 280     }
 281     return \@ret;
 282 }
 283
 284 sub update_slots
 285 {
 286     my ($self, $storage, $drive) = @_;
 287     $drive = $drive || 0;
 288
 289     return $self->send_cmd("update slots storage=$storage drive=$drive");
 290 }
 291
 292 sub get_fileset
 293 {
 294     my ($self, $fs) = @_;
 295
 296     my $out = $self->send_cmd("show fileset=\"$fs\"");
 297
 298     my $ret = {};
 299
 300     foreach my $l (split(/\r\n/, $out)) {
 301         #              I /usr/local
 302         if ($l =~ /^\s+([I|E])\s+(.+)$/) { # include
 303             push @{$ret->{$1}}, { file => $2 };
 304         }
 305     }
 306
 307     return $ret;
 308 }
 309
 310 sub list_job
 311 {
 312     my ($self) = @_;
 313     return split(/\r\n/, $self->send_cmd(".jobs"));
 314 }
 315
 316 sub list_fileset
 317 {
 318     my ($self) = @_;
 319     return split(/\r\n/, $self->send_cmd(".filesets"));
 320 }
 321
 322 sub list_storage
 323 {
 324     my ($self) = @_;
 325     return split(/\r\n/, $self->send_cmd(".storage"));
 326 }
 327
 328 sub list_client
 329 {
 330     my ($self) = @_;
 331     return split(/\r\n/, $self->send_cmd(".clients"));
 332 }
 333
 334 sub list_pool
 335 {
 336     my ($self) = @_;
 337     return split(/\r\n/, $self->send_cmd(".pools"));
 338 }
 339
 340 use Time::ParseDate qw/parsedate/;
 341 use POSIX qw/strftime/;
 342 use Data::Dumper;
 343
 344 sub _get_volume
 345 {
 346     my ($self, @volume) = @_;
 347     return '' unless (@volume);
 348
 349     my $sel='';
 350     foreach my $vol (@volume) {
 351         if ($vol =~ /^([\w\d\.-]+)$/) {
 352             $sel .= " volume=$1";
 353
 354         } else {
 355             $self->{error} = "Sorry media is bad";
 356             return '';
 357         }
 358     }
 359
 360     return $sel;
 361 }
 362
 363 sub purge_volume
 364 {
 365     my ($self, @volume) = @_;
 366
 367     my $sel = $self->_get_volume(@volume);
 368     my $ret;
 369     if ($sel) {
 370         $ret = $self->send_cmd("purge $sel");
 371     } else {
 372         $ret = $self->{error};
 373     }
 374     return $ret;
 375 }
 376
 377 sub prune_volume
 378 {
 379     my ($self, @volume) = @_;
 380
 381     my $sel = $self->_get_volume(@volume);
 382     my $ret;
 383     if ($sel) {
 384         $ret = $self->send_cmd("prune $sel yes");
 385     } else {
 386         $ret = $self->{error};
 387     }
 388     return $ret;
 389 }
 390
 391 sub purge_job
 392 {
 393     my ($self, @jobid) = @_;
 394
 395     return 0 unless (@jobid);
 396
 397     my $sel='';
 398     foreach my $job (@jobid) {
 399         if ($job =~ /^(\d+)$/) {
 400             $sel .= " jobid=$1";
 401
 402         } else {
 403             $self->{error} = "Sorry jobid is bad";
 404             return 0;
 405         }
 406     }
 407
 408     $self->send_cmd("purge $sel");
 409 }
 410
 411 sub close
 412 {
 413     my ($self) = @_;
 414     $self->send("quit\n");
 415     $self->{bconsole}->soft_close();
 416     $self->{bconsole} = undef;
 417 }
 418
 419 1;
 420
 421 __END__
 422
 423 # to use this
 424 # grep -v __END__ Bconsole.pm | perl
 425
 426 package main;
 427
 428 print "test sans conio\n";
 429
 430 my $c = new Bconsole(pref => {
 431     bconsole => '/tmp/bacula/sbin/bconsole -n -c /tmp/bacula/etc/bconsole.conf',
 432 },
 433                      debug => 0);
 434
 435 print "fileset : ", join(',', $c->list_fileset()), "\n";
 436 print "job : ",     join(',', $c->list_job()), "\n";
 437 print "storage : ", join(',', $c->list_storage()), "\n";
 438 #print "prune : " . $c->prune_volume('000001'), "\n";
 439 #print "update : " . $c->send_cmd('update slots storage=SDLT-1-2, drive=0'), "\n";
 440 #print "label : ", join(',', $c->label_barcodes(storage => 'SDLT-1-2',
 441 #                                              slots => 6,
 442 #                                              drive => 0)), "\n";
 443
 444