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