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.
14 This program is Free Software; you can redistribute it and/or
15 modify it under the terms of version two of the GNU General Public
16 License as published by the Free Software Foundation plus additions
17 that are listed in the file LICENSE.
19 This program is distributed in the hope that it will be useful, but
20 WITHOUT ANY WARRANTY; without even the implied warranty of
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 General Public License for more details.
24 You should have received a copy of the GNU General Public License
25 along with this program; if not, write to the Free Software
26 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
29 Bacula® is a registered trademark of John Walker.
30 The licensor of Bacula is the Free Software Foundation Europe
31 (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
32 Switzerland, email:ftf@fsfeurope.org.
41 ################################################################
42 # Manage with Expect the bconsole tool
47 # my $pref = new Pref(config_file => 'brestore.conf');
48 # my $bconsole = new Bconsole(pref => $pref);
51 my ($class, %arg) = @_;
54 pref => $arg{pref}, # Pref object
55 bconsole => undef, # Expect object
56 log_stdout => $arg{log_stdout} || 0,
57 timeout => $arg{timeout} || 20,
58 debug => $arg{debug} || 0,
66 my ($self, %arg) = @_;
69 for my $key (keys %arg) {
71 $arg{$key} =~ tr/""/ /;
72 $cmd .= "$key=\"$arg{$key}\" ";
76 unless ($self->connect()) {
80 print STDERR "===> $cmd yes\n";
81 $self->{bconsole}->clear_accum();
82 $self->send("$cmd yes\n");
83 $self->expect_it('-re',qr/^[*]/);
84 my $ret = $self->before();
85 if ($ret =~ /jobid=(\d+)/is) {
92 # for brestore.pl::BwebConsole
100 my ($self, $what) = @_;
101 $self->{bconsole}->send($what);
106 my ($self, @what) = @_;
107 unless ($self->{bconsole}->expect($self->{timeout}, @what)) {
108 return $self->error($self->{bconsole}->error());
115 my ($self, $how) = @_;
117 if ($self->{bconsole}) {
118 $self->{bconsole}->log_stdout($how);
121 $self->{log_stdout} = $how;
126 my ($self, $error) = @_;
127 $self->{error} = $error;
129 print STDERR "E: bconsole (", $self->{pref}->{bconsole}, ") $! $error\n";
138 if ($self->{error}) {
142 unless ($self->{bconsole}) {
143 my @cmd = split(/\s+/, $self->{pref}->{bconsole}) ;
145 return $self->error("bconsole string not found");
147 $self->{bconsole} = new Expect;
148 $self->{bconsole}->raw_pty(0);
149 $self->{bconsole}->debug($self->{debug});
150 $self->{bconsole}->log_stdout($self->{debug} || $self->{log_stdout});
152 # WARNING : die is trapped by gtk_main_loop()
153 # and exit() closes DBI connection
156 my $sav = $SIG{__DIE__};
157 $SIG{__DIE__} = sub { _exit 1 ;};
158 my $old = $ENV{COLUMNS};
160 $ret = $self->{bconsole}->spawn(@cmd) ;
161 delete $ENV{COLUMNS};
162 $ENV{COLUMNS} = $old if ($old) ;
163 $SIG{__DIE__} = $sav;
167 return $self->error($self->{bconsole}->error());
170 # TODO : we must verify that expect return the good value
172 $self->expect_it('*');
173 $self->send_cmd('gui on');
180 my ($self, $jobid) = @_;
181 return $self->send_cmd("cancel jobid=$jobid");
184 # get text between to expect
188 return $self->{bconsole}->before();
193 my ($self, $cmd) = @_;
194 unless ($self->connect()) {
197 $self->send("$cmd\n");
198 $self->expect_it($cmd);
199 $self->{bconsole}->clear_accum();
200 $self->expect_it('-re',qr/^[*]/);
201 return $self->before();
206 my ($self, $cmd) = @_;
207 unless ($self->connect()) {
210 $self->send("$cmd\n");
211 $self->expect_it('-re', '[?].+:');
213 $self->send("yes\n");
214 $self->expect_it("yes");
215 $self->{bconsole}->clear_accum();
216 $self->expect_it('-re',qr/^[*]/);
217 return $self->before();
222 my ($self, %arg) = @_;
224 unless ($arg{storage}) {
228 unless ($self->connect()) {
232 $arg{drive} = $arg{drive} || '0' ;
233 $arg{pool} = $arg{pool} || 'Scratch';
235 my $cmd = "label barcodes drive=$arg{drive} pool=\"$arg{pool}\" storage=\"$arg{storage}\"";
238 $cmd .= " slots=$arg{slots}";
241 $self->send("$cmd\n");
242 $self->expect_it('-re', '[?].+\).*:');
243 my $res = $self->before();
244 $self->send("yes\n");
245 $self->expect_it("yes");
246 $res .= $self->before();
247 $self->expect_it('-re',qr/^[*]/);
248 $res .= $self->before();
253 # return [ { name => 'test1', vol => '00001', ... },
254 # { name => 'test2', vol => '00002', ... }... ]
256 sub director_get_sched
258 my ($self, $days) = @_ ;
262 unless ($self->connect()) {
266 my $status = $self->send_cmd("st director days=$days") ;
269 foreach my $l (split(/\r?\n/, $status)) {
270 #Level Type Pri Scheduled Name Volume
271 #Incremental Backup 11 03-ao-06 23:05 TEST_DATA 000001
272 if ($l =~ /^(I|F|Di)\w+\s+\w+\s+\d+/i) {
273 my ($level, $type, $pri, $d, $h, @name_vol) = split(/\s+/, $l);
275 my $vol = pop @name_vol; # last element
276 my $name = join(" ", @name_vol); # can contains space
294 my ($self, $storage, $drive) = @_;
295 $drive = $drive || 0;
297 return $self->send_cmd("update slots storage=$storage drive=$drive");
302 my ($self, $fs) = @_;
304 my $out = $self->send_cmd("show fileset=\"$fs\"");
308 foreach my $l (split(/\r\n/, $out)) {
310 if ($l =~ /^\s+([I|E])\s+(.+)$/) { # include
311 push @{$ret->{$1}}, { file => $2 };
321 return split(/\r\n/, $self->send_cmd(".jobs"));
327 return split(/\r\n/, $self->send_cmd(".filesets"));
333 return split(/\r\n/, $self->send_cmd(".storage"));
339 return split(/\r\n/, $self->send_cmd(".clients"));
345 return split(/\r\n/, $self->send_cmd(".pools"));
348 use Time::ParseDate qw/parsedate/;
349 use POSIX qw/strftime/;
354 my ($self, @volume) = @_;
355 return '' unless (@volume);
358 foreach my $vol (@volume) {
359 if ($vol =~ /^([\w\d\.-]+)$/) {
360 $sel .= " volume=$1";
363 $self->error("Sorry media is bad");
373 my ($self, $volume) = @_;
375 my $sel = $self->_get_volume($volume);
378 $ret = $self->send_cmd("purge $sel");
380 $ret = $self->{error};
387 my ($self, $volume) = @_;
389 my $sel = $self->_get_volume($volume);
392 $ret = $self->send_cmd("prune $sel yes");
394 $ret = $self->{error};
401 my ($self, @jobid) = @_;
403 return 0 unless (@jobid);
406 foreach my $job (@jobid) {
407 if ($job =~ /^(\d+)$/) {
411 return $self->error("Sorry jobid is bad");
415 $self->send_cmd("purge $sel");
421 $self->send("quit\n");
422 $self->{bconsole}->soft_close();
423 $self->{bconsole} = undef;
431 # grep -v __END__ Bconsole.pm | perl
435 print "test sans conio\n";
437 my $c = new Bconsole(pref => {
438 bconsole => '/tmp/bacula/sbin/bconsole -n -c /tmp/bacula/etc/bconsole.conf',
442 print "fileset : ", join(',', $c->list_fileset()), "\n";
443 print "job : ", join(',', $c->list_job()), "\n";
444 print "storage : ", join(',', $c->list_storage()), "\n";
445 #print "prune : " . $c->prune_volume('000001'), "\n";
446 #print "update : " . $c->send_cmd('update slots storage=SDLT-1-2, drive=0'), "\n";
447 #print "label : ", join(',', $c->label_barcodes(storage => 'SDLT-1-2',
449 # drive => 0)), "\n";