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