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