1 ################################################################
6 Bweb - A Bacula web interface
7 Bacula® - The Network Backup Solution
9 Copyright (C) 2000-2006 Free Software Foundation Europe e.V.
11 The main author of Bweb is Eric Bollengier.
12 The main author of Bacula is Kern Sibbald, with contributions from
13 many others, a complete list can be found in the file AUTHORS.
15 This program is Free Software; you can redistribute it and/or
16 modify it under the terms of version two of the GNU General Public
17 License as published by the Free Software Foundation plus additions
18 that are listed in the file LICENSE.
20 This program is distributed in the hope that it will be useful, but
21 WITHOUT ANY WARRANTY; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 General Public License for more details.
25 You should have received a copy of the GNU General Public License
26 along with this program; if not, write to the Free Software
27 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
30 Bacula® is a registered trademark of John Walker.
31 The licensor of Bacula is the Free Software Foundation Europe
32 (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
33 Switzerland, email:ftf@fsfeurope.org.
45 Bweb::Gui - Base package for all Bweb object
49 This package define base fonction like new, display, etc..
54 our $template_dir='/usr/share/bweb/tpl';
58 new - creation a of new Bweb object
62 This function take an hash of argument and place them
65 IE : $obj = new Obj(name => 'test', age => '10');
67 $obj->{name} eq 'test' and $obj->{age} eq 10
73 my ($class, %arg) = @_;
78 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
85 my ($self, $what) = @_;
89 print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
91 print "<pre>$what</pre>";
98 error - display an error to the user
102 this function set $self->{error} with arg, display a message with
103 error.tpl and return 0
108 return $self->error("Can't use this file");
115 my ($self, $what) = @_;
116 $self->{error} = $what;
117 $self->display($self, 'error.tpl');
123 display - display an html page with HTML::Template
127 this function is use to render all html codes. it takes an
128 ref hash as arg in which all param are usable in template.
130 it will use global template_dir to search the template file.
132 hash keys are not sensitive. See HTML::Template for more
133 explanations about the hash ref. (it's can be quiet hard to understand)
137 $ref = { name => 'me', age => 26 };
138 $self->display($ref, "people.tpl");
144 my ($self, $hash, $tpl) = @_ ;
146 my $template = HTML::Template->new(filename => $tpl,
147 path =>[$template_dir],
148 die_on_bad_params => 0,
149 case_sensitive => 0);
151 foreach my $var (qw/limit offset/) {
153 unless ($hash->{$var}) {
154 my $value = CGI::param($var) || '';
156 if ($value =~ /^(\d+)$/) {
157 $template->param($var, $1) ;
162 $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
163 $template->param('loginname', CGI::remote_user());
165 $template->param($hash);
166 print $template->output();
170 ################################################################
172 package Bweb::Config;
174 use base q/Bweb::Gui/;
178 Bweb::Config - read, write, display, modify configuration
182 this package is used for manage configuration
186 $conf = new Bweb::Config(config_file => '/path/to/conf');
197 =head1 PACKAGE VARIABLE
199 %k_re - hash of all acceptable option.
203 this variable permit to check all option with a regexp.
207 our %k_re = ( dbi => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
208 user => qr/^([\w\d\.-]+)$/i,
209 password => qr/^(.*)$/i,
210 fv_write_path => qr!^([/\w\d\.-]*)$!,
211 template_dir => qr!^([/\w\d\.-]+)$!,
212 debug => qr/^(on)?$/,
213 email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
214 graph_font => qr!^([/\w\d\.-]+.ttf)$!,
215 bconsole => qr!^(.+)?$!,
216 syslog_file => qr!^(.+)?$!,
217 log_dir => qr!^(.+)?$!,
218 stat_job_table => qr!^(\w*)$!,
219 display_log_time => qr!^(on)?$!,
224 load - load config_file
228 this function load the specified config_file.
236 unless (open(FP, $self->{config_file}))
238 return $self->error("can't load config_file $self->{config_file} : $!");
240 my $f=''; my $tmpbuffer;
241 while(read FP,$tmpbuffer,4096)
249 no strict; # I have no idea of the contents of the file
256 return $self->error("If you update from an old bweb install, your must reload this page and if it's fail again, you have to configure bweb again...") ;
259 foreach my $k (keys %$VAR1) {
260 $self->{$k} = $VAR1->{$k};
268 load_old - load old configuration format
276 unless (open(FP, $self->{config_file}))
278 return $self->error("$self->{config_file} : $!");
281 while (my $line = <FP>)
284 my ($k, $v) = split(/\s*=\s*/, $line, 2);
296 save - save the current configuration to config_file
304 if ($self->{ach_list}) {
305 # shortcut for display_begin
306 $self->{achs} = [ map {{ name => $_ }}
307 keys %{$self->{ach_list}}
311 unless (open(FP, ">$self->{config_file}"))
313 return $self->error("$self->{config_file} : $!\n" .
314 "You must add this to your config file\n"
315 . Data::Dumper::Dumper($self));
318 print FP Data::Dumper::Dumper($self);
326 edit, view, modify - html form ouput
334 $self->display($self, "config_edit.tpl");
340 $self->display($self, "config_view.tpl");
350 foreach my $k (CGI::param())
352 next unless (exists $k_re{$k}) ;
353 my $val = CGI::param($k);
354 if ($val =~ $k_re{$k}) {
357 $self->{error} .= "bad parameter : $k = [$val]";
363 if ($self->{error}) { # an error as occured
364 $self->display($self, 'error.tpl');
372 ################################################################
374 package Bweb::Client;
376 use base q/Bweb::Gui/;
380 Bweb::Client - Bacula FD
384 this package is use to do all Client operations like, parse status etc...
388 $client = new Bweb::Client(name => 'zog-fd');
389 $client->status(); # do a 'status client=zog-fd'
395 display_running_job - Html display of a running job
399 this function is used to display information about a current job
403 sub display_running_job
405 my ($self, $conf, $jobid) = @_ ;
407 my $status = $self->status($conf);
410 if ($status->{$jobid}) {
411 $self->display($status->{$jobid}, "client_job_status.tpl");
414 for my $id (keys %$status) {
415 $self->display($status->{$id}, "client_job_status.tpl");
422 $client = new Bweb::Client(name => 'plume-fd');
424 $client->status($bweb);
428 dirty hack to parse "status client=xxx-fd"
432 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
433 Backup Job started: 06-jun-06 17:22
434 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
435 Files Examined=10,697
436 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
442 JobName => Full_plume.2006-06-06_17.22.23,
445 Bytes => 194,484,132,
455 my ($self, $conf) = @_ ;
457 if (defined $self->{cur_jobs}) {
458 return $self->{cur_jobs} ;
462 my $b = new Bconsole(pref => $conf);
463 my $ret = $b->send_cmd("st client=$self->{name}");
467 for my $r (split(/\n/, $ret)) {
469 $r =~ s/(^\s+|\s+$)//g;
470 if ($r =~ /JobId (\d+) Job (\S+)/) {
472 $arg->{$jobid} = { @param, JobId => $jobid } ;
476 @param = ( JobName => $2 );
478 } elsif ($r =~ /=.+=/) {
479 push @param, split(/\s+|\s*=\s*/, $r) ;
481 } elsif ($r =~ /=/) { # one per line
482 push @param, split(/\s*=\s*/, $r) ;
484 } elsif ($r =~ /:/) { # one per line
485 push @param, split(/\s*:\s*/, $r, 2) ;
489 if ($jobid and @param) {
490 $arg->{$jobid} = { @param,
492 Client => $self->{name},
496 $self->{cur_jobs} = $arg ;
502 ################################################################
504 package Bweb::Autochanger;
506 use base q/Bweb::Gui/;
510 Bweb::Autochanger - Object to manage Autochanger
514 this package will parse the mtx output and manage drives.
518 $auto = new Bweb::Autochanger(precmd => 'sudo');
520 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
524 $auto->slot_is_full(10);
525 $auto->transfer(10, 11);
531 my ($class, %arg) = @_;
534 name => '', # autochanger name
535 label => {}, # where are volume { label1 => 40, label2 => drive0 }
536 drive => [], # drive use [ 'media1', 'empty', ..]
537 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
538 io => [], # io slot number list [ 41, 42, 43...]
539 info => {slot => 0, # informations (slot, drive, io)
543 mtxcmd => '/usr/sbin/mtx',
545 device => '/dev/changer',
546 precmd => '', # ssh command
547 bweb => undef, # link to bacula web object (use for display)
550 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
557 status - parse the output of mtx status
561 this function will launch mtx status and parse the output. it will
562 give a perlish view of the autochanger content.
564 it uses ssh if the autochanger is on a other host.
571 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
573 # TODO : reset all infos
574 $self->{info}->{drive} = 0;
575 $self->{info}->{slot} = 0;
576 $self->{info}->{io} = 0;
578 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
581 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
582 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
583 #Data Transfer Element 1:Empty
584 # Storage Element 1:Empty
585 # Storage Element 2:Full :VolumeTag=000002
586 # Storage Element 3:Empty
587 # Storage Element 4:Full :VolumeTag=000004
588 # Storage Element 5:Full :VolumeTag=000001
589 # Storage Element 6:Full :VolumeTag=000003
590 # Storage Element 7:Empty
591 # Storage Element 41 IMPORT/EXPORT:Empty
592 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
597 # Storage Element 7:Empty
598 # Storage Element 2:Full :VolumeTag=000002
599 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
602 $self->set_empty_slot($1);
604 $self->set_slot($1, $4);
607 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
610 $self->set_empty_drive($1);
612 $self->set_drive($1, $4, $6);
615 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
618 $self->set_empty_io($1);
620 $self->set_io($1, $4);
623 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
625 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
626 $self->{info}->{drive} = $1;
627 $self->{info}->{slot} = $2;
628 if ($l =~ /(\d+)\s+Import/) {
629 $self->{info}->{io} = $1 ;
631 $self->{info}->{io} = 0;
636 $self->debug($self) ;
641 my ($self, $slot) = @_;
644 if ($self->{slot}->[$slot] eq 'loaded') {
648 my $label = $self->{slot}->[$slot] ;
650 return $self->is_media_loaded($label);
655 my ($self, $drive, $slot) = @_;
657 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
658 return 0 if ($self->slot_is_full($slot)) ;
660 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
663 my $content = $self->get_slot($slot);
664 print "content = $content<br/> $drive => $slot<br/>";
665 $self->set_empty_drive($drive);
666 $self->set_slot($slot, $content);
669 $self->{error} = $out;
674 # TODO: load/unload have to use mtx script from bacula
677 my ($self, $drive, $slot) = @_;
679 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
680 return 0 unless ($self->slot_is_full($slot)) ;
682 print "Loading drive $drive with slot $slot<br/>\n";
683 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
686 my $content = $self->get_slot($slot);
687 print "content = $content<br/> $slot => $drive<br/>";
688 $self->set_drive($drive, $slot, $content);
691 $self->{error} = $out;
699 my ($self, $media) = @_;
701 unless ($self->{label}->{$media}) {
705 if ($self->{label}->{$media} =~ /drive\d+/) {
715 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
720 my ($self, $slot, $tag) = @_;
721 $self->{slot}->[$slot] = $tag || 'full';
722 push @{ $self->{io} }, $slot;
725 $self->{label}->{$tag} = $slot;
731 my ($self, $slot) = @_;
733 push @{ $self->{io} }, $slot;
735 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
736 $self->{slot}->[$slot] = 'empty';
742 my ($self, $slot) = @_;
743 return $self->{slot}->[$slot];
748 my ($self, $slot, $tag) = @_;
749 $self->{slot}->[$slot] = $tag || 'full';
752 $self->{label}->{$tag} = $slot;
758 my ($self, $slot) = @_;
760 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
761 $self->{slot}->[$slot] = 'empty';
767 my ($self, $drive) = @_;
768 $self->{drive}->[$drive] = 'empty';
773 my ($self, $drive, $slot, $tag) = @_;
774 $self->{drive}->[$drive] = $tag || $slot;
776 $self->{slot}->[$slot] = $tag || 'loaded';
779 $self->{label}->{$tag} = "drive$drive";
785 my ($self, $slot) = @_;
787 # slot don't exists => full
788 if (not defined $self->{slot}->[$slot]) {
792 if ($self->{slot}->[$slot] eq 'empty') {
795 return 1; # vol, full, loaded
798 sub slot_get_first_free
801 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
802 return $slot unless ($self->slot_is_full($slot));
806 sub io_get_first_free
810 foreach my $slot (@{ $self->{io} }) {
811 return $slot unless ($self->slot_is_full($slot));
818 my ($self, $media) = @_;
820 return $self->{label}->{$media} ;
825 my ($self, $media) = @_;
827 return defined $self->{label}->{$media} ;
832 my ($self, $slot) = @_;
834 unless ($self->slot_is_full($slot)) {
835 print "Autochanger $self->{name} slot $slot is empty\n";
840 if ($self->is_slot_loaded($slot)) {
843 print "Autochanger $self->{name} $slot is currently in use\n";
847 # autochanger must have I/O
848 unless ($self->have_io()) {
849 print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
853 my $dst = $self->io_get_first_free();
856 print "Autochanger $self->{name} you must empty I/O first\n";
859 $self->transfer($slot, $dst);
864 my ($self, $src, $dst) = @_ ;
865 if ($self->{debug}) {
866 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
868 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
871 my $content = $self->get_slot($src);
872 $self->{slot}->[$src] = 'empty';
873 $self->set_slot($dst, $content);
876 $self->{error} = $out;
883 my ($self, $index) = @_;
884 return $self->{drive_name}->[$index];
887 # TODO : do a tapeinfo request to get informations
897 for my $slot (@{$self->{io}})
899 if ($self->is_slot_loaded($slot)) {
900 print "$slot is currently loaded\n";
904 if ($self->slot_is_full($slot))
906 my $free = $self->slot_get_first_free() ;
907 print "move $slot to $free :\n";
910 if ($self->transfer($slot, $free)) {
911 print "<img src='/bweb/T.png' alt='ok'><br/>\n";
913 print "<img src='/bweb/E.png' alt='ok' title='$self->{error}'><br/>\n";
917 $self->{error} = "<img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'><br/>\n";
923 # TODO : this is with mtx status output,
924 # we can do an other function from bacula view (with StorageId)
928 my $bweb = $self->{bweb};
930 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
931 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
934 SELECT Media.VolumeName AS volumename,
935 Media.VolStatus AS volstatus,
936 Media.LastWritten AS lastwritten,
937 Media.VolBytes AS volbytes,
938 Media.MediaType AS mediatype,
940 Media.InChanger AS inchanger,
942 $bweb->{sql}->{FROM_UNIXTIME}(
943 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
944 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
947 INNER JOIN Pool USING (PoolId)
949 WHERE Media.VolumeName IN ($media_list)
952 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
954 # TODO : verify slot and bacula slot
958 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
960 if ($self->slot_is_full($slot)) {
962 my $vol = $self->{slot}->[$slot];
963 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
965 my $bslot = $all->{$vol}->{slot} ;
966 my $inchanger = $all->{$vol}->{inchanger};
968 # if bacula slot or inchanger flag is bad, we display a message
969 if ($bslot != $slot or !$inchanger) {
970 push @to_update, $slot;
973 $all->{$vol}->{realslot} = $slot;
975 push @{ $param }, $all->{$vol};
977 } else { # empty or no label
978 push @{ $param }, {realslot => $slot,
979 volstatus => 'Unknown',
980 volumename => $self->{slot}->[$slot]} ;
983 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
987 my $i=0; my $drives = [] ;
988 foreach my $d (@{ $self->{drive} }) {
989 $drives->[$i] = { index => $i,
990 load => $self->{drive}->[$i],
991 name => $self->{drive_name}->[$i],
996 $bweb->display({ Name => $self->{name},
997 nb_drive => $self->{info}->{drive},
998 nb_io => $self->{info}->{io},
1001 Update => scalar(@to_update) },
1009 ################################################################
1013 use base q/Bweb::Gui/;
1017 Bweb - main Bweb package
1021 this package is use to compute and display informations
1026 use POSIX qw/strftime/;
1028 our $config_file='/etc/bacula/bweb.conf';
1034 %sql_func - hash to make query mysql/postgresql compliant
1040 UNIX_TIMESTAMP => '',
1041 FROM_UNIXTIME => '',
1042 TO_SEC => " interval '1 second' * ",
1043 SEC_TO_INT => "SEC_TO_INT",
1046 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1047 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1048 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1049 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1050 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1051 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1054 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1055 FROM_UNIXTIME => 'FROM_UNIXTIME',
1058 SEC_TO_TIME => 'SEC_TO_TIME',
1059 MATCH => " REGEXP ",
1060 STARTTIME_DAY => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1061 STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1062 STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1063 STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1064 STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1065 STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1069 sub dbh_selectall_arrayref
1071 my ($self, $query) = @_;
1072 $self->connect_db();
1073 $self->debug($query);
1074 return $self->{dbh}->selectall_arrayref($query);
1079 my ($self, @what) = @_;
1080 return join(',', $self->dbh_quote(@what)) ;
1085 my ($self, @what) = @_;
1087 $self->connect_db();
1089 return map { $self->{dbh}->quote($_) } @what;
1091 return $self->{dbh}->quote($what[0]) ;
1097 my ($self, $query) = @_ ;
1098 $self->connect_db();
1099 $self->debug($query);
1100 return $self->{dbh}->do($query);
1103 sub dbh_selectall_hashref
1105 my ($self, $query, $join) = @_;
1107 $self->connect_db();
1108 $self->debug($query);
1109 return $self->{dbh}->selectall_hashref($query, $join) ;
1112 sub dbh_selectrow_hashref
1114 my ($self, $query) = @_;
1116 $self->connect_db();
1117 $self->debug($query);
1118 return $self->{dbh}->selectrow_hashref($query) ;
1124 my @unit = qw(b Kb Mb Gb Tb);
1125 my $val = shift || 0;
1127 my $format = '%i %s';
1128 while ($val / 1024 > 1) {
1132 $format = ($i>0)?'%0.1f %s':'%i %s';
1133 return sprintf($format, $val, $unit[$i]);
1136 # display Day, Hour, Year
1142 $val /= 60; # sec -> min
1144 if ($val / 60 <= 1) {
1148 $val /= 60; # min -> hour
1149 if ($val / 24 <= 1) {
1150 return "$val hours";
1153 $val /= 24; # hour -> day
1154 if ($val / 365 < 2) {
1158 $val /= 365 ; # day -> year
1160 return "$val years";
1163 # get Day, Hour, Year
1169 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1173 my %times = ( m => 60,
1179 my $mult = $times{$2} || 0;
1189 unless ($self->{dbh}) {
1190 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1191 $self->{info}->{user},
1192 $self->{info}->{password});
1194 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1195 unless ($self->{dbh});
1197 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1199 if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1200 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1207 my ($class, %arg) = @_;
1209 dbh => undef, # connect_db();
1211 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1217 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1219 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1220 $self->{sql} = $sql_func{$1};
1223 $self->{debug} = $self->{info}->{debug};
1224 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1232 $self->display($self->{info}, "begin.tpl");
1238 $self->display($self->{info}, "end.tpl");
1246 my $arg = $self->get_form("client", "qre_client");
1248 if ($arg->{qre_client}) {
1249 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1250 } elsif ($arg->{client}) {
1251 $where = "WHERE Name = '$arg->{client}' ";
1255 SELECT Name AS name,
1257 AutoPrune AS autoprune,
1258 FileRetention AS fileretention,
1259 JobRetention AS jobretention
1264 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1266 my $dsp = { ID => $cur_id++,
1267 clients => [ values %$all] };
1269 $self->display($dsp, "client_list.tpl") ;
1274 my ($self, %arg) = @_;
1281 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1283 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1285 $self->{sql}->{TO_SEC}($arg{age})
1288 $label = "last " . human_sec($arg{age});
1291 if ($arg{groupby}) {
1292 $limit .= " GROUP BY $arg{groupby} ";
1296 $limit .= " ORDER BY $arg{order} ";
1300 $limit .= " LIMIT $arg{limit} ";
1301 $label .= " limited to $arg{limit}";
1305 $limit .= " OFFSET $arg{offset} ";
1306 $label .= " with $arg{offset} offset ";
1310 $label = 'no filter';
1313 return ($limit, $label);
1318 $bweb->get_form(...) - Get useful stuff
1322 This function get and check parameters against regexp.
1324 If word begin with 'q', the return will be quoted or join quoted
1325 if it's end with 's'.
1330 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1333 qclient => 'plume-fd',
1334 qpools => "'plume-fd', 'test-fd', '...'",
1341 my ($self, @what) = @_;
1342 my %what = map { $_ => 1 } @what;
1362 my %opt_ss =( # string with space
1366 my %opt_s = ( # default to ''
1383 my %opt_p = ( # option with path
1391 my %opt_d = ( # option with date
1396 foreach my $i (@what) {
1397 if (exists $opt_i{$i}) {# integer param
1398 my $value = CGI::param($i) || $opt_i{$i} ;
1399 if ($value =~ /^(\d+)$/) {
1402 } elsif ($opt_s{$i}) { # simple string param
1403 my $value = CGI::param($i) || '';
1404 if ($value =~ /^([\w\d\.-]+)$/) {
1407 } elsif ($opt_ss{$i}) { # simple string param (with space)
1408 my $value = CGI::param($i) || '';
1409 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1412 } elsif ($i =~ /^j(\w+)s$/) { # quote join args
1413 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1415 $ret{$i} = $self->dbh_join(@value) ;
1418 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1419 my $value = CGI::param($1) ;
1421 $ret{$i} = $self->dbh_quote($value);
1424 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1425 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1426 grep { ! /^\s*$/ } CGI::param($1) ];
1427 } elsif (exists $opt_p{$i}) {
1428 my $value = CGI::param($i) || '';
1429 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1432 } elsif (exists $opt_d{$i}) {
1433 my $value = CGI::param($i) || '';
1434 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1441 foreach my $s (CGI::param('slot')) {
1442 if ($s =~ /^(\d+)$/) {
1443 push @{$ret{slots}}, $s;
1449 my $when = CGI::param('when') || '';
1450 if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1455 if ($what{db_clients}) {
1457 SELECT Client.Name as clientname
1461 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1462 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1466 if ($what{db_mediatypes}) {
1468 SELECT MediaType as mediatype
1472 my $medias = $self->dbh_selectall_hashref($query, 'mediatype');
1473 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1477 if ($what{db_locations}) {
1479 SELECT Location as location, Cost as cost FROM Location
1481 my $loc = $self->dbh_selectall_hashref($query, 'location');
1482 $ret{db_locations} = [ sort { $a->{location}
1488 if ($what{db_pools}) {
1489 my $query = "SELECT Name as name FROM Pool";
1491 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1492 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1495 if ($what{db_filesets}) {
1497 SELECT FileSet.FileSet AS fileset
1501 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1503 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1504 values %$filesets] ;
1507 if ($what{db_jobnames}) {
1509 SELECT DISTINCT Job.Name AS jobname
1513 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1515 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1516 values %$jobnames] ;
1519 if ($what{db_devices}) {
1521 SELECT Device.Name AS name
1525 my $devices = $self->dbh_selectall_hashref($query, 'name');
1527 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1538 my $fields = $self->get_form(qw/age level status clients filesets
1540 db_clients limit db_filesets width height
1541 qclients qfilesets qjobnames db_jobnames/);
1544 my $url = CGI::url(-full => 0,
1547 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1549 # this organisation is to keep user choice between 2 click
1550 # TODO : fileset and client selection doesn't work
1559 sub display_client_job
1561 my ($self, %arg) = @_ ;
1563 $arg{order} = ' Job.JobId DESC ';
1564 my ($limit, $label) = $self->get_limit(%arg);
1566 my $clientname = $self->dbh_quote($arg{clientname});
1569 SELECT DISTINCT Job.JobId AS jobid,
1570 Job.Name AS jobname,
1571 FileSet.FileSet AS fileset,
1573 StartTime AS starttime,
1574 JobFiles AS jobfiles,
1575 JobBytes AS jobbytes,
1576 JobStatus AS jobstatus,
1577 JobErrors AS joberrors
1579 FROM Client,Job,FileSet
1580 WHERE Client.Name=$clientname
1581 AND Client.ClientId=Job.ClientId
1582 AND Job.FileSetId=FileSet.FileSetId
1586 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1588 $self->display({ clientname => $arg{clientname},
1591 Jobs => [ values %$all ],
1593 "display_client_job.tpl") ;
1596 sub get_selected_media_location
1600 my $medias = $self->get_form('jmedias');
1602 unless ($medias->{jmedias}) {
1607 SELECT Media.VolumeName AS volumename, Location.Location AS location
1608 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1609 WHERE Media.VolumeName IN ($medias->{jmedias})
1612 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1614 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1625 my $medias = $self->get_selected_media_location();
1631 my $elt = $self->get_form('db_locations');
1633 $self->display({ ID => $cur_id++,
1634 %$elt, # db_locations
1636 sort { $a->{volumename} cmp $b->{volumename} } values %$medias
1646 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1648 $self->display($elt, "help_extern.tpl");
1651 sub help_extern_compute
1655 my $number = CGI::param('limit') || '' ;
1656 unless ($number =~ /^(\d+)$/) {
1657 return $self->error("Bad arg number : $number ");
1660 my ($sql, undef) = $self->get_param('pools',
1661 'locations', 'mediatypes');
1664 SELECT Media.VolumeName AS volumename,
1665 Media.VolStatus AS volstatus,
1666 Media.LastWritten AS lastwritten,
1667 Media.MediaType AS mediatype,
1668 Media.VolMounts AS volmounts,
1670 Media.Recycle AS recycle,
1671 $self->{sql}->{FROM_UNIXTIME}(
1672 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1673 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1676 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1677 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1679 WHERE Media.InChanger = 1
1680 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1682 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1686 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1688 $self->display({ Medias => [ values %$all ] },
1689 "help_extern_compute.tpl");
1696 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1697 $self->display($param, "help_intern.tpl");
1700 sub help_intern_compute
1704 my $number = CGI::param('limit') || '' ;
1705 unless ($number =~ /^(\d+)$/) {
1706 return $self->error("Bad arg number : $number ");
1709 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1711 if (CGI::param('expired')) {
1713 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1714 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1720 SELECT Media.VolumeName AS volumename,
1721 Media.VolStatus AS volstatus,
1722 Media.LastWritten AS lastwritten,
1723 Media.MediaType AS mediatype,
1724 Media.VolMounts AS volmounts,
1726 $self->{sql}->{FROM_UNIXTIME}(
1727 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1728 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1731 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1732 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1734 WHERE Media.InChanger <> 1
1735 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1736 AND Media.Recycle = 1
1738 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1742 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1744 $self->display({ Medias => [ values %$all ] },
1745 "help_intern_compute.tpl");
1751 my ($self, %arg) = @_ ;
1753 my ($limit, $label) = $self->get_limit(%arg);
1757 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1758 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1759 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1760 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1761 (SELECT count(Job.JobId)
1763 WHERE Job.JobStatus IN ('E','e','f','A')
1766 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1769 my $row = $self->dbh_selectrow_hashref($query) ;
1771 $row->{nb_bytes} = human_size($row->{nb_bytes});
1773 $row->{db_size} = '???';
1774 $row->{label} = $label;
1776 $self->display($row, "general.tpl");
1781 my ($self, @what) = @_ ;
1782 my %elt = map { $_ => 1 } @what;
1787 if ($elt{clients}) {
1788 my @clients = grep { ! /^\s*$/ } CGI::param('client');
1790 $ret{clients} = \@clients;
1791 my $str = $self->dbh_join(@clients);
1792 $limit .= "AND Client.Name IN ($str) ";
1796 if ($elt{filesets}) {
1797 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1799 $ret{filesets} = \@filesets;
1800 my $str = $self->dbh_join(@filesets);
1801 $limit .= "AND FileSet.FileSet IN ($str) ";
1805 if ($elt{mediatypes}) {
1806 my @medias = grep { ! /^\s*$/ } CGI::param('mediatype');
1808 $ret{mediatypes} = \@medias;
1809 my $str = $self->dbh_join(@medias);
1810 $limit .= "AND Media.MediaType IN ($str) ";
1815 my $client = CGI::param('client');
1816 $ret{client} = $client;
1817 $client = $self->dbh_join($client);
1818 $limit .= "AND Client.Name = $client ";
1822 my $level = CGI::param('level') || '';
1823 if ($level =~ /^(\w)$/) {
1825 $limit .= "AND Job.Level = '$1' ";
1830 my $jobid = CGI::param('jobid') || '';
1832 if ($jobid =~ /^(\d+)$/) {
1834 $limit .= "AND Job.JobId = '$1' ";
1839 my $status = CGI::param('status') || '';
1840 if ($status =~ /^(\w)$/) {
1843 $limit .= "AND Job.JobStatus IN ('f','E') ";
1845 $limit .= "AND Job.JobStatus = '$1' ";
1850 if ($elt{volstatus}) {
1851 my $status = CGI::param('volstatus') || '';
1852 if ($status =~ /^(\w+)$/) {
1854 $limit .= "AND Media.VolStatus = '$1' ";
1858 if ($elt{locations}) {
1859 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1861 $ret{locations} = \@location;
1862 my $str = $self->dbh_join(@location);
1863 $limit .= "AND Location.Location IN ($str) ";
1868 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1870 $ret{pools} = \@pool;
1871 my $str = $self->dbh_join(@pool);
1872 $limit .= "AND Pool.Name IN ($str) ";
1876 if ($elt{location}) {
1877 my $location = CGI::param('location') || '';
1879 $ret{location} = $location;
1880 $location = $self->dbh_quote($location);
1881 $limit .= "AND Location.Location = $location ";
1886 my $pool = CGI::param('pool') || '';
1889 $pool = $self->dbh_quote($pool);
1890 $limit .= "AND Pool.Name = $pool ";
1894 if ($elt{jobtype}) {
1895 my $jobtype = CGI::param('jobtype') || '';
1896 if ($jobtype =~ /^(\w)$/) {
1898 $limit .= "AND Job.Type = '$1' ";
1902 return ($limit, %ret);
1913 my ($self, %arg) = @_ ;
1915 $arg{order} = ' Job.JobId DESC ';
1917 my ($limit, $label) = $self->get_limit(%arg);
1918 my ($where, undef) = $self->get_param('clients',
1927 SELECT Job.JobId AS jobid,
1928 Client.Name AS client,
1929 FileSet.FileSet AS fileset,
1930 Job.Name AS jobname,
1932 StartTime AS starttime,
1934 Pool.Name AS poolname,
1935 JobFiles AS jobfiles,
1936 JobBytes AS jobbytes,
1937 JobStatus AS jobstatus,
1938 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1939 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
1942 JobErrors AS joberrors
1945 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1946 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1947 WHERE Client.ClientId=Job.ClientId
1948 AND Job.JobStatus != 'R'
1953 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
1955 $self->display({ Filter => $label,
1959 sort { $a->{jobid} <=> $b->{jobid} }
1966 # display job informations
1967 sub display_job_zoom
1969 my ($self, $jobid) = @_ ;
1971 $jobid = $self->dbh_quote($jobid);
1974 SELECT DISTINCT Job.JobId AS jobid,
1975 Client.Name AS client,
1976 Job.Name AS jobname,
1977 FileSet.FileSet AS fileset,
1979 Pool.Name AS poolname,
1980 StartTime AS starttime,
1981 JobFiles AS jobfiles,
1982 JobBytes AS jobbytes,
1983 JobStatus AS jobstatus,
1984 JobErrors AS joberrors,
1985 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1986 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
1989 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
1990 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
1991 WHERE Client.ClientId=Job.ClientId
1992 AND Job.JobId = $jobid
1995 my $row = $self->dbh_selectrow_hashref($query) ;
1997 # display all volumes associate with this job
1999 SELECT Media.VolumeName as volumename
2000 FROM Job,Media,JobMedia
2001 WHERE Job.JobId = $jobid
2002 AND JobMedia.JobId=Job.JobId
2003 AND JobMedia.MediaId=Media.MediaId
2006 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2008 $row->{volumes} = [ values %$all ] ;
2010 $self->display($row, "display_job_zoom.tpl");
2017 my ($where, %elt) = $self->get_param('pools',
2022 my $arg = $self->get_form('jmedias', 'qre_media');
2024 if ($arg->{jmedias}) {
2025 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2027 if ($arg->{qre_media}) {
2028 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2032 SELECT Media.VolumeName AS volumename,
2033 Media.VolBytes AS volbytes,
2034 Media.VolStatus AS volstatus,
2035 Media.MediaType AS mediatype,
2036 Media.InChanger AS online,
2037 Media.LastWritten AS lastwritten,
2038 Location.Location AS location,
2039 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2040 Pool.Name AS poolname,
2041 $self->{sql}->{FROM_UNIXTIME}(
2042 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2043 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2046 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2047 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2048 Media.MediaType AS MediaType
2050 WHERE Media.VolStatus = 'Full'
2051 GROUP BY Media.MediaType
2052 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2054 WHERE Media.PoolId=Pool.PoolId
2058 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2060 $self->display({ ID => $cur_id++,
2062 Location => $elt{location},
2063 Medias => [ values %$all ]
2065 "display_media.tpl");
2072 my $pool = $self->get_form('db_pools');
2074 foreach my $name (@{ $pool->{db_pools} }) {
2075 CGI::param('pool', $name->{name});
2076 $self->display_media();
2080 sub display_media_zoom
2084 my $medias = $self->get_form('jmedias');
2086 unless ($medias->{jmedias}) {
2087 return $self->error("Can't get media selection");
2091 SELECT InChanger AS online,
2092 VolBytes AS nb_bytes,
2093 VolumeName AS volumename,
2094 VolStatus AS volstatus,
2095 VolMounts AS nb_mounts,
2096 Media.VolUseDuration AS voluseduration,
2097 Media.MaxVolJobs AS maxvoljobs,
2098 Media.MaxVolFiles AS maxvolfiles,
2099 Media.MaxVolBytes AS maxvolbytes,
2100 VolErrors AS nb_errors,
2101 Pool.Name AS poolname,
2102 Location.Location AS location,
2103 Media.Recycle AS recycle,
2104 Media.VolRetention AS volretention,
2105 Media.LastWritten AS lastwritten,
2106 Media.VolReadTime/1000000 AS volreadtime,
2107 Media.VolWriteTime/1000000 AS volwritetime,
2108 Media.RecycleCount AS recyclecount,
2109 Media.Comment AS comment,
2110 $self->{sql}->{FROM_UNIXTIME}(
2111 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2112 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2115 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2116 WHERE Pool.PoolId = Media.PoolId
2117 AND VolumeName IN ($medias->{jmedias})
2120 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2122 foreach my $media (values %$all) {
2123 my $mq = $self->dbh_quote($media->{volumename});
2126 SELECT DISTINCT Job.JobId AS jobid,
2128 Job.StartTime AS starttime,
2131 Job.JobFiles AS files,
2132 Job.JobBytes AS bytes,
2133 Job.jobstatus AS status
2134 FROM Media,JobMedia,Job
2135 WHERE Media.VolumeName=$mq
2136 AND Media.MediaId=JobMedia.MediaId
2137 AND JobMedia.JobId=Job.JobId
2140 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2143 SELECT LocationLog.Date AS date,
2144 Location.Location AS location,
2145 LocationLog.Comment AS comment
2146 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2147 WHERE Media.MediaId = LocationLog.MediaId
2148 AND Media.VolumeName = $mq
2152 my $log = $self->dbh_selectall_arrayref($query) ;
2154 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2157 $self->display({ jobs => [ values %$jobs ],
2158 LocationLog => $logtxt,
2160 "display_media_zoom.tpl");
2168 my $loc = $self->get_form('qlocation');
2169 unless ($loc->{qlocation}) {
2170 return $self->error("Can't get location");
2174 SELECT Location.Location AS location,
2175 Location.Cost AS cost,
2176 Location.Enabled AS enabled
2178 WHERE Location.Location = $loc->{qlocation}
2181 my $row = $self->dbh_selectrow_hashref($query);
2183 $self->display({ ID => $cur_id++,
2184 %$row }, "location_edit.tpl") ;
2192 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2193 unless ($arg->{qlocation}) {
2194 return $self->error("Can't get location");
2196 unless ($arg->{qnewlocation}) {
2197 return $self->error("Can't get new location name");
2199 unless ($arg->{cost}) {
2200 return $self->error("Can't get new cost");
2203 my $enabled = CGI::param('enabled') || '';
2204 $enabled = $enabled?1:0;
2207 UPDATE Location SET Cost = $arg->{cost},
2208 Location = $arg->{qnewlocation},
2210 WHERE Location.Location = $arg->{qlocation}
2213 $self->dbh_do($query);
2215 $self->display_location();
2221 my $arg = $self->get_form(qw/qlocation/) ;
2223 unless ($arg->{qlocation}) {
2224 return $self->error("Can't get location");
2228 SELECT count(Media.MediaId) AS nb
2229 FROM Media INNER JOIN Location USING (LocationID)
2230 WHERE Location = $arg->{qlocation}
2233 my $res = $self->dbh_selectrow_hashref($query);
2236 return $self->error("Sorry, the location must be empty");
2240 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2243 $self->dbh_do($query);
2245 $self->display_location();
2252 my $arg = $self->get_form(qw/qlocation cost/) ;
2254 unless ($arg->{qlocation}) {
2255 $self->display({}, "location_add.tpl");
2258 unless ($arg->{cost}) {
2259 return $self->error("Can't get new cost");
2262 my $enabled = CGI::param('enabled') || '';
2263 $enabled = $enabled?1:0;
2266 INSERT INTO Location (Location, Cost, Enabled)
2267 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2270 $self->dbh_do($query);
2272 $self->display_location();
2275 sub display_location
2280 SELECT Location.Location AS location,
2281 Location.Cost AS cost,
2282 Location.Enabled AS enabled,
2283 (SELECT count(Media.MediaId)
2285 WHERE Media.LocationId = Location.LocationId
2290 my $location = $self->dbh_selectall_hashref($query, 'location');
2292 $self->display({ ID => $cur_id++,
2293 Locations => [ values %$location ] },
2294 "display_location.tpl");
2301 my $medias = $self->get_selected_media_location();
2306 my $arg = $self->get_form('db_locations', 'qnewlocation');
2308 $self->display({ email => $self->{info}->{email_media},
2310 medias => [ values %$medias ],
2312 "update_location.tpl");
2315 sub get_media_max_size
2317 my ($self, $type) = @_;
2319 "SELECT avg(VolBytes) AS size
2321 WHERE Media.VolStatus = 'Full'
2322 AND Media.MediaType = '$type'
2325 my $res = $self->selectrow_hashref($query);
2328 return $res->{size};
2338 my $media = $self->get_form('qmedia');
2340 unless ($media->{qmedia}) {
2341 return $self->error("Can't get media");
2345 SELECT Media.Slot AS slot,
2346 PoolMedia.Name AS poolname,
2347 Media.VolStatus AS volstatus,
2348 Media.InChanger AS inchanger,
2349 Location.Location AS location,
2350 Media.VolumeName AS volumename,
2351 Media.MaxVolBytes AS maxvolbytes,
2352 Media.MaxVolJobs AS maxvoljobs,
2353 Media.MaxVolFiles AS maxvolfiles,
2354 Media.VolUseDuration AS voluseduration,
2355 Media.VolRetention AS volretention,
2356 Media.Comment AS comment,
2357 PoolRecycle.Name AS poolrecycle
2359 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
2360 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
2361 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2363 WHERE Media.VolumeName = $media->{qmedia}
2366 my $row = $self->dbh_selectrow_hashref($query);
2367 $row->{volretention} = human_sec($row->{volretention});
2368 $row->{voluseduration} = human_sec($row->{voluseduration});
2370 my $elt = $self->get_form(qw/db_pools db_locations/);
2375 }, "update_media.tpl");
2382 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
2384 unless ($arg->{jmedias}) {
2385 return $self->error("Can't get selected media");
2388 unless ($arg->{qnewlocation}) {
2389 return $self->error("Can't get new location");
2394 SET LocationId = (SELECT LocationId
2396 WHERE Location = $arg->{qnewlocation})
2397 WHERE Media.VolumeName IN ($arg->{jmedias})
2400 my $nb = $self->dbh_do($query);
2402 print "$nb media updated, you may have to update your autochanger.";
2404 $self->display_media();
2411 my $medias = $self->get_selected_media_location();
2413 return $self->error("Can't get media selection");
2415 my $newloc = CGI::param('newlocation');
2417 my $user = CGI::param('user') || 'unknown';
2418 my $comm = CGI::param('comment') || '';
2419 $comm = $self->dbh_quote("$user: $comm");
2423 foreach my $media (keys %$medias) {
2425 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
2427 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$media'),
2428 (SELECT LocationId FROM Location WHERE Location = '$medias->{$media}->{location}'),
2429 (SELECT VolStatus FROM Media WHERE VolumeName = '$media')
2432 $self->dbh_do($query);
2433 $self->debug($query);
2437 $q->param('action', 'update_location');
2438 my $url = $q->url(-full => 1, -query=>1);
2440 $self->display({ email => $self->{info}->{email_media},
2442 newlocation => $newloc,
2443 # [ { volumename => 'vol1' }, { volumename => 'vol2'
\81 },..]
2444 medias => [ values %$medias ],
2446 "change_location.tpl");
2450 sub display_client_stats
2452 my ($self, %arg) = @_ ;
2454 my $client = $self->dbh_quote($arg{clientname});
2455 my ($limit, $label) = $self->get_limit(%arg);
2459 count(Job.JobId) AS nb_jobs,
2460 sum(Job.JobBytes) AS nb_bytes,
2461 sum(Job.JobErrors) AS nb_err,
2462 sum(Job.JobFiles) AS nb_files,
2463 Client.Name AS clientname
2464 FROM Job INNER JOIN Client USING (ClientId)
2466 Client.Name = $client
2468 GROUP BY Client.Name
2471 my $row = $self->dbh_selectrow_hashref($query);
2473 $row->{ID} = $cur_id++;
2474 $row->{label} = $label;
2476 $self->display($row, "display_client_stats.tpl");
2479 # poolname can be undef
2482 my ($self, $poolname) = @_ ;
2486 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
2487 if ($arg->{jmediatypes}) {
2488 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
2489 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
2492 # TODO : afficher les tailles et les dates
2495 SELECT subq.volmax AS volmax,
2496 subq.volnum AS volnum,
2497 subq.voltotal AS voltotal,
2499 Pool.Recycle AS recycle,
2500 Pool.VolRetention AS volretention,
2501 Pool.VolUseDuration AS voluseduration,
2502 Pool.MaxVolJobs AS maxvoljobs,
2503 Pool.MaxVolFiles AS maxvolfiles,
2504 Pool.MaxVolBytes AS maxvolbytes,
2505 subq.PoolId AS PoolId
2508 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
2509 count(Media.MediaId) AS volnum,
2510 sum(Media.VolBytes) AS voltotal,
2511 Media.PoolId AS PoolId,
2512 Media.MediaType AS MediaType
2514 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
2515 Media.MediaType AS MediaType
2517 WHERE Media.VolStatus = 'Full'
2518 GROUP BY Media.MediaType
2519 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2520 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
2522 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
2526 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2529 SELECT Pool.Name AS name,
2530 sum(VolBytes) AS size
2531 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
2532 WHERE Media.VolStatus IN ('Recycled', 'Purged')
2536 my $empty = $self->dbh_selectall_hashref($query, 'name');
2538 foreach my $p (values %$all) {
2539 if ($p->{volmax} > 0) { # mysql returns 0.0000
2540 # we remove Recycled/Purged media from pool usage
2541 if (defined $empty->{$p->{name}}) {
2542 $p->{voltotal} -= $empty->{$p->{name}}->{size};
2544 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
2546 $p->{poolusage} = 0;
2550 SELECT VolStatus AS volstatus, count(MediaId) AS nb
2552 WHERE PoolId=$p->{poolid}
2556 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
2557 foreach my $t (values %$content) {
2558 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
2563 $self->display({ ID => $cur_id++,
2564 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
2565 Pools => [ values %$all ]},
2566 "display_pool.tpl");
2569 sub display_running_job
2573 my $arg = $self->get_form('client', 'jobid');
2575 if (!$arg->{client} and $arg->{jobid}) {
2578 SELECT Client.Name AS name
2579 FROM Job INNER JOIN Client USING (ClientId)
2580 WHERE Job.JobId = $arg->{jobid}
2583 my $row = $self->dbh_selectrow_hashref($query);
2586 $arg->{client} = $row->{name};
2587 CGI::param('client', $arg->{client});
2591 if ($arg->{client}) {
2592 my $cli = new Bweb::Client(name => $arg->{client});
2593 $cli->display_running_job($self->{info}, $arg->{jobid});
2594 if ($arg->{jobid}) {
2595 $self->get_job_log();
2598 $self->error("Can't get client or jobid");
2602 sub display_running_jobs
2604 my ($self, $display_action) = @_;
2607 SELECT Job.JobId AS jobid,
2608 Job.Name AS jobname,
2610 Job.StartTime AS starttime,
2611 Job.JobFiles AS jobfiles,
2612 Job.JobBytes AS jobbytes,
2613 Job.JobStatus AS jobstatus,
2614 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
2615 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2617 Client.Name AS clientname
2618 FROM Job INNER JOIN Client USING (ClientId)
2619 WHERE JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
2621 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2623 $self->display({ ID => $cur_id++,
2624 display_action => $display_action,
2625 Jobs => [ values %$all ]},
2626 "running_job.tpl") ;
2629 # return the autochanger list to update
2634 my $arg = $self->get_form('jmedias');
2636 unless ($arg->{jmedias}) {
2637 return $self->error("Can't get media selection");
2641 SELECT Media.VolumeName AS volumename,
2642 Storage.Name AS storage,
2643 Location.Location AS location,
2645 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
2646 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2647 WHERE Media.VolumeName IN ($arg->{jmedias})
2648 AND Media.InChanger = 1
2651 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2653 foreach my $vol (values %$all) {
2654 my $a = $self->ach_get($vol->{location});
2656 $ret{$vol->{location}} = 1;
2658 unless ($a->{have_status}) {
2660 $a->{have_status} = 1;
2663 print "eject $vol->{volumename} from $vol->{storage} : ";
2664 if ($a->send_to_io($vol->{slot})) {
2665 print "<img src='/bweb/T.png' alt='ok'><br/>";
2667 print "<img src='/bweb/E.png' alt='err'><br/>";
2677 my ($to, $subject, $content) = (CGI::param('email'),
2678 CGI::param('subject'),
2679 CGI::param('content'));
2680 $to =~ s/[^\w\d\.\@<>,]//;
2681 $subject =~ s/[^\w\d\.\[\]]/ /;
2683 open(MAIL, "|mail -s '$subject' '$to'") ;
2684 print MAIL $content;
2694 my $arg = $self->get_form('jobid', 'client');
2696 print CGI::header('text/brestore');
2697 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
2698 print "client=$arg->{client}\n" if ($arg->{client});
2699 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
2703 # TODO : move this to Bweb::Autochanger ?
2704 # TODO : make this internal to not eject tape ?
2710 my ($self, $name) = @_;
2713 return $self->error("Can't get your autochanger name ach");
2716 unless ($self->{info}->{ach_list}) {
2717 return $self->error("Could not find any autochanger");
2720 my $a = $self->{info}->{ach_list}->{$name};
2723 $self->error("Can't get your autochanger $name from your ach_list");
2728 $a->{debug} = $self->{debug};
2735 my ($self, $ach) = @_;
2737 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
2739 $self->{info}->save();
2747 my $arg = $self->get_form('ach');
2749 or !$self->{info}->{ach_list}
2750 or !$self->{info}->{ach_list}->{$arg->{ach}})
2752 return $self->error("Can't get autochanger name");
2755 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
2759 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
2761 my $b = $self->get_bconsole();
2763 my @storages = $b->list_storage() ;
2765 $ach->{devices} = [ map { { name => $_ } } @storages ];
2767 $self->display($ach, "ach_add.tpl");
2768 delete $ach->{drives};
2769 delete $ach->{devices};
2776 my $arg = $self->get_form('ach');
2779 or !$self->{info}->{ach_list}
2780 or !$self->{info}->{ach_list}->{$arg->{ach}})
2782 return $self->error("Can't get autochanger name");
2785 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
2787 $self->{info}->save();
2788 $self->{info}->view();
2794 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
2796 my $b = $self->get_bconsole();
2797 my @storages = $b->list_storage() ;
2799 unless ($arg->{ach}) {
2800 $arg->{devices} = [ map { { name => $_ } } @storages ];
2801 return $self->display($arg, "ach_add.tpl");
2805 foreach my $drive (CGI::param('drives'))
2807 unless (grep(/^$drive$/,@storages)) {
2808 return $self->error("Can't find $drive in storage list");
2811 my $index = CGI::param("index_$drive");
2812 unless (defined $index and $index =~ /^(\d+)$/) {
2813 return $self->error("Can't get $drive index");
2816 $drives[$index] = $drive;
2820 return $self->error("Can't get drives from Autochanger");
2823 my $a = new Bweb::Autochanger(name => $arg->{ach},
2824 precmd => $arg->{precmd},
2825 drive_name => \@drives,
2826 device => $arg->{device},
2827 mtxcmd => $arg->{mtxcmd});
2829 $self->ach_register($a) ;
2831 $self->{info}->view();
2837 my $arg = $self->get_form('jobid');
2839 if ($arg->{jobid}) {
2840 my $b = $self->get_bconsole();
2841 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
2845 title => "Delete a job ",
2846 name => "delete jobid=$arg->{jobid}",
2855 my $arg = $self->get_form(qw/media volstatus inchanger pool
2856 slot volretention voluseduration
2857 maxvoljobs maxvolfiles maxvolbytes
2858 qcomment poolrecycle
2861 unless ($arg->{media}) {
2862 return $self->error("Can't find media selection");
2865 my $update = "update volume=$arg->{media} ";
2867 if ($arg->{volstatus}) {
2868 $update .= " volstatus=$arg->{volstatus} ";
2871 if ($arg->{inchanger}) {
2872 $update .= " inchanger=yes " ;
2874 $update .= " slot=$arg->{slot} ";
2877 $update .= " slot=0 inchanger=no ";
2881 $update .= " pool=$arg->{pool} " ;
2884 if (defined $arg->{volretention}) {
2885 $update .= " volretention=\"$arg->{volretention}\" " ;
2888 if (defined $arg->{voluseduration}) {
2889 $update .= " voluse=\"$arg->{voluseduration}\" " ;
2892 if (defined $arg->{maxvoljobs}) {
2893 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
2896 if (defined $arg->{maxvolfiles}) {
2897 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
2900 if (defined $arg->{maxvolbytes}) {
2901 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
2904 my $b = $self->get_bconsole();
2907 content => $b->send_cmd($update),
2908 title => "Update a volume ",
2914 my $media = $self->dbh_quote($arg->{media});
2916 my $loc = CGI::param('location') || '';
2918 $loc = $self->dbh_quote($loc); # is checked by db
2919 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
2921 if ($arg->{poolrecycle}) {
2922 push @q, "RecyclePoolId=(SELECT PoolId FROM Pool WHERE Name='$arg->{poolrecycle}')";
2924 if (!$arg->{qcomment}) {
2925 $arg->{qcomment} = "''";
2927 push @q, "Comment=$arg->{qcomment}";
2932 SET " . join (',', @q) . "
2933 WHERE Media.VolumeName = $media
2935 $self->dbh_do($query);
2937 $self->update_media();
2944 my $ach = CGI::param('ach') ;
2945 $ach = $self->ach_get($ach);
2947 return $self->error("Bad autochanger name");
2951 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
2952 $b->update_slots($ach->{name});
2960 my $arg = $self->get_form('jobid', 'limit', 'offset');
2961 unless ($arg->{jobid}) {
2962 return $self->error("Can't get jobid");
2965 if ($arg->{limit} == 100) {
2966 $arg->{limit} = 1000;
2969 my $t = CGI::param('time') || $self->{info}->{display_log_time} || '';
2972 SELECT Job.Name as name, Client.Name as clientname
2973 FROM Job INNER JOIN Client ON (Job.ClientId = Client.ClientId)
2974 WHERE JobId = $arg->{jobid}
2977 my $row = $self->dbh_selectrow_hashref($query);
2980 return $self->error("Can't find $arg->{jobid} in catalog");
2984 SELECT Time AS time, LogText AS log
2986 WHERE Log.JobId = $arg->{jobid}
2987 OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
2988 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
2992 OFFSET $arg->{offset}
2995 my $log = $self->dbh_selectall_arrayref($query);
2997 return $self->error("Can't get log for jobid $arg->{jobid}");
3003 $logtxt = join("", map { ($_->[0] . ' ' . $_->[1]) } @$log ) ;
3005 $logtxt = join("", map { $_->[1] } @$log ) ;
3008 $self->display({ lines=> $logtxt,
3009 jobid => $arg->{jobid},
3010 name => $row->{name},
3011 client => $row->{clientname},
3012 offset => $arg->{offset},
3013 limit => $arg->{limit},
3014 }, 'display_log.tpl');
3022 my $arg = $self->get_form('ach', 'slots', 'drive');
3024 unless ($arg->{ach}) {
3025 return $self->error("Can't find autochanger name");
3028 my $a = $self->ach_get($arg->{ach});
3030 return $self->error("Can't find autochanger name in configuration");
3033 my $storage = $a->get_drive_name($arg->{drive});
3035 return $self->error("Can't get your drive name");
3040 if ($arg->{slots}) {
3041 $slots = join(",", @{ $arg->{slots} });
3042 $t += 60*scalar( @{ $arg->{slots} }) ;
3045 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3046 print "<h1>This command can take long time, be patient...</h1>";
3048 $b->label_barcodes(storage => $storage,
3049 drive => $arg->{drive},
3057 SET LocationId = (SELECT LocationId
3059 WHERE Location = '$arg->{ach}'),
3061 RecyclePoolId = PoolId
3063 WHERE Media.PoolId = (SELECT PoolId
3065 WHERE Name = 'Scratch')
3066 AND (LocationId = 0 OR LocationId IS NULL)
3075 my @volume = CGI::param('media');
3078 return $self->error("Can't get media selection");
3081 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3084 content => $b->purge_volume(@volume),
3085 title => "Purge media",
3086 name => "purge volume=" . join(' volume=', @volume),
3095 my @volume = CGI::param('media');
3097 return $self->error("Can't get media selection");
3100 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3103 content => $b->prune_volume(@volume),
3104 title => "Prune media",
3105 name => "prune volume=" . join(' volume=', @volume),
3115 my $arg = $self->get_form('jobid');
3116 unless ($arg->{jobid}) {
3117 return $self->error("Can't get jobid");
3120 my $b = $self->get_bconsole();
3122 content => $b->cancel($arg->{jobid}),
3123 title => "Cancel job",
3124 name => "cancel jobid=$arg->{jobid}",
3130 # Warning, we display current fileset
3133 my $arg = $self->get_form('fileset');
3135 if ($arg->{fileset}) {
3136 my $b = $self->get_bconsole();
3137 my $ret = $b->get_fileset($arg->{fileset});
3138 $self->display({ fileset => $arg->{fileset},
3140 }, "fileset_view.tpl");
3142 $self->error("Can't get fileset name");
3146 sub director_show_sched
3150 my $arg = $self->get_form('days');
3152 my $b = $self->get_bconsole();
3153 my $ret = $b->director_get_sched( $arg->{days} );
3158 }, "scheduled_job.tpl");
3161 sub enable_disable_job
3163 my ($self, $what) = @_ ;
3165 my $name = CGI::param('job') || '';
3166 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3167 return $self->error("Can't find job name");
3170 my $b = $self->get_bconsole();
3180 content => $b->send_cmd("$cmd job=\"$name\""),
3181 title => "$cmd $name",
3182 name => "$cmd job=\"$name\"",
3189 return new Bconsole(pref => $self->{info});
3195 my $b = $self->get_bconsole();
3197 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3199 $self->display({ Jobs => $joblist }, "run_job.tpl");
3204 my ($self, $ouput) = @_;
3207 foreach my $l (split(/\r\n/, $ouput)) {
3208 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
3214 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
3220 foreach my $k (keys %arg) {
3221 $lowcase{lc($k)} = $arg{$k} ;
3230 my $b = $self->get_bconsole();
3232 my $job = CGI::param('job') || '';
3234 my $info = $b->send_cmd("show job=\"$job\"");
3235 my $attr = $self->run_parse_job($info);
3237 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3239 my $pools = [ map { { name => $_ } } $b->list_pool() ];
3240 my $clients = [ map { { name => $_ } }$b->list_client()];
3241 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
3242 my $storages= [ map { { name => $_ } }$b->list_storage()];
3247 clients => $clients,
3248 filesets => $filesets,
3249 storages => $storages,
3251 }, "run_job_mod.tpl");
3257 my $b = $self->get_bconsole();
3259 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
3269 my $b = $self->get_bconsole();
3271 # TODO: check input (don't use pool, level)
3273 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when');
3274 my $job = CGI::param('job') || '';
3275 my $storage = CGI::param('storage') || '';
3277 my $jobid = $b->run(job => $job,
3278 client => $arg->{client},
3279 priority => $arg->{priority},
3280 level => $arg->{level},
3281 storage => $storage,
3282 pool => $arg->{pool},
3283 when => $arg->{when},
3286 print $jobid, $b->{error};
3288 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";