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     my $go  = 'yes';
  70
  71     if ($arg{restore}) {
  72         $cmd = 'restore ';
  73         $go  = 'done yes';
  74         delete $arg{restore};
  75     }
  76
  77     for my $key (keys %arg) {
  78         if ($arg{$key}) {
  79             $arg{$key} =~ tr/""/  /;
  80             $cmd .= "$key=\"$arg{$key}\" ";
  81         }
  82     }
  83
  84     unless ($self->connect()) {
  85         return 0;
  86     }
  87
  88     print STDERR "===> $cmd $go\n";
  89     $self->{bconsole}->clear_accum();
  90     $self->send("$cmd $go\n");
  91     $self->expect_it('-re',qr/^[*]/);
  92     my $ret = $self->before();
  93     if ($ret =~ /jobid=(\d+)/is) {
  94         return $1;
  95     } else {
  96         return 0;
  97     }
  98 }
  99
 100 # for brestore.pl::BwebConsole
 101 sub prepare
 102 {
 103     # do nothing
 104 }
 105
 106 sub send
 107 {
 108     my ($self, $what) = @_;
 109     $self->{bconsole}->send($what);
 110 }
 111
 112 sub expect_it
 113 {
 114     my ($self, @what) = @_;
 115     unless ($self->{bconsole}->expect($self->{timeout}, @what)) {
 116         return $self->error($self->{bconsole}->error());
 117     }
 118     return 1;
 119 }
 120
 121 sub log_stdout
 122 {
 123     my ($self, $how) = @_;
 124
 125     if ($self->{bconsole}) {
 126        $self->{bconsole}->log_stdout($how);
 127     }
 128
 129     $self->{log_stdout} = $how;
 130 }
 131
 132 sub error
 133 {
 134     my ($self, $error) = @_;
 135     $self->{error} = $error;
 136     if ($error) {
 137         print STDERR "E: bconsole (", $self->{pref}->{bconsole}, ") $! $error\n";
 138     }
 139     return 0;
 140 }
 141
 142 sub connect
 143 {
 144     my ($self) = @_;
 145
 146     if ($self->{error}) {
 147         return 0 ;
 148     }
 149
 150     unless ($self->{bconsole}) {
 151         my @cmd = split(/\s+/, $self->{pref}->{bconsole}) ;
 152         unless (@cmd) {
 153             return $self->error("bconsole string not found");
 154         }
 155         $self->{bconsole} = new Expect;
 156         $self->{bconsole}->raw_pty(0);
 157         $self->{bconsole}->debug($self->{debug});
 158         $self->{bconsole}->log_stdout($self->{debug} || $self->{log_stdout});
 159
 160         # WARNING : die is trapped by gtk_main_loop()
 161         # and exit() closes DBI connection
 162         my $ret;
 163         {
 164             my $sav = $SIG{__DIE__};
 165             $SIG{__DIE__} = sub {  _exit 1 ;};
 166             my $old = $ENV{COLUMNS};
 167             $ENV{COLUMNS} = 300;
 168             $ret = $self->{bconsole}->spawn(@cmd) ;
 169             delete $ENV{COLUMNS};
 170             $ENV{COLUMNS} = $old if ($old) ;
 171             $SIG{__DIE__} = $sav;
 172         }
 173
 174         unless ($ret) {
 175             return $self->error($self->{bconsole}->error());
 176         }
 177
 178         # TODO : we must verify that expect return the good value
 179
 180         $self->expect_it('*');
 181         $self->send_cmd('gui on');
 182     }
 183     return 1 ;
 184 }
 185
 186 sub cancel
 187 {
 188     my ($self, $jobid) = @_;
 189     return $self->send_cmd("cancel jobid=$jobid");
 190 }
 191
 192 # get text between to expect
 193 sub before
 194 {
 195     my ($self) = @_;
 196     return $self->{bconsole}->before();
 197 }
 198
 199 sub send_cmd
 200 {
 201     my ($self, $cmd) = @_;
 202     unless ($self->connect()) {
 203         return '';
 204     }
 205     $self->send("$cmd\n");
 206     $self->expect_it($cmd);
 207     $self->{bconsole}->clear_accum();
 208     $self->expect_it('-re',qr/^[*]/);
 209     return $self->before();
 210 }
 211
 212 sub send_cmd_yes
 213 {
 214     my ($self, $cmd) = @_;
 215     unless ($self->connect()) {
 216         return '';
 217     }
 218     $self->send("$cmd\n");
 219     $self->expect_it('-re', '[?].+:');
 220
 221     $self->send("yes\n");
 222     $self->expect_it("yes");
 223     $self->{bconsole}->clear_accum();
 224     $self->expect_it('-re',qr/^[*]/);
 225     return $self->before();
 226 }
 227
 228 sub label_barcodes
 229 {
 230     my ($self, %arg) = @_;
 231
 232     unless ($arg{storage}) {
 233         return '';
 234     }
 235
 236     unless ($self->connect()) {
 237         return '';
 238     }
 239
 240     $arg{drive} = $arg{drive} || '0' ;
 241     $arg{pool} = $arg{pool} || 'Scratch';
 242
 243     my $cmd = "label barcodes drive=$arg{drive} pool=\"$arg{pool}\" storage=\"$arg{storage}\"";
 244
 245     if ($arg{slots}) {
 246         $cmd .= " slots=$arg{slots}";
 247     }
 248
 249     $self->send("$cmd\n");
 250     $self->expect_it('-re', '[?].+\).*:');
 251     my $res = $self->before();
 252     $self->send("yes\n");
 253     $self->expect_it("yes");
 254     $res .= $self->before();
 255     $self->expect_it('-re',qr/^[*]/);
 256     $res .= $self->before();
 257     return $res;
 258 }
 259
 260 #
 261 # return [ { name => 'test1', vol => '00001', ... },
 262 #          { name => 'test2', vol => '00002', ... }... ]
 263 #
 264 sub director_get_sched
 265 {
 266     my ($self, $days) = @_ ;
 267
 268     $days = $days || 1;
 269
 270     unless ($self->connect()) {
 271         return '';
 272     }
 273
 274     my $status = $self->send_cmd("st director days=$days") ;
 275
 276     my @ret;
 277     foreach my $l (split(/\r?\n/, $status)) {
 278         #Level          Type     Pri  Scheduled        Name       Volume
 279         #Incremental    Backup    11  03-ao-06 23:05  TEST_DATA  000001
 280         if ($l =~ /^(I|F|Di)\w+\s+\w+\s+\d+/i) {
 281             my ($level, $type, $pri, $d, $h, @name_vol) = split(/\s+/, $l);
 282
 283             my $vol = pop @name_vol; # last element
 284             my $name = join(" ", @name_vol); # can contains space
 285
 286             push @ret, {
 287                 level => $level,
 288                 type  => $type,
 289                 priority => $pri,
 290                 date  => "$d $h",
 291                 name  => $name,
 292                 volume => $vol,
 293             };
 294         }
 295
 296     }
 297     return \@ret;
 298 }
 299
 300 sub update_slots
 301 {
 302     my ($self, $storage, $drive) = @_;
 303     $drive = $drive || 0;
 304
 305     return $self->send_cmd("update slots storage=$storage drive=$drive");
 306 }
 307
 308 sub get_fileset
 309 {
 310     my ($self, $fs) = @_;
 311
 312     my $out = $self->send_cmd("show fileset=\"$fs\"");
 313
 314     my $ret = {};
 315
 316     foreach my $l (split(/\r\n/, $out)) {
 317         #              I /usr/local
 318         if ($l =~ /^\s+([I|E])\s+(.+)$/) { # include
 319             push @{$ret->{$1}}, { file => $2 };
 320         }
 321     }
 322
 323     return $ret;
 324 }
 325
 326 sub list_job
 327 {
 328     my ($self) = @_;
 329     return split(/\r\n/, $self->send_cmd(".jobs"));
 330 }
 331
 332 sub list_fileset
 333 {
 334     my ($self) = @_;
 335     return split(/\r\n/, $self->send_cmd(".filesets"));
 336 }
 337
 338 sub list_storage
 339 {
 340     my ($self) = @_;
 341     return split(/\r\n/, $self->send_cmd(".storage"));
 342 }
 343
 344 sub list_client
 345 {
 346     my ($self) = @_;
 347     return split(/\r\n/, $self->send_cmd(".clients"));
 348 }
 349
 350 sub list_pool
 351 {
 352     my ($self) = @_;
 353     return split(/\r\n/, $self->send_cmd(".pools"));
 354 }
 355
 356 use Time::ParseDate qw/parsedate/;
 357 use POSIX qw/strftime/;
 358 use Data::Dumper;
 359
 360 sub _get_volume
 361 {
 362     my ($self, @volume) = @_;
 363     return '' unless (@volume);
 364
 365     my $sel='';
 366     foreach my $vol (@volume) {
 367         if ($vol =~ /^([\w\d\.-]+)$/) {
 368             $sel .= " volume=$1";
 369
 370         } else {
 371             $self->error("Sorry media is bad");
 372             return '';
 373         }
 374     }
 375
 376     return $sel;
 377 }
 378
 379 sub purge_volume
 380 {
 381     my ($self, $volume) = @_;
 382
 383     my $sel = $self->_get_volume($volume);
 384     my $ret;
 385     if ($sel) {
 386         $ret = $self->send_cmd("purge $sel");
 387     } else {
 388         $ret = $self->{error};
 389     }
 390     return $ret;
 391 }
 392
 393 sub prune_volume
 394 {
 395     my ($self, $volume) = @_;
 396
 397     my $sel = $self->_get_volume($volume);
 398     my $ret;
 399     if ($sel) {
 400         $ret = $self->send_cmd("prune $sel yes");
 401     } else {
 402         $ret = $self->{error};
 403     }
 404     return $ret;
 405 }
 406
 407 sub purge_job
 408 {
 409     my ($self, @jobid) = @_;
 410
 411     return 0 unless (@jobid);
 412
 413     my $sel='';
 414     foreach my $job (@jobid) {
 415         if ($job =~ /^(\d+)$/) {
 416             $sel .= " jobid=$1";
 417
 418         } else {
 419             return $self->error("Sorry jobid is bad");
 420         }
 421     }
 422
 423     $self->send_cmd("purge $sel");
 424 }
 425
 426 sub close
 427 {
 428     my ($self) = @_;
 429     $self->send("quit\n");
 430     $self->{bconsole}->soft_close();
 431     $self->{bconsole} = undef;
 432 }
 433
 434 1;
 435
 436 __END__
 437
 438 # to use this
 439 # grep -v __END__ Bconsole.pm | perl
 440
 441 package main;
 442
 443 print "test sans conio\n";
 444
 445 my $c = new Bconsole(pref => {
 446     bconsole => '/tmp/bacula/sbin/bconsole -n -c /tmp/bacula/etc/bconsole.conf',
 447 },
 448                      debug => 0);
 449
 450 print "fileset : ", join(',', $c->list_fileset()), "\n";
 451 print "job : ",     join(',', $c->list_job()), "\n";
 452 print "storage : ", join(',', $c->list_storage()), "\n";
 453 #print "prune : " . $c->prune_volume('000001'), "\n";
 454 #print "update : " . $c->send_cmd('update slots storage=SDLT-1-2, drive=0'), "\n";
 455 #print "label : ", join(',', $c->label_barcodes(storage => 'SDLT-1-2',
 456 #                                              slots => 6,
 457 #                                              drive => 0)), "\n";
 458
 459