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 sub list_pool
 305 {
 306     my ($self) = @_;
 307     return split(/\r\n/, $self->send_cmd(".pools"));
 308 }
 309
 310 use Time::ParseDate qw/parsedate/;
 311 use POSIX qw/strftime/;
 312 use Data::Dumper;
 313
 314 sub _get_volume
 315 {
 316     my ($self, @volume) = @_;
 317     return '' unless (@volume);
 318
 319     my $sel='';
 320     foreach my $vol (@volume) {
 321         if ($vol =~ /^([\w\d\.-]+)$/) {
 322             $sel .= " volume=$1";
 323
 324         } else {
 325             $self->{error} = "Sorry media is bad";
 326             return '';
 327         }
 328     }
 329
 330     return $sel;
 331 }
 332
 333 sub purge_volume
 334 {
 335     my ($self, @volume) = @_;
 336
 337     my $sel = $self->_get_volume(@volume);
 338     my $ret;
 339     if ($sel) {
 340         $ret = $self->send_cmd("purge $sel");
 341     } else {
 342         $ret = $self->{error};
 343     }
 344     return $ret;
 345 }
 346
 347 sub prune_volume
 348 {
 349     my ($self, @volume) = @_;
 350
 351     my $sel = $self->_get_volume(@volume);
 352     my $ret;
 353     if ($sel) {
 354         $ret = $self->send_cmd_yes("prune $sel");
 355     } else {
 356         $ret = $self->{error};
 357     }
 358     return $ret;
 359 }
 360
 361 sub purge_job
 362 {
 363     my ($self, @jobid) = @_;
 364
 365     return 0 unless (@jobid);
 366
 367     my $sel='';
 368     foreach my $job (@jobid) {
 369         if ($job =~ /^(\d+)$/) {
 370             $sel .= " jobid=$1";
 371
 372         } else {
 373             $self->{error} = "Sorry jobid is bad";
 374             return 0;
 375         }
 376     }
 377
 378     $self->send_cmd("purge $sel");
 379 }
 380
 381 sub close
 382 {
 383     my ($self) = @_;
 384     $self->send("quit\n");
 385     $self->{bconsole}->soft_close();
 386     $self->{bconsole} = undef;
 387 }
 388
 389 1;
 390
 391 __END__
 392
 393 # to use this
 394 # grep -v __END__ Bconsole.pm | perl
 395
 396 package main;
 397
 398 print "test sans conio\n";
 399
 400 my $c = new Bconsole(pref => {
 401     bconsole => '/tmp/bacula/sbin/bconsole -n -c /tmp/bacula/etc/bconsole.conf',
 402 },
 403                      debug => 0);
 404
 405 print "fileset : ", join(',', $c->list_fileset()), "\n";
 406 print "job : ",     join(',', $c->list_job()), "\n";
 407 print "storage : ", join(',', $c->list_storage()), "\n";
 408 #print "prune : " . $c->prune_volume('000001'), "\n";
 409 #print "update : " . $c->send_cmd_with_drive('update slots storage=SDLT-1-2'), "\n";
 410 #print "label : ", join(',', $c->label_barcodes(storage => 'SDLT-1-2',
 411 #                                              slots => 6,
 412 #                                              drive => 0)), "\n";
 413
 414