git.sur5r.net Git - bacula/bacula/blob - gui/bweb/lib/Bconsole.pm

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