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