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