5 Bweb - A Bacula web interface
6 Bacula® - The Network Backup Solution
8 Copyright (C) 2000-2006 Free Software Foundation Europe e.V.
10 The main author of Bweb is Eric Bollengier.
11 The main author of Bacula is Kern Sibbald, with contributions from
12 many others, a complete list can be found in the file AUTHORS.
13 This program is Free Software; you can redistribute it and/or
14 modify it under the terms of version three of the GNU Affero General Public
15 License as published by the Free Software Foundation and included
18 This program is distributed in the hope that it will be useful, but
19 WITHOUT ANY WARRANTY; without even the implied warranty of
20 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 Affero General Public License for more details.
23 You should have received a copy of the GNU Affero General Public License
24 along with this program; if not, write to the Free Software
25 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
28 Bacula® is a registered trademark of Kern Sibbald.
29 The licensor of Bacula is the Free Software Foundation Europe
30 (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zürich,
31 Switzerland, email:ftf@fsfeurope.org.
40 ################################################################
41 # Manage with Expect the bconsole tool
46 # my $pref = new Pref(config_file => 'brestore.conf');
47 # my $bconsole = new Bconsole(pref => $pref);
50 my ($class, %arg) = @_;
53 pref => $arg{pref}, # Pref object
54 bconsole => undef, # Expect object
55 log_stdout => $arg{log_stdout} || 0,
56 timeout => $arg{timeout} || 20,
57 debug => $arg{debug} || 0,
65 my ($self, %arg) = @_;
76 for my $key (keys %arg) {
78 $arg{$key} =~ tr/""/ /;
79 $cmd .= "$key=\"$arg{$key}\" ";
83 unless ($self->connect()) {
87 print STDERR "===> $cmd $go\n";
88 $self->{bconsole}->clear_accum();
89 $self->send("$cmd $go\n");
90 $self->expect_it('-re','^[*]');
91 my $ret = $self->before();
92 if ($ret =~ /jobid=(\d+)/is) {
99 # for brestore.pl::BwebConsole
107 my ($self, $what) = @_;
108 $self->{bconsole}->send($what);
113 my ($self, @what) = @_;
114 unless ($self->{bconsole}->expect($self->{timeout}, @what)) {
115 return $self->error($self->{bconsole}->error());
122 my ($self, $how) = @_;
124 if ($self->{bconsole}) {
125 $self->{bconsole}->log_stdout($how);
128 $self->{log_stdout} = $how;
133 my ($self, $error) = @_;
134 $self->{error} = $error;
136 print STDERR "E: bconsole (", $self->{pref}->{bconsole}, ") $! $error\n";
145 if ($self->{error}) {
149 unless ($self->{bconsole}) {
150 my @cmd = split(/\s+/, $self->{pref}->{bconsole}) ;
152 return $self->error("bconsole string not found");
154 $self->{bconsole} = new Expect;
155 $self->{bconsole}->raw_pty(1);
156 $self->{bconsole}->debug($self->{debug});
157 $self->{bconsole}->log_stdout($self->{debug} || $self->{log_stdout});
159 # WARNING : die is trapped by gtk_main_loop()
160 # and exit() closes DBI connection
163 my $sav = $SIG{__DIE__};
164 $SIG{__DIE__} = sub { _exit 1 ;};
165 my $old = $ENV{COLUMNS};
167 $ret = $self->{bconsole}->spawn(@cmd) ;
168 delete $ENV{COLUMNS};
169 $ENV{COLUMNS} = $old if ($old) ;
170 $SIG{__DIE__} = $sav;
174 return $self->error($self->{bconsole}->error());
177 # TODO : we must verify that expect return the good value
179 $self->expect_it('*');
180 $self->send_cmd('gui on');
187 my ($self, $jobid) = @_;
188 return $self->send_cmd("cancel jobid=$jobid");
191 # get text between to expect
195 return $self->{bconsole}->before();
200 my ($self, $cmd) = @_;
201 unless ($self->connect()) {
204 $self->{bconsole}->clear_accum();
205 $self->send("$cmd\n");
206 $self->expect_it('-re','^[*]');
207 return $self->before();
212 my ($self, $cmd) = @_;
213 unless ($self->connect()) {
216 $self->send("$cmd\n");
217 $self->expect_it('-re', '[?].+:');
219 $self->send_cmd("yes");
220 return $self->before();
225 my ($self, %arg) = @_;
227 unless ($arg{storage}) {
231 unless ($self->connect()) {
235 $arg{drive} = $arg{drive} || '0' ;
236 $arg{pool} = $arg{pool} || 'Scratch';
238 my $cmd = "label barcodes drive=$arg{drive} pool=\"$arg{pool}\" storage=\"$arg{storage}\"";
241 $cmd .= " slots=$arg{slots}";
244 $self->send("$cmd\n");
245 $self->expect_it('-re', '[?].+\).*:');
246 my $res = $self->before();
247 $self->send("yes\n");
248 # $self->expect_it("yes");
249 # $res .= $self->before();
250 $self->expect_it('-re','^[*]');
251 $res .= $self->before();
256 # return [ { name => 'test1', vol => '00001', ... },
257 # { name => 'test2', vol => '00002', ... }... ]
259 sub director_get_sched
261 my ($self, $days) = @_ ;
265 unless ($self->connect()) {
269 my $status = $self->send_cmd("st director days=$days") ;
272 foreach my $l (split(/\r?\n/, $status)) {
273 #Level Type Pri Scheduled Name Volume
274 #Incremental Backup 11 03-ao-06 23:05 TEST_DATA 000001
275 if ($l =~ /^(I|F|Di)\w+\s+\w+\s+\d+/i) {
276 my ($level, $type, $pri, $d, $h, @name_vol) = split(/\s+/, $l);
278 my $vol = pop @name_vol; # last element
279 my $name = join(" ", @name_vol); # can contains space
297 my ($self, $storage, $drive) = @_;
298 $drive = $drive || 0;
300 return $self->send_cmd("update slots storage=$storage drive=$drive");
307 # 'file' => '</tmp/regress/tmp/file-list'
310 # 'file' => '</tmp/regress/tmp/other-file-list'
315 # 'file' => '</tmp/regress/tmp/efile-list'
318 # 'file' => '</tmp/regress/tmp/other-efile-list'
324 my ($self, $fs) = @_;
326 my $out = $self->send_cmd("show fileset=\"$fs\"");
330 foreach my $l (split(/\r?\n/, $out)) {
332 if ($l =~ /^\s+([I|E])\s+(.+)$/) { # include
333 push @{$ret->{$1}}, { file => $2 };
343 return sort split(/\r?\n/, $self->send_cmd(".jobs type=B"));
349 return sort split(/\r?\n/, $self->send_cmd(".jobs type=R"));
355 return sort split(/\r?\n/, $self->send_cmd(".jobs"));
361 return sort split(/\r?\n/, $self->send_cmd(".filesets"));
367 return sort split(/\r?\n/, $self->send_cmd(".storage"));
373 return sort split(/\r?\n/, $self->send_cmd(".clients"));
379 return sort split(/\r?\n/, $self->send_cmd(".pools"));
382 use Time::ParseDate qw/parsedate/;
383 use POSIX qw/strftime/;
388 my ($self, @volume) = @_;
389 return '' unless (@volume);
392 foreach my $vol (@volume) {
393 if ($vol =~ /^([\w\d\.-]+)$/) {
394 $sel .= " volume=$1";
397 $self->error("Sorry media is bad");
407 my ($self, $volume) = @_;
409 my $sel = $self->_get_volume($volume);
412 $ret = $self->send_cmd("purge $sel");
414 $ret = $self->{error};
421 my ($self, $volume) = @_;
423 my $sel = $self->_get_volume($volume);
426 $ret = $self->send_cmd("prune $sel yes");
428 $ret = $self->{error};
435 my ($self, @jobid) = @_;
437 return 0 unless (@jobid);
440 foreach my $job (@jobid) {
441 if ($job =~ /^(\d+)$/) {
445 return $self->error("Sorry jobid is bad");
449 $self->send_cmd("purge $sel");
455 $self->send("quit\n");
456 $self->{bconsole}->soft_close();
457 $self->{bconsole} = undef;
465 # grep -v __END__ Bconsole.pm | perl
469 use Data::Dumper qw/Dumper/;
470 print "test sans conio\n";
472 my $c = new Bconsole(pref => {
473 bconsole => '/tmp/regress/bin/bconsole -n -c /tmp/regress/bin/bconsole.conf',
477 print "fileset : ", join(',', $c->list_fileset()), "\n";
478 print "job : ", join(',', $c->list_job()), "\n";
479 print "storage : ", join(',', $c->list_storage()), "\n";
480 my $r = $c->get_fileset($c->list_fileset());
482 print "FS Include:\n", join (",", map { $_->{file} } @{$r->{I}}), "\n";
483 print "FS Exclude:\n", join (",", map { $_->{file} } @{$r->{E}}), "\n";
484 #print $c->label_barcodes(pool => 'Scratch', drive => 0, storage => 'LTO3', slots => '45');
485 #print "prune : " . $c->prune_volume('000001'), "\n";
486 #print "update : " . $c->send_cmd('update slots storage=SDLT-1-2, drive=0'), "\n";
487 #print "label : ", join(',', $c->label_barcodes(storage => 'SDLT-1-2',
489 # drive => 0)), "\n";