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