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)) {
116 my ($self, $how) = @_;
118 if ($self->{bconsole}) {
119 $self->{bconsole}->log_stdout($how);
122 $self->{log_stdout} = $how;
129 if ($self->{error}) {
133 unless ($self->{bconsole}) {
134 my @cmd = split(/\s+/, $self->{pref}->{bconsole}) ;
136 $self->{error} = "bconsole string not found";
139 $self->{bconsole} = new Expect;
140 $self->{bconsole}->raw_pty(0);
141 $self->{bconsole}->debug($self->{debug});
142 $self->{bconsole}->log_stdout($self->{debug} || $self->{log_stdout});
144 # WARNING : die is trapped by gtk_main_loop()
145 # and exit() closes DBI connection
148 my $sav = $SIG{__DIE__};
149 $SIG{__DIE__} = sub { _exit 1 ;};
150 $ret = $self->{bconsole}->spawn(@cmd) ;
151 $SIG{__DIE__} = $sav;
159 # TODO : we must verify that expect return the good value
161 $self->expect_it('*');
162 $self->send_cmd('gui on');
169 my ($self, $jobid) = @_;
170 return $self->send_cmd("cancel jobid=$jobid");
173 # get text between to expect
177 return $self->{bconsole}->before();
182 my ($self, $cmd) = @_;
183 unless ($self->connect()) {
186 $self->send("$cmd\n");
187 $self->expect_it($cmd);
188 $self->{bconsole}->clear_accum();
189 $self->expect_it('-re',qr/^[*]/);
190 return $self->before();
195 my ($self, $cmd) = @_;
196 unless ($self->connect()) {
199 $self->send("$cmd\n");
200 $self->expect_it('-re', '[?].+:');
202 $self->send("yes\n");
203 $self->expect_it("yes");
204 $self->{bconsole}->clear_accum();
205 $self->expect_it('-re',qr/^[*]/);
206 return $self->before();
211 my ($self, %arg) = @_;
213 unless ($arg{storage}) {
217 unless ($self->connect()) {
221 $arg{drive} = $arg{drive} || '0' ;
222 $arg{pool} = $arg{pool} || 'Scratch';
224 my $cmd = "label barcodes drive=$arg{drive} pool=\"$arg{pool}\" storage=\"$arg{storage}\"";
227 $cmd .= " slots=$arg{slots}";
230 $self->send("$cmd\n");
231 $self->expect_it('-re', '[?].+\)\s*:');
232 my $res = $self->before();
233 $self->send("yes\n");
234 $self->expect_it("yes");
235 $res .= $self->before();
236 $self->expect_it('-re',qr/^[*]/);
237 $res .= $self->before();
242 # return [ { name => 'test1', vol => '00001', ... },
243 # { name => 'test2', vol => '00002', ... }... ]
245 sub director_get_sched
247 my ($self, $days) = @_ ;
251 unless ($self->connect()) {
255 my $status = $self->send_cmd("st director days=$days") ;
258 foreach my $l (split(/\r?\n/, $status)) {
259 #Level Type Pri Scheduled Name Volume
260 #Incremental Backup 11 03-ao-06 23:05 TEST_DATA 000001
261 if ($l =~ /^(I|F|Di)\w+\s+\w+\s+\d+/i) {
262 my ($level, $type, $pri, $d, $h, @name_vol) = split(/\s+/, $l);
264 my $vol = pop @name_vol; # last element
265 my $name = join(" ", @name_vol); # can contains space
283 my ($self, $storage, $drive) = @_;
284 $drive = $drive || 0;
286 return $self->send_cmd("update slots storage=$storage drive=$drive");
291 my ($self, $fs) = @_;
293 my $out = $self->send_cmd("show fileset=\"$fs\"");
297 foreach my $l (split(/\r\n/, $out)) {
299 if ($l =~ /^\s+([I|E])\s+(.+)$/) { # include
300 push @{$ret->{$1}}, { file => $2 };
310 return split(/\r\n/, $self->send_cmd(".jobs"));
316 return split(/\r\n/, $self->send_cmd(".filesets"));
322 return split(/\r\n/, $self->send_cmd(".storage"));
328 return split(/\r\n/, $self->send_cmd(".clients"));
334 return split(/\r\n/, $self->send_cmd(".pools"));
337 use Time::ParseDate qw/parsedate/;
338 use POSIX qw/strftime/;
343 my ($self, @volume) = @_;
344 return '' unless (@volume);
347 foreach my $vol (@volume) {
348 if ($vol =~ /^([\w\d\.-]+)$/) {
349 $sel .= " volume=$1";
352 $self->{error} = "Sorry media is bad";
362 my ($self, @volume) = @_;
364 my $sel = $self->_get_volume(@volume);
367 $ret = $self->send_cmd("purge $sel");
369 $ret = $self->{error};
376 my ($self, @volume) = @_;
378 my $sel = $self->_get_volume(@volume);
381 $ret = $self->send_cmd("prune $sel yes");
383 $ret = $self->{error};
390 my ($self, @jobid) = @_;
392 return 0 unless (@jobid);
395 foreach my $job (@jobid) {
396 if ($job =~ /^(\d+)$/) {
400 $self->{error} = "Sorry jobid is bad";
405 $self->send_cmd("purge $sel");
411 $self->send("quit\n");
412 $self->{bconsole}->soft_close();
413 $self->{bconsole} = undef;
421 # grep -v __END__ Bconsole.pm | perl
425 print "test sans conio\n";
427 my $c = new Bconsole(pref => {
428 bconsole => '/tmp/bacula/sbin/bconsole -n -c /tmp/bacula/etc/bconsole.conf',
432 print "fileset : ", join(',', $c->list_fileset()), "\n";
433 print "job : ", join(',', $c->list_job()), "\n";
434 print "storage : ", join(',', $c->list_storage()), "\n";
435 #print "prune : " . $c->prune_volume('000001'), "\n";
436 #print "update : " . $c->send_cmd('update slots storage=SDLT-1-2, drive=0'), "\n";
437 #print "label : ", join(',', $c->label_barcodes(storage => 'SDLT-1-2',
439 # drive => 0)), "\n";