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','^[*]');
  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(1);
 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->{bconsole}->clear_accum();
 206     $self->send("$cmd\n");
 207     $self->expect_it('-re','^[*]');
 208     return $self->before();
 209 }
 210
 211 sub send_cmd_yes
 212 {
 213     my ($self, $cmd) = @_;
 214     unless ($self->connect()) {
 215         return '';
 216     }
 217     $self->send("$cmd\n");
 218     $self->expect_it('-re', '[?].+:');
 219
 220     $self->send_cmd("yes");
 221     return $self->before();
 222 }
 223
 224 sub label_barcodes
 225 {
 226     my ($self, %arg) = @_;
 227
 228     unless ($arg{storage}) {
 229         return '';
 230     }
 231
 232     unless ($self->connect()) {
 233         return '';
 234     }
 235
 236     $arg{drive} = $arg{drive} || '0' ;
 237     $arg{pool} = $arg{pool} || 'Scratch';
 238
 239     my $cmd = "label barcodes drive=$arg{drive} pool=\"$arg{pool}\" storage=\"$arg{storage}\"";
 240
 241     if ($arg{slots}) {
 242         $cmd .= " slots=$arg{slots}";
 243     }
 244
 245     $self->send("$cmd\n");
 246     $self->expect_it('-re', '[?].+\).*:');
 247     my $res = $self->before();
 248     $self->send("yes\n");
 249 #    $self->expect_it("yes");
 250 #    $res .= $self->before();
 251     $self->expect_it('-re','^[*]');
 252     $res .= $self->before();
 253     return $res;
 254 }
 255
 256 #
 257 # return [ { name => 'test1', vol => '00001', ... },
 258 #          { name => 'test2', vol => '00002', ... }... ]
 259 #
 260 sub director_get_sched
 261 {
 262     my ($self, $days) = @_ ;
 263
 264     $days = $days || 1;
 265
 266     unless ($self->connect()) {
 267         return '';
 268     }
 269
 270     my $status = $self->send_cmd("st director days=$days") ;
 271
 272     my @ret;
 273     foreach my $l (split(/\r?\n/, $status)) {
 274         #Level          Type     Pri  Scheduled        Name       Volume
 275         #Incremental    Backup    11  03-ao-06 23:05  TEST_DATA  000001
 276         if ($l =~ /^(I|F|Di)\w+\s+\w+\s+\d+/i) {
 277             my ($level, $type, $pri, $d, $h, @name_vol) = split(/\s+/, $l);
 278
 279             my $vol = pop @name_vol; # last element
 280             my $name = join(" ", @name_vol); # can contains space
 281
 282             push @ret, {
 283                 level => $level,
 284                 type  => $type,
 285                 priority => $pri,
 286                 date  => "$d $h",
 287                 name  => $name,
 288                 volume => $vol,
 289             };
 290         }
 291
 292     }
 293     return \@ret;
 294 }
 295
 296 sub update_slots
 297 {
 298     my ($self, $storage, $drive) = @_;
 299     $drive = $drive || 0;
 300
 301     return $self->send_cmd("update slots storage=$storage drive=$drive");
 302 }
 303
 304 # Return:
 305 #$VAR1 = {
 306 #          'I' => [
 307 #                   {
 308 #                     'file' => '</tmp/regress/tmp/file-list'
 309 #                   },
 310 #                   {
 311 #                     'file' => '</tmp/regress/tmp/other-file-list'
 312 #                   }
 313 #                 ],
 314 #          'E' => [
 315 #                   {
 316 #                     'file' => '</tmp/regress/tmp/efile-list'
 317 #                   },
 318 #                   {
 319 #                     'file' => '</tmp/regress/tmp/other-efile-list'
 320 #                   }
 321 #                 ]
 322 #        };
 323 sub get_fileset
 324 {
 325     my ($self, $fs) = @_;
 326
 327     my $out = $self->send_cmd("show fileset=\"$fs\"");
 328
 329     my $ret = {};
 330
 331     foreach my $l (split(/\r?\n/, $out)) {
 332         #              I /usr/local
 333         if ($l =~ /^\s+([I|E])\s+(.+)$/) { # include
 334             push @{$ret->{$1}}, { file => $2 };
 335         }
 336     }
 337
 338     return $ret;
 339 }
 340
 341 sub list_job
 342 {
 343     my ($self) = @_;
 344     return sort split(/\r?\n/, $self->send_cmd(".jobs"));
 345 }
 346
 347 sub list_fileset
 348 {
 349     my ($self) = @_;
 350     return sort split(/\r?\n/, $self->send_cmd(".filesets"));
 351 }
 352
 353 sub list_storage
 354 {
 355     my ($self) = @_;
 356     return sort split(/\r?\n/, $self->send_cmd(".storage"));
 357 }
 358
 359 sub list_client
 360 {
 361     my ($self) = @_;
 362     return sort split(/\r?\n/, $self->send_cmd(".clients"));
 363 }
 364
 365 sub list_pool
 366 {
 367     my ($self) = @_;
 368     return sort split(/\r?\n/, $self->send_cmd(".pools"));
 369 }
 370
 371 use Time::ParseDate qw/parsedate/;
 372 use POSIX qw/strftime/;
 373 use Data::Dumper;
 374
 375 sub _get_volume
 376 {
 377     my ($self, @volume) = @_;
 378     return '' unless (@volume);
 379
 380     my $sel='';
 381     foreach my $vol (@volume) {
 382         if ($vol =~ /^([\w\d\.-]+)$/) {
 383             $sel .= " volume=$1";
 384
 385         } else {
 386             $self->error("Sorry media is bad");
 387             return '';
 388         }
 389     }
 390
 391     return $sel;
 392 }
 393
 394 sub purge_volume
 395 {
 396     my ($self, $volume) = @_;
 397
 398     my $sel = $self->_get_volume($volume);
 399     my $ret;
 400     if ($sel) {
 401         $ret = $self->send_cmd("purge $sel");
 402     } else {
 403         $ret = $self->{error};
 404     }
 405     return $ret;
 406 }
 407
 408 sub prune_volume
 409 {
 410     my ($self, $volume) = @_;
 411
 412     my $sel = $self->_get_volume($volume);
 413     my $ret;
 414     if ($sel) {
 415         $ret = $self->send_cmd("prune $sel yes");
 416     } else {
 417         $ret = $self->{error};
 418     }
 419     return $ret;
 420 }
 421
 422 sub purge_job
 423 {
 424     my ($self, @jobid) = @_;
 425
 426     return 0 unless (@jobid);
 427
 428     my $sel='';
 429     foreach my $job (@jobid) {
 430         if ($job =~ /^(\d+)$/) {
 431             $sel .= " jobid=$1";
 432
 433         } else {
 434             return $self->error("Sorry jobid is bad");
 435         }
 436     }
 437
 438     $self->send_cmd("purge $sel");
 439 }
 440
 441 sub close
 442 {
 443     my ($self) = @_;
 444     $self->send("quit\n");
 445     $self->{bconsole}->soft_close();
 446     $self->{bconsole} = undef;
 447 }
 448
 449 1;
 450
 451 __END__
 452
 453 # to use this
 454 # grep -v __END__ Bconsole.pm | perl
 455
 456 package main;
 457
 458 use Data::Dumper qw/Dumper/;
 459 print "test sans conio\n";
 460
 461 my $c = new Bconsole(pref => {
 462     bconsole => '/tmp/regress/bin/bconsole -n -c /tmp/regress/bin/bconsole.conf',
 463 },
 464                      debug => 0);
 465
 466 print "fileset : ", join(',', $c->list_fileset()), "\n";
 467 print "job : ",     join(',', $c->list_job()), "\n";
 468 print "storage : ", join(',', $c->list_storage()), "\n";
 469 my $r = $c->get_fileset($c->list_fileset());
 470 print Dumper($r);
 471 print "FS Include:\n", join (",", map { $_->{file} } @{$r->{I}}), "\n";
 472 print "FS Exclude:\n", join (",", map { $_->{file} } @{$r->{E}}), "\n";
 473 #print $c->label_barcodes(pool => 'Scratch', drive => 0, storage => 'LTO3', slots => '45');
 474 #print "prune : " . $c->prune_volume('000001'), "\n";
 475 #print "update : " . $c->send_cmd('update slots storage=SDLT-1-2, drive=0'), "\n";
 476 #print "label : ", join(',', $c->label_barcodes(storage => 'SDLT-1-2',
 477 #                                              slots => 6,
 478 #                                              drive => 0)), "\n";
 479
 480