=head1 LICENSE
- Copyright (C) 2006 Eric Bollengier
- All rights reserved.
+ Bweb - A Bacula web interface
+ Bacula® - The Network Backup Solution
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- any later version.
+ Copyright (C) 2000-2006 Free Software Foundation Europe e.V.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
+ The main author of Bweb is Eric Bollengier.
+ The main author of Bacula is Kern Sibbald, with contributions from
+ many others, a complete list can be found in the file AUTHORS.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ This program is Free Software; you can redistribute it and/or
+ modify it under the terms of version two of the GNU General Public
+ License as published by the Free Software Foundation plus additions
+ that are listed in the file LICENSE.
+
+ This program is distributed in the hope that it will be useful, but
+ WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ 02110-1301, USA.
+
+ Bacula® is a registered trademark of John Walker.
+ The licensor of Bacula is the Free Software Foundation Europe
+ (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
+ Switzerland, email:ftf@fsfeurope.org.
=head1 VERSION
use HTML::Template;
our $template_dir='/usr/share/bweb/tpl';
-
=head1 FUNCTION
new - creation a of new Bweb object
our %k_re = ( dbi => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
user => qr/^([\w\d\.-]+)$/i,
password => qr/^(.*)$/i,
+ fv_write_path => qr!^([/\w\d\.-]*)$!,
template_dir => qr!^([/\w\d\.-]+)$!,
debug => qr/^(on)?$/,
email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
bconsole => qr!^(.+)?$!,
syslog_file => qr!^(.+)?$!,
log_dir => qr!^(.+)?$!,
+ stat_job_table => qr!^(\w*)$!,
);
=head1 FUNCTION
unless (open(FP, $self->{config_file}))
{
- return $self->error("$self->{config_file} : $!");
+ return $self->error("can't load config_file $self->{config_file} : $!");
}
my $f=''; my $tmpbuffer;
while(read FP,$tmpbuffer,4096)
sub transfer
{
my ($self, $src, $dst) = @_ ;
- print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
+ if ($self->{debug}) {
+ print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
+ }
my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
if ($? == 0) {
my $content = $self->get_slot($src);
- print "$content ($src) => $dst<br/>";
$self->{slot}->[$src] = 'empty';
$self->set_slot($dst, $content);
return 1;
if ($self->slot_is_full($slot))
{
my $free = $self->slot_get_first_free() ;
- print "want to move $slot to $free\n";
+ print "move $slot to $free :\n";
if ($free) {
- $self->transfer($slot, $free) || print "$self->{error}\n";
+ if ($self->transfer($slot, $free)) {
+ print "<img src='/bweb/T.png' alt='ok'><br/>\n";
+ } else {
+ print "<img src='/bweb/E.png' alt='ok' title='$self->{error}'><br/>\n";
+ }
} else {
- $self->{error} = "E : Can't find free slot";
+ $self->{error} = "<img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'><br/>\n";
}
}
}
} else { # empty or no label
push @{ $param }, {realslot => $slot,
- volstatus => 'Unknow',
+ volstatus => 'Unknown',
volumename => $self->{slot}->[$slot]} ;
}
} else { # empty
use DBI;
use POSIX qw/strftime/;
+our $config_file='/etc/bacula/bweb.conf';
+
our $cur_id=0;
=head1 VARIABLE
$self->{info}->{user},
$self->{info}->{password});
- print "Can't connect to your database, see error log\n"
+ $self->error("Can't connect to your database:\n$DBI::errstr\n")
unless ($self->{dbh});
$self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
$ret{$i} = $1;
}
} elsif ($i =~ /^j(\w+)s$/) { # quote join args
- my @value = CGI::param($1) ;
+ my @value = grep { ! /^\s*$/ } CGI::param($1) ;
if (@value) {
$ret{$i} = $self->dbh_join(@value) ;
}
} elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
$ret{$i} = [ map { { name => $self->dbh_quote($_) } }
- CGI::param($1) ];
+ grep { ! /^\s*$/ } CGI::param($1) ];
} elsif (exists $opt_p{$i}) {
my $value = CGI::param($i) || '';
if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
}
}
+ if ($what{when}) {
+ my $when = CGI::param('when') || '';
+ if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
+ $ret{when} = $1;
+ }
+ }
+
if ($what{db_clients}) {
my $query = "
SELECT Client.Name as clientname
my $limit = '';
if ($elt{clients}) {
- my @clients = CGI::param('client');
+ my @clients = grep { ! /^\s*$/ } CGI::param('client');
if (@clients) {
$ret{clients} = \@clients;
my $str = $self->dbh_join(@clients);
}
if ($elt{filesets}) {
- my @filesets = CGI::param('fileset');
+ my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
if (@filesets) {
$ret{filesets} = \@filesets;
my $str = $self->dbh_join(@filesets);
}
if ($elt{mediatypes}) {
- my @medias = CGI::param('mediatype');
+ my @medias = grep { ! /^\s*$/ } CGI::param('mediatype');
if (@medias) {
$ret{mediatypes} = \@medias;
my $str = $self->dbh_join(@medias);
}
}
+ if ($elt{volstatus}) {
+ my $status = CGI::param('volstatus') || '';
+ if ($status =~ /^(\w+)$/) {
+ $ret{status} = $1;
+ $limit .= "AND Media.VolStatus = '$1' ";
+ }
+ }
+
if ($elt{locations}) {
- my @location = CGI::param('location') ;
+ my @location = grep { ! /^\s*$/ } CGI::param('location') ;
if (@location) {
$ret{locations} = \@location;
my $str = $self->dbh_join(@location);
}
if ($elt{pools}) {
- my @pool = CGI::param('pool') ;
+ my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
if (@pool) {
$ret{pools} = \@pool;
my $str = $self->dbh_join(@pool);
'level',
'filesets',
'jobtype',
+ 'pools',
'jobid',
'status');
Job.Name AS jobname,
Level AS level,
StartTime AS starttime,
+ EndTime AS endtime,
Pool.Name AS poolname,
JobFiles AS jobfiles,
JobBytes AS jobbytes,
{
my ($self) = @_ ;
- my ($where, %elt) = $self->get_param('pool',
- 'mediatype',
- 'location');
+ my ($where, %elt) = $self->get_param('pools',
+ 'mediatypes',
+ 'volstatus',
+ 'locations');
my $arg = $self->get_form('jmedias', 'qre_media');
}
my $newloc = CGI::param('newlocation');
- my $user = CGI::param('user') || 'unknow';
+ my $user = CGI::param('user') || 'unknown';
my $comm = CGI::param('comment') || '';
$comm = $self->dbh_quote("$user: $comm");
$self->display({ email => $self->{info}->{email_media},
url => $url,
newlocation => $newloc,
- # [ { volumename => 'vol1' }, { volumename => 'vol2' },..]
+ # [ { volumename => 'vol1' }, { volumename => 'vol2'\81 },..]
medias => [ values %$medias ],
},
"change_location.tpl");
"running_job.tpl") ;
}
+# return the autochanger list to update
sub eject_media
{
my ($self) = @_;
+ my %ret;
my $arg = $self->get_form('jmedias');
unless ($arg->{jmedias}) {
foreach my $vol (values %$all) {
my $a = $self->ach_get($vol->{location});
next unless ($a) ;
+ $ret{$vol->{location}} = 1;
unless ($a->{have_status}) {
$a->status();
print "eject $vol->{volumename} from $vol->{storage} : ";
if ($a->send_to_io($vol->{slot})) {
- print "ok</br>";
+ print "<img src='/bweb/T.png' alt='ok'><br/>";
} else {
- print "err</br>";
+ print "<img src='/bweb/E.png' alt='err'><br/>";
}
}
+ return keys %ret;
}
sub move_email
return undef;
}
- $a->{bweb} = $self;
+ $a->{bweb} = $self;
+ $a->{debug} = $self->{debug};
return $a;
}
$update .= " pool=$arg->{pool} " ;
}
- $arg->{volretention} ||= 0 ;
- if ($arg->{volretention}) {
+ if (defined $arg->{volretention}) {
$update .= " volretention=\"$arg->{volretention}\" " ;
}
- $arg->{voluseduration} ||= 0 ;
- if ($arg->{voluseduration}) {
+ if (defined $arg->{voluseduration}) {
$update .= " voluse=\"$arg->{voluseduration}\" " ;
}
- $arg->{maxvoljobs} ||= 0;
- if ($arg->{maxvoljobs}) {
+ if (defined $arg->{maxvoljobs}) {
$update .= " maxvoljobs=$arg->{maxvoljobs} " ;
}
- $arg->{maxvolfiles} ||= 0;
- if ($arg->{maxvolfiles}) {
+ if (defined $arg->{maxvolfiles}) {
$update .= " maxvolfiles=$arg->{maxvolfiles} " ;
}
- $arg->{maxvolbytes} ||= 0;
- if ($arg->{maxvolbytes}) {
+ if (defined $arg->{maxvolbytes}) {
$update .= " maxvolbytes=$arg->{maxvolbytes} " ;
}
return $self->error("Can't find autochanger name");
}
+ my $a = $self->ach_get($arg->{ach});
+ unless ($a) {
+ return $self->error("Can't find autochanger name in configuration");
+ }
+
+ my $storage = $a->get_drive_name($arg->{drive});
+ unless ($storage) {
+ return $self->error("Can't get your drive name");
+ }
+
my $slots = '';
my $t = 300 ;
if ($arg->{slots}) {
my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
print "<h1>This command can take long time, be patient...</h1>";
print "<pre>" ;
- $b->label_barcodes(storage => $arg->{ach},
+ $b->label_barcodes(storage => $storage,
drive => $arg->{drive},
pool => 'Scratch',
slots => $slots) ;
$b->close();
print "</pre>";
+
+ $self->dbh_do("
+ UPDATE Media
+ SET LocationId = (SELECT LocationId
+ FROM Location
+ WHERE Location = '$arg->{ach}'),
+
+ RecyclePoolId = PoolId
+
+ WHERE Media.PoolId = (SELECT PoolId
+ FROM Pool
+ WHERE Name = 'Scratch')
+ AND (LocationId = 0 OR LocationId IS NULL)
+");
+
}
sub purge
# TODO: check input (don't use pool, level)
- my $arg = $self->get_form('pool', 'level', 'client', 'priority');
+ my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when');
my $job = CGI::param('job') || '';
my $storage = CGI::param('storage') || '';
level => $arg->{level},
storage => $storage,
pool => $arg->{pool},
+ when => $arg->{when},
);
print $jobid, $b->{error};