1 ################################################################
6 Bweb - A Bacula web interface
7 Bacula® - The Network Backup Solution
9 Copyright (C) 2000-2009 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.
14 This program is Free Software; you can redistribute it and/or
15 modify it under the terms of version three of the GNU Affero General Public
16 License as published by the Free Software Foundation and included
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 Affero General Public License for more details.
24 You should have received a copy of the GNU Affero 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 Kern Sibbald.
30 The licensor of Bacula is the Free Software Foundation Europe
31 (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zürich,
32 Switzerland, email:ftf@fsfeurope.org.
44 Bweb::Gui - Base package for all Bweb object
48 This package define base fonction like new, display, etc..
53 our $template_dir='/usr/share/bweb/tpl';
57 new - creation a of new Bweb object
61 This function take an hash of argument and place them
64 IE : $obj = new Obj(name => 'test', age => '10');
66 $obj->{name} eq 'test' and $obj->{age} eq 10
72 my ($class, %arg) = @_;
77 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
84 my ($self, $what) = @_;
88 print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
90 print "<pre>$what</pre>";
97 my ($self, $what) = @_;
99 my $old = $self->{debug};
102 $self->{debug} = $old;
107 error - display an error to the user
111 this function set $self->{error} with arg, display a message with
112 error.tpl and return 0
117 return $self->error("Can't use this file");
124 my ($self, $what) = @_;
125 $self->{error} = $what;
126 $self->display($self, 'error.tpl');
132 display - display an html page with HTML::Template
136 this function is use to render all html codes. it takes an
137 ref hash as arg in which all param are usable in template.
139 it will use user template_dir then global template_dir
140 to search the template file.
142 hash keys are not sensitive. See HTML::Template for more
143 explanations about the hash ref. (it's can be quiet hard to understand)
147 $ref = { name => 'me', age => 26 };
148 $self->display($ref, "people.tpl");
154 my ($self, $hash, $tpl) = @_ ;
155 my $dir = $self->{template_dir} || $template_dir;
156 my $lang = $self->{lang} || 'en';
157 my $template = HTML::Template->new(filename => $tpl,
158 path =>["$dir/$lang",
161 die_on_bad_params => 0,
162 case_sensitive => 0);
164 foreach my $var (qw/limit offset/) {
166 unless ($hash->{$var}) {
167 my $value = CGI::param($var) || '';
169 if ($value =~ /^(\d+)$/) {
170 $template->param($var, $1) ;
175 $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
176 $template->param('loginname', CGI::remote_user());
178 $template->param($hash);
179 print $template->output();
183 ################################################################
185 package Bweb::Config;
187 use base q/Bweb::Gui/;
191 Bweb::Config - read, write, display, modify configuration
195 this package is used for manage configuration
199 $conf = new Bweb::Config(config_file => '/path/to/conf');
210 =head1 PACKAGE VARIABLE
212 %k_re - hash of all acceptable option.
216 this variable permit to check all option with a regexp.
220 our %k_re = ( dbi => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
221 user => qr/^([\w\d\.-]+)$/i,
222 password => qr/^(.*)$/,
223 fv_write_path => qr!^([/\w\d\.-]*)$!,
224 template_dir => qr!^([/\w\d\.-]+)$!,
225 debug => qr/^(on)?$/,
226 lang => qr/^(\w\w)?$/,
227 email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
228 graph_font => qr!^([/\w\d\.-]+.ttf)?$!,
229 bconsole => qr!^(.+)?$!,
230 syslog_file => qr!^(.+)?$!,
231 log_dir => qr!^(.+)?$!,
232 wiki_url => qr!(.*)$!,
233 stat_job_table => qr!^(\w*)$!,
234 display_log_time => qr!^(on)?$!,
235 enable_security => qr/^(on)?$/,
236 enable_security_acl => qr/^(on)?$/,
237 default_age => qr/^((?:\d+(?:[ywdhms]\s*?)?)+)\s*$/,
242 load - load config_file
246 this function load the specified config_file.
254 unless (open(FP, $self->{config_file}))
256 return $self->error("can't load config_file $self->{config_file} : $!");
258 my $f=''; my $tmpbuffer;
259 while(read FP,$tmpbuffer,4096)
267 no strict; # I have no idea of the contents of the file
274 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...") ;
278 $self->{default_age} = '7d';
280 foreach my $k (keys %$VAR1) {
281 $self->{$k} = $VAR1->{$k};
289 load_old - load old configuration format
297 unless (open(FP, $self->{config_file}))
299 return $self->error("$self->{config_file} : $!");
302 while (my $line = <FP>)
305 my ($k, $v) = split(/\s*=\s*/, $line, 2);
317 save - save the current configuration to config_file
325 if ($self->{ach_list}) {
326 # shortcut for display_begin
327 $self->{achs} = [ map {{ name => $_ }}
328 keys %{$self->{ach_list}}
332 unless (open(FP, ">$self->{config_file}"))
334 return $self->error("$self->{config_file} : $!\n" .
335 "You must add this to your config file\n"
336 . Data::Dumper::Dumper($self));
339 print FP Data::Dumper::Dumper($self);
347 edit, view, modify - html form ouput
355 $self->display($self, "config_edit.tpl");
361 $self->display($self, "config_view.tpl");
369 # we need to reset checkbox first
371 $self->{display_log_time} = 0;
372 $self->{enable_security} = 0;
373 $self->{enable_security_acl} = 0;
375 foreach my $k (CGI::param())
377 next unless (exists $k_re{$k}) ;
378 my $val = CGI::param($k);
379 if ($val =~ $k_re{$k}) {
382 $self->{error} .= "bad parameter : $k = [$val]";
388 if ($self->{error}) { # an error as occured
389 $self->display($self, 'error.tpl');
397 ################################################################
399 package Bweb::Client;
401 use base q/Bweb::Gui/;
405 Bweb::Client - Bacula FD
409 this package is use to do all Client operations like, parse status etc...
413 $client = new Bweb::Client(name => 'zog-fd');
414 $client->status(); # do a 'status client=zog-fd'
420 display_running_job - Html display of a running job
424 this function is used to display information about a current job
428 sub display_running_job
430 my ($self, $bweb, $jobid, $infos) = @_ ;
431 my $status = $self->status($bweb->{info});
434 if ($status->{$jobid}) {
435 $status = $status->{$jobid};
436 $status->{last_jobbytes} = $infos->{jobbytes};
437 $status->{last_jobfiles} = $infos->{jobfiles};
438 $status->{corr_jobbytes} = $infos->{corr_jobbytes};
439 $status->{corr_jobfiles} = $infos->{corr_jobfiles};
440 $status->{jobbytes}=$status->{Bytes};
441 $status->{jobbytes} =~ s![^\d]!!g;
442 $status->{jobfiles}=$status->{'Files Examined'};
443 $status->{jobfiles} =~ s/,//g;
444 $bweb->display($status, "client_job_status.tpl");
447 for my $id (keys %$status) {
448 $bweb->display($status->{$id}, "client_job_status.tpl");
455 $client = new Bweb::Client(name => 'plume-fd');
457 $client->status($bweb);
461 dirty hack to parse "status client=xxx-fd"
465 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
466 Backup Job started: 06-jun-06 17:22
467 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
468 Files Examined=10,697
469 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
475 JobName => Full_plume.2006-06-06_17.22.23,
478 Bytes => 194,484,132,
488 my ($self, $conf) = @_ ;
490 if (defined $self->{cur_jobs}) {
491 return $self->{cur_jobs} ;
495 my $b = new Bconsole(pref => $conf);
496 my $ret = $b->send_cmd("st client=$self->{name}");
500 for my $r (split(/\n/, $ret)) {
502 $r =~ s/(^\s+|\s+$)//g;
503 if ($r =~ /JobId (\d+) Job (\S+)/) {
505 $arg->{$jobid} = { @param, JobId => $jobid } ;
509 @param = ( JobName => $2 );
511 } elsif ($r =~ /=.+=/) {
512 push @param, split(/\s+|\s*=\s*/, $r) ;
514 } elsif ($r =~ /=/) { # one per line
515 push @param, split(/\s*=\s*/, $r) ;
517 } elsif ($r =~ /:/) { # one per line
518 push @param, split(/\s*:\s*/, $r, 2) ;
522 if ($jobid and @param) {
523 $arg->{$jobid} = { @param,
525 Client => $self->{name},
529 $self->{cur_jobs} = $arg ;
535 ################################################################
537 package Bweb::Autochanger;
539 use base q/Bweb::Gui/;
543 Bweb::Autochanger - Object to manage Autochanger
547 this package will parse the mtx output and manage drives.
551 $auto = new Bweb::Autochanger(precmd => 'sudo');
553 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
557 $auto->slot_is_full(10);
558 $auto->transfer(10, 11);
564 my ($class, %arg) = @_;
567 name => '', # autochanger name
568 label => {}, # where are volume { label1 => 40, label2 => drive0 }
569 drive => [], # drive use [ 'media1', 'empty', ..]
570 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
571 io => [], # io slot number list [ 41, 42, 43...]
572 info => {slot => 0, # informations (slot, drive, io)
576 mtxcmd => '/usr/sbin/mtx',
578 device => '/dev/changer',
579 precmd => '', # ssh command
580 bweb => undef, # link to bacula web object (use for display)
583 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
590 status - parse the output of mtx status
594 this function will launch mtx status and parse the output. it will
595 give a perlish view of the autochanger content.
597 it uses ssh if the autochanger is on a other host.
604 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
606 # TODO : reset all infos
607 $self->{info}->{drive} = 0;
608 $self->{info}->{slot} = 0;
609 $self->{info}->{io} = 0;
611 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
614 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
615 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
616 #Data Transfer Element 1:Empty
617 # Storage Element 1:Empty
618 # Storage Element 2:Full :VolumeTag=000002
619 # Storage Element 3:Empty
620 # Storage Element 4:Full :VolumeTag=000004
621 # Storage Element 5:Full :VolumeTag=000001
622 # Storage Element 6:Full :VolumeTag=000003
623 # Storage Element 7:Empty
624 # Storage Element 41 IMPORT/EXPORT:Empty
625 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
630 # Storage Element 7:Empty
631 # Storage Element 2:Full :VolumeTag=000002
632 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d.-]+))?/){
635 $self->set_empty_slot($1);
637 $self->set_slot($1, $4);
640 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d.-]+))?)?/) {
643 $self->set_empty_drive($1);
645 $self->set_drive($1, $4, $6);
648 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w.-]+))?/)
651 $self->set_empty_io($1);
653 $self->set_io($1, $4);
656 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
658 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
659 $self->{info}->{drive} = $1;
660 $self->{info}->{slot} = $2;
661 if ($l =~ /(\d+)\s+Import/) {
662 $self->{info}->{io} = $1 ;
664 $self->{info}->{io} = 0;
669 $self->debug($self) ;
674 my ($self, $slot) = @_;
677 if ($self->{slot}->[$slot] eq 'loaded') {
681 my $label = $self->{slot}->[$slot] ;
683 return $self->is_media_loaded($label);
688 my ($self, $drive, $slot) = @_;
690 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
691 return 0 if ($self->slot_is_full($slot)) ;
693 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
696 my $content = $self->get_slot($slot);
697 print "content = $content<br/> $drive => $slot<br/>";
698 $self->set_empty_drive($drive);
699 $self->set_slot($slot, $content);
702 $self->{error} = $out;
707 # TODO: load/unload have to use mtx script from bacula
710 my ($self, $drive, $slot) = @_;
712 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
713 return 0 unless ($self->slot_is_full($slot)) ;
715 print "Loading drive $drive with slot $slot<br/>\n";
716 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
719 my $content = $self->get_slot($slot);
720 print "content = $content<br/> $slot => $drive<br/>";
721 $self->set_drive($drive, $slot, $content);
724 $self->{error} = $out;
732 my ($self, $media) = @_;
734 unless ($self->{label}->{$media}) {
738 if ($self->{label}->{$media} =~ /drive\d+/) {
748 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
753 my ($self, $slot, $tag) = @_;
754 $self->{slot}->[$slot] = $tag || 'full';
755 push @{ $self->{io} }, $slot;
758 $self->{label}->{$tag} = $slot;
764 my ($self, $slot) = @_;
766 push @{ $self->{io} }, $slot;
768 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
769 $self->{slot}->[$slot] = 'empty';
775 my ($self, $slot) = @_;
776 return $self->{slot}->[$slot];
781 my ($self, $slot, $tag) = @_;
782 $self->{slot}->[$slot] = $tag || 'full';
785 $self->{label}->{$tag} = $slot;
791 my ($self, $slot) = @_;
793 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
794 $self->{slot}->[$slot] = 'empty';
800 my ($self, $drive) = @_;
801 $self->{drive}->[$drive] = 'empty';
806 my ($self, $drive, $slot, $tag) = @_;
807 $self->{drive}->[$drive] = $tag || $slot;
808 $self->{drive_slot}->[$drive] = $slot;
810 $self->{slot}->[$slot] = $tag || 'loaded';
813 $self->{label}->{$tag} = "drive$drive";
819 my ($self, $slot) = @_;
821 # slot don't exists => full
822 if (not defined $self->{slot}->[$slot]) {
826 if ($self->{slot}->[$slot] eq 'empty') {
829 return 1; # vol, full, loaded
832 sub slot_get_first_free
835 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
836 return $slot unless ($self->slot_is_full($slot));
840 sub io_get_first_free
844 foreach my $slot (@{ $self->{io} }) {
845 return $slot unless ($self->slot_is_full($slot));
852 my ($self, $media) = @_;
854 return $self->{label}->{$media} ;
859 my ($self, $media) = @_;
861 return defined $self->{label}->{$media} ;
866 my ($self, $slot) = @_;
868 unless ($self->slot_is_full($slot)) {
869 print "Autochanger $self->{name} slot $slot is empty<br>\n";
874 if ($self->is_slot_loaded($slot)) {
877 print "Autochanger $self->{name} $slot is currently in use<br>\n";
881 # autochanger must have I/O
882 unless ($self->have_io()) {
883 print "Autochanger $self->{name} don't have I/O, you can take media yourself<br>\n";
887 my $dst = $self->io_get_first_free();
890 print "Autochanger $self->{name} mailbox is full, you must empty I/O first<br>\n";
894 $self->transfer($slot, $dst);
899 my ($self, $src, $dst) = @_ ;
900 if ($self->{debug}) {
901 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
903 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
906 my $content = $self->get_slot($src);
907 $self->{slot}->[$src] = 'empty';
908 $self->set_slot($dst, $content);
911 $self->{error} = $out;
918 my ($self, $index) = @_;
919 return $self->{drive_name}->[$index];
922 # TODO : do a tapeinfo request to get informations
932 print "<table><tr>\n";
933 for my $slot (@{$self->{io}})
935 if ($self->is_slot_loaded($slot)) {
936 print "<td></td><td>Slot $slot is currently loaded</td></tr>\n";
940 if ($self->slot_is_full($slot))
942 my $free = $self->slot_get_first_free() ;
943 print "</tr><tr><td>move slot $slot to $free :</td>";
946 if ($self->transfer($slot, $free)) {
947 print "<td><img src='/bweb/T.png' alt='ok'></td>\n";
949 print "<td><img src='/bweb/E.png' alt='ok' title='$self->{error}'></td>\n";
953 $self->{error} = "<td><img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'></td>\n";
957 print "</tr></table>\n";
960 # TODO : this is with mtx status output,
961 # we can do an other function from bacula view (with StorageId)
965 my $bweb = $self->{bweb};
967 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
968 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
971 SELECT Media.VolumeName AS volumename,
972 Media.VolStatus AS volstatus,
973 Media.LastWritten AS lastwritten,
974 Media.VolBytes AS volbytes,
975 Media.MediaType AS mediatype,
977 Media.InChanger AS inchanger,
979 $bweb->{sql}->{FROM_UNIXTIME}(
980 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
981 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
984 INNER JOIN Pool USING (PoolId)
986 WHERE Media.VolumeName IN ($media_list)
989 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
991 # TODO : verify slot and bacula slot
995 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
997 if ($self->slot_is_full($slot)) {
999 my $vol = $self->{slot}->[$slot];
1000 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
1002 my $bslot = $all->{$vol}->{slot} ;
1003 my $inchanger = $all->{$vol}->{inchanger};
1005 # if bacula slot or inchanger flag is bad, we display a message
1006 if ($bslot != $slot or !$inchanger) {
1007 push @to_update, $slot;
1010 $all->{$vol}->{realslot} = $slot;
1012 push @{ $param }, $all->{$vol};
1014 } else { # empty or no label
1015 push @{ $param }, {realslot => $slot,
1016 volstatus => 'Unknown',
1017 volumename => $self->{slot}->[$slot]} ;
1020 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
1024 my $i=0; my $drives = [] ;
1025 foreach my $d (@{ $self->{drive} }) {
1026 $drives->[$i] = { index => $i,
1027 load => $self->{drive}->[$i],
1028 name => $self->{drive_name}->[$i],
1033 $bweb->display({ Name => $self->{name},
1034 nb_drive => $self->{info}->{drive},
1035 nb_io => $self->{info}->{io},
1038 Update => scalar(@to_update) },
1045 ################################################################
1047 package Bweb::Sched;
1048 use base q/Bweb::Gui/;
1052 Bweb::Sched() - Bweb package that parse show schedule ouput
1054 new Bweb::Sched(format => '%Y-%m-%d', year => 2008);
1058 my $b = $bweb->get_bconsole();
1059 my $s = $b->send_cmd("show schedule");
1060 my $sched = new Bweb::Sched(begin => '2007-01-01', end => '2007-01-02 12:00');
1061 $sched->parse_scheds(split(/\r?\n/, $s));
1072 'level' => 'Differential',
1079 my ($class, @arg) = @_;
1080 my $self = $class->SUPER::new(@arg);
1082 # we compare the current schedule date with begin and end
1083 # in a float form ex: 20071212.1243 > 20070101
1084 if ($self->{begin} and $self->{end}) {
1085 ($self->{fbegin}, $self->{fend}) = ($self->{begin}, $self->{end});
1086 $self->{fbegin} =~ s/(-|:)//g; $self->{fbegin} =~ s/ /./;
1087 $self->{fend} =~ s/(-|:)//g; $self->{fend} =~ s/ /./;
1090 bless($self,$class);
1092 if ($self->{bconsole}) {
1093 my $sel = $self->{name}?"=\"$self->{name}\"":'';
1094 my $b = $self->{bconsole};
1095 my $out = $b->send_cmd("show schedule$sel");
1096 $self->parse_scheds(split(/\r?\n/, $out));
1097 undef $self->{bconsole}; # useless now
1103 # cleanup and add a schedule
1106 my ($self, $name, $info) = @_;
1107 # bacula uses dates that start from 0, we start from 1
1108 foreach (@{$info->{mday}},@{$info->{month}}) { $_++ };
1111 $info->{event} = [ $self->get_events($info, $self->{format}) ];
1113 foreach my $i (qw/hour mday month wday wom woy mins/) {
1117 push @{$self->{schedules}->{$name}}, $info;
1120 # return the name of all schedules
1123 my ($self, $name) = @_;
1125 return keys %{ $self->{schedules} };
1128 # return an array of all schedule
1131 my ($self, $sched) = @_;
1132 return $self->{schedules}->{$sched};
1135 # return an ref array of all events
1136 # [ '2007-12-19 04:05', '2007-12-19 04:05' ]
1139 my ($self, $sched) = @_;
1140 return $sched->{event};
1143 # return the pool name
1146 my ($self, $sched) = @_;
1147 return $sched->{pool} || '';
1150 # return the level name (Incremental, Differential, Full)
1153 my ($self, $sched) = @_;
1154 return $sched->{level};
1157 # parse bacula sched bitmap
1160 my ($self, @output) = @_;
1167 foreach my $ligne (@output) {
1168 if ($ligne =~ /Schedule: name=(.+)/) {
1169 if ($name and $elt) {
1170 $elt->{level} = $run;
1171 $self->add_sched($name, $elt);
1176 elsif ($ligne =~ /Run Level=(.+)/) {
1177 if ($name and $elt) {
1178 $elt->{level} = $run;
1179 $self->add_sched($name, $elt);
1184 elsif ($ligne =~ /(hour|mday|month|mins)=(.+)/) {
1185 # All theses lines have the same format
1187 my ($k,$v) = ($1,$2);
1188 # we get all values (0 1 4 9)
1189 $elt->{$k}=[split (/\s/,$v)];
1191 # we make a bitmap for this kind of data (0 0 1 0 0 0 1) for a quick access
1192 elsif ($ligne =~ /(wday|wom|woy)=(.+)/) {
1193 my ($k,$v) = ($1,$2);
1194 foreach my $e (split (/\s/,$v)) {
1198 elsif ($ligne =~ /Pool: name=(.+?) PoolType/) {
1203 if ($name and $elt) {
1204 $elt->{level} = $run;
1205 $self->add_sched($name, $elt);
1209 use Date::Calc qw(:all);
1211 # read bacula schedule bitmap and get $format date string
1215 my ($self, $s,$format) = @_;
1216 my $year = $self->{year} || ((localtime)[5] + 1900);
1217 $format = $format || '%u-%02u-%02u %02u:%02u';
1219 foreach my $m (@{$s->{month}}) # mois de l'annee
1221 foreach my $md (@{$s->{mday}}) # jour du mois
1223 # print " m=$m md=$md\n";
1224 # we check if this day exists (31 fev)
1225 next if (!check_date($year,$m,$md));
1226 # print " check_date ok\n";
1228 my $w = ($md-1)/7; # we use the same thing than bacula
1229 next if (! $s->{wom}->[$w]);
1230 # print " wom ok\n";
1232 # on recupere le jour de la semaine
1233 my $wd = Day_of_Week($year,$m,$md);
1235 my ($w1,undef) = Week_of_Year($year,$m,$wd);
1236 next if (! $s->{woy}->[$w1-1]); # bacula 0-51
1237 # print " woy ok\n";
1239 $wd = 0 if ($wd == 7) ; # sunday is 0 on bacula
1240 next if (! $s->{wday}->[$wd]);
1241 # print " wday ok\n";
1243 foreach my $h (@{$s->{hour}}) # hour of the day
1245 foreach my $min (@{$s->{mins}}) # minute
1247 if ($self->{fbegin}) {
1249 my $d = sprintf('%d%0.2d%0.2d.%0.2d%0.2d',
1250 $year,$m,$md,$h,$min);
1251 next if ($d < $self->{fbegin} or $d > $self->{fend});
1253 push @ret, sprintf($format, $year,$m,$md,$h,$min);
1262 ################################################################
1266 use base q/Bweb::Gui/;
1270 Bweb - main Bweb package
1274 this package is use to compute and display informations
1279 use POSIX qw/strftime/;
1281 our $config_file= '/etc/bacula/bweb.conf';
1283 if ($ENV{BWEBCONF} && -f $ENV{BWEBCONF}) {
1284 $config_file = $ENV{BWEBCONF};
1291 %sql_func - hash to make query mysql/postgresql compliant
1297 UNIX_TIMESTAMP => '',
1298 FROM_UNIXTIME => '',
1299 TO_SEC => " interval '1 second' * ",
1300 SEC_TO_INT => "SEC_TO_INT",
1303 STARTTIME_SEC => " date_trunc('sec', Job.StartTime) ",
1304 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1305 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1306 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1307 STARTTIME_WEEK => " date_trunc('week', Job.StartTime) ",
1308 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1309 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1310 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1311 STARTTIME_PWEEK => " date_part('week', Job.StartTime) ",
1312 DB_SIZE => " SELECT pg_database_size(current_database()) ",
1313 CAT_POOL_TYPE => " MediaType || '_' || Pool.Name ",
1317 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1318 FROM_UNIXTIME => 'FROM_UNIXTIME',
1321 SEC_TO_TIME => 'SEC_TO_TIME',
1322 MATCH => " REGEXP ",
1323 STARTTIME_SEC => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %T') ",
1324 STARTTIME_DAY => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d') ",
1325 STARTTIME_HOUR => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %H') ",
1326 STARTTIME_MONTH => " DATE_FORMAT(Job.StartTime, '%Y-%m') ",
1327 STARTTIME_WEEK => " DATE_FORMAT(Job.StartTime, '%Y-%v') ",
1328 STARTTIME_PHOUR=> " DATE_FORMAT(Job.StartTime, '%H') ",
1329 STARTTIME_PDAY => " DATE_FORMAT(Job.StartTime, '%d') ",
1330 STARTTIME_PMONTH => " DATE_FORMAT(Job.StartTime, '%m') ",
1331 STARTTIME_PWEEK => " DATE_FORMAT(Job.StartTime, '%v') ",
1332 # with mysql < 5, you have to play with the ugly SHOW command
1333 #DB_SIZE => " SELECT 0 ",
1334 # works only with mysql 5
1335 DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1336 CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1337 CONCAT_SEP => " SEPARATOR '' ",
1344 return $self->{info}->{dbi} =~ /dbi:mysql/i;
1351 $self->{dbh}->disconnect();
1356 sub dbh_selectall_arrayref
1358 my ($self, $query) = @_;
1359 $self->connect_db();
1360 $self->debug($query);
1361 return $self->{dbh}->selectall_arrayref($query);
1366 my ($self, @what) = @_;
1367 return join(',', $self->dbh_quote(@what)) ;
1372 my ($self, @what) = @_;
1374 $self->connect_db();
1376 return map { $self->{dbh}->quote($_) } @what;
1378 return $self->{dbh}->quote($what[0]) ;
1384 my ($self, $query) = @_ ;
1385 $self->connect_db();
1386 $self->debug($query);
1387 return $self->{dbh}->do($query);
1390 sub dbh_selectall_hashref
1392 my ($self, $query, $join) = @_;
1394 $self->connect_db();
1395 $self->debug($query);
1396 return $self->{dbh}->selectall_hashref($query, $join) ;
1399 sub dbh_selectrow_hashref
1401 my ($self, $query) = @_;
1403 $self->connect_db();
1404 $self->debug($query);
1405 return $self->{dbh}->selectrow_hashref($query) ;
1410 my ($self, @what) = @_;
1411 if ($self->dbh_is_mysql()) {
1412 return 'CONCAT(' . join(',', @what) . ')' ;
1414 return join(' || ', @what);
1420 my ($self, $query) = @_;
1421 $self->debug($query, up => 1);
1422 return $self->{dbh}->prepare($query);
1428 my @unit = qw(B KB MB GB TB);
1429 my $val = shift || 0;
1431 my $format = '%i %s';
1432 while ($val / 1024 > 1) {
1436 $format = ($i>0)?'%0.1f %s':'%i %s';
1437 return sprintf($format, $val, $unit[$i]);
1444 if ($val =~ /^(?:\d+(?:[ywdhms]\s*)?)+\s*$/) {
1459 # display Day, Hour, Year
1465 $val /= 60; # sec -> min
1467 if ($val / 60 <= 1) {
1471 $val /= 60; # min -> hour
1472 if ($val / 24 <= 1) {
1473 return "$val hours";
1476 $val /= 24; # hour -> day
1477 if ($val / 365 < 2) {
1481 $val /= 365 ; # day -> year
1483 return "$val years";
1489 my $val = shift || 0;
1491 if ($val eq '1' or $val eq "yes") {
1493 } elsif ($val eq '2' or $val eq "archived") {
1501 sub from_human_enabled
1503 my $val = shift || 0;
1505 if ($val eq '1' or $val eq "yes") {
1507 } elsif ($val eq '2' or $val eq "archived") {
1514 # get Day, Hour, Year
1520 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1524 my %times = ( m => 60,
1530 my $mult = $times{$2} || 0;
1535 # get long term statistic table
1539 my $ret = $self->{info}->{stat_job_table} || 'JobHisto';
1540 if ($ret !~ m/^job$/i) {
1541 $ret = "(SELECT * FROM Job UNION SELECT * FROM $ret)";
1550 unless ($self->{dbh}) {
1552 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1553 $self->{info}->{user},
1554 $self->{info}->{password});
1556 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1557 unless ($self->{dbh});
1559 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1561 if ($self->dbh_is_mysql()) {
1562 $self->{dbh}->do("SET group_concat_max_len=1000000");
1564 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1571 my ($class, %arg) = @_;
1573 dbh => undef, # connect_db();
1575 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1581 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1583 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1584 $self->{sql} = $sql_func{$1};
1587 $self->{loginname} = CGI::remote_user();
1588 $self->{debug} = $self->{info}->{debug};
1589 $self->{lang} = $self->{info}->{lang};
1590 $self->{template_dir} = $self->{info}->{template_dir};
1598 if ($self->{info}->{enable_security}) {
1599 $self->get_roles(); # get lang
1601 $self->display($self->{info}, "begin.tpl");
1607 $self->display($self->{info}, "end.tpl");
1613 my $arg = $self->get_form("qclient");
1614 my $f1 = $self->get_client_group_filter();
1615 my $f2 = $self->get_client_filter();
1617 # client_group_name | here
1618 #-------------------+-----
1623 SELECT client_group_name, max(here) AS here FROM (
1624 SELECT client_group_name, 1 AS here
1626 JOIN client_group_member USING (client_group_id)
1627 JOIN Client USING (ClientId) $f2
1628 WHERE Name = $arg->{qclient}
1630 SELECT client_group_name, 0
1631 FROM client_group $f1
1633 GROUP by client_group_name";
1635 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
1637 $self->display({ client_group => [ values %$all ], %$arg }, "client_edit.tpl");
1643 my $where=''; # by default
1645 my $arg = $self->get_form("client", "qre_client",
1646 "jclient_groups", "qnotingroup");
1648 if ($arg->{qre_client}) {
1649 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1650 } elsif ($arg->{client}) {
1651 $where = "WHERE Name = '$arg->{client}' ";
1652 } elsif ($arg->{jclient_groups}) {
1653 # $filter could already contains client_group_member
1655 JOIN client_group_member USING (ClientId)
1656 JOIN client_group USING (client_group_id)
1657 WHERE client_group_name IN ($arg->{jclient_groups}) ";
1658 } elsif ($arg->{qnotingroup}) {
1661 (SELECT 1 FROM client_group_member
1662 WHERE Client.ClientId = client_group_member.ClientId
1668 SELECT Name AS name,
1670 AutoPrune AS autoprune,
1671 FileRetention AS fileretention,
1672 JobRetention AS jobretention
1673 FROM Client " . $self->get_client_filter() .
1676 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1678 my $dsp = { ID => $cur_id++,
1679 clients => [ values %$all] };
1681 $self->display($dsp, "client_list.tpl") ;
1686 my ($self, %arg) = @_;
1691 if ($arg{since} and $arg{age}) {
1692 my $now = "$self->{sql}->{UNIX_TIMESTAMP}(TIMESTAMP '$arg{since}')";
1694 AND $self->{sql}->{UNIX_TIMESTAMP}(StartTime) > $now
1695 AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime) < ($now + $self->{sql}->{TO_SEC}($arg{age}))";
1696 $label .= "since $arg{since} and during " . human_sec($arg{age});
1698 } elsif ($arg{age}) {
1700 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1702 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1704 $self->{sql}->{TO_SEC}($arg{age})
1707 $label = "last " . human_sec($arg{age});
1710 if ($arg{groupby}) {
1711 $limit .= " GROUP BY $arg{groupby} ";
1715 $limit .= " ORDER BY $arg{order} ";
1719 $limit .= " LIMIT $arg{limit} ";
1720 $label .= " limited to $arg{limit}";
1724 $limit .= " OFFSET $arg{offset} ";
1725 $label .= " with $arg{offset} offset ";
1729 $label = 'no filter';
1732 return ($limit, $label);
1737 $bweb->get_form(...) - Get useful stuff
1741 This function get and check parameters against regexp.
1743 If word begin with 'q', the return will be quoted or join quoted
1744 if it's end with 's'.
1749 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1752 qclient => 'plume-fd',
1753 qpools => "'plume-fd', 'test-fd', '...'",
1760 my ($self, @what) = @_;
1761 my %what = map { $_ => 1 } @what;
1775 age => $self->{info}->{default_age},
1785 my %opt_ss =( # string with space
1789 my %opt_s = ( # default to ''
1811 my %opt_p = ( # option with path
1818 my %opt_r = (regexwhere => 1);
1819 my %opt_d = ( # option with date
1823 my %opt_t = (when => 2, # option with time
1824 begin => 1, # 1 hh:min are optionnal
1825 end => 1, # 2 hh:min are required
1828 foreach my $i (@what) {
1829 if (exists $opt_i{$i}) {# integer param
1830 my $value = CGI::param($i) || $opt_i{$i} ;
1831 if ($value =~ /^(\d+)$/) {
1833 } elsif ($i eq 'age' && # can have unit
1834 $value =~ /^(?:\d+(?:[ywdhms]\s*)?)+\s*$/) # 2y1h2m34s
1836 $ret{$i} = human_sec_unit($value);
1838 } elsif ($opt_s{$i}) { # simple string param
1839 my $value = CGI::param($i) || '';
1840 if ($value =~ /^([\w\d\.-]+)$/) {
1843 } elsif ($opt_ss{$i}) { # simple string param (with space)
1844 my $value = CGI::param($i) || '';
1845 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1848 } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1849 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1851 $ret{$i} = $self->dbh_join(@value) ;
1854 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1855 my $value = CGI::param($1) ;
1857 $ret{$i} = $self->dbh_quote($value);
1860 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1861 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1862 grep { ! /^\s*$/ } CGI::param($1) ];
1863 } elsif (exists $opt_p{$i}) {
1864 my $value = CGI::param($i) || '';
1865 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1868 } elsif (exists $opt_r{$i}) {
1869 my $value = CGI::param($i) || '';
1870 if ($value =~ /^([^'"']+)$/) {
1873 } elsif (exists $opt_d{$i}) {
1874 my $value = CGI::param($i) || '';
1875 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1878 } elsif (exists $opt_t{$i}) { # 1: hh:min optionnal, 2: hh:min required
1879 my $when = CGI::param($i) || '';
1880 if ($when =~ /(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}(:\d{2})?)?)/) {
1881 if ($opt_t{$i} == 1 or defined $2) {
1888 if ($what{storage_cmd}) {
1889 if (!grep {/^\Q$ret{storage_cmd}\E$/} ('mount', 'umount', 'release','status')) {
1890 delete $ret{storage_cmd};
1895 foreach my $s (CGI::param('slot')) {
1896 if ($s =~ /^(\d+)$/) {
1897 push @{$ret{slots}}, $s;
1903 my $age = $ret{age} || human_sec_unit($opt_i{age});
1904 my $since = CGI::param('since') || strftime('%F %T', localtime(time - $age));
1905 if ($since =~ /^(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?)$/) {
1911 my $lang = CGI::param('lang') || 'en';
1912 if ($lang =~ /^(\w\w)$/) {
1917 if ($what{db_clients}) {
1919 if ($what{filter}) {
1920 # get security filter only if asked
1921 $filter = $self->get_client_filter();
1925 SELECT Client.Name as clientname
1929 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1930 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1934 if ($what{db_client_groups}) {
1936 if ($what{filter}) {
1937 # get security filter only if asked
1938 $filter = $self->get_client_group_filter();
1942 SELECT client_group_name AS name, comment AS comment
1943 FROM client_group $filter
1945 my $grps = $self->dbh_selectall_hashref($query, 'name');
1946 $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1950 if ($what{db_usernames}) {
1952 SELECT username, comment
1955 my $users = $self->dbh_selectall_hashref($query, 'username');
1956 $ret{db_usernames} = [sort {$a->{username} cmp $b->{username} }
1960 if ($what{db_roles}) {
1962 SELECT rolename, comment
1965 my $r = $self->dbh_selectall_hashref($query, 'rolename');
1966 $ret{db_roles} = [sort {$a->{rolename} cmp $b->{rolename} }
1970 if ($what{db_mediatypes}) {
1972 SELECT MediaType as mediatype
1975 my $media = $self->dbh_selectall_hashref($query, 'mediatype');
1976 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1980 if ($what{db_locations}) {
1982 SELECT Location as location, Cost as cost
1985 my $loc = $self->dbh_selectall_hashref($query, 'location');
1986 $ret{db_locations} = [ sort { $a->{location}
1992 if ($what{db_pools}) {
1993 my $query = "SELECT Name as name FROM Pool";
1995 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1996 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1999 if ($what{db_filesets}) {
2001 SELECT FileSet.FileSet AS fileset
2004 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
2006 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
2007 values %$filesets] ;
2010 if ($what{db_jobnames}) {
2012 if ($what{filter}) {
2013 $filter = " JOIN Client USING (ClientId) " . $self->get_client_filter();
2016 SELECT DISTINCT Job.Name AS jobname
2019 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
2021 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
2022 values %$jobnames] ;
2025 if ($what{db_devices}) {
2027 SELECT Device.Name AS name
2030 my $devices = $self->dbh_selectall_hashref($query, 'name');
2032 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
2042 $self->can_do('r_view_stat');
2043 my $fields = $self->get_form(qw/age level status clients filesets
2044 graph gtype type filter db_clients
2045 limit db_filesets width height
2046 qclients qfilesets qjobnames db_jobnames/);
2048 my $url = CGI::url(-full => 0,
2051 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
2053 # this organisation is to keep user choice between 2 click
2054 # TODO : fileset and client selection doesn't work
2061 if ($fields->{gtype} and $fields->{gtype} eq 'balloon') {
2062 system("./bgraph.pl");
2066 sub get_selected_media_location
2070 my $media = $self->get_form('jmedias');
2072 unless ($media->{jmedias}) {
2077 SELECT Media.VolumeName AS volumename, Location.Location AS location
2078 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2079 WHERE Media.VolumeName IN ($media->{jmedias})
2082 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2084 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
2093 my ($self, $in) = @_ ;
2094 $self->can_do('r_media_mgnt');
2095 my $media = $self->get_selected_media_location();
2101 my $elt = $self->get_form('db_locations');
2103 $self->display({ ID => $cur_id++,
2104 enabled => human_enabled($in),
2105 %$elt, # db_locations
2107 sort { $a->{volumename} cmp $b->{volumename} } values %$media
2116 $self->can_do('r_media_mgnt');
2118 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
2120 $self->display($elt, "help_extern.tpl");
2123 sub help_extern_compute
2126 $self->can_do('r_media_mgnt');
2128 my $number = CGI::param('limit') || '' ;
2129 unless ($number =~ /^(\d+)$/) {
2130 return $self->error("Bad arg number : $number ");
2133 my ($sql, undef) = $self->get_param('pools',
2134 'locations', 'mediatypes');
2137 SELECT Media.VolumeName AS volumename,
2138 Media.VolStatus AS volstatus,
2139 Media.LastWritten AS lastwritten,
2140 Media.MediaType AS mediatype,
2141 Media.VolMounts AS volmounts,
2143 Media.Recycle AS recycle,
2144 $self->{sql}->{FROM_UNIXTIME}(
2145 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2146 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2149 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2150 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2152 WHERE Media.InChanger = 1
2153 AND Media.VolStatus IN ('Disabled', 'Error', 'Full', 'Used')
2155 ORDER BY expire DESC, recycle, Media.VolMounts DESC
2159 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2161 $self->display({ Media => [ values %$all ] },
2162 "help_extern_compute.tpl");
2168 $self->can_do('r_media_mgnt');
2170 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
2171 $self->display($param, "help_intern.tpl");
2174 sub help_intern_compute
2177 $self->can_do('r_media_mgnt');
2179 my $number = CGI::param('limit') || '' ;
2180 unless ($number =~ /^(\d+)$/) {
2181 return $self->error("Bad arg number : $number ");
2184 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
2186 if (CGI::param('expired')) {
2187 # we take only expired volumes or purged/recycle ones
2190 ( ($self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2191 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2194 Media.VolStatus IN ('Purged', 'Recycle')
2201 SELECT Media.VolumeName AS volumename,
2202 Media.VolStatus AS volstatus,
2203 Media.LastWritten AS lastwritten,
2204 Media.MediaType AS mediatype,
2205 Media.VolMounts AS volmounts,
2207 $self->{sql}->{FROM_UNIXTIME}(
2208 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2209 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2212 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2213 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
2215 WHERE Media.InChanger <> 1
2216 AND Media.VolStatus IN ('Purged', 'Full', 'Append', 'Recycle')
2217 AND Media.Recycle = 1
2219 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
2223 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2225 $self->display({ Media => [ values %$all ] },
2226 "help_intern_compute.tpl");
2232 my ($self, %arg) = @_ ;
2234 my ($limit, $label) = $self->get_limit(%arg);
2238 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
2239 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
2240 (SELECT count(Job.JobId) FROM Job) AS nb_job,
2241 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
2242 ($self->{sql}->{DB_SIZE}) AS db_size,
2243 (SELECT count(Job.JobId)
2245 WHERE Job.JobStatus IN ('E','e','f','A')
2248 (SELECT count(Client.ClientId) FROM Client) AS nb_client
2251 my $row = $self->dbh_selectrow_hashref($query) ;
2253 $row->{nb_bytes} = human_size($row->{nb_bytes});
2255 $row->{db_size} = human_size($row->{db_size});
2256 $row->{label} = $label;
2257 $row->{age} = $arg{age};
2259 $self->display($row, "general.tpl");
2264 my ($self, @what) = @_ ;
2265 my %elt = map { $_ => 1 } @what;
2270 if ($elt{clients}) {
2271 my @clients = grep { ! /^\s*$/ } CGI::param('client');
2273 $ret{clients} = \@clients;
2274 my $str = $self->dbh_join(@clients);
2275 $limit .= "AND Client.Name IN ($str) ";
2279 if ($elt{client_groups}) {
2280 my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
2282 $ret{client_groups} = \@clients;
2283 my $str = $self->dbh_join(@clients);
2284 $limit .= "AND client_group_name IN ($str) ";
2288 if ($elt{filesets}) {
2289 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
2291 $ret{filesets} = \@filesets;
2292 my $str = $self->dbh_join(@filesets);
2293 $limit .= "AND FileSet.FileSet IN ($str) ";
2297 if ($elt{mediatypes}) {
2298 my @media = grep { ! /^\s*$/ } CGI::param('mediatype');
2300 $ret{mediatypes} = \@media;
2301 my $str = $self->dbh_join(@media);
2302 $limit .= "AND Media.MediaType IN ($str) ";
2307 my $client = CGI::param('client');
2309 $ret{client} = $client;
2310 $client = $self->dbh_quote($client);
2311 $limit .= "AND Client.Name = $client ";
2316 my $level = CGI::param('level') || '';
2317 if ($level =~ /^(\w)$/) {
2319 $limit .= "AND Job.Level = '$1' ";
2324 my $jobid = CGI::param('jobid') || '';
2326 if ($jobid =~ /^(\d+)$/) {
2328 $limit .= "AND Job.JobId = '$1' ";
2333 my $status = CGI::param('status') || '';
2334 if ($status =~ /^(\w)$/) {
2337 $limit .= "AND Job.JobStatus IN ('E','e','f','A') ";
2338 } elsif ($1 eq 'W') {
2339 $limit .= "AND Job.JobStatus IN ('T', 'W') OR Job.JobErrors > 0 ";
2341 $limit .= "AND Job.JobStatus = '$1' ";
2346 if ($elt{volstatus}) {
2347 my $status = CGI::param('volstatus') || '';
2348 if ($status =~ /^(\w+)$/) {
2350 $limit .= "AND Media.VolStatus = '$1' ";
2354 if ($elt{locations}) {
2355 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
2357 $ret{locations} = \@location;
2358 my $str = $self->dbh_join(@location);
2359 $limit .= "AND Location.Location IN ($str) ";
2364 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
2366 $ret{pools} = \@pool;
2367 my $str = $self->dbh_join(@pool);
2368 $limit .= "AND Pool.Name IN ($str) ";
2372 if ($elt{location}) {
2373 my $location = CGI::param('location') || '';
2375 $ret{location} = $location;
2376 $location = $self->dbh_quote($location);
2377 $limit .= "AND Location.Location = $location ";
2382 my $pool = CGI::param('pool') || '';
2385 $pool = $self->dbh_quote($pool);
2386 $limit .= "AND Pool.Name = $pool ";
2390 if ($elt{jobtype}) {
2391 my $jobtype = CGI::param('jobtype') || '';
2392 if ($jobtype =~ /^(\w)$/) {
2394 $limit .= "AND Job.Type = '$1' ";
2398 return ($limit, %ret);
2409 my ($self, %arg) = @_ ;
2410 return if $self->cant_do('r_view_job');
2412 $arg{order} = ' Job.JobId DESC ';
2414 my ($limit, $label) = $self->get_limit(%arg);
2415 my ($where, undef) = $self->get_param('clients',
2424 if (CGI::param('client_group')) {
2426 JOIN client_group_member USING (ClientId)
2427 JOIN client_group USING (client_group_id)
2430 my $filter = $self->get_client_filter();
2433 SELECT Job.JobId AS jobid,
2434 Client.Name AS client,
2435 FileSet.FileSet AS fileset,
2436 Job.Name AS jobname,
2438 StartTime AS starttime,
2440 Pool.Name AS poolname,
2441 JobFiles AS jobfiles,
2442 JobBytes AS jobbytes,
2443 JobStatus AS jobstatus,
2445 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2446 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2449 JobErrors AS joberrors
2451 FROM Client $filter $cgq,
2452 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2453 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2454 WHERE Client.ClientId=Job.ClientId
2455 AND Job.JobStatus NOT IN ('R', 'C')
2460 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2462 $self->display({ Filter => $label,
2466 sort { $a->{jobid} <=> $b->{jobid} }
2473 # display job informations
2474 sub display_job_zoom
2476 my ($self, $jobid) = @_ ;
2477 $self->can_do('r_view_job');
2479 $jobid = $self->dbh_quote($jobid);
2481 # get security filter
2482 my $filter = $self->get_client_filter();
2485 SELECT DISTINCT Job.JobId AS jobid,
2486 Client.Name AS client,
2487 Job.Name AS jobname,
2488 FileSet.FileSet AS fileset,
2490 Pool.Name AS poolname,
2491 StartTime AS starttime,
2492 JobFiles AS jobfiles,
2493 JobBytes AS jobbytes,
2494 JobStatus AS jobstatus,
2495 JobErrors AS joberrors,
2497 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2498 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2500 FROM Client $filter,
2501 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2502 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2503 WHERE Client.ClientId=Job.ClientId
2504 AND Job.JobId = $jobid
2507 my $row = $self->dbh_selectrow_hashref($query) ;
2509 # display all volumes associate with this job
2511 SELECT Media.VolumeName as volumename
2512 FROM Job,Media,JobMedia
2513 WHERE Job.JobId = $jobid
2514 AND JobMedia.JobId=Job.JobId
2515 AND JobMedia.MediaId=Media.MediaId
2518 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2520 $row->{volumes} = [ values %$all ] ;
2521 $row->{wiki_url} = $self->{info}->{wiki_url};
2523 $self->display($row, "display_job_zoom.tpl");
2526 sub display_job_group
2528 my ($self, %arg) = @_;
2529 $self->can_do('r_view_job');
2531 my ($limit, $label) = $self->get_limit(groupby => 'client_group_name', %arg);
2533 my ($where, undef) = $self->get_param('client_groups',
2536 my $filter = $self->get_client_group_filter();
2539 SELECT client_group_name AS client_group_name,
2540 COALESCE(jobok.jobfiles,0) + COALESCE(joberr.jobfiles,0) AS jobfiles,
2541 COALESCE(jobok.jobbytes,0) + COALESCE(joberr.jobbytes,0) AS jobbytes,
2542 COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2543 COALESCE(jobok.nbjobs,0) AS nbjobok,
2544 COALESCE(joberr.nbjobs,0) AS nbjoberr,
2545 COALESCE(jobok.duration, '0:0:0') AS duration
2547 FROM client_group $filter LEFT JOIN (
2548 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2549 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2550 SUM(JobErrors) AS joberrors,
2551 SUM($self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2552 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2555 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2556 JOIN client_group USING (client_group_id)
2558 WHERE Type IN ('B', 'R') AND JobStatus IN ('T', 'W')
2561 ) AS jobok USING (client_group_name) LEFT JOIN
2564 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2565 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2566 SUM(JobErrors) AS joberrors
2567 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2568 JOIN client_group USING (client_group_id)
2570 WHERE Type IN ('B', 'R') AND JobStatus IN ('f','E', 'A')
2573 ) AS joberr USING (client_group_name)
2577 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2579 my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2582 $self->display($rep, "display_job_group.tpl");
2587 my ($self, %arg) = @_ ;
2588 $self->can_do('r_view_media');
2590 my ($limit, $label) = $self->get_limit(%arg);
2591 my ($where, %elt) = $self->get_param('pools',
2596 my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2598 if ($arg->{jmedias}) {
2599 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2601 if ($arg->{qre_media}) {
2602 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2604 if ($arg->{expired}) {
2606 AND VolStatus = ('Full', 'Used')
2607 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2608 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2609 ) < NOW() " . $where ;
2613 SELECT Media.VolumeName AS volumename,
2614 Media.VolBytes AS volbytes,
2615 Media.VolStatus AS volstatus,
2616 Media.MediaType AS mediatype,
2617 Media.InChanger AS online,
2618 Media.LastWritten AS lastwritten,
2619 Location.Location AS location,
2620 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2621 Pool.Name AS poolname,
2622 $self->{sql}->{FROM_UNIXTIME}(
2623 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2624 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2627 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2628 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2629 Media.MediaType AS MediaType
2631 WHERE Media.VolStatus = 'Full'
2632 GROUP BY Media.MediaType
2633 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2635 WHERE Media.PoolId=Pool.PoolId
2640 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2642 $self->display({ ID => $cur_id++,
2644 Location => $elt{location},
2645 Media => [ values %$all ],
2647 "display_media.tpl");
2650 sub display_allmedia
2654 my $pool = $self->get_form('db_pools');
2656 foreach my $name (@{ $pool->{db_pools} }) {
2657 CGI::param('pool', $name->{name});
2658 $self->display_media();
2662 sub display_media_zoom
2666 my $media = $self->get_form('jmedias');
2668 unless ($media->{jmedias}) {
2669 return $self->error("Can't get media selection");
2673 SELECT InChanger AS online,
2674 Media.Enabled AS enabled,
2675 VolBytes AS nb_bytes,
2676 VolumeName AS volumename,
2677 VolStatus AS volstatus,
2678 VolMounts AS nb_mounts,
2679 Media.VolUseDuration AS voluseduration,
2680 Media.MaxVolJobs AS maxvoljobs,
2681 Media.MaxVolFiles AS maxvolfiles,
2682 Media.MaxVolBytes AS maxvolbytes,
2683 VolErrors AS nb_errors,
2684 Pool.Name AS poolname,
2685 Location.Location AS location,
2686 Media.Recycle AS recycle,
2687 Media.VolRetention AS volretention,
2688 Media.LastWritten AS lastwritten,
2689 Media.VolReadTime/1000000 AS volreadtime,
2690 Media.VolWriteTime/1000000 AS volwritetime,
2691 Media.RecycleCount AS recyclecount,
2692 Media.Comment AS comment,
2693 $self->{sql}->{FROM_UNIXTIME}(
2694 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2695 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2698 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2699 WHERE Pool.PoolId = Media.PoolId
2700 AND VolumeName IN ($media->{jmedias})
2703 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2705 foreach my $media (values %$all) {
2706 my $mq = $self->dbh_quote($media->{volumename});
2709 SELECT DISTINCT Job.JobId AS jobid,
2711 Job.StartTime AS starttime,
2714 Job.JobFiles AS files,
2715 Job.JobBytes AS bytes,
2716 Job.jobstatus AS status
2717 FROM Media,JobMedia,Job
2718 WHERE Media.VolumeName=$mq
2719 AND Media.MediaId=JobMedia.MediaId
2720 AND JobMedia.JobId=Job.JobId
2723 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2726 SELECT LocationLog.Date AS date,
2727 Location.Location AS location,
2728 LocationLog.Comment AS comment
2729 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2730 WHERE Media.MediaId = LocationLog.MediaId
2731 AND Media.VolumeName = $mq
2735 my $log = $self->dbh_selectall_arrayref($query) ;
2737 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2740 $self->display({ jobs => [ values %$jobs ],
2741 LocationLog => $logtxt,
2743 "display_media_zoom.tpl");
2750 $self->can_do('r_location_mgnt');
2752 my $loc = $self->get_form('qlocation');
2753 unless ($loc->{qlocation}) {
2754 return $self->error("Can't get location");
2758 SELECT Location.Location AS location,
2759 Location.Cost AS cost,
2760 Location.Enabled AS enabled
2762 WHERE Location.Location = $loc->{qlocation}
2765 my $row = $self->dbh_selectrow_hashref($query);
2766 $row->{enabled} = human_enabled($row->{enabled});
2767 $self->display({ ID => $cur_id++,
2768 %$row }, "location_edit.tpl") ;
2774 $self->can_do('r_location_mgnt');
2776 my $arg = $self->get_form(qw/qlocation qnewlocation cost enabled/) ;
2777 unless ($arg->{qlocation}) {
2778 return $self->error("Can't get location");
2780 unless ($arg->{qnewlocation}) {
2781 return $self->error("Can't get new location name");
2783 unless ($arg->{cost}) {
2784 return $self->error("Can't get new cost");
2787 my $enabled = from_human_enabled($arg->{enabled});
2790 UPDATE Location SET Cost = $arg->{cost},
2791 Location = $arg->{qnewlocation},
2793 WHERE Location.Location = $arg->{qlocation}
2796 $self->dbh_do($query);
2798 $self->location_display();
2804 $self->can_do('r_location_mgnt');
2806 my $arg = $self->get_form(qw/qlocation/) ;
2808 unless ($arg->{qlocation}) {
2809 return $self->error("Can't get location");
2813 SELECT count(Media.MediaId) AS nb
2814 FROM Media INNER JOIN Location USING (LocationID)
2815 WHERE Location = $arg->{qlocation}
2818 my $res = $self->dbh_selectrow_hashref($query);
2821 return $self->error("Sorry, the location must be empty");
2825 DELETE FROM Location WHERE Location = $arg->{qlocation}
2828 $self->dbh_do($query);
2830 $self->location_display();
2836 $self->can_do('r_location_mgnt');
2838 my $arg = $self->get_form(qw/qlocation cost/) ;
2840 unless ($arg->{qlocation}) {
2841 $self->display({}, "location_add.tpl");
2844 unless ($arg->{cost}) {
2845 return $self->error("Can't get new cost");
2848 my $enabled = CGI::param('enabled') || '';
2849 $enabled = from_human_enabled($enabled);
2852 INSERT INTO Location (Location, Cost, Enabled)
2853 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2856 $self->dbh_do($query);
2858 $self->location_display();
2861 sub location_display
2866 SELECT Location.Location AS location,
2867 Location.Cost AS cost,
2868 Location.Enabled AS enabled,
2869 (SELECT count(Media.MediaId)
2871 WHERE Media.LocationId = Location.LocationId
2876 my $location = $self->dbh_selectall_hashref($query, 'location');
2878 $self->display({ ID => $cur_id++,
2879 Locations => [ values %$location ] },
2880 "display_location.tpl");
2887 my $media = $self->get_selected_media_location();
2892 my $arg = $self->get_form('db_locations', 'qnewlocation');
2894 $self->display({ email => $self->{info}->{email_media},
2896 media => [ values %$media ],
2898 "update_location.tpl");
2901 ###########################################################
2906 my $arg = $self->get_form(qw/jclient_groups qclient/);
2908 unless ($arg->{qclient}) {
2909 return $self->error("Can't get client name");
2912 $self->can_do('r_group_mgnt');
2914 my $f1 = $self->get_client_filter();
2915 my $f2 = $self->get_client_group_filter();
2917 $self->{dbh}->begin_work();
2920 DELETE FROM client_group_member
2924 WHERE Client.Name = $arg->{qclient})
2926 $self->dbh_do($query);
2928 if ($arg->{jclient_groups}) {
2930 INSERT INTO client_group_member (client_group_id, ClientId)
2931 (SELECT client_group_id, (SELECT ClientId
2933 WHERE Name = $arg->{qclient})
2934 FROM client_group $f2 WHERE client_group_name IN ($arg->{jclient_groups})
2937 $self->dbh_do($query);
2940 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2942 $self->display_clients();
2948 my $grp = $self->get_form(qw/qclient_group db_clients/);
2950 unless ($grp->{qclient_group}) {
2951 $self->can_do('r_group_mgnt');
2952 $self->display({ ID => $cur_id++,
2953 client_group => "''",
2955 }, "groups_edit.tpl");
2959 unless ($self->cant_do('r_group_mgnt')) {
2960 $self->can_do('r_view_group');
2965 FROM Client JOIN client_group_member using (ClientId)
2966 JOIN client_group using (client_group_id)
2967 WHERE client_group_name = $grp->{qclient_group}
2970 my $row = $self->dbh_selectall_hashref($query, "name");
2972 $self->display({ ID => $cur_id++,
2973 client_group => $grp->{qclient_group},
2975 client_group_member => [ values %$row]},
2982 $self->can_do('r_group_mgnt');
2984 my $arg = $self->get_form(qw/qclient_group jclients qnewgroup qcomment/);
2985 if (!$arg->{qcomment}) {
2986 $arg->{qcomment} = "''";
2989 if (!$arg->{qclient_group} and $arg->{qnewgroup}) {
2991 INSERT INTO client_group (client_group_name, comment)
2992 VALUES ($arg->{qnewgroup}, $arg->{qcomment})
2994 $self->dbh_do($query);
2995 $arg->{qclient_group} = $arg->{qnewgroup};
2998 unless ($arg->{qclient_group}) {
2999 return $self->error("Can't get groups");
3002 $self->{dbh}->begin_work();
3005 DELETE FROM client_group_member
3006 WHERE client_group_id IN
3007 (SELECT client_group_id
3009 WHERE client_group_name = $arg->{qclient_group})
3011 $self->dbh_do($query);
3013 if ($arg->{jclients}) {
3015 INSERT INTO client_group_member (ClientId, client_group_id)
3017 (SELECT client_group_id
3019 WHERE client_group_name = $arg->{qclient_group})
3020 FROM Client WHERE Name IN ($arg->{jclients})
3023 $self->dbh_do($query);
3025 if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
3028 SET client_group_name = $arg->{qnewgroup}, comment = $arg->{qcomment}
3029 WHERE client_group_name = $arg->{qclient_group}
3032 $self->dbh_do($query);
3035 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
3037 $self->display_groups();
3043 $self->can_do('r_group_mgnt');
3045 my $arg = $self->get_form(qw/qclient_group/);
3047 unless ($arg->{qclient_group}) {
3048 return $self->error("Can't get groups");
3051 $self->{dbh}->begin_work();
3054 DELETE FROM client_group_member
3055 WHERE client_group_id IN
3056 (SELECT client_group_id
3058 WHERE client_group_name = $arg->{qclient_group})");
3061 DELETE FROM bweb_client_group_acl
3062 WHERE client_group_id IN
3063 (SELECT client_group_id
3065 WHERE client_group_name = $arg->{qclient_group})");
3068 DELETE FROM client_group
3069 WHERE client_group_name = $arg->{qclient_group}");
3071 $self->{dbh}->commit();
3072 $self->display_groups();
3080 if ($self->cant_do('r_group_mgnt')) {
3081 $arg = $self->get_form(qw/db_client_groups filter/) ;
3083 $arg = $self->get_form(qw/db_client_groups/) ;
3086 if ($self->{dbh}->errstr) {
3087 return $self->error("Can't use groups with bweb, read INSTALL to enable them");
3092 $self->display({ ID => $cur_id++,
3094 "display_groups.tpl");
3097 ###########################################################
3102 if (not $self->{info}->{enable_security}) {
3105 if (!$self->{loginname}) {
3106 $self->error("Can't get your login name");
3107 $self->display_end();
3110 # admin is a special user that can do everything
3111 if ($self->{loginname} eq 'admin') {
3115 if (defined $self->{security}) {
3118 $self->{security} = {};
3119 my $u = $self->dbh_quote($self->{loginname});
3122 SELECT use_acl, rolename, tpl
3124 JOIN bweb_role_member USING (userid)
3125 JOIN bweb_role USING (roleid)
3128 my $rows = $self->dbh_selectall_arrayref($query);
3129 # do cache with this role
3130 if (!$rows or !scalar(@$rows)) {
3131 $self->error("Can't get $self->{loginname}'s roles");
3132 $self->display_end();
3135 foreach my $r (@$rows) {
3136 $self->{security}->{$r->[1]}=1;
3138 $self->{security}->{use_acl} = $rows->[0]->[0];
3139 if ($rows->[0]->[2] =~ /^(\w\w)$/) {
3147 my ($self, $client) = @_;
3149 my $filter = $self->get_client_filter();
3153 my $cont = $self->dbh_selectrow_hashref("
3156 WHERE Name = '$client'
3158 return defined $cont;
3163 my ($self, $action) = @_;
3164 # is security enabled in configuration ?
3165 if (not $self->{info}->{enable_security}) {
3168 # admin is a special user that can do everything
3169 if ($self->{loginname} eq 'admin') {
3173 if (!$self->{loginname}) {
3174 $self->{error} = "Can't do $action, your are not logged. " .
3175 "Check security with your administrator";
3178 if (!$self->get_roles()) {
3181 if (!$self->{security}->{$action}) {
3183 "$self->{loginname} sorry, but this action ($action) " .
3184 "is not permited. " .
3185 "Check security with your administrator";
3191 # make like an assert (program die)
3194 my ($self, $action) = @_;
3195 if ($self->cant_do($action)) {
3196 $self->error($self->{error});
3197 $self->display_end();
3207 if (!$self->{info}->{enable_security} or
3208 !$self->{info}->{enable_security_acl})
3213 if ($self->get_roles()) {
3214 return $self->{security}->{use_acl};
3220 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
3221 sub get_client_filter
3223 my ($self, $login) = @_;
3226 $u = $self->dbh_quote($login);
3227 } elsif ($self->use_filter()) {
3228 $u = $self->dbh_quote($self->{loginname});
3233 JOIN (SELECT ClientId FROM client_group_member
3234 JOIN client_group USING (client_group_id)
3235 JOIN bweb_client_group_acl USING (client_group_id)
3236 JOIN bweb_user USING (userid)
3237 WHERE bweb_user.username = $u
3238 ) AS filter USING (ClientId)";
3241 #JOIN client_group USING (client_group_id)" . $b->get_client_group_filter()
3242 sub get_client_group_filter
3244 my ($self, $login) = @_;
3247 $u = $self->dbh_quote($login);
3248 } elsif ($self->use_filter()) {
3249 $u = $self->dbh_quote($self->{loginname});
3254 JOIN (SELECT client_group_id
3255 FROM bweb_client_group_acl
3256 JOIN bweb_user USING (userid)
3257 WHERE bweb_user.username = $u
3258 ) AS filter USING (client_group_id)";
3261 # role and username have to be quoted before
3262 # role and username can be a quoted list
3265 my ($self, $role, $username) = @_;
3266 $self->can_do("r_user_mgnt");
3268 my $nb = $self->dbh_do("
3269 DELETE FROM bweb_role_member
3270 WHERE roleid = (SELECT roleid FROM bweb_role
3271 WHERE rolename IN ($role))
3272 AND userid = (SELECT userid FROM bweb_user
3273 WHERE username IN ($username))");
3277 # role and username have to be quoted before
3278 # role and username can be a quoted list
3281 my ($self, $role, $username) = @_;
3282 $self->can_do("r_user_mgnt");
3284 my $nb = $self->dbh_do("
3285 INSERT INTO bweb_role_member (roleid, userid)
3286 SELECT roleid, userid FROM bweb_role, bweb_user
3287 WHERE rolename IN ($role)
3288 AND username IN ($username)
3293 # role and username have to be quoted before
3294 # role and username can be a quoted list
3297 my ($self, $copy, $user) = @_;
3298 $self->can_do("r_user_mgnt");
3300 my $nb = $self->dbh_do("
3301 INSERT INTO bweb_role_member (roleid, userid)
3302 SELECT roleid, a.userid
3303 FROM bweb_user AS a, bweb_role_member
3304 JOIN bweb_user USING (userid)
3305 WHERE bweb_user.username = $copy
3306 AND a.username = $user");
3310 # username can be a join quoted list of usernames
3313 my ($self, $username) = @_;
3314 $self->can_do("r_user_mgnt");
3317 DELETE FROM bweb_role_member
3321 WHERE username in ($username))");
3323 DELETE FROM bweb_client_group_acl
3327 WHERE username IN ($username))");
3334 $self->can_do("r_user_mgnt");
3336 my $arg = $self->get_form(qw/jusernames/);
3338 unless ($arg->{jusernames}) {
3339 return $self->error("Can't get user");
3342 $self->{dbh}->begin_work();
3344 $self->revoke_all($arg->{jusernames});
3346 DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
3348 $self->{dbh}->commit();
3350 $self->display_users();
3356 $self->can_do("r_user_mgnt");
3358 # we don't quote username directly to check that it is conform
3359 my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate
3360 lang qcopy_username jclient_groups/) ;
3362 if (not $arg->{qcreate}) {
3363 $arg = $self->get_form(qw/db_roles db_usernames db_client_groups/);
3364 $self->display($arg, "display_user.tpl");
3368 my $u = $self->dbh_quote($arg->{username});
3370 $arg->{use_acl}=(CGI::param('use_acl')?'true':'false');
3372 if (!$arg->{qpasswd}) {
3373 $arg->{qpasswd} = "''";
3375 if (!$arg->{qcomment}) {
3376 $arg->{qcomment} = "''";
3379 # will fail if user already exists
3380 # UPDATE with mysql dbi does not return if update is ok
3383 SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment},
3384 use_acl=$arg->{use_acl}, tpl='$arg->{lang}'
3385 WHERE username = $u")
3386 # and (! $self->dbh_is_mysql() )
3389 INSERT INTO bweb_user (username, passwd, use_acl, comment, tpl)
3390 VALUES ($u, $arg->{qpasswd}, $arg->{use_acl},
3391 $arg->{qcomment}, '$arg->{lang}')");
3393 $self->{dbh}->begin_work();
3395 $self->revoke_all($u);
3397 if ($arg->{qcopy_username}) {
3398 $self->grant_like($arg->{qcopy_username}, $u);
3400 $self->grant($arg->{jrolenames}, $u);
3403 if ($arg->{jclient_groups}) {
3405 INSERT INTO bweb_client_group_acl (client_group_id, userid)
3406 SELECT client_group_id, userid
3407 FROM client_group, bweb_user
3408 WHERE client_group_name IN ($arg->{jclient_groups})
3413 $self->{dbh}->commit();
3415 $self->display_users();
3418 # TODO: we miss a matrix with all user/roles
3422 $self->can_do("r_user_mgnt");
3424 my $arg = $self->get_form(qw/db_usernames/) ;
3426 if ($self->{dbh}->errstr) {
3427 return $self->error("Can't use users with bweb, read INSTALL to enable them");
3430 $self->display({ ID => $cur_id++,
3432 "display_users.tpl");
3438 $self->can_do("r_user_mgnt");
3440 my $arg = $self->get_form('username');
3441 my $user = $self->dbh_quote($arg->{username});
3443 my $userp = $self->dbh_selectrow_hashref("
3444 SELECT username, passwd, comment, use_acl, tpl
3446 WHERE username = $user
3449 return $self->error("Can't find $user in catalog");
3451 my $filter = $self->get_client_group_filter($arg->{username});
3452 my $scg = $self->dbh_selectall_hashref("
3453 SELECT client_group_name AS name
3454 FROM client_group $filter
3458 #------------+--------
3463 my $role = $self->dbh_selectall_hashref("
3464 SELECT rolename, max(here) AS userid FROM (
3465 SELECT rolename, 1 AS here
3467 JOIN bweb_role_member USING (userid)
3468 JOIN bweb_role USING (roleid)
3469 WHERE username = $user
3474 GROUP by rolename", 'rolename');
3476 $arg = $self->get_form(qw/db_usernames db_client_groups/);
3479 db_usernames => $arg->{db_usernames},
3480 username => $userp->{username},
3481 comment => $userp->{comment},
3482 passwd => $userp->{passwd},
3483 lang => $userp->{tpl},
3484 use_acl => $userp->{use_acl},
3485 db_client_groups => $arg->{db_client_groups},
3486 client_group => [ values %$scg ],
3487 db_roles => [ values %$role],
3488 }, "display_user.tpl");
3492 ###########################################################
3494 sub get_media_max_size
3496 my ($self, $type) = @_;
3498 "SELECT avg(VolBytes) AS size
3500 WHERE Media.VolStatus = 'Full'
3501 AND Media.MediaType = '$type'
3504 my $res = $self->selectrow_hashref($query);
3507 return $res->{size};
3517 my $media = $self->get_form('qmedia');
3519 unless ($media->{qmedia}) {
3520 return $self->error("Can't get media");
3524 SELECT Media.Slot AS slot,
3525 PoolMedia.Name AS poolname,
3526 Media.VolStatus AS volstatus,
3527 Media.InChanger AS inchanger,
3528 Location.Location AS location,
3529 Media.VolumeName AS volumename,
3530 Media.MaxVolBytes AS maxvolbytes,
3531 Media.MaxVolJobs AS maxvoljobs,
3532 Media.MaxVolFiles AS maxvolfiles,
3533 Media.VolUseDuration AS voluseduration,
3534 Media.VolRetention AS volretention,
3535 Media.Comment AS comment,
3536 PoolRecycle.Name AS poolrecycle,
3537 Media.Enabled AS enabled
3539 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
3540 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
3541 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
3543 WHERE Media.VolumeName = $media->{qmedia}
3546 my $row = $self->dbh_selectrow_hashref($query);
3547 $row->{volretention} = human_sec($row->{volretention});
3548 $row->{voluseduration} = human_sec($row->{voluseduration});
3549 $row->{enabled} = human_enabled($row->{enabled});
3551 my $elt = $self->get_form(qw/db_pools db_locations/);
3556 }, "update_media.tpl");
3562 $self->can_do('r_media_mgnt');
3564 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
3566 unless ($arg->{jmedias}) {
3567 return $self->error("Can't get selected media");
3570 unless ($arg->{qnewlocation}) {
3571 return $self->error("Can't get new location");
3576 SET LocationId = (SELECT LocationId
3578 WHERE Location = $arg->{qnewlocation})
3579 WHERE Media.VolumeName IN ($arg->{jmedias})
3582 my $nb = $self->dbh_do($query);
3584 print "$nb media updated, you may have to update your autochanger.";
3586 $self->display_media();
3592 $self->can_do('r_media_mgnt');
3594 my $media = $self->get_selected_media_location();
3596 return $self->error("Can't get media selection");
3598 my $newloc = CGI::param('newlocation');
3600 my $user = CGI::param('user') || 'unknown';
3601 my $comm = CGI::param('comment') || '';
3602 $comm = $self->dbh_quote("$user: $comm");
3604 my $arg = $self->get_form('enabled');
3605 my $en = from_human_enabled($arg->{enabled});
3606 my $b = $self->get_bconsole();
3609 foreach my $vol (keys %$media) {
3611 INSERT INTO LocationLog (Date,Comment,MediaId,LocationId,NewEnabled,NewVolStatus)
3612 SELECT NOW(), $comm, Media.MediaId, Location.LocationId, $en, VolStatus
3613 FROM Media, Location
3614 WHERE Media.VolumeName = '$vol'
3615 AND Location.Location = '$media->{$vol}->{location}'
3617 $self->dbh_do($query);
3618 $self->debug($query);
3619 $b->send_cmd("update volume=\"$vol\" enabled=$en");
3624 $q->param('action', 'update_location');
3625 my $url = $q->url(-full => 1, -query=>1);
3627 $self->display({ email => $self->{info}->{email_media},
3629 newlocation => $newloc,
3630 # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3631 media => [ values %$media ],
3633 "change_location.tpl");
3637 sub display_client_stats
3639 my ($self, %arg) = @_ ;
3640 $self->can_do('r_view_stat');
3642 my $client = $self->dbh_quote($arg{clientname});
3643 # get security filter
3644 my $filter = $self->get_client_filter();
3646 my ($limit, $label) = $self->get_limit(%arg);
3649 count(Job.JobId) AS nb_jobs,
3650 sum(Job.JobBytes) AS nb_bytes,
3651 sum(Job.JobErrors) AS nb_err,
3652 sum(Job.JobFiles) AS nb_files,
3653 Client.Name AS clientname
3654 FROM Job JOIN Client USING (ClientId) $filter
3656 Client.Name = $client
3658 GROUP BY Client.Name
3661 my $row = $self->dbh_selectrow_hashref($query);
3663 $row->{ID} = $cur_id++;
3664 $row->{label} = $label;
3665 $row->{grapharg} = "client";
3666 $row->{age} = $arg{age};
3668 $self->display($row, "display_client_stats.tpl");
3672 sub _display_group_stats
3674 my ($self, %arg) = @_ ;
3676 my $carg = $self->get_form(qw/qclient_group/);
3678 unless ($carg->{qclient_group}) {
3679 return $self->error("Can't get group");
3681 my $jobt = $self->get_stat_table();
3682 my ($limit, $label) = $self->get_limit(%arg);
3686 count(Job.JobId) AS nb_jobs,
3687 sum(Job.JobBytes) AS nb_bytes,
3688 sum(Job.JobErrors) AS nb_err,
3689 sum(Job.JobFiles) AS nb_files,
3690 client_group.client_group_name AS clientname
3692 JOIN Client USING (ClientId)
3693 JOIN client_group_member ON (Client.ClientId = client_group_member.ClientId)
3694 JOIN client_group USING (client_group_id)
3696 client_group.client_group_name = $carg->{qclient_group}
3698 GROUP BY client_group.client_group_name
3701 my $row = $self->dbh_selectrow_hashref($query);
3703 $row->{ID} = $cur_id++;
3704 $row->{label} = $label;
3705 $row->{grapharg} = "client_group";
3707 $self->display($row, "display_client_stats.tpl");
3710 # [ name, num, value, joberrors, nb_job ] =>
3712 # [ { name => 'ALL',
3713 # events => [ { num => 1, label => '2007-01',
3714 # value => 'T', title => 10 },
3715 # { num => 2, label => '2007-02',
3716 # value => 'R', title => 11 },
3719 # { name => 'Other',
3723 sub make_overview_tab
3725 my ($self, $q) = @_;
3726 my $ret = $self->dbh_selectall_arrayref($q);
3730 for my $elt (@$ret) {
3731 if ($cur_name and $cur_name ne $elt->[0]) { # order by name, num
3732 push @items, { name => $cur_name, events => $events};
3735 $cur_name = $elt->[0];
3737 { num => $elt->[1], status => $elt->[2],
3738 joberrors => $elt->[3], title => "$elt->[4] jobs"};
3740 push @items, { name => $cur_name, events => $events};
3744 sub get_time_overview
3746 my ($self, $arg) = @_; # want since et age from get_form();
3747 my $type = $arg->{type} || 'day';
3748 if ($type =~ /^(day|week|hour|month)$/) {
3754 my $jobt = $self->get_stat_table();
3755 my $stime1 = $self->{sql}->{"STARTTIME_P" . $type}; # get 1,2,3
3756 $stime1 =~ s/Job.StartTime/date/;
3757 my $stime2 = $self->{sql}->{"STARTTIME_" . $type}; # get 2007-01-03, 2007-01-23
3759 my ($limit, $label) = $self->get_limit('since' => $arg->{since},
3760 'age' => $arg->{age});
3761 return ($stime1, $stime2, $limit, $label, $jobt);
3764 # lu ma me je ve sa di
3765 # groupe1 v v x w v v v overview
3766 # |-- s1 v v v v v v v overview_zoom
3767 # |-- s2 v v x v v v v
3768 # `-- s3 v v v w v v v
3769 sub display_overview_zoom
3772 $self->can_do('r_view_stat');
3774 my $arg = $self->get_form(qw/jclient_groups age since type level/);
3776 if (!$arg->{jclient_groups}) {
3777 return $self->error("Can't get client_group selection");
3779 my ($filter2, undef) = $self->get_param(qw/level jobtype/);
3780 my ($stime1, $stime2, $limit, $label, $jobt) = $self->get_time_overview($arg);
3782 my $filter = $self->get_client_filter();
3784 SELECT name, $stime1 AS num,
3785 JobStatus AS value, joberrors, nb_job
3787 SELECT $stime2 AS date,
3788 Client.Name AS name,
3789 MAX(severity) AS severity,
3791 SUM(JobErrors) AS joberrors
3793 JOIN client_group_member USING (ClientId)
3794 JOIN client_group USING (client_group_id)
3795 JOIN Client USING (ClientId) $filter
3796 JOIN Status USING (JobStatus)
3797 WHERE client_group_name IN ($arg->{jclient_groups})
3798 AND JobStatus IN ('T', 'W', 'f', 'A', 'e', 'E')
3800 GROUP BY Client.Name, date
3801 ) AS sub JOIN Status USING (severity)
3804 my $items = $self->make_overview_tab($q);
3805 $self->display({label => $label,
3806 action => "job;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client=",
3807 items => $items}, "overview.tpl");
3810 sub display_overview
3813 $self->can_do('r_view_stat');
3815 my $arg = $self->get_form(qw/jclient_groups age since type level/);
3816 my ($filter2, undef) = $self->get_param(qw/client_groups level jobtype/);
3817 my $filter3 = $self->get_client_group_filter();
3818 my ($stime1, $stime2, $filter1, $label, $jobt) = $self->get_time_overview($arg);
3821 SELECT name, $stime1 AS num,
3822 JobStatus AS value, joberrors, nb_job
3824 SELECT $stime2 AS date,
3825 client_group_name AS name,
3826 MAX(severity) AS severity,
3828 SUM(JobErrors) AS joberrors
3830 JOIN client_group_member USING (ClientId)
3831 JOIN client_group USING (client_group_id) $filter3
3832 JOIN Status USING (JobStatus)
3833 WHERE JobStatus IN ('T', 'W', 'f', 'A', 'e', 'E')
3835 GROUP BY client_group_name, date
3836 ) AS sub JOIN Status USING (severity)
3839 my $items = $self->make_overview_tab($q);
3840 $self->display({label=>$label,
3841 action => "overview_zoom;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client_group=",
3842 items => $items}, "overview.tpl");
3846 # poolname can be undef
3849 my ($self, $poolname) = @_ ;
3850 $self->can_do('r_view_media');
3855 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3856 if ($arg->{jmediatypes}) {
3857 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3858 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
3861 # TODO : afficher les tailles et les dates
3864 SELECT subq.volmax AS volmax,
3865 subq.volnum AS volnum,
3866 subq.voltotal AS voltotal,
3868 Pool.Recycle AS recycle,
3869 Pool.VolRetention AS volretention,
3870 Pool.VolUseDuration AS voluseduration,
3871 Pool.MaxVolJobs AS maxvoljobs,
3872 Pool.MaxVolFiles AS maxvolfiles,
3873 Pool.MaxVolBytes AS maxvolbytes,
3874 subq.PoolId AS PoolId,
3875 subq.MediaType AS mediatype,
3876 $self->{sql}->{CAT_POOL_TYPE} AS uniq
3879 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3880 count(Media.MediaId) AS volnum,
3881 sum(Media.VolBytes) AS voltotal,
3882 Media.PoolId AS PoolId,
3883 Media.MediaType AS MediaType
3885 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3886 Media.MediaType AS MediaType
3888 WHERE Media.VolStatus = 'Full'
3889 GROUP BY Media.MediaType
3890 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3891 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3893 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3897 my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3900 SELECT Pool.Name AS name,
3901 sum(VolBytes) AS size
3902 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3903 WHERE Media.VolStatus IN ('Recycled', 'Purged')
3907 my $empty = $self->dbh_selectall_hashref($query, 'name');
3909 foreach my $p (values %$all) {
3910 if ($p->{volmax} > 0) { # mysql returns 0.0000
3911 # we remove Recycled/Purged media from pool usage
3912 if (defined $empty->{$p->{name}}) {
3913 $p->{voltotal} -= $empty->{$p->{name}}->{size};
3915 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
3917 $p->{poolusage} = 0;
3921 SELECT VolStatus AS volstatus, count(MediaId) AS nb
3923 WHERE PoolId=$p->{poolid}
3924 AND Media.MediaType = '$p->{mediatype}'
3928 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
3929 foreach my $t (values %$content) {
3930 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
3935 $self->display({ ID => $cur_id++,
3936 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
3937 Pools => [ values %$all ]},
3938 "display_pool.tpl");
3941 # With this function, we get an estimation of next jobfiles/jobbytes count
3942 sub get_estimate_query
3944 my ($self, $mode, $job, $level) = @_;
3945 # get security filter
3946 my $filter = $self->get_client_filter();
3950 if ($self->dbh_is_mysql()) { # mysql doesn't have statistics functions
3952 SELECT jobname AS jobname,
3953 0.1 AS corr_jobbytes, AVG(jobbytes) AS jobbytes,
3954 COUNT(1) AS nb_jobbytes ";
3956 # postgresql have functions that permit to handle lineal regression
3958 # REGR_SLOPE(Y,X) = get x
3959 # REGR_INTERCEPT(Y,X) = get b
3960 # and we need y when x=now()
3961 # CORR gives the correlation
3962 # (TODO: display progress bar only if CORR > 0.8)
3963 my $now = scalar(time);
3965 SELECT temp.jobname AS jobname,
3966 CORR(jobbytes,jobtdate) AS corr_jobbytes,
3967 ($now*REGR_SLOPE(jobbytes,jobtdate)
3968 + REGR_INTERCEPT(jobbytes,jobtdate)) AS jobbytes,
3969 COUNT(1) AS nb_jobbytes ";
3971 # if it's a differential, we need to compare since the last full
3973 # F D D D F D D D F I I I I D I I I
3975 # | # # # # # # | # #
3976 # | # # # # # # # # | # # # # # # # # #
3977 # +----------------- +-------------------
3979 if ($level eq 'D') {
3981 AND Job.StartTime > (
3984 WHERE Job.Name = '$job'
3986 AND Job.JobStatus IN ('T', 'W')
3987 ORDER BY Job.StartTime DESC LIMIT 1
3994 SELECT Job.Name AS jobname,
3995 JobBytes AS jobbytes,
3996 JobTDate AS jobtdate
3997 FROM Job INNER JOIN Client USING (ClientId) $filter
3998 WHERE Job.Name = '$job'
3999 AND Job.Level = '$level'
4000 AND Job.JobStatus IN ('T', 'W')
4002 ORDER BY StartTime DESC
4004 ) AS temp GROUP BY temp.jobname
4007 if ($mode eq 'jobfiles') {
4008 $query =~ s/jobbytes/jobfiles/g;
4009 $query =~ s/JobBytes/JobFiles/g;
4014 sub display_running_job
4017 return if $self->cant_do('r_view_running_job');
4019 my $arg = $self->get_form('jobid');
4021 return $self->error("Can't get jobid") unless ($arg->{jobid});
4023 # get security filter
4024 my $filter = $self->get_client_filter();
4027 SELECT Client.Name AS name, Job.Name AS jobname,
4028 Job.Level AS level, Type AS type, JobStatus AS jobstatus
4029 FROM Job INNER JOIN Client USING (ClientId) $filter
4030 WHERE Job.JobId = $arg->{jobid}
4033 my $row = $self->dbh_selectrow_hashref($query);
4036 $arg->{client} = $row->{name};
4038 return $self->error("Can't get client");
4041 my $status = $row->{jobstatus};
4043 if ($status =~ /[TfAaEWD]/) {
4044 $self->display_job_zoom($arg->{jobid});
4045 $self->get_job_log();
4049 if ($row->{type} eq 'B') {
4050 # for jobfiles, we use only last Full backup. status client= returns
4051 # all files that have been checked
4052 my $query1 = $self->get_estimate_query('jobfiles', $row->{jobname}, 'F');
4053 my $query2 = $self->get_estimate_query('jobbytes',
4054 $row->{jobname}, $row->{level});
4056 # LEFT JOIN because we always have a previous Full
4058 SELECT corr_jobbytes, jobbytes, corr_jobfiles, jobfiles
4059 FROM ($query1) AS A LEFT JOIN ($query2) AS B USING (jobname)
4061 $row = $self->dbh_selectrow_hashref($query);
4064 $row->{jobbytes} = $row->{jobfiles} = 0;
4067 if ($status =~ /[RBSmMsjlL]/) {
4068 my $cli = new Bweb::Client(name => $arg->{client});
4069 $cli->display_running_job($self, $arg->{jobid}, $row);
4071 if ($arg->{jobid}) {
4072 $self->get_job_log();
4076 sub display_running_jobs
4078 my ($self, $display_action) = @_;
4079 return if $self->cant_do('r_view_running_job');
4081 # get security filter
4082 my $filter = $self->get_client_filter();
4085 SELECT Job.JobId AS jobid,
4086 Job.Name AS jobname,
4088 Job.StartTime AS starttime,
4089 Job.JobFiles AS jobfiles,
4090 Job.JobBytes AS jobbytes,
4091 Job.JobStatus AS jobstatus,
4092 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
4093 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
4095 Client.Name AS clientname
4096 FROM Job INNER JOIN Client USING (ClientId) $filter
4098 JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
4100 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
4102 $self->display({ ID => $cur_id++,
4103 display_action => $display_action,
4104 Jobs => [ values %$all ]},
4105 "running_job.tpl") ;
4108 sub display_group_stats
4111 my $arg = $self->get_form('age', 'since');
4112 return if $self->cant_do('r_view_stat');
4114 my $filter = $self->get_client_group_filter();
4116 my $jobt = $self->get_stat_table();
4118 my ($limit, $label) = $self->get_limit(%$arg);
4119 my ($where, undef) = $self->get_param('client_groups', 'level');
4122 SELECT client_group_name AS name, nb_byte, nb_file, nb_job, nb_err, nb_resto
4125 SELECT sum(JobBytes) AS nb_byte,
4126 sum(JobFiles) AS nb_file,
4127 count(1) AS nb_job, client_group_name
4128 FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4129 JOIN client_group USING (client_group_id) $filter
4130 WHERE JobStatus IN ('T', 'W') AND Type IN ('M', 'B', 'g')
4132 GROUP BY client_group_name ORDER BY client_group_name
4136 SELECT count(1) AS nb_err, client_group_name
4137 FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4138 JOIN client_group USING (client_group_id)
4139 WHERE JobStatus IN ('E','e','f','A') AND Type = 'B'
4141 GROUP BY client_group_name ORDER BY client_group_name
4143 ) AS T3 USING (client_group_name) LEFT JOIN (
4145 SELECT count(1) AS nb_resto, client_group_name
4146 FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4147 JOIN client_group USING (client_group_id)
4148 WHERE JobStatus IN ('T','W') AND Type = 'R'
4150 GROUP BY client_group_name ORDER BY client_group_name
4152 ) AS T2 USING (client_group_name)
4154 $self->debug($query);
4155 my $all = $self->dbh_selectall_hashref($query, 'name') ;
4158 $self->display({ ID => $cur_id++,
4160 Stats => [ values %$all ]},
4161 "display_stats.tpl") ;
4164 # return the autochanger list to update
4168 $self->can_do('r_media_mgnt');
4171 my $arg = $self->get_form('jmedias');
4173 unless ($arg->{jmedias}) {
4174 return $self->error("Can't get media selection");
4178 SELECT Media.VolumeName AS volumename,
4179 Storage.Name AS storage,
4180 Location.Location AS location,
4182 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
4183 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
4184 WHERE Media.VolumeName IN ($arg->{jmedias})
4185 AND Media.InChanger = 1
4188 my $all = $self->dbh_selectall_hashref($query, 'volumename');
4190 foreach my $vol (values %$all) {
4191 my $a = $self->ach_get($vol->{location});
4193 $ret{$vol->{location}} = 1;
4195 unless ($a->{have_status}) {
4197 $a->{have_status} = 1;
4200 print "eject $vol->{volumename} from $vol->{storage} : ";
4201 if ($a->send_to_io($vol->{slot})) {
4202 print "<img src='/bweb/T.png' alt='ok'><br/>";
4204 print "<img src='/bweb/E.png' alt='err'><br/>";
4214 my ($to, $subject, $content) = (CGI::param('email'),
4215 CGI::param('subject'),
4216 CGI::param('content'));
4217 $to =~ s/[^\w\d\.\@<>,]//;
4218 $subject =~ s/[^\w\d\.\[\]]/ /;
4220 open(MAIL, "|mail -s '$subject' '$to'") ;
4221 print MAIL $content;
4231 my $arg = $self->get_form('jobid', 'client');
4233 print CGI::header('text/brestore');
4234 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
4235 print "client=$arg->{client}\n" if ($arg->{client});
4236 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
4240 # TODO : move this to Bweb::Autochanger ?
4241 # TODO : make this internal to not eject tape ?
4247 my ($self, $name) = @_;
4250 return $self->error("Can't get your autochanger name ach");
4253 unless ($self->{info}->{ach_list}) {
4254 return $self->error("Could not find any autochanger");
4257 my $a = $self->{info}->{ach_list}->{$name};
4260 $self->error("Can't get your autochanger $name from your ach_list");
4265 $a->{debug} = $self->{debug};
4272 my ($self, $ach) = @_;
4273 $self->can_do('r_configure');
4275 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
4277 $self->{info}->save();
4285 $self->can_do('r_configure');
4287 my $arg = $self->get_form('ach');
4289 or !$self->{info}->{ach_list}
4290 or !$self->{info}->{ach_list}->{$arg->{ach}})
4292 return $self->error("Can't get autochanger name");
4295 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
4299 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
4301 my $b = $self->get_bconsole();
4303 my @storages = $b->list_storage() ;
4305 $ach->{devices} = [ map { { name => $_ } } @storages ];
4307 $self->display($ach, "ach_add.tpl");
4308 delete $ach->{drives};
4309 delete $ach->{devices};
4316 $self->can_do('r_configure');
4318 my $arg = $self->get_form('ach');
4321 or !$self->{info}->{ach_list}
4322 or !$self->{info}->{ach_list}->{$arg->{ach}})
4324 return $self->error("Can't get autochanger name");
4327 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
4329 $self->{info}->save();
4330 $self->{info}->view();
4336 $self->can_do('r_configure');
4338 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
4340 my $b = $self->get_bconsole();
4341 my @storages = $b->list_storage() ;
4343 unless ($arg->{ach}) {
4344 $arg->{devices} = [ map { { name => $_ } } @storages ];
4345 return $self->display($arg, "ach_add.tpl");
4349 foreach my $drive (CGI::param('drives'))
4351 unless (grep(/^$drive$/,@storages)) {
4352 return $self->error("Can't find $drive in storage list");
4355 my $index = CGI::param("index_$drive");
4356 unless (defined $index and $index =~ /^(\d+)$/) {
4357 return $self->error("Can't get $drive index");
4360 $drives[$index] = $drive;
4364 return $self->error("Can't get drives from Autochanger");
4367 my $a = new Bweb::Autochanger(name => $arg->{ach},
4368 precmd => $arg->{precmd},
4369 drive_name => \@drives,
4370 device => $arg->{device},
4371 mtxcmd => $arg->{mtxcmd});
4373 $self->ach_register($a) ;
4375 $self->{info}->view();
4381 $self->can_do('r_delete_job');
4383 my $arg = $self->get_form('jobid');
4385 if ($arg->{jobid}) {
4386 my $b = $self->get_bconsole();
4387 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
4391 title => "Delete a job ",
4392 name => "delete jobid=$arg->{jobid}",
4401 $self->can_do('r_media_mgnt');
4403 my $arg = $self->get_form(qw/media volstatus inchanger pool
4404 slot volretention voluseduration
4405 maxvoljobs maxvolfiles maxvolbytes
4406 qcomment poolrecycle enabled
4409 unless ($arg->{media}) {
4410 return $self->error("Can't find media selection");
4413 my $update = "update volume=$arg->{media} ";
4415 if ($arg->{volstatus}) {
4416 $update .= " volstatus=$arg->{volstatus} ";
4419 if ($arg->{inchanger}) {
4420 $update .= " inchanger=yes " ;
4422 $update .= " slot=$arg->{slot} ";
4425 $update .= " slot=0 inchanger=no ";
4428 if ($arg->{enabled}) {
4429 $update .= " enabled=$arg->{enabled} ";
4433 $update .= " pool=$arg->{pool} " ;
4436 if (defined $arg->{volretention}) {
4437 $update .= " volretention=\"$arg->{volretention}\" " ;
4440 if (defined $arg->{voluseduration}) {
4441 $update .= " voluse=\"$arg->{voluseduration}\" " ;
4444 if (defined $arg->{maxvoljobs}) {
4445 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
4448 if (defined $arg->{maxvolfiles}) {
4449 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
4452 if (defined $arg->{maxvolbytes}) {
4453 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
4456 if (defined $arg->{poolrecycle}) {
4457 $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
4460 my $b = $self->get_bconsole();
4463 content => $b->send_cmd($update),
4464 title => "Update a volume ",
4472 my $media = $self->dbh_quote($arg->{media});
4474 my $loc = CGI::param('location') || '';
4476 $loc = $self->dbh_quote($loc); # is checked by db
4477 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
4479 if (!$arg->{qcomment}) {
4480 $arg->{qcomment} = "''";
4482 push @q, "Comment=$arg->{qcomment}";
4487 SET " . join (',', @q) . "
4488 WHERE Media.VolumeName = $media
4490 $self->dbh_do($query);
4492 $self->update_media();
4498 $self->can_do('r_autochanger_mgnt');
4500 my $ach = CGI::param('ach') ;
4501 $ach = $self->ach_get($ach);
4503 return $self->error("Bad autochanger name");
4507 title => "Scanning autochanger content ",
4508 name => "update slots",
4512 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
4513 $b->update_slots($ach->{name});
4523 $self->can_do('r_view_log');
4525 my $arg = $self->get_form('jobid', 'limit', 'offset');
4526 unless ($arg->{jobid}) {
4527 return $self->error("Can't get jobid");
4530 if ($arg->{limit} == 100) {
4531 $arg->{limit} = 1000;
4533 # get security filter
4534 my $filter = $self->get_client_filter();
4537 SELECT Job.Name as name, Client.Name as clientname
4538 FROM Job INNER JOIN Client USING (ClientId) $filter
4539 WHERE JobId = $arg->{jobid}
4542 my $row = $self->dbh_selectrow_hashref($query);
4545 return $self->error("Can't find $arg->{jobid} in catalog");
4548 # display only Error and Warning messages
4550 if (CGI::param('error')) {
4551 $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning|ERR=' ";
4555 if (CGI::param('time') || $self->{info}->{display_log_time}) {
4556 $logtext = $self->dbh_strcat('Time', " ' ' ", 'LogText');
4558 $logtext = 'LogText';
4562 SELECT count(1) AS nbline,
4563 GROUP_CONCAT($logtext $self->{sql}->{CONCAT_SEP}) AS logtxt, id
4565 SELECT 1 AS id, Time, LogText
4567 WHERE ( Log.JobId = $arg->{jobid}
4569 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
4570 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
4574 OFFSET $arg->{offset}
4580 my $log = $self->dbh_selectrow_hashref($query);
4582 return $self->error("Can't get log for jobid $arg->{jobid}");
4584 $log->{logtxt} =~ s/\0//g;
4585 $self->display({ lines=> $log->{logtxt},
4586 nbline => $log->{nbline},
4587 jobid => $arg->{jobid},
4588 name => $row->{name},
4589 client => $row->{clientname},
4590 offset => $arg->{offset},
4591 limit => $arg->{limit},
4592 }, 'display_log.tpl');
4595 sub cancel_future_job
4598 $self->can_do('r_cancel_job');
4600 my $arg = $self->get_form(qw/job pool level client when/);
4602 if ( !$arg->{job} or !$arg->{pool} or !$arg->{level}
4603 or !$arg->{client} or !$arg->{when})
4605 return $self->error("Can't get enough information to mark this job as canceled");
4608 $arg->{level} =~ s/^(.).+/$1/; # we keep the first letter
4609 my $jobtable = $self->{info}->{stat_job_table} || 'JobHisto';
4611 if ($jobtable =~ /^Job$/i) {
4612 return $self->error("Can add records only in history table");
4614 my $jname = "$arg->{job}.$arg->{when}";
4617 my $found = $self->dbh_selectrow_hashref("
4622 AND Name = '$arg->{job}'
4625 return $self->error("$jname is already in history table");
4629 INSERT INTO $jobtable
4630 (JobId, Name, Job, Type, Level, JobStatus, SchedTime, StartTime, EndTime,
4631 RealEndTime, ClientId, PoolId)
4633 (0, '$arg->{job}', '$jname', 'B', '$arg->{level}', 'A',
4634 '$arg->{when}', '$arg->{when}', '$arg->{when}', '$arg->{when}',
4635 (SELECT ClientId FROM Client WHERE Name = '$arg->{client}'),
4636 (SELECT PoolId FROM Pool WHERE Name = '$arg->{pool}')
4639 $self->display({ Filter => "Dummy record for $jname",
4643 client => $arg->{client},
4644 jobname => $arg->{job},
4645 pool => $arg->{pool},
4646 level => $arg->{level},
4647 starttime => $arg->{when},
4648 duration => '00:00:00',
4661 $self->can_do('r_media_mgnt');
4662 my $arg = $self->get_form('storage', 'pool', 'nb', 'media', 'offset');
4663 my $b = $self->get_bconsole();
4665 if (!$arg->{storage} || !$arg->{pool} || not defined $arg->{nb} || !$arg->{media} || !$arg->{offset}) {
4666 CGI::param(offset => 0);
4667 $arg = $self->get_form('db_pools');
4668 $arg->{storage} = [ map { { name => $_ } }$b->list_storage()];
4669 $self->display($arg, 'add_media.tpl');
4673 $b->send("add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n");
4674 if ($arg->{nb} > 0) {
4675 $arg->{offset} = $arg->{offset}?$arg->{offset}:1;
4676 $b->send("$arg->{nb}\n");
4677 $b->send("$arg->{media}\n");
4678 $b->send("$arg->{offset}\n");
4682 $b->send("$arg->{media}\n");
4685 $b->expect_it('-re','^[*]');
4687 CGI::param('media', '');
4688 CGI::param('re_media', $arg->{media});
4689 $self->display_media();
4695 $self->can_do('r_autochanger_mgnt');
4697 my $arg = $self->get_form('ach', 'slots', 'drive', 'pool');
4699 unless ($arg->{ach}) {
4700 return $self->error("Can't find autochanger name");
4703 my $a = $self->ach_get($arg->{ach});
4705 return $self->error("Can't find autochanger name in configuration");
4708 my $storage = $a->get_drive_name($arg->{drive});
4710 return $self->error("Can't get your drive name");
4716 if ($arg->{slots}) {
4717 $slots = join(",", @{ $arg->{slots} });
4718 $slots_sql = " AND Slot IN ($slots) ";
4719 $t += 60*scalar( @{ $arg->{slots} }) ;
4721 my $pool = $arg->{pool} || 'Scratch';
4722 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
4723 print "<h1>This command can take long time, be patient...</h1>";
4725 $b->label_barcodes(storage => $storage,
4726 drive => $arg->{drive},
4734 SET LocationId = (SELECT LocationId
4736 WHERE Location = '$arg->{ach}')
4738 WHERE (LocationId = 0 OR LocationId IS NULL)
4747 $self->can_do('r_purge');
4749 my @volume = CGI::param('media');
4752 return $self->error("Can't get media selection");
4755 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4757 foreach my $v (@volume) {
4759 content => $b->purge_volume($v),
4760 title => "Purge media",
4761 name => "purge volume=$v",
4771 $self->can_do('r_prune');
4773 my @volume = CGI::param('media');
4775 return $self->error("Can't get media selection");
4778 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4780 foreach my $v (@volume) {
4782 content => $b->prune_volume($v),
4783 title => "Prune volume",
4784 name => "prune volume=$v",
4794 $self->can_do('r_cancel_job');
4796 my $arg = $self->get_form('jobid');
4797 unless ($arg->{jobid}) {
4798 return $self->error("Can't get jobid");
4801 my $b = $self->get_bconsole();
4803 content => $b->cancel($arg->{jobid}),
4804 title => "Cancel job",
4805 name => "cancel jobid=$arg->{jobid}",
4812 # Warning, we display current fileset
4815 my $arg = $self->get_form('fileset');
4817 if ($arg->{fileset}) {
4818 my $b = $self->get_bconsole();
4819 my $ret = $b->get_fileset($arg->{fileset});
4820 $self->display({ fileset => $arg->{fileset},
4822 }, "fileset_view.tpl");
4824 $self->error("Can't get fileset name");
4828 sub director_show_sched
4831 $self->can_do('r_view_job');
4832 my $arg = $self->get_form('days');
4834 my $b = $self->get_bconsole();
4835 my $ret = $b->director_get_sched( $arg->{days} );
4840 }, "scheduled_job.tpl");
4843 sub enable_disable_job
4845 my ($self, $what) = @_ ;
4846 $self->can_do('r_run_job');
4848 my $arg = $self->get_form('job');
4850 return $self->error("Can't find job name");
4853 my $b = $self->get_bconsole();
4863 content => $b->send_cmd("$cmd job=\"$arg->{job}\""),
4864 title => "$cmd $arg->{job}",
4865 name => "$cmd job=\"$arg->{job}\"",
4873 return new Bconsole(pref => $self->{info});
4879 $self->can_do('r_storage_mgnt');
4880 my $arg = $self->get_form(qw/storage storage_cmd drive slot/);
4881 my $b = $self->get_bconsole();
4883 if ($arg->{storage} and $arg->{storage_cmd}) {
4884 my $cmd = "$arg->{storage_cmd} storage=\"$arg->{storage}\" drive=$arg->{drive} slot=$arg->{slot}";
4885 my $ret = $b->send_cmd($cmd);
4889 title => "Storage ",
4894 my $storages= [ map { { name => $_ } } $b->list_storage()];
4895 $self->display({ storage => $storages}, "cmd_storage.tpl");
4902 $self->can_do('r_run_job');
4904 my $b = $self->get_bconsole();
4906 my $joblist = [ map { { name => $_ } } $b->list_backup() ];
4908 $self->display({ Jobs => $joblist }, "run_job.tpl");
4913 my ($self, $ouput) = @_;
4916 $self->debug($ouput);
4917 foreach my $l (split(/\r?\n/, $ouput)) {
4919 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4925 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4931 foreach my $k (keys %arg) {
4932 $lowcase{lc($k)} = $arg{$k} ;
4934 $self->debug(\%lowcase);
4941 $self->can_do('r_run_job');
4943 my $b = $self->get_bconsole();
4944 my $arg = $self->get_form(qw/pool level client fileset storage media job/);
4947 return $self->error("Can't get job name");
4950 # we take informations from director, and we overwrite with user wish
4951 my $info = $b->send_cmd("show job=\"$arg->{job}\"");
4952 my $attr = $self->run_parse_job($info);
4954 if (!$arg->{pool} and $arg->{media}) {
4955 my $r = $self->dbh_selectrow_hashref("
4956 SELECT Pool.Name AS name
4957 FROM Media JOIN Pool USING (PoolId)
4958 WHERE Media.VolumeName = '$arg->{media}'
4959 AND Pool.Name != 'Scratch'
4962 $arg->{pool} = $r->{name};
4966 my %job_opt = (%$attr, %$arg);
4968 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
4970 my $pools = [ map { { name => $_ } } $b->list_pool() ];
4971 my $clients = [ map { { name => $_ } }$b->list_client()];
4972 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
4973 my $storages= [ map { { name => $_ } }$b->list_storage()];
4978 clients => $clients,
4979 filesets => $filesets,
4980 storages => $storages,
4982 }, "run_job_mod.tpl");
4988 $self->can_do('r_run_job');
4990 my $b = $self->get_bconsole();
4992 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
5002 $self->can_do('r_run_job');
5004 my $b = $self->get_bconsole();
5006 # TODO: check input (don't use pool, level)
5008 my $arg = $self->get_form(qw/pool level client priority when
5009 fileset job storage/);
5011 return $self->error("Can't get your job name");
5014 my $jobid = $b->run(job => $arg->{job},
5015 client => $arg->{client},
5016 priority => $arg->{priority},
5017 level => $arg->{level},
5018 storage => $arg->{storage},
5019 pool => $arg->{pool},
5020 fileset => $arg->{fileset},
5021 when => $arg->{when},
5026 print "<br>You can follow job (jobid=$jobid) execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a><script type='text/javascript' language='JavaScript'>setTimeout(function() { window.location='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'},2000);</script>";
5029 sub display_next_job
5033 my $arg = $self->get_form(qw/job begin end/);
5035 return $self->error("Can't get job name");
5038 my $b = $self->get_bconsole();
5040 my $job = $b->send_cmd("show job=\"$arg->{job}\"");
5041 my $attr = $self->run_parse_job($job);
5043 if (!$attr->{schedule}) {
5044 return $self->error("Can't get $arg->{job} schedule");
5046 my $jpool=$attr->{pool} || '';
5048 my $sched = new Bweb::Sched(bconsole => $b, name => $attr->{schedule},
5049 begin => $arg->{begin}, end => $arg->{end});
5051 my $ss = $sched->get_scheds($attr->{schedule});
5054 foreach my $s (@$ss) {
5055 my $level = $sched->get_level($s);
5056 my $pool = $sched->get_pool($s) || $jpool;
5057 my $evt = $sched->get_event($s);
5058 push @ret, map { "$_ : $pool ($level)\n" } @$evt;
5061 print "<b>$arg->{job}:</b><pre>", sort @ret, "</pre><br>";
5064 # permit to verify for higher level backup
5065 # we attempt a Increment, we made a Full, that ok
5066 # TODO: Pool may have change
5067 sub get_higher_level
5069 my ($self, $level) = @_;
5070 if ($level eq 'F') {
5072 } elsif ($level eq 'D') {
5074 } elsif ($level eq 'I') {
5075 return "'F', 'D', 'I'";
5080 # check jobs against their schedule
5083 my ($self, $sched, $schedname, $job, $job_pool, $client, $type) = @_;
5084 return undef if (!$self->can_view_client($client));
5086 my $sch = $sched->get_scheds($schedname);
5087 return undef if (!$sch);
5090 foreach my $s (@$sch) {
5092 if ($type eq 'B') { # we take the pool only for backup job
5093 $pool = $sched->get_pool($s) || $job_pool;
5095 my $level = $sched->get_level($s);
5096 my ($l) = ($level =~ m/^(.)/); # we keep the first letter
5097 $l = $self->get_higher_level($l);
5098 my $evts = $sched->get_event($s);
5099 my $end = $sched->{end}; # this backup must have start before the next one
5100 foreach my $evt (reverse @$evts) {
5101 my $all = $self->dbh_selectrow_hashref("
5104 JOIN Client USING (ClientId) LEFT JOIN Pool USING (PoolId)
5105 WHERE Job.StartTime >= '$evt'
5106 AND Job.StartTime < '$end'
5107 AND Job.Name = '$job'
5108 AND Job.Type = '$type'
5109 AND Job.JobStatus IN ('T', 'W')
5110 AND Job.Level IN ($l)
5111 " . ($pool?" AND Pool.Name = '$pool' ":'') . "
5112 AND Client.Name = '$client'
5118 push @{$self->{tmp}}, {date => $evt, level => $level,
5119 type => 'Backup', name => $job,
5120 pool => $pool, volume => $pool,
5128 sub display_missing_job
5131 my $arg = $self->get_form(qw/begin end age/);
5133 if (!$arg->{begin}) { # TODO: change this
5134 $arg->{begin} = strftime('%F %T', localtime(time - $arg->{age}));
5137 $arg->{end} = strftime('%F %T', localtime(time));
5139 $self->{tmp} = []; # check_job use this for result
5141 my $bconsole = $self->get_bconsole();
5143 my $sched = new Bweb::Sched(bconsole => $bconsole,
5144 begin => $arg->{begin},
5145 end => $arg->{end});
5147 my $job = $bconsole->send_cmd("show job");
5148 my ($jname, $jsched, $jclient, $jpool, $jtype);
5149 foreach my $j (split(/\r?\n/, $job)) {
5150 if ($j =~ /Job: name=([\w\d\-]+?) JobType=(\d+)/i) {
5151 if ($jname and $jsched) {
5152 $self->check_job($sched, $jsched, $jname,
5153 $jpool, $jclient, $jtype);
5157 $jclient = $jpool = $jsched = undef;
5158 } elsif ($j =~ /Client: name=(.+?) address=/i) {
5160 } elsif ($j =~ /Pool: name=([\w\d\-]+) PoolType=/i) {
5162 } elsif ($j =~ /Schedule: name=([\w\d\-]+)/i) {
5168 title => "Missing Jobs (from $arg->{begin} to $arg->{end})",
5169 list => $self->{tmp},
5170 wiki_url => $self->{info}->{wiki_url},
5172 }, "scheduled_job.tpl");
5174 delete $self->{tmp};