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