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 "=> $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 label_barcodes
 193 {
 194     my ($self, %arg) = @_;
 195
 196     unless ($arg{storage}) {
 197         return '';
 198     }
 199
 200     unless ($self->connect()) {
 201         return '';
 202     }
 203
 204     $arg{drive} = $arg{drive} || '0' ;
 205     $arg{pool} = $arg{pool} || 'Scratch';
 206
 207     my $cmd = "label barcodes drive=$arg{drive} pool=\"$arg{pool}\" storage=\"$arg{storage}\"";
 208
 209     if ($arg{slots}) {
 210         $cmd .= " slots=$arg{slots}";
 211     }
 212
 213     $self->send("$cmd\n");
 214     $self->expect_it('-re', '[?].+\)\s*:');
 215     my $res = $self->before();
 216     $self->send("yes\n");
 217     $self->expect_it("yes");
 218     $res .= $self->before();
 219     $self->expect_it('-re',qr/^[*]/);
 220     $res .= $self->before();
 221     return $res;
 222 }
 223
 224 #
 225 # return [ { name => 'test1', vol => '00001', ... },
 226 #          { name => 'test2', vol => '00002', ... }... ]
 227 #
 228 sub director_get_sched
 229 {
 230     my ($self, $days) = @_ ;
 231
 232     $days = $days || 1;
 233
 234     unless ($self->connect()) {
 235         return '';
 236     }
 237
 238     my $status = $self->send_cmd("st director days=$days") ;
 239
 240     my @ret;
 241     foreach my $l (split(/\r?\n/, $status)) {
 242         #Level          Type     Pri  Scheduled        Name       Volume
 243         #Incremental    Backup    11  03-ao-06 23:05  TEST_DATA  000001
 244         if ($l =~ /^(I|F|Di)\w+\s+\w+\s+\d+/i) {
 245             my ($level, $type, $pri, $d, $h, @name_vol) = split(/\s+/, $l);
 246
 247             my $vol = pop @name_vol; # last element
 248             my $name = join(" ", @name_vol); # can contains space
 249
 250             push @ret, {
 251                 level => $level,
 252                 type  => $type,
 253                 priority => $pri,
 254                 date  => "$d $h",
 255                 name  => $name,
 256                 volume => $vol,
 257             };
 258         }
 259
 260     }
 261     return \@ret;
 262 }
 263
 264 sub update_slots
 265 {
 266     my ($self, $storage, $drive) = @_;
 267     $drive = $drive || 0;
 268
 269     return $self->send_cmd("update slots storage=$storage drive=$drive");
 270 }
 271
 272 sub get_fileset
 273 {
 274     my ($self, $fs) = @_;
 275
 276     my $out = $self->send_cmd("show fileset=\"$fs\"");
 277
 278     my $ret = {};
 279
 280     foreach my $l (split(/\r\n/, $out)) {
 281         #              I /usr/local
 282         if ($l =~ /^\s+([I|E])\s+(.+)$/) { # include
 283             push @{$ret->{$1}}, { file => $2 };
 284         }
 285     }
 286
 287     return $ret;
 288 }
 289
 290 sub list_job
 291 {
 292     my ($self) = @_;
 293     return split(/\r\n/, $self->send_cmd(".jobs"));
 294 }
 295
 296 sub list_fileset
 297 {
 298     my ($self) = @_;
 299     return split(/\r\n/, $self->send_cmd(".filesets"));
 300 }
 301
 302 sub list_storage
 303 {
 304     my ($self) = @_;
 305     return split(/\r\n/, $self->send_cmd(".storage"));
 306 }
 307
 308 sub list_client
 309 {
 310     my ($self) = @_;
 311     return split(/\r\n/, $self->send_cmd(".clients"));
 312 }
 313
 314 sub list_pool
 315 {
 316     my ($self) = @_;
 317     return split(/\r\n/, $self->send_cmd(".pools"));
 318 }
 319
 320 use Time::ParseDate qw/parsedate/;
 321 use POSIX qw/strftime/;
 322 use Data::Dumper;
 323
 324 sub _get_volume
 325 {
 326     my ($self, @volume) = @_;
 327     return '' unless (@volume);
 328
 329     my $sel='';
 330     foreach my $vol (@volume) {
 331         if ($vol =~ /^([\w\d\.-]+)$/) {
 332             $sel .= " volume=$1";
 333
 334         } else {
 335             $self->{error} = "Sorry media is bad";
 336             return '';
 337         }
 338     }
 339
 340     return $sel;
 341 }
 342
 343 sub purge_volume
 344 {
 345     my ($self, @volume) = @_;
 346
 347     my $sel = $self->_get_volume(@volume);
 348     my $ret;
 349     if ($sel) {
 350         $ret = $self->send_cmd("purge $sel");
 351     } else {
 352         $ret = $self->{error};
 353     }
 354     return $ret;
 355 }
 356
 357 sub prune_volume
 358 {
 359     my ($self, @volume) = @_;
 360
 361     my $sel = $self->_get_volume(@volume);
 362     my $ret;
 363     if ($sel) {
 364         $ret = $self->send_cmd_yes("prune $sel");
 365     } else {
 366         $ret = $self->{error};
 367     }
 368     return $ret;
 369 }
 370
 371 sub purge_job
 372 {
 373     my ($self, @jobid) = @_;
 374
 375     return 0 unless (@jobid);
 376
 377     my $sel='';
 378     foreach my $job (@jobid) {
 379         if ($job =~ /^(\d+)$/) {
 380             $sel .= " jobid=$1";
 381
 382         } else {
 383             $self->{error} = "Sorry jobid is bad";
 384             return 0;
 385         }
 386     }
 387
 388     $self->send_cmd("purge $sel");
 389 }
 390
 391 sub close
 392 {
 393     my ($self) = @_;
 394     $self->send("quit\n");
 395     $self->{bconsole}->soft_close();
 396     $self->{bconsole} = undef;
 397 }
 398
 399 1;
 400
 401 __END__
 402
 403 # to use this
 404 # grep -v __END__ Bconsole.pm | perl
 405
 406 package main;
 407
 408 print "test sans conio\n";
 409
 410 my $c = new Bconsole(pref => {
 411     bconsole => '/tmp/bacula/sbin/bconsole -n -c /tmp/bacula/etc/bconsole.conf',
 412 },
 413                      debug => 0);
 414
 415 print "fileset : ", join(',', $c->list_fileset()), "\n";
 416 print "job : ",     join(',', $c->list_job()), "\n";
 417 print "storage : ", join(',', $c->list_storage()), "\n";
 418 #print "prune : " . $c->prune_volume('000001'), "\n";
 419 #print "update : " . $c->send_cmd('update slots storage=SDLT-1-2, drive=0'), "\n";
 420 #print "label : ", join(',', $c->label_barcodes(storage => 'SDLT-1-2',
 421 #                                              slots => 6,
 422 #                                              drive => 0)), "\n";
 423
 424