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