1 ################################################################
6 Bweb - A Bacula web interface
7 Bacula® - The Network Backup Solution
9 Copyright (C) 2000-2007 Free Software Foundation Europe e.V.
11 The main author of Bweb is Eric Bollengier.
12 The main author of Bacula is Kern Sibbald, with contributions from
13 many others, a complete list can be found in the file AUTHORS.
15 This program is Free Software; you can redistribute it and/or
16 modify it under the terms of version two of the GNU General Public
17 License as published by the Free Software Foundation plus additions
18 that are listed in the file LICENSE.
20 This program is distributed in the hope that it will be useful, but
21 WITHOUT ANY WARRANTY; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 General Public License for more details.
25 You should have received a copy of the GNU General Public License
26 along with this program; if not, write to the Free Software
27 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
30 Bacula® is a registered trademark of John Walker.
31 The licensor of Bacula is the Free Software Foundation Europe
32 (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
33 Switzerland, email:ftf@fsfeurope.org.
45 Bweb::Gui - Base package for all Bweb object
49 This package define base fonction like new, display, etc..
54 our $template_dir='/usr/share/bweb/tpl';
58 new - creation a of new Bweb object
62 This function take an hash of argument and place them
65 IE : $obj = new Obj(name => 'test', age => '10');
67 $obj->{name} eq 'test' and $obj->{age} eq 10
73 my ($class, %arg) = @_;
78 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
85 my ($self, $what) = @_;
89 print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
91 print "<pre>$what</pre>";
98 error - display an error to the user
102 this function set $self->{error} with arg, display a message with
103 error.tpl and return 0
108 return $self->error("Can't use this file");
115 my ($self, $what) = @_;
116 $self->{error} = $what;
117 $self->display($self, 'error.tpl');
123 display - display an html page with HTML::Template
127 this function is use to render all html codes. it takes an
128 ref hash as arg in which all param are usable in template.
130 it will use user template_dir then global template_dir
131 to search the template file.
133 hash keys are not sensitive. See HTML::Template for more
134 explanations about the hash ref. (it's can be quiet hard to understand)
138 $ref = { name => 'me', age => 26 };
139 $self->display($ref, "people.tpl");
145 my ($self, $hash, $tpl) = @_ ;
146 my $dir = $self->{template_dir} || $template_dir;
147 my $lang = $self->{lang} || 'en';
148 my $template = HTML::Template->new(filename => $tpl,
149 path =>["$dir/$lang",
151 die_on_bad_params => 0,
152 case_sensitive => 0);
154 foreach my $var (qw/limit offset/) {
156 unless ($hash->{$var}) {
157 my $value = CGI::param($var) || '';
159 if ($value =~ /^(\d+)$/) {
160 $template->param($var, $1) ;
165 $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
166 $template->param('loginname', CGI::remote_user());
168 $template->param($hash);
169 print $template->output();
173 ################################################################
175 package Bweb::Config;
177 use base q/Bweb::Gui/;
181 Bweb::Config - read, write, display, modify configuration
185 this package is used for manage configuration
189 $conf = new Bweb::Config(config_file => '/path/to/conf');
200 =head1 PACKAGE VARIABLE
202 %k_re - hash of all acceptable option.
206 this variable permit to check all option with a regexp.
210 our %k_re = ( dbi => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
211 user => qr/^([\w\d\.-]+)$/i,
212 password => qr/^(.*)$/,
213 fv_write_path => qr!^([/\w\d\.-]*)$!,
214 template_dir => qr!^([/\w\d\.-]+)$!,
215 debug => qr/^(on)?$/,
216 lang => qr/^(\w\w)?$/,
217 email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
218 graph_font => qr!^([/\w\d\.-]+.ttf)$!,
219 bconsole => qr!^(.+)?$!,
220 syslog_file => qr!^(.+)?$!,
221 log_dir => qr!^(.+)?$!,
222 wiki_url => qr!(.*)$!,
223 stat_job_table => qr!^(\w*)$!,
224 display_log_time => qr!^(on)?$!,
225 enable_security => qr/^(on)?$/,
226 enable_security_acl => qr/^(on)?$/,
231 load - load config_file
235 this function load the specified config_file.
243 unless (open(FP, $self->{config_file}))
245 return $self->error("can't load config_file $self->{config_file} : $!");
247 my $f=''; my $tmpbuffer;
248 while(read FP,$tmpbuffer,4096)
256 no strict; # I have no idea of the contents of the file
263 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...") ;
266 foreach my $k (keys %$VAR1) {
267 $self->{$k} = $VAR1->{$k};
275 load_old - load old configuration format
283 unless (open(FP, $self->{config_file}))
285 return $self->error("$self->{config_file} : $!");
288 while (my $line = <FP>)
291 my ($k, $v) = split(/\s*=\s*/, $line, 2);
303 save - save the current configuration to config_file
311 if ($self->{ach_list}) {
312 # shortcut for display_begin
313 $self->{achs} = [ map {{ name => $_ }}
314 keys %{$self->{ach_list}}
318 unless (open(FP, ">$self->{config_file}"))
320 return $self->error("$self->{config_file} : $!\n" .
321 "You must add this to your config file\n"
322 . Data::Dumper::Dumper($self));
325 print FP Data::Dumper::Dumper($self);
333 edit, view, modify - html form ouput
341 $self->display($self, "config_edit.tpl");
347 $self->display($self, "config_view.tpl");
355 # we need to reset checkbox first
357 $self->{display_log_time} = 0;
358 $self->{enable_security} = 0;
359 $self->{enable_security_acl} = 0;
361 foreach my $k (CGI::param())
363 next unless (exists $k_re{$k}) ;
364 my $val = CGI::param($k);
365 if ($val =~ $k_re{$k}) {
368 $self->{error} .= "bad parameter : $k = [$val]";
374 if ($self->{error}) { # an error as occured
375 $self->display($self, 'error.tpl');
383 ################################################################
385 package Bweb::Client;
387 use base q/Bweb::Gui/;
391 Bweb::Client - Bacula FD
395 this package is use to do all Client operations like, parse status etc...
399 $client = new Bweb::Client(name => 'zog-fd');
400 $client->status(); # do a 'status client=zog-fd'
406 display_running_job - Html display of a running job
410 this function is used to display information about a current job
414 sub display_running_job
416 my ($self, $conf, $jobid) = @_ ;
418 my $status = $self->status($conf);
421 if ($status->{$jobid}) {
422 $self->display($status->{$jobid}, "client_job_status.tpl");
425 for my $id (keys %$status) {
426 $self->display($status->{$id}, "client_job_status.tpl");
433 $client = new Bweb::Client(name => 'plume-fd');
435 $client->status($bweb);
439 dirty hack to parse "status client=xxx-fd"
443 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
444 Backup Job started: 06-jun-06 17:22
445 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
446 Files Examined=10,697
447 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
453 JobName => Full_plume.2006-06-06_17.22.23,
456 Bytes => 194,484,132,
466 my ($self, $conf) = @_ ;
468 if (defined $self->{cur_jobs}) {
469 return $self->{cur_jobs} ;
473 my $b = new Bconsole(pref => $conf);
474 my $ret = $b->send_cmd("st client=$self->{name}");
478 for my $r (split(/\n/, $ret)) {
480 $r =~ s/(^\s+|\s+$)//g;
481 if ($r =~ /JobId (\d+) Job (\S+)/) {
483 $arg->{$jobid} = { @param, JobId => $jobid } ;
487 @param = ( JobName => $2 );
489 } elsif ($r =~ /=.+=/) {
490 push @param, split(/\s+|\s*=\s*/, $r) ;
492 } elsif ($r =~ /=/) { # one per line
493 push @param, split(/\s*=\s*/, $r) ;
495 } elsif ($r =~ /:/) { # one per line
496 push @param, split(/\s*:\s*/, $r, 2) ;
500 if ($jobid and @param) {
501 $arg->{$jobid} = { @param,
503 Client => $self->{name},
507 $self->{cur_jobs} = $arg ;
513 ################################################################
515 package Bweb::Autochanger;
517 use base q/Bweb::Gui/;
521 Bweb::Autochanger - Object to manage Autochanger
525 this package will parse the mtx output and manage drives.
529 $auto = new Bweb::Autochanger(precmd => 'sudo');
531 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
535 $auto->slot_is_full(10);
536 $auto->transfer(10, 11);
542 my ($class, %arg) = @_;
545 name => '', # autochanger name
546 label => {}, # where are volume { label1 => 40, label2 => drive0 }
547 drive => [], # drive use [ 'media1', 'empty', ..]
548 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
549 io => [], # io slot number list [ 41, 42, 43...]
550 info => {slot => 0, # informations (slot, drive, io)
554 mtxcmd => '/usr/sbin/mtx',
556 device => '/dev/changer',
557 precmd => '', # ssh command
558 bweb => undef, # link to bacula web object (use for display)
561 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
568 status - parse the output of mtx status
572 this function will launch mtx status and parse the output. it will
573 give a perlish view of the autochanger content.
575 it uses ssh if the autochanger is on a other host.
582 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
584 # TODO : reset all infos
585 $self->{info}->{drive} = 0;
586 $self->{info}->{slot} = 0;
587 $self->{info}->{io} = 0;
589 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
592 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
593 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
594 #Data Transfer Element 1:Empty
595 # Storage Element 1:Empty
596 # Storage Element 2:Full :VolumeTag=000002
597 # Storage Element 3:Empty
598 # Storage Element 4:Full :VolumeTag=000004
599 # Storage Element 5:Full :VolumeTag=000001
600 # Storage Element 6:Full :VolumeTag=000003
601 # Storage Element 7:Empty
602 # Storage Element 41 IMPORT/EXPORT:Empty
603 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
608 # Storage Element 7:Empty
609 # Storage Element 2:Full :VolumeTag=000002
610 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
613 $self->set_empty_slot($1);
615 $self->set_slot($1, $4);
618 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
621 $self->set_empty_drive($1);
623 $self->set_drive($1, $4, $6);
626 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
629 $self->set_empty_io($1);
631 $self->set_io($1, $4);
634 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
636 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
637 $self->{info}->{drive} = $1;
638 $self->{info}->{slot} = $2;
639 if ($l =~ /(\d+)\s+Import/) {
640 $self->{info}->{io} = $1 ;
642 $self->{info}->{io} = 0;
647 $self->debug($self) ;
652 my ($self, $slot) = @_;
655 if ($self->{slot}->[$slot] eq 'loaded') {
659 my $label = $self->{slot}->[$slot] ;
661 return $self->is_media_loaded($label);
666 my ($self, $drive, $slot) = @_;
668 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
669 return 0 if ($self->slot_is_full($slot)) ;
671 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
674 my $content = $self->get_slot($slot);
675 print "content = $content<br/> $drive => $slot<br/>";
676 $self->set_empty_drive($drive);
677 $self->set_slot($slot, $content);
680 $self->{error} = $out;
685 # TODO: load/unload have to use mtx script from bacula
688 my ($self, $drive, $slot) = @_;
690 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
691 return 0 unless ($self->slot_is_full($slot)) ;
693 print "Loading drive $drive with slot $slot<br/>\n";
694 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
697 my $content = $self->get_slot($slot);
698 print "content = $content<br/> $slot => $drive<br/>";
699 $self->set_drive($drive, $slot, $content);
702 $self->{error} = $out;
710 my ($self, $media) = @_;
712 unless ($self->{label}->{$media}) {
716 if ($self->{label}->{$media} =~ /drive\d+/) {
726 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
731 my ($self, $slot, $tag) = @_;
732 $self->{slot}->[$slot] = $tag || 'full';
733 push @{ $self->{io} }, $slot;
736 $self->{label}->{$tag} = $slot;
742 my ($self, $slot) = @_;
744 push @{ $self->{io} }, $slot;
746 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
747 $self->{slot}->[$slot] = 'empty';
753 my ($self, $slot) = @_;
754 return $self->{slot}->[$slot];
759 my ($self, $slot, $tag) = @_;
760 $self->{slot}->[$slot] = $tag || 'full';
763 $self->{label}->{$tag} = $slot;
769 my ($self, $slot) = @_;
771 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
772 $self->{slot}->[$slot] = 'empty';
778 my ($self, $drive) = @_;
779 $self->{drive}->[$drive] = 'empty';
784 my ($self, $drive, $slot, $tag) = @_;
785 $self->{drive}->[$drive] = $tag || $slot;
787 $self->{slot}->[$slot] = $tag || 'loaded';
790 $self->{label}->{$tag} = "drive$drive";
796 my ($self, $slot) = @_;
798 # slot don't exists => full
799 if (not defined $self->{slot}->[$slot]) {
803 if ($self->{slot}->[$slot] eq 'empty') {
806 return 1; # vol, full, loaded
809 sub slot_get_first_free
812 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
813 return $slot unless ($self->slot_is_full($slot));
817 sub io_get_first_free
821 foreach my $slot (@{ $self->{io} }) {
822 return $slot unless ($self->slot_is_full($slot));
829 my ($self, $media) = @_;
831 return $self->{label}->{$media} ;
836 my ($self, $media) = @_;
838 return defined $self->{label}->{$media} ;
843 my ($self, $slot) = @_;
845 unless ($self->slot_is_full($slot)) {
846 print "Autochanger $self->{name} slot $slot is empty\n";
851 if ($self->is_slot_loaded($slot)) {
854 print "Autochanger $self->{name} $slot is currently in use\n";
858 # autochanger must have I/O
859 unless ($self->have_io()) {
860 print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
864 my $dst = $self->io_get_first_free();
867 print "Autochanger $self->{name} you must empty I/O first\n";
870 $self->transfer($slot, $dst);
875 my ($self, $src, $dst) = @_ ;
876 if ($self->{debug}) {
877 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
879 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
882 my $content = $self->get_slot($src);
883 $self->{slot}->[$src] = 'empty';
884 $self->set_slot($dst, $content);
887 $self->{error} = $out;
894 my ($self, $index) = @_;
895 return $self->{drive_name}->[$index];
898 # TODO : do a tapeinfo request to get informations
908 for my $slot (@{$self->{io}})
910 if ($self->is_slot_loaded($slot)) {
911 print "$slot is currently loaded\n";
915 if ($self->slot_is_full($slot))
917 my $free = $self->slot_get_first_free() ;
918 print "move $slot to $free :\n";
921 if ($self->transfer($slot, $free)) {
922 print "<img src='/bweb/T.png' alt='ok'><br/>\n";
924 print "<img src='/bweb/E.png' alt='ok' title='$self->{error}'><br/>\n";
928 $self->{error} = "<img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'><br/>\n";
934 # TODO : this is with mtx status output,
935 # we can do an other function from bacula view (with StorageId)
939 my $bweb = $self->{bweb};
941 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
942 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
945 SELECT Media.VolumeName AS volumename,
946 Media.VolStatus AS volstatus,
947 Media.LastWritten AS lastwritten,
948 Media.VolBytes AS volbytes,
949 Media.MediaType AS mediatype,
951 Media.InChanger AS inchanger,
953 $bweb->{sql}->{FROM_UNIXTIME}(
954 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
955 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
958 INNER JOIN Pool USING (PoolId)
960 WHERE Media.VolumeName IN ($media_list)
963 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
965 # TODO : verify slot and bacula slot
969 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
971 if ($self->slot_is_full($slot)) {
973 my $vol = $self->{slot}->[$slot];
974 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
976 my $bslot = $all->{$vol}->{slot} ;
977 my $inchanger = $all->{$vol}->{inchanger};
979 # if bacula slot or inchanger flag is bad, we display a message
980 if ($bslot != $slot or !$inchanger) {
981 push @to_update, $slot;
984 $all->{$vol}->{realslot} = $slot;
986 push @{ $param }, $all->{$vol};
988 } else { # empty or no label
989 push @{ $param }, {realslot => $slot,
990 volstatus => 'Unknown',
991 volumename => $self->{slot}->[$slot]} ;
994 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
998 my $i=0; my $drives = [] ;
999 foreach my $d (@{ $self->{drive} }) {
1000 $drives->[$i] = { index => $i,
1001 load => $self->{drive}->[$i],
1002 name => $self->{drive_name}->[$i],
1007 $bweb->display({ Name => $self->{name},
1008 nb_drive => $self->{info}->{drive},
1009 nb_io => $self->{info}->{io},
1012 Update => scalar(@to_update) },
1019 ################################################################
1021 package Bweb::Sched;
1022 use base q/Bweb::Gui/;
1026 Bweb::Sched() - Bweb package that parse show schedule ouput
1028 new Bweb::Sched(format => '%Y-%m-%d', year => 2008);
1032 my $b = $bweb->get_bconsole();
1033 my $s = $b->send_cmd("show schedule");
1034 my $sched = new Bweb::Sched(begin => '2007-01-01', end => '2007-01-02 12:00');
1035 $sched->parse_scheds(split(/\r?\n/, $s));
1046 'level' => 'Differential',
1053 my ($class, @arg) = @_;
1054 my $self = $class->SUPER::new(@arg);
1056 # we compare the current schedule date with begin and end
1057 # in a float form ex: 20071212.1243 > 20070101
1058 if ($self->{begin} and $self->{end}) {
1059 ($self->{fbegin}, $self->{fend}) = ($self->{begin}, $self->{end});
1060 $self->{fbegin} =~ s/(-|:)//g; $self->{fbegin} =~ s/ /./;
1061 $self->{fend} =~ s/(-|:)//g; $self->{fend} =~ s/ /./;
1064 bless($self,$class);
1066 if ($self->{bconsole}) {
1067 my $sel = $self->{name}?"=\"$self->{name}\"":'';
1068 my $b = $self->{bconsole};
1069 my $out = $b->send_cmd("show schedule$sel");
1070 $self->parse_scheds(split(/\r?\n/, $out));
1071 undef $self->{bconsole}; # useless now
1077 # cleanup and add a schedule
1080 my ($self, $name, $info) = @_;
1081 # bacula uses dates that start from 0, we start from 1
1082 foreach (@{$info->{mday}},@{$info->{month}}) { $_++ };
1085 $info->{event} = [ $self->get_events($info, $self->{format}) ];
1087 foreach my $i (qw/hour mday month wday wom woy mins/) {
1091 push @{$self->{schedules}->{$name}}, $info;
1094 # return the name of all schedules
1097 my ($self, $name) = @_;
1099 return keys %{ $self->{schedules} };
1102 # return an array of all schedule
1105 my ($self, $sched) = @_;
1106 return $self->{schedules}->{$sched};
1109 # return an ref array of all events
1110 # [ '2007-12-19 04:05', '2007-12-19 04:05' ]
1113 my ($self, $sched) = @_;
1114 return $sched->{event};
1117 # return the pool name
1120 my ($self, $sched) = @_;
1121 return $sched->{pool} || '';
1124 # return the level name (Incremental, Differential, Full)
1127 my ($self, $sched) = @_;
1128 return $sched->{level};
1131 # parse bacula sched bitmap
1134 my ($self, @output) = @_;
1141 foreach my $ligne (@output) {
1142 if ($ligne =~ /Schedule: name=(.+)/) {
1143 if ($name and $elt) {
1144 $elt->{level} = $run;
1145 $self->add_sched($name, $elt);
1150 elsif ($ligne =~ /Run Level=(.+)/) {
1151 if ($name and $elt) {
1152 $elt->{level} = $run;
1153 $self->add_sched($name, $elt);
1158 elsif ($ligne =~ /(hour|mday|month|mins)=(.+)/) {
1159 # All theses lines have the same format
1161 my ($k,$v) = ($1,$2);
1162 # we get all values (0 1 4 9)
1163 $elt->{$k}=[split (/\s/,$v)];
1165 # we make a bitmap for this kind of data (0 0 1 0 0 0 1) for a quick access
1166 elsif ($ligne =~ /(wday|wom|woy)=(.+)/) {
1167 my ($k,$v) = ($1,$2);
1168 foreach my $e (split (/\s/,$v)) {
1172 elsif ($ligne =~ /Pool: name=(.+?) PoolType/) {
1177 if ($name and $elt) {
1178 $elt->{level} = $run;
1179 $self->add_sched($name, $elt);
1183 use Date::Calc qw(:all);
1185 # read bacula schedule bitmap and get $format date string
1189 my ($self, $s,$format) = @_;
1190 my $year = $self->{year} || ((localtime)[5] + 1900);
1191 $format = $format || '%u-%02u-%02u %02u:%02u';
1193 foreach my $m (@{$s->{month}}) # mois de l'annee
1195 foreach my $md (@{$s->{mday}}) # jour du mois
1197 # print " m=$m md=$md\n";
1198 # we check if this day exists (31 fev)
1199 next if (!check_date($year,$m,$md));
1200 # print " check_date ok\n";
1202 my $w = ($md-1)/7; # we use the same thing than bacula
1203 next if (! $s->{wom}->[$w]);
1204 # print " wom ok\n";
1206 # on recupere le jour de la semaine
1207 my $wd = Day_of_Week($year,$m,$md);
1209 my ($w1,undef) = Week_of_Year($year,$m,$wd);
1210 next if (! $s->{woy}->[$w1-1]); # bacula 0-51
1211 # print " woy ok\n";
1213 $wd = 0 if ($wd == 7) ; # sunday is 0 on bacula
1214 next if (! $s->{wday}->[$wd]);
1215 # print " wday ok\n";
1217 foreach my $h (@{$s->{hour}}) # hour of the day
1219 foreach my $min (@{$s->{mins}}) # minute
1221 if ($self->{fbegin}) {
1223 my $d = sprintf('%d%0.2d%0.2d.%0.2d%0.2d',
1224 $year,$m,$md,$h,$min);
1225 next if ($d < $self->{fbegin} or $d > $self->{fend});
1227 push @ret, sprintf($format, $year,$m,$md,$h,$min);
1236 ################################################################
1240 use base q/Bweb::Gui/;
1244 Bweb - main Bweb package
1248 this package is use to compute and display informations
1253 use POSIX qw/strftime/;
1255 our $config_file='/etc/bacula/bweb.conf';
1261 %sql_func - hash to make query mysql/postgresql compliant
1267 UNIX_TIMESTAMP => '',
1268 FROM_UNIXTIME => '',
1269 TO_SEC => " interval '1 second' * ",
1270 SEC_TO_INT => "SEC_TO_INT",
1273 STARTTIME_SEC => " date_trunc('sec', Job.StartTime) ",
1274 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1275 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1276 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1277 STARTTIME_WEEK => " date_trunc('week', Job.StartTime) ",
1278 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1279 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1280 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1281 STARTTIME_PWEEK => " date_part('week', Job.StartTime) ",
1282 DB_SIZE => " SELECT pg_database_size(current_database()) ",
1283 CAT_POOL_TYPE => " MediaType || '_' || Pool.Name ",
1287 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1288 FROM_UNIXTIME => 'FROM_UNIXTIME',
1291 SEC_TO_TIME => 'SEC_TO_TIME',
1292 MATCH => " REGEXP ",
1293 STARTTIME_SEC => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %T') ",
1294 STARTTIME_DAY => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d') ",
1295 STARTTIME_HOUR => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %H') ",
1296 STARTTIME_MONTH => " DATE_FORMAT(Job.StartTime, '%Y-%m') ",
1297 STARTTIME_WEEK => " DATE_FORMAT(Job.StartTime, '%Y-%v') ",
1298 STARTTIME_PHOUR=> " DATE_FORMAT(Job.StartTime, '%H') ",
1299 STARTTIME_PDAY => " DATE_FORMAT(Job.StartTime, '%d') ",
1300 STARTTIME_PMONTH => " DATE_FORMAT(Job.StartTime, '%m') ",
1301 STARTTIME_PWEEK => " DATE_FORMAT(Job.StartTime, '%v') ",
1302 # with mysql < 5, you have to play with the ugly SHOW command
1303 DB_SIZE => " SELECT 0 ",
1304 # works only with mysql 5
1305 # DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1306 CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1307 CONCAT_SEP => " SEPARATOR '' ",
1314 return $self->{info}->{dbi} =~ /dbi:mysql/i;
1321 $self->{dbh}->disconnect();
1326 sub dbh_selectall_arrayref
1328 my ($self, $query) = @_;
1329 $self->connect_db();
1330 $self->debug($query);
1331 return $self->{dbh}->selectall_arrayref($query);
1336 my ($self, @what) = @_;
1337 return join(',', $self->dbh_quote(@what)) ;
1342 my ($self, @what) = @_;
1344 $self->connect_db();
1346 return map { $self->{dbh}->quote($_) } @what;
1348 return $self->{dbh}->quote($what[0]) ;
1354 my ($self, $query) = @_ ;
1355 $self->connect_db();
1356 $self->debug($query);
1357 return $self->{dbh}->do($query);
1360 sub dbh_selectall_hashref
1362 my ($self, $query, $join) = @_;
1364 $self->connect_db();
1365 $self->debug($query);
1366 return $self->{dbh}->selectall_hashref($query, $join) ;
1369 sub dbh_selectrow_hashref
1371 my ($self, $query) = @_;
1373 $self->connect_db();
1374 $self->debug($query);
1375 return $self->{dbh}->selectrow_hashref($query) ;
1380 my ($self, @what) = @_;
1381 if ($self->dbh_is_mysql()) {
1382 return 'CONCAT(' . join(',', @what) . ')' ;
1384 return join(' || ', @what);
1390 my ($self, $query) = @_;
1391 $self->debug($query, up => 1);
1392 return $self->{dbh}->prepare($query);
1398 my @unit = qw(B KB MB GB TB);
1399 my $val = shift || 0;
1401 my $format = '%i %s';
1402 while ($val / 1024 > 1) {
1406 $format = ($i>0)?'%0.1f %s':'%i %s';
1407 return sprintf($format, $val, $unit[$i]);
1410 # display Day, Hour, Year
1416 $val /= 60; # sec -> min
1418 if ($val / 60 <= 1) {
1422 $val /= 60; # min -> hour
1423 if ($val / 24 <= 1) {
1424 return "$val hours";
1427 $val /= 24; # hour -> day
1428 if ($val / 365 < 2) {
1432 $val /= 365 ; # day -> year
1434 return "$val years";
1440 my $val = shift || 0;
1442 if ($val eq '1' or $val eq "yes") {
1444 } elsif ($val eq '2' or $val eq "archived") {
1452 sub from_human_enabled
1454 my $val = shift || 0;
1456 if ($val eq '1' or $val eq "yes") {
1458 } elsif ($val eq '2' or $val eq "archived") {
1465 # get Day, Hour, Year
1471 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1475 my %times = ( m => 60,
1481 my $mult = $times{$2} || 0;
1491 unless ($self->{dbh}) {
1493 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1494 $self->{info}->{user},
1495 $self->{info}->{password});
1497 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1498 unless ($self->{dbh});
1500 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1502 if ($self->dbh_is_mysql()) {
1503 $self->{dbh}->do("SET group_concat_max_len=1000000");
1505 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1512 my ($class, %arg) = @_;
1514 dbh => undef, # connect_db();
1516 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1522 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1524 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1525 $self->{sql} = $sql_func{$1};
1528 $self->{loginname} = CGI::remote_user();
1529 $self->{debug} = $self->{info}->{debug};
1530 $self->{lang} = $self->{info}->{lang};
1531 $self->{template_dir} = $self->{info}->{template_dir};
1539 if ($self->{info}->{enable_security}) {
1540 $self->get_roles(); # get lang
1542 $self->display($self->{info}, "begin.tpl");
1548 $self->display($self->{info}, "end.tpl");
1554 my $where=''; # by default
1556 my $arg = $self->get_form("client", "qre_client",
1557 "jclient_groups", "qnotingroup");
1559 if ($arg->{qre_client}) {
1560 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1561 } elsif ($arg->{client}) {
1562 $where = "WHERE Name = '$arg->{client}' ";
1563 } elsif ($arg->{jclient_groups}) {
1564 # $filter could already contains client_group_member
1566 JOIN client_group_member USING (ClientId)
1567 JOIN client_group USING (client_group_id)
1568 WHERE client_group_name IN ($arg->{jclient_groups}) ";
1569 } elsif ($arg->{qnotingroup}) {
1572 (SELECT 1 FROM client_group_member
1573 WHERE Client.ClientId = client_group_member.ClientId
1579 SELECT Name AS name,
1581 AutoPrune AS autoprune,
1582 FileRetention AS fileretention,
1583 JobRetention AS jobretention
1584 FROM Client " . $self->get_client_filter() .
1587 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1589 my $dsp = { ID => $cur_id++,
1590 clients => [ values %$all] };
1592 $self->display($dsp, "client_list.tpl") ;
1597 my ($self, %arg) = @_;
1602 if ($arg{since} and $arg{age}) {
1603 my $now = "$self->{sql}->{UNIX_TIMESTAMP}(TIMESTAMP '$arg{since}')";
1605 AND $self->{sql}->{UNIX_TIMESTAMP}(StartTime) > $now
1606 AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime) < ($now + $self->{sql}->{TO_SEC}($arg{age}))";
1607 $label .= "since $arg{since} and during " . human_sec($arg{age});
1609 } elsif ($arg{age}) {
1611 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1613 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1615 $self->{sql}->{TO_SEC}($arg{age})
1618 $label = "last " . human_sec($arg{age});
1621 if ($arg{groupby}) {
1622 $limit .= " GROUP BY $arg{groupby} ";
1626 $limit .= " ORDER BY $arg{order} ";
1630 $limit .= " LIMIT $arg{limit} ";
1631 $label .= " limited to $arg{limit}";
1635 $limit .= " OFFSET $arg{offset} ";
1636 $label .= " with $arg{offset} offset ";
1640 $label = 'no filter';
1643 return ($limit, $label);
1648 $bweb->get_form(...) - Get useful stuff
1652 This function get and check parameters against regexp.
1654 If word begin with 'q', the return will be quoted or join quoted
1655 if it's end with 's'.
1660 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1663 qclient => 'plume-fd',
1664 qpools => "'plume-fd', 'test-fd', '...'",
1671 my ($self, @what) = @_;
1672 my %what = map { $_ => 1 } @what;
1695 my %opt_ss =( # string with space
1699 my %opt_s = ( # default to ''
1720 my %opt_p = ( # option with path
1727 my %opt_r = (regexwhere => 1);
1728 my %opt_d = ( # option with date
1732 my %opt_t = (when => 2, # option with time
1733 begin => 1, # 1 hh:min are optionnal
1734 end => 1, # 2 hh:min are required
1737 foreach my $i (@what) {
1738 if (exists $opt_i{$i}) {# integer param
1739 my $value = CGI::param($i) || $opt_i{$i} ;
1740 if ($value =~ /^(\d+)$/) {
1743 } elsif ($opt_s{$i}) { # simple string param
1744 my $value = CGI::param($i) || '';
1745 if ($value =~ /^([\w\d\.-]+)$/) {
1748 } elsif ($opt_ss{$i}) { # simple string param (with space)
1749 my $value = CGI::param($i) || '';
1750 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1753 } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1754 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1756 $ret{$i} = $self->dbh_join(@value) ;
1759 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1760 my $value = CGI::param($1) ;
1762 $ret{$i} = $self->dbh_quote($value);
1765 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1766 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1767 grep { ! /^\s*$/ } CGI::param($1) ];
1768 } elsif (exists $opt_p{$i}) {
1769 my $value = CGI::param($i) || '';
1770 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1773 } elsif (exists $opt_r{$i}) {
1774 my $value = CGI::param($i) || '';
1775 if ($value =~ /^([^'"']+)$/) {
1778 } elsif (exists $opt_d{$i}) {
1779 my $value = CGI::param($i) || '';
1780 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1783 } elsif (exists $opt_t{$i}) { # 1: hh:min optionnal, 2: hh:min required
1784 my $when = CGI::param($i) || '';
1785 if ($when =~ /(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?)/) {
1786 if ($opt_t{$i} == 1 or defined $2) {
1794 foreach my $s (CGI::param('slot')) {
1795 if ($s =~ /^(\d+)$/) {
1796 push @{$ret{slots}}, $s;
1802 my $age = $ret{age} || $opt_i{age};
1803 my $since = CGI::param('since') || strftime('%F %T', localtime(time - $age));
1804 if ($since =~ /^(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?)$/) {
1810 my $lang = CGI::param('lang') || 'en';
1811 if ($lang =~ /^(\w\w)$/) {
1816 if ($what{db_clients}) {
1818 if ($what{filter}) {
1819 # get security filter only if asked
1820 $filter = $self->get_client_filter();
1824 SELECT Client.Name as clientname
1828 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1829 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1833 if ($what{db_client_groups}) {
1835 if ($what{filter}) {
1836 # get security filter only if asked
1837 $filter = $self->get_client_group_filter();
1841 SELECT client_group_name AS name
1842 FROM client_group $filter
1844 my $grps = $self->dbh_selectall_hashref($query, 'name');
1845 $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1849 if ($what{db_usernames}) {
1854 my $users = $self->dbh_selectall_hashref($query, 'username');
1855 $ret{db_usernames} = [sort {$a->{username} cmp $b->{username} }
1859 if ($what{db_roles}) {
1864 my $r = $self->dbh_selectall_hashref($query, 'rolename');
1865 $ret{db_roles} = [sort {$a->{rolename} cmp $b->{rolename} }
1869 if ($what{db_mediatypes}) {
1871 SELECT MediaType as mediatype
1874 my $media = $self->dbh_selectall_hashref($query, 'mediatype');
1875 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1879 if ($what{db_locations}) {
1881 SELECT Location as location, Cost as cost
1884 my $loc = $self->dbh_selectall_hashref($query, 'location');
1885 $ret{db_locations} = [ sort { $a->{location}
1891 if ($what{db_pools}) {
1892 my $query = "SELECT Name as name FROM Pool";
1894 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1895 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1898 if ($what{db_filesets}) {
1900 SELECT FileSet.FileSet AS fileset
1903 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1905 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1906 values %$filesets] ;
1909 if ($what{db_jobnames}) {
1911 if ($what{filter}) {
1912 $filter = " JOIN Client USING (ClientId) " . $self->get_client_filter();
1915 SELECT DISTINCT Job.Name AS jobname
1918 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1920 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1921 values %$jobnames] ;
1924 if ($what{db_devices}) {
1926 SELECT Device.Name AS name
1929 my $devices = $self->dbh_selectall_hashref($query, 'name');
1931 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1941 $self->can_do('r_view_stat');
1942 my $fields = $self->get_form(qw/age level status clients filesets
1943 graph gtype type filter db_clients
1944 limit db_filesets width height
1945 qclients qfilesets qjobnames db_jobnames/);
1947 my $url = CGI::url(-full => 0,
1950 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1952 # this organisation is to keep user choice between 2 click
1953 # TODO : fileset and client selection doesn't work
1960 if ($fields->{gtype} eq 'balloon') {
1961 system("./bgraph.pl");
1965 sub get_selected_media_location
1969 my $media = $self->get_form('jmedias');
1971 unless ($media->{jmedias}) {
1976 SELECT Media.VolumeName AS volumename, Location.Location AS location
1977 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1978 WHERE Media.VolumeName IN ($media->{jmedias})
1981 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1983 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1992 my ($self, $in) = @_ ;
1993 $self->can_do('r_media_mgnt');
1994 my $media = $self->get_selected_media_location();
2000 my $elt = $self->get_form('db_locations');
2002 $self->display({ ID => $cur_id++,
2003 enabled => human_enabled($in),
2004 %$elt, # db_locations
2006 sort { $a->{volumename} cmp $b->{volumename} } values %$media
2015 $self->can_do('r_media_mgnt');
2017 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
2019 $self->display($elt, "help_extern.tpl");
2022 sub help_extern_compute
2025 $self->can_do('r_media_mgnt');
2027 my $number = CGI::param('limit') || '' ;
2028 unless ($number =~ /^(\d+)$/) {
2029 return $self->error("Bad arg number : $number ");
2032 my ($sql, undef) = $self->get_param('pools',
2033 'locations', 'mediatypes');
2036 SELECT Media.VolumeName AS volumename,
2037 Media.VolStatus AS volstatus,
2038 Media.LastWritten AS lastwritten,
2039 Media.MediaType AS mediatype,
2040 Media.VolMounts AS volmounts,
2042 Media.Recycle AS recycle,
2043 $self->{sql}->{FROM_UNIXTIME}(
2044 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2045 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2048 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2049 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2051 WHERE Media.InChanger = 1
2052 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
2054 ORDER BY expire DESC, recycle, Media.VolMounts DESC
2058 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2060 $self->display({ Media => [ values %$all ] },
2061 "help_extern_compute.tpl");
2067 $self->can_do('r_media_mgnt');
2069 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
2070 $self->display($param, "help_intern.tpl");
2073 sub help_intern_compute
2076 $self->can_do('r_media_mgnt');
2078 my $number = CGI::param('limit') || '' ;
2079 unless ($number =~ /^(\d+)$/) {
2080 return $self->error("Bad arg number : $number ");
2083 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
2085 if (CGI::param('expired')) {
2087 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2088 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2094 SELECT Media.VolumeName AS volumename,
2095 Media.VolStatus AS volstatus,
2096 Media.LastWritten AS lastwritten,
2097 Media.MediaType AS mediatype,
2098 Media.VolMounts AS volmounts,
2100 $self->{sql}->{FROM_UNIXTIME}(
2101 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2102 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2105 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2106 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
2108 WHERE Media.InChanger <> 1
2109 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
2110 AND Media.Recycle = 1
2112 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
2116 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2118 $self->display({ Media => [ values %$all ] },
2119 "help_intern_compute.tpl");
2125 my ($self, %arg) = @_ ;
2127 my ($limit, $label) = $self->get_limit(%arg);
2131 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
2132 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
2133 (SELECT count(Job.JobId) FROM Job) AS nb_job,
2134 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
2135 ($self->{sql}->{DB_SIZE}) AS db_size,
2136 (SELECT count(Job.JobId)
2138 WHERE Job.JobStatus IN ('E','e','f','A')
2141 (SELECT count(Client.ClientId) FROM Client) AS nb_client
2144 my $row = $self->dbh_selectrow_hashref($query) ;
2146 $row->{nb_bytes} = human_size($row->{nb_bytes});
2148 $row->{db_size} = human_size($row->{db_size});
2149 $row->{label} = $label;
2151 $self->display($row, "general.tpl");
2156 my ($self, @what) = @_ ;
2157 my %elt = map { $_ => 1 } @what;
2162 if ($elt{clients}) {
2163 my @clients = grep { ! /^\s*$/ } CGI::param('client');
2165 $ret{clients} = \@clients;
2166 my $str = $self->dbh_join(@clients);
2167 $limit .= "AND Client.Name IN ($str) ";
2171 if ($elt{client_groups}) {
2172 my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
2174 $ret{client_groups} = \@clients;
2175 my $str = $self->dbh_join(@clients);
2176 $limit .= "AND client_group_name IN ($str) ";
2180 if ($elt{filesets}) {
2181 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
2183 $ret{filesets} = \@filesets;
2184 my $str = $self->dbh_join(@filesets);
2185 $limit .= "AND FileSet.FileSet IN ($str) ";
2189 if ($elt{mediatypes}) {
2190 my @media = grep { ! /^\s*$/ } CGI::param('mediatype');
2192 $ret{mediatypes} = \@media;
2193 my $str = $self->dbh_join(@media);
2194 $limit .= "AND Media.MediaType IN ($str) ";
2199 my $client = CGI::param('client');
2200 $ret{client} = $client;
2201 $client = $self->dbh_join($client);
2202 $limit .= "AND Client.Name = $client ";
2206 my $level = CGI::param('level') || '';
2207 if ($level =~ /^(\w)$/) {
2209 $limit .= "AND Job.Level = '$1' ";
2214 my $jobid = CGI::param('jobid') || '';
2216 if ($jobid =~ /^(\d+)$/) {
2218 $limit .= "AND Job.JobId = '$1' ";
2223 my $status = CGI::param('status') || '';
2224 if ($status =~ /^(\w)$/) {
2227 $limit .= "AND Job.JobStatus IN ('f','E') ";
2228 } elsif ($1 eq 'W') {
2229 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
2231 $limit .= "AND Job.JobStatus = '$1' ";
2236 if ($elt{volstatus}) {
2237 my $status = CGI::param('volstatus') || '';
2238 if ($status =~ /^(\w+)$/) {
2240 $limit .= "AND Media.VolStatus = '$1' ";
2244 if ($elt{locations}) {
2245 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
2247 $ret{locations} = \@location;
2248 my $str = $self->dbh_join(@location);
2249 $limit .= "AND Location.Location IN ($str) ";
2254 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
2256 $ret{pools} = \@pool;
2257 my $str = $self->dbh_join(@pool);
2258 $limit .= "AND Pool.Name IN ($str) ";
2262 if ($elt{location}) {
2263 my $location = CGI::param('location') || '';
2265 $ret{location} = $location;
2266 $location = $self->dbh_quote($location);
2267 $limit .= "AND Location.Location = $location ";
2272 my $pool = CGI::param('pool') || '';
2275 $pool = $self->dbh_quote($pool);
2276 $limit .= "AND Pool.Name = $pool ";
2280 if ($elt{jobtype}) {
2281 my $jobtype = CGI::param('jobtype') || '';
2282 if ($jobtype =~ /^(\w)$/) {
2284 $limit .= "AND Job.Type = '$1' ";
2288 return ($limit, %ret);
2299 my ($self, %arg) = @_ ;
2300 return if $self->cant_do('r_view_job');
2302 $arg{order} = ' Job.JobId DESC ';
2304 my ($limit, $label) = $self->get_limit(%arg);
2305 my ($where, undef) = $self->get_param('clients',
2314 if (CGI::param('client_group')) {
2316 JOIN client_group_member USING (ClientId)
2317 JOIN client_group USING (client_group_id)
2320 my $filter = $self->get_client_filter();
2323 SELECT Job.JobId AS jobid,
2324 Client.Name AS client,
2325 FileSet.FileSet AS fileset,
2326 Job.Name AS jobname,
2328 StartTime AS starttime,
2330 Pool.Name AS poolname,
2331 JobFiles AS jobfiles,
2332 JobBytes AS jobbytes,
2333 JobStatus AS jobstatus,
2334 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2335 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2338 JobErrors AS joberrors
2340 FROM Client $filter $cgq,
2341 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2342 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2343 WHERE Client.ClientId=Job.ClientId
2344 AND Job.JobStatus NOT IN ('R', 'C')
2349 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2351 $self->display({ Filter => $label,
2355 sort { $a->{jobid} <=> $b->{jobid} }
2362 # display job informations
2363 sub display_job_zoom
2365 my ($self, $jobid) = @_ ;
2366 $self->can_do('r_view_job');
2368 $jobid = $self->dbh_quote($jobid);
2370 # get security filter
2371 my $filter = $self->get_client_filter();
2374 SELECT DISTINCT Job.JobId AS jobid,
2375 Client.Name AS client,
2376 Job.Name AS jobname,
2377 FileSet.FileSet AS fileset,
2379 Pool.Name AS poolname,
2380 StartTime AS starttime,
2381 JobFiles AS jobfiles,
2382 JobBytes AS jobbytes,
2383 JobStatus AS jobstatus,
2384 JobErrors AS joberrors,
2385 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2386 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2388 FROM Client $filter,
2389 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2390 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2391 WHERE Client.ClientId=Job.ClientId
2392 AND Job.JobId = $jobid
2395 my $row = $self->dbh_selectrow_hashref($query) ;
2397 # display all volumes associate with this job
2399 SELECT Media.VolumeName as volumename
2400 FROM Job,Media,JobMedia
2401 WHERE Job.JobId = $jobid
2402 AND JobMedia.JobId=Job.JobId
2403 AND JobMedia.MediaId=Media.MediaId
2406 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2408 $row->{volumes} = [ values %$all ] ;
2409 $row->{wiki_url} = $self->{info}->{wiki_url};
2411 $self->display($row, "display_job_zoom.tpl");
2414 sub display_job_group
2416 my ($self, %arg) = @_;
2417 $self->can_do('r_view_job');
2419 my ($limit, $label) = $self->get_limit(groupby => 'client_group_name', %arg);
2421 my ($where, undef) = $self->get_param('client_groups',
2424 my $filter = $self->get_client_group_filter();
2427 SELECT client_group_name AS client_group_name,
2428 COALESCE(jobok.jobfiles,0) + COALESCE(joberr.jobfiles,0) AS jobfiles,
2429 COALESCE(jobok.jobbytes,0) + COALESCE(joberr.jobbytes,0) AS jobbytes,
2430 COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2431 COALESCE(jobok.nbjobs,0) AS nbjobok,
2432 COALESCE(joberr.nbjobs,0) AS nbjoberr,
2433 COALESCE(jobok.duration, '0:0:0') AS duration
2435 FROM client_group $filter LEFT JOIN (
2436 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2437 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2438 SUM(JobErrors) AS joberrors,
2439 SUM($self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2440 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2443 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2444 JOIN client_group USING (client_group_id)
2446 WHERE JobStatus = 'T'
2449 ) AS jobok USING (client_group_name) LEFT JOIN
2452 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2453 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2454 SUM(JobErrors) AS joberrors
2455 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2456 JOIN client_group USING (client_group_id)
2458 WHERE JobStatus IN ('f','E', 'A')
2461 ) AS joberr USING (client_group_name)
2465 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2467 my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2470 $self->display($rep, "display_job_group.tpl");
2475 my ($self, %arg) = @_ ;
2476 $self->can_do('r_view_media');
2478 my ($limit, $label) = $self->get_limit(%arg);
2479 my ($where, %elt) = $self->get_param('pools',
2484 my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2486 if ($arg->{jmedias}) {
2487 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2489 if ($arg->{qre_media}) {
2490 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2492 if ($arg->{expired}) {
2494 AND VolStatus = 'Full'
2495 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2496 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2497 ) < NOW() " . $where ;
2501 SELECT Media.VolumeName AS volumename,
2502 Media.VolBytes AS volbytes,
2503 Media.VolStatus AS volstatus,
2504 Media.MediaType AS mediatype,
2505 Media.InChanger AS online,
2506 Media.LastWritten AS lastwritten,
2507 Location.Location AS location,
2508 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2509 Pool.Name AS poolname,
2510 $self->{sql}->{FROM_UNIXTIME}(
2511 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2512 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2515 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2516 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2517 Media.MediaType AS MediaType
2519 WHERE Media.VolStatus = 'Full'
2520 GROUP BY Media.MediaType
2521 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2523 WHERE Media.PoolId=Pool.PoolId
2528 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2530 $self->display({ ID => $cur_id++,
2532 Location => $elt{location},
2533 Media => [ values %$all ],
2535 "display_media.tpl");
2538 sub display_allmedia
2542 my $pool = $self->get_form('db_pools');
2544 foreach my $name (@{ $pool->{db_pools} }) {
2545 CGI::param('pool', $name->{name});
2546 $self->display_media();
2550 sub display_media_zoom
2554 my $media = $self->get_form('jmedias');
2556 unless ($media->{jmedias}) {
2557 return $self->error("Can't get media selection");
2561 SELECT InChanger AS online,
2562 Media.Enabled AS enabled,
2563 VolBytes AS nb_bytes,
2564 VolumeName AS volumename,
2565 VolStatus AS volstatus,
2566 VolMounts AS nb_mounts,
2567 Media.VolUseDuration AS voluseduration,
2568 Media.MaxVolJobs AS maxvoljobs,
2569 Media.MaxVolFiles AS maxvolfiles,
2570 Media.MaxVolBytes AS maxvolbytes,
2571 VolErrors AS nb_errors,
2572 Pool.Name AS poolname,
2573 Location.Location AS location,
2574 Media.Recycle AS recycle,
2575 Media.VolRetention AS volretention,
2576 Media.LastWritten AS lastwritten,
2577 Media.VolReadTime/1000000 AS volreadtime,
2578 Media.VolWriteTime/1000000 AS volwritetime,
2579 Media.RecycleCount AS recyclecount,
2580 Media.Comment AS comment,
2581 $self->{sql}->{FROM_UNIXTIME}(
2582 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2583 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2586 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2587 WHERE Pool.PoolId = Media.PoolId
2588 AND VolumeName IN ($media->{jmedias})
2591 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2593 foreach my $media (values %$all) {
2594 my $mq = $self->dbh_quote($media->{volumename});
2597 SELECT DISTINCT Job.JobId AS jobid,
2599 Job.StartTime AS starttime,
2602 Job.JobFiles AS files,
2603 Job.JobBytes AS bytes,
2604 Job.jobstatus AS status
2605 FROM Media,JobMedia,Job
2606 WHERE Media.VolumeName=$mq
2607 AND Media.MediaId=JobMedia.MediaId
2608 AND JobMedia.JobId=Job.JobId
2611 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2614 SELECT LocationLog.Date AS date,
2615 Location.Location AS location,
2616 LocationLog.Comment AS comment
2617 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2618 WHERE Media.MediaId = LocationLog.MediaId
2619 AND Media.VolumeName = $mq
2623 my $log = $self->dbh_selectall_arrayref($query) ;
2625 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2628 $self->display({ jobs => [ values %$jobs ],
2629 LocationLog => $logtxt,
2631 "display_media_zoom.tpl");
2638 $self->can_do('r_location_mgnt');
2640 my $loc = $self->get_form('qlocation');
2641 unless ($loc->{qlocation}) {
2642 return $self->error("Can't get location");
2646 SELECT Location.Location AS location,
2647 Location.Cost AS cost,
2648 Location.Enabled AS enabled
2650 WHERE Location.Location = $loc->{qlocation}
2653 my $row = $self->dbh_selectrow_hashref($query);
2654 $row->{enabled} = human_enabled($row->{enabled});
2655 $self->display({ ID => $cur_id++,
2656 %$row }, "location_edit.tpl") ;
2662 $self->can_do('r_location_mgnt');
2664 my $arg = $self->get_form(qw/qlocation qnewlocation cost enabled/) ;
2665 unless ($arg->{qlocation}) {
2666 return $self->error("Can't get location");
2668 unless ($arg->{qnewlocation}) {
2669 return $self->error("Can't get new location name");
2671 unless ($arg->{cost}) {
2672 return $self->error("Can't get new cost");
2675 my $enabled = from_human_enabled($arg->{enabled});
2678 UPDATE Location SET Cost = $arg->{cost},
2679 Location = $arg->{qnewlocation},
2681 WHERE Location.Location = $arg->{qlocation}
2684 $self->dbh_do($query);
2686 $self->location_display();
2692 $self->can_do('r_location_mgnt');
2694 my $arg = $self->get_form(qw/qlocation/) ;
2696 unless ($arg->{qlocation}) {
2697 return $self->error("Can't get location");
2701 SELECT count(Media.MediaId) AS nb
2702 FROM Media INNER JOIN Location USING (LocationID)
2703 WHERE Location = $arg->{qlocation}
2706 my $res = $self->dbh_selectrow_hashref($query);
2709 return $self->error("Sorry, the location must be empty");
2713 DELETE FROM Location WHERE Location = $arg->{qlocation}
2716 $self->dbh_do($query);
2718 $self->location_display();
2724 $self->can_do('r_location_mgnt');
2726 my $arg = $self->get_form(qw/qlocation cost/) ;
2728 unless ($arg->{qlocation}) {
2729 $self->display({}, "location_add.tpl");
2732 unless ($arg->{cost}) {
2733 return $self->error("Can't get new cost");
2736 my $enabled = CGI::param('enabled') || '';
2737 $enabled = from_human_enabled($enabled);
2740 INSERT INTO Location (Location, Cost, Enabled)
2741 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2744 $self->dbh_do($query);
2746 $self->location_display();
2749 sub location_display
2754 SELECT Location.Location AS location,
2755 Location.Cost AS cost,
2756 Location.Enabled AS enabled,
2757 (SELECT count(Media.MediaId)
2759 WHERE Media.LocationId = Location.LocationId
2764 my $location = $self->dbh_selectall_hashref($query, 'location');
2766 $self->display({ ID => $cur_id++,
2767 Locations => [ values %$location ] },
2768 "display_location.tpl");
2775 my $media = $self->get_selected_media_location();
2780 my $arg = $self->get_form('db_locations', 'qnewlocation');
2782 $self->display({ email => $self->{info}->{email_media},
2784 media => [ values %$media ],
2786 "update_location.tpl");
2789 ###########################################################
2794 $self->can_do('r_group_mgnt');
2796 my $grp = $self->get_form(qw/qclient_group db_clients/);
2798 unless ($grp->{qclient_group}) {
2799 $self->display({ ID => $cur_id++,
2800 client_group => "''",
2802 }, "groups_edit.tpl");
2808 FROM Client JOIN client_group_member using (clientid)
2809 JOIN client_group using (client_group_id)
2810 WHERE client_group_name = $grp->{qclient_group}
2813 my $row = $self->dbh_selectall_hashref($query, "name");
2815 $self->display({ ID => $cur_id++,
2816 client_group => $grp->{qclient_group},
2818 client_group_member => [ values %$row]},
2825 $self->can_do('r_group_mgnt');
2827 my $arg = $self->get_form(qw/qclient_group jclients qnewgroup/);
2829 if (!$arg->{qclient_group} and $arg->{qnewgroup}) {
2831 INSERT INTO client_group (client_group_name)
2832 VALUES ($arg->{qnewgroup})
2834 $self->dbh_do($query);
2835 $arg->{qclient_group} = $arg->{qnewgroup};
2838 unless ($arg->{qclient_group}) {
2839 return $self->error("Can't get groups");
2842 $self->{dbh}->begin_work();
2845 DELETE FROM client_group_member
2846 WHERE client_group_id IN
2847 (SELECT client_group_id
2849 WHERE client_group_name = $arg->{qclient_group})
2851 $self->dbh_do($query);
2853 if ($arg->{jclients}) {
2855 INSERT INTO client_group_member (clientid, client_group_id)
2857 (SELECT client_group_id
2859 WHERE client_group_name = $arg->{qclient_group})
2860 FROM Client WHERE Name IN ($arg->{jclients})
2863 $self->dbh_do($query);
2865 if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2868 SET client_group_name = $arg->{qnewgroup}
2869 WHERE client_group_name = $arg->{qclient_group}
2872 $self->dbh_do($query);
2875 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2877 $self->display_groups();
2883 $self->can_do('r_group_mgnt');
2885 my $arg = $self->get_form(qw/qclient_group/);
2887 unless ($arg->{qclient_group}) {
2888 return $self->error("Can't get groups");
2891 $self->{dbh}->begin_work();
2894 DELETE FROM client_group_member
2895 WHERE client_group_id IN
2896 (SELECT client_group_id
2898 WHERE client_group_name = $arg->{qclient_group})");
2901 DELETE FROM bweb_client_group_acl
2902 WHERE client_group_id IN
2903 (SELECT client_group_id
2905 WHERE client_group_name = $arg->{qclient_group})");
2908 DELETE FROM client_group
2909 WHERE client_group_name = $arg->{qclient_group}");
2911 $self->{dbh}->commit();
2912 $self->display_groups();
2920 if ($self->cant_do('r_group_mgnt')) {
2921 $arg = $self->get_form(qw/db_client_groups filter/) ;
2923 $arg = $self->get_form(qw/db_client_groups/) ;
2926 if ($self->{dbh}->errstr) {
2927 return $self->error("Can't use groups with bweb, read INSTALL to enable them");
2932 $self->display({ ID => $cur_id++,
2934 "display_groups.tpl");
2937 ###########################################################
2942 if (not $self->{info}->{enable_security}) {
2945 # admin is a special user that can do everything
2946 if ($self->{loginname} eq 'admin') {
2949 if (!$self->{loginname}) {
2950 $self->error("Can't get your login name");
2951 $self->display_end();
2955 if (defined $self->{security}) {
2958 $self->{security} = {};
2959 my $u = $self->dbh_quote($self->{loginname});
2962 SELECT use_acl, rolename, tpl
2964 JOIN bweb_role_member USING (userid)
2965 JOIN bweb_role USING (roleid)
2968 my $rows = $self->dbh_selectall_arrayref($query);
2969 # do cache with this role
2970 if (!$rows or !scalar(@$rows)) {
2971 $self->error("Can't get $self->{loginname}'s roles");
2972 $self->display_end();
2975 foreach my $r (@$rows) {
2976 $self->{security}->{$r->[1]}=1;
2978 $self->{security}->{use_acl} = $rows->[0]->[0];
2979 if ($rows->[0]->[2] =~ /^(\w\w)$/) {
2987 my ($self, $client) = @_;
2989 my $filter = $self->get_client_filter();
2993 my $cont = $self->dbh_selectrow_hashref("
2996 WHERE Name = '$client'
2998 return defined $cont;
3003 my ($self, $action) = @_;
3004 # is security enabled in configuration ?
3005 if (not $self->{info}->{enable_security}) {
3008 # admin is a special user that can do everything
3009 if ($self->{loginname} eq 'admin') {
3013 if (!$self->{loginname}) {
3014 $self->{error} = "Can't do $action, your are not logged. " .
3015 "Check security with your administrator";
3018 if (!$self->get_roles()) {
3021 if (!$self->{security}->{$action}) {
3023 "$self->{loginname} sorry, but this action ($action) " .
3024 "is not permited. " .
3025 "Check security with your administrator";
3031 # make like an assert (program die)
3034 my ($self, $action) = @_;
3035 if ($self->cant_do($action)) {
3036 $self->error($self->{error});
3037 $self->display_end();
3047 if (!$self->{info}->{enable_security} or
3048 !$self->{info}->{enable_security_acl})
3053 if ($self->get_roles()) {
3054 return $self->{security}->{use_acl};
3060 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
3061 sub get_client_filter
3063 my ($self, $login) = @_;
3066 $u = $self->dbh_quote($login);
3067 } elsif ($self->use_filter()) {
3068 $u = $self->dbh_quote($self->{loginname});
3073 JOIN (SELECT ClientId FROM client_group_member
3074 JOIN client_group USING (client_group_id)
3075 JOIN bweb_client_group_acl USING (client_group_id)
3076 JOIN bweb_user USING (userid)
3077 WHERE bweb_user.username = $u
3078 ) AS filter USING (ClientId)";
3081 #JOIN client_group USING (client_group_id)" . $b->get_client_group_filter()
3082 sub get_client_group_filter
3084 my ($self, $login) = @_;
3087 $u = $self->dbh_quote($login);
3088 } elsif ($self->use_filter()) {
3089 $u = $self->dbh_quote($self->{loginname});
3094 JOIN (SELECT client_group_id
3095 FROM bweb_client_group_acl
3096 JOIN bweb_user USING (userid)
3097 WHERE bweb_user.username = $u
3098 ) AS filter USING (client_group_id)";
3101 # role and username have to be quoted before
3102 # role and username can be a quoted list
3105 my ($self, $role, $username) = @_;
3106 $self->can_do("r_user_mgnt");
3108 my $nb = $self->dbh_do("
3109 DELETE FROM bweb_role_member
3110 WHERE roleid = (SELECT roleid FROM bweb_role
3111 WHERE rolename IN ($role))
3112 AND userid = (SELECT userid FROM bweb_user
3113 WHERE username IN ($username))");
3117 # role and username have to be quoted before
3118 # role and username can be a quoted list
3121 my ($self, $role, $username) = @_;
3122 $self->can_do("r_user_mgnt");
3124 my $nb = $self->dbh_do("
3125 INSERT INTO bweb_role_member (roleid, userid)
3126 SELECT roleid, userid FROM bweb_role, bweb_user
3127 WHERE rolename IN ($role)
3128 AND username IN ($username)
3133 # role and username have to be quoted before
3134 # role and username can be a quoted list
3137 my ($self, $copy, $user) = @_;
3138 $self->can_do("r_user_mgnt");
3140 my $nb = $self->dbh_do("
3141 INSERT INTO bweb_role_member (roleid, userid)
3142 SELECT roleid, a.userid
3143 FROM bweb_user AS a, bweb_role_member
3144 JOIN bweb_user USING (userid)
3145 WHERE bweb_user.username = $copy
3146 AND a.username = $user");
3150 # username can be a join quoted list of usernames
3153 my ($self, $username) = @_;
3154 $self->can_do("r_user_mgnt");
3157 DELETE FROM bweb_role_member
3161 WHERE username in ($username))");
3163 DELETE FROM bweb_client_group_acl
3167 WHERE username IN ($username))");
3174 $self->can_do("r_user_mgnt");
3176 my $arg = $self->get_form(qw/jusernames/);
3178 unless ($arg->{jusernames}) {
3179 return $self->error("Can't get user");
3182 $self->{dbh}->begin_work();
3184 $self->revoke_all($arg->{jusernames});
3186 DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
3188 $self->{dbh}->commit();
3190 $self->display_users();
3196 $self->can_do("r_user_mgnt");
3198 # we don't quote username directly to check that it is conform
3199 my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate
3200 lang qcopy_username jclient_groups/) ;
3202 if (not $arg->{qcreate}) {
3203 $arg = $self->get_form(qw/db_roles db_usernames db_client_groups/);
3204 $self->display($arg, "display_user.tpl");
3208 my $u = $self->dbh_quote($arg->{username});
3210 $arg->{use_acl}=(CGI::param('use_acl')?'true':'false');
3212 if (!$arg->{qpasswd}) {
3213 $arg->{qpasswd} = "''";
3215 if (!$arg->{qcomment}) {
3216 $arg->{qcomment} = "''";
3219 # will fail if user already exists
3220 # UPDATE with mysql dbi does not return if update is ok
3223 SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment},
3224 use_acl=$arg->{use_acl}, tpl='$arg->{lang}'
3225 WHERE username = $u")
3226 # and (! $self->dbh_is_mysql() )
3229 INSERT INTO bweb_user (username, passwd, use_acl, comment, tpl)
3230 VALUES ($u, $arg->{qpasswd}, $arg->{use_acl},
3231 $arg->{qcomment}, '$arg->{lang}')");
3233 $self->{dbh}->begin_work();
3235 $self->revoke_all($u);
3237 if ($arg->{qcopy_username}) {
3238 $self->grant_like($arg->{qcopy_username}, $u);
3240 $self->grant($arg->{jrolenames}, $u);
3243 if ($arg->{jclient_groups}) {
3245 INSERT INTO bweb_client_group_acl (client_group_id, userid)
3246 SELECT client_group_id, userid
3247 FROM client_group, bweb_user
3248 WHERE client_group_name IN ($arg->{jclient_groups})
3253 $self->{dbh}->commit();
3255 $self->display_users();
3258 # TODO: we miss a matrix with all user/roles
3262 $self->can_do("r_user_mgnt");
3264 my $arg = $self->get_form(qw/db_usernames/) ;
3266 if ($self->{dbh}->errstr) {
3267 return $self->error("Can't use users with bweb, read INSTALL to enable them");
3270 $self->display({ ID => $cur_id++,
3272 "display_users.tpl");
3278 $self->can_do("r_user_mgnt");
3280 my $arg = $self->get_form('username');
3281 my $user = $self->dbh_quote($arg->{username});
3283 my $userp = $self->dbh_selectrow_hashref("
3284 SELECT username, passwd, comment, use_acl, tpl
3286 WHERE username = $user
3289 return $self->error("Can't find $user in catalog");
3291 my $filter = $self->get_client_group_filter($arg->{username});
3292 my $scg = $self->dbh_selectall_hashref("
3293 SELECT client_group_name AS name
3294 FROM client_group $filter
3298 #------------+--------
3303 my $role = $self->dbh_selectall_hashref("
3304 SELECT rolename, temp.userid
3306 LEFT JOIN (SELECT roleid, userid
3307 FROM bweb_user JOIN bweb_role_member USING (userid)
3308 WHERE username = $user) AS temp USING (roleid)
3312 $arg = $self->get_form(qw/db_usernames db_client_groups/);
3315 db_usernames => $arg->{db_usernames},
3316 username => $userp->{username},
3317 comment => $userp->{comment},
3318 passwd => $userp->{passwd},
3319 lang => $userp->{tpl},
3320 use_acl => $userp->{use_acl},
3321 db_client_groups => $arg->{db_client_groups},
3322 client_group => [ values %$scg ],
3323 db_roles => [ values %$role],
3324 }, "display_user.tpl");
3328 ###########################################################
3330 sub get_media_max_size
3332 my ($self, $type) = @_;
3334 "SELECT avg(VolBytes) AS size
3336 WHERE Media.VolStatus = 'Full'
3337 AND Media.MediaType = '$type'
3340 my $res = $self->selectrow_hashref($query);
3343 return $res->{size};
3353 my $media = $self->get_form('qmedia');
3355 unless ($media->{qmedia}) {
3356 return $self->error("Can't get media");
3360 SELECT Media.Slot AS slot,
3361 PoolMedia.Name AS poolname,
3362 Media.VolStatus AS volstatus,
3363 Media.InChanger AS inchanger,
3364 Location.Location AS location,
3365 Media.VolumeName AS volumename,
3366 Media.MaxVolBytes AS maxvolbytes,
3367 Media.MaxVolJobs AS maxvoljobs,
3368 Media.MaxVolFiles AS maxvolfiles,
3369 Media.VolUseDuration AS voluseduration,
3370 Media.VolRetention AS volretention,
3371 Media.Comment AS comment,
3372 PoolRecycle.Name AS poolrecycle,
3373 Media.Enabled AS enabled
3375 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
3376 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
3377 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
3379 WHERE Media.VolumeName = $media->{qmedia}
3382 my $row = $self->dbh_selectrow_hashref($query);
3383 $row->{volretention} = human_sec($row->{volretention});
3384 $row->{voluseduration} = human_sec($row->{voluseduration});
3385 $row->{enabled} = human_enabled($row->{enabled});
3387 my $elt = $self->get_form(qw/db_pools db_locations/);
3392 }, "update_media.tpl");
3398 $self->can_do('r_media_mgnt');
3400 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
3402 unless ($arg->{jmedias}) {
3403 return $self->error("Can't get selected media");
3406 unless ($arg->{qnewlocation}) {
3407 return $self->error("Can't get new location");
3412 SET LocationId = (SELECT LocationId
3414 WHERE Location = $arg->{qnewlocation})
3415 WHERE Media.VolumeName IN ($arg->{jmedias})
3418 my $nb = $self->dbh_do($query);
3420 print "$nb media updated, you may have to update your autochanger.";
3422 $self->display_media();
3428 $self->can_do('r_media_mgnt');
3430 my $media = $self->get_selected_media_location();
3432 return $self->error("Can't get media selection");
3434 my $newloc = CGI::param('newlocation');
3436 my $user = CGI::param('user') || 'unknown';
3437 my $comm = CGI::param('comment') || '';
3438 $comm = $self->dbh_quote("$user: $comm");
3440 my $arg = $self->get_form('enabled');
3441 my $en = from_human_enabled($arg->{enabled});
3442 my $b = $self->get_bconsole();
3445 foreach my $vol (keys %$media) {
3447 INSERT INTO LocationLog (Date,Comment,MediaId,LocationId,NewEnabled,NewVolStatus)
3448 SELECT NOW(), $comm, Media.MediaId, Location.LocationId, $en, VolStatus
3449 FROM Media, Location
3450 WHERE Media.VolumeName = '$vol'
3451 AND Location.Location = '$media->{$vol}->{location}'
3453 $self->dbh_do($query);
3454 $self->debug($query);
3455 $b->send_cmd("update volume=\"$vol\" enabled=$en");
3460 $q->param('action', 'update_location');
3461 my $url = $q->url(-full => 1, -query=>1);
3463 $self->display({ email => $self->{info}->{email_media},
3465 newlocation => $newloc,
3466 # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3467 media => [ values %$media ],
3469 "change_location.tpl");
3473 sub display_client_stats
3475 my ($self, %arg) = @_ ;
3476 $self->can_do('r_view_stat');
3478 my $client = $self->dbh_quote($arg{clientname});
3479 # get security filter
3480 my $filter = $self->get_client_filter();
3482 my ($limit, $label) = $self->get_limit(%arg);
3485 count(Job.JobId) AS nb_jobs,
3486 sum(Job.JobBytes) AS nb_bytes,
3487 sum(Job.JobErrors) AS nb_err,
3488 sum(Job.JobFiles) AS nb_files,
3489 Client.Name AS clientname
3490 FROM Job JOIN Client USING (ClientId) $filter
3492 Client.Name = $client
3494 GROUP BY Client.Name
3497 my $row = $self->dbh_selectrow_hashref($query);
3499 $row->{ID} = $cur_id++;
3500 $row->{label} = $label;
3501 $row->{grapharg} = "client";
3503 $self->display($row, "display_client_stats.tpl");
3507 sub display_group_stats
3509 my ($self, %arg) = @_ ;
3511 my $carg = $self->get_form(qw/qclient_group/);
3513 unless ($carg->{qclient_group}) {
3514 return $self->error("Can't get group");
3517 my ($limit, $label) = $self->get_limit(%arg);
3521 count(Job.JobId) AS nb_jobs,
3522 sum(Job.JobBytes) AS nb_bytes,
3523 sum(Job.JobErrors) AS nb_err,
3524 sum(Job.JobFiles) AS nb_files,
3525 client_group.client_group_name AS clientname
3526 FROM Job JOIN Client USING (ClientId)
3527 JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
3528 JOIN client_group USING (client_group_id)
3530 client_group.client_group_name = $carg->{qclient_group}
3532 GROUP BY client_group.client_group_name
3535 my $row = $self->dbh_selectrow_hashref($query);
3537 $row->{ID} = $cur_id++;
3538 $row->{label} = $label;
3539 $row->{grapharg} = "client_group";
3541 $self->display($row, "display_client_stats.tpl");
3544 # [ name, num, value, joberrors, nb_job ] =>
3546 # [ { name => 'ALL',
3547 # events => [ { num => 1, label => '2007-01',
3548 # value => 'T', title => 10 },
3549 # { num => 2, label => '2007-02',
3550 # value => 'R', title => 11 },
3553 # { name => 'Other',
3557 sub make_overview_tab
3559 my ($self, $q) = @_;
3560 my $ret = $self->dbh_selectall_arrayref($q);
3564 for my $elt (@$ret) {
3565 if ($cur_name and $cur_name ne $elt->[0]) { # order by name, num
3566 push @items, { name => $cur_name, events => $events};
3569 $cur_name = $elt->[0];
3571 { num => $elt->[1], status => $elt->[2],
3572 joberrors => $elt->[3], title => "$elt->[4] jobs"};
3574 push @items, { name => $cur_name, events => $events};
3578 sub get_time_overview
3580 my ($self, $arg) = @_; # want since et age from get_form();
3581 my $type = $arg->{type} || 'day';
3582 if ($type =~ /^(day|week|hour|month)$/) {
3588 my $jobt = $self->{info}->{stat_job_table} || 'Job';
3589 my $stime1 = $self->{sql}->{"STARTTIME_P" . $type}; # get 1,2,3
3590 $stime1 =~ s/Job.StartTime/date/;
3591 my $stime2 = $self->{sql}->{"STARTTIME_" . $type}; # get 2007-01-03, 2007-01-23
3593 my ($limit, $label) = $self->get_limit('since' => $arg->{since},
3594 'age' => $arg->{age});
3595 return ($stime1, $stime2, $limit, $label, $jobt);
3598 # lu ma me je ve sa di
3599 # groupe1 v v x w v v v overview
3600 # |-- s1 v v v v v v v overview_zoom
3601 # |-- s2 v v x v v v v
3602 # `-- s3 v v v w v v v
3603 sub display_overview_zoom
3606 $self->can_do('r_view_stat');
3608 my $arg = $self->get_form(qw/jclient_groups age since type/);
3610 if (!$arg->{jclient_groups}) {
3611 return $self->error("Can't get client_group selection");
3613 my ($filter2, undef) = $self->get_param(qw/level jobtype/);
3614 my ($stime1, $stime2, $limit, $label, $jobt) = $self->get_time_overview($arg);
3616 my $filter = $self->get_client_filter();
3618 SELECT name, $stime1 AS num,
3619 JobStatus AS value, joberrors, nb_job
3621 SELECT $stime2 AS date,
3622 Client.Name AS name,
3623 MAX(severity) AS severity,
3625 SUM(JobErrors) AS joberrors
3627 JOIN client_group_member USING (ClientId)
3628 JOIN client_group USING (client_group_id)
3629 JOIN Client USING (ClientId) $filter
3630 JOIN Status USING (JobStatus)
3631 WHERE client_group_name IN ($arg->{jclient_groups})
3634 GROUP BY Client.Name, date
3635 ) AS sub JOIN Status USING (severity)
3638 my $items = $self->make_overview_tab($q);
3639 $self->display({label => $label,
3640 action => "job;since=$arg->{since};type=$arg->{type};age=$arg->{age};client=",
3641 items => $items}, "overview.tpl");
3644 sub display_overview
3647 $self->can_do('r_view_stat');
3649 my $arg = $self->get_form(qw/jclient_groups age since type/);
3650 my ($filter2, undef) = $self->get_param(qw/client_groups level jobtype/);
3651 my $filter3 = $self->get_client_group_filter();
3652 my ($stime1, $stime2, $filter1, $label, $jobt) = $self->get_time_overview($arg);
3655 SELECT name, $stime1 AS num,
3656 JobStatus AS value, joberrors, nb_job
3658 SELECT $stime2 AS date,
3659 client_group_name AS name,
3660 MAX(severity) AS severity,
3662 SUM(JobErrors) AS joberrors
3664 JOIN client_group_member USING (ClientId)
3665 JOIN client_group USING (client_group_id) $filter3
3666 JOIN Status USING (JobStatus)
3667 WHERE true $filter1 $filter2
3668 GROUP BY client_group_name, date
3669 ) AS sub JOIN Status USING (severity)
3672 my $items = $self->make_overview_tab($q);
3673 $self->display({label=>$label,
3674 action => "overview_zoom;since=$arg->{since};type=$arg->{type};age=$arg->{age};client_group=",
3675 items => $items}, "overview.tpl");
3679 # poolname can be undef
3682 my ($self, $poolname) = @_ ;
3683 $self->can_do('r_view_media');
3688 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3689 if ($arg->{jmediatypes}) {
3690 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3691 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
3694 # TODO : afficher les tailles et les dates
3697 SELECT subq.volmax AS volmax,
3698 subq.volnum AS volnum,
3699 subq.voltotal AS voltotal,
3701 Pool.Recycle AS recycle,
3702 Pool.VolRetention AS volretention,
3703 Pool.VolUseDuration AS voluseduration,
3704 Pool.MaxVolJobs AS maxvoljobs,
3705 Pool.MaxVolFiles AS maxvolfiles,
3706 Pool.MaxVolBytes AS maxvolbytes,
3707 subq.PoolId AS PoolId,
3708 subq.MediaType AS mediatype,
3709 $self->{sql}->{CAT_POOL_TYPE} AS uniq
3712 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3713 count(Media.MediaId) AS volnum,
3714 sum(Media.VolBytes) AS voltotal,
3715 Media.PoolId AS PoolId,
3716 Media.MediaType AS MediaType
3718 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3719 Media.MediaType AS MediaType
3721 WHERE Media.VolStatus = 'Full'
3722 GROUP BY Media.MediaType
3723 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3724 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3726 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3730 my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3733 SELECT Pool.Name AS name,
3734 sum(VolBytes) AS size
3735 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3736 WHERE Media.VolStatus IN ('Recycled', 'Purged')
3740 my $empty = $self->dbh_selectall_hashref($query, 'name');
3742 foreach my $p (values %$all) {
3743 if ($p->{volmax} > 0) { # mysql returns 0.0000
3744 # we remove Recycled/Purged media from pool usage
3745 if (defined $empty->{$p->{name}}) {
3746 $p->{voltotal} -= $empty->{$p->{name}}->{size};
3748 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
3750 $p->{poolusage} = 0;
3754 SELECT VolStatus AS volstatus, count(MediaId) AS nb
3756 WHERE PoolId=$p->{poolid}
3757 AND Media.MediaType = '$p->{mediatype}'
3761 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
3762 foreach my $t (values %$content) {
3763 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
3768 $self->display({ ID => $cur_id++,
3769 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
3770 Pools => [ values %$all ]},
3771 "display_pool.tpl");
3774 sub display_running_job
3777 return if $self->cant_do('r_view_running_job');
3779 my $arg = $self->get_form('client', 'jobid');
3781 if (!$arg->{client} and $arg->{jobid}) {
3782 # get security filter
3783 my $filter = $self->get_client_filter();
3786 SELECT Client.Name AS name
3787 FROM Job INNER JOIN Client USING (ClientId) $filter
3788 WHERE Job.JobId = $arg->{jobid}
3791 my $row = $self->dbh_selectrow_hashref($query);
3794 $arg->{client} = $row->{name};
3795 CGI::param('client', $arg->{client});
3799 if ($arg->{client}) {
3800 my $cli = new Bweb::Client(name => $arg->{client});
3801 $cli->display_running_job($self->{info}, $arg->{jobid});
3802 if ($arg->{jobid}) {
3803 $self->get_job_log();
3806 $self->error("Can't get client or jobid");
3810 sub display_running_jobs
3812 my ($self, $display_action) = @_;
3813 return if $self->cant_do('r_view_running_job');
3815 # get security filter
3816 my $filter = $self->get_client_filter();
3819 SELECT Job.JobId AS jobid,
3820 Job.Name AS jobname,
3822 Job.StartTime AS starttime,
3823 Job.JobFiles AS jobfiles,
3824 Job.JobBytes AS jobbytes,
3825 Job.JobStatus AS jobstatus,
3826 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
3827 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
3829 Client.Name AS clientname
3830 FROM Job INNER JOIN Client USING (ClientId) $filter
3832 JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
3834 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
3836 $self->display({ ID => $cur_id++,
3837 display_action => $display_action,
3838 Jobs => [ values %$all ]},
3839 "running_job.tpl") ;
3842 # return the autochanger list to update
3846 $self->can_do('r_media_mgnt');
3849 my $arg = $self->get_form('jmedias');
3851 unless ($arg->{jmedias}) {
3852 return $self->error("Can't get media selection");
3856 SELECT Media.VolumeName AS volumename,
3857 Storage.Name AS storage,
3858 Location.Location AS location,
3860 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
3861 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
3862 WHERE Media.VolumeName IN ($arg->{jmedias})
3863 AND Media.InChanger = 1
3866 my $all = $self->dbh_selectall_hashref($query, 'volumename');
3868 foreach my $vol (values %$all) {
3869 my $a = $self->ach_get($vol->{location});
3871 $ret{$vol->{location}} = 1;
3873 unless ($a->{have_status}) {
3875 $a->{have_status} = 1;
3878 print "eject $vol->{volumename} from $vol->{storage} : ";
3879 if ($a->send_to_io($vol->{slot})) {
3880 print "<img src='/bweb/T.png' alt='ok'><br/>";
3882 print "<img src='/bweb/E.png' alt='err'><br/>";
3892 my ($to, $subject, $content) = (CGI::param('email'),
3893 CGI::param('subject'),
3894 CGI::param('content'));
3895 $to =~ s/[^\w\d\.\@<>,]//;
3896 $subject =~ s/[^\w\d\.\[\]]/ /;
3898 open(MAIL, "|mail -s '$subject' '$to'") ;
3899 print MAIL $content;
3909 my $arg = $self->get_form('jobid', 'client');
3911 print CGI::header('text/brestore');
3912 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
3913 print "client=$arg->{client}\n" if ($arg->{client});
3914 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
3918 # TODO : move this to Bweb::Autochanger ?
3919 # TODO : make this internal to not eject tape ?
3925 my ($self, $name) = @_;
3928 return $self->error("Can't get your autochanger name ach");
3931 unless ($self->{info}->{ach_list}) {
3932 return $self->error("Could not find any autochanger");
3935 my $a = $self->{info}->{ach_list}->{$name};
3938 $self->error("Can't get your autochanger $name from your ach_list");
3943 $a->{debug} = $self->{debug};
3950 my ($self, $ach) = @_;
3951 $self->can_do('r_configure');
3953 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
3955 $self->{info}->save();
3963 $self->can_do('r_configure');
3965 my $arg = $self->get_form('ach');
3967 or !$self->{info}->{ach_list}
3968 or !$self->{info}->{ach_list}->{$arg->{ach}})
3970 return $self->error("Can't get autochanger name");
3973 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
3977 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
3979 my $b = $self->get_bconsole();
3981 my @storages = $b->list_storage() ;
3983 $ach->{devices} = [ map { { name => $_ } } @storages ];
3985 $self->display($ach, "ach_add.tpl");
3986 delete $ach->{drives};
3987 delete $ach->{devices};
3994 $self->can_do('r_configure');
3996 my $arg = $self->get_form('ach');
3999 or !$self->{info}->{ach_list}
4000 or !$self->{info}->{ach_list}->{$arg->{ach}})
4002 return $self->error("Can't get autochanger name");
4005 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
4007 $self->{info}->save();
4008 $self->{info}->view();
4014 $self->can_do('r_configure');
4016 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
4018 my $b = $self->get_bconsole();
4019 my @storages = $b->list_storage() ;
4021 unless ($arg->{ach}) {
4022 $arg->{devices} = [ map { { name => $_ } } @storages ];
4023 return $self->display($arg, "ach_add.tpl");
4027 foreach my $drive (CGI::param('drives'))
4029 unless (grep(/^$drive$/,@storages)) {
4030 return $self->error("Can't find $drive in storage list");
4033 my $index = CGI::param("index_$drive");
4034 unless (defined $index and $index =~ /^(\d+)$/) {
4035 return $self->error("Can't get $drive index");
4038 $drives[$index] = $drive;
4042 return $self->error("Can't get drives from Autochanger");
4045 my $a = new Bweb::Autochanger(name => $arg->{ach},
4046 precmd => $arg->{precmd},
4047 drive_name => \@drives,
4048 device => $arg->{device},
4049 mtxcmd => $arg->{mtxcmd});
4051 $self->ach_register($a) ;
4053 $self->{info}->view();
4059 $self->can_do('r_delete_job');
4061 my $arg = $self->get_form('jobid');
4063 if ($arg->{jobid}) {
4064 my $b = $self->get_bconsole();
4065 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
4069 title => "Delete a job ",
4070 name => "delete jobid=$arg->{jobid}",
4078 $self->can_do('r_media_mgnt');
4080 my $arg = $self->get_form(qw/media volstatus inchanger pool
4081 slot volretention voluseduration
4082 maxvoljobs maxvolfiles maxvolbytes
4083 qcomment poolrecycle enabled
4086 unless ($arg->{media}) {
4087 return $self->error("Can't find media selection");
4090 my $update = "update volume=$arg->{media} ";
4092 if ($arg->{volstatus}) {
4093 $update .= " volstatus=$arg->{volstatus} ";
4096 if ($arg->{inchanger}) {
4097 $update .= " inchanger=yes " ;
4099 $update .= " slot=$arg->{slot} ";
4102 $update .= " slot=0 inchanger=no ";
4105 if ($arg->{enabled}) {
4106 $update .= " enabled=$arg->{enabled} ";
4110 $update .= " pool=$arg->{pool} " ;
4113 if (defined $arg->{volretention}) {
4114 $update .= " volretention=\"$arg->{volretention}\" " ;
4117 if (defined $arg->{voluseduration}) {
4118 $update .= " voluse=\"$arg->{voluseduration}\" " ;
4121 if (defined $arg->{maxvoljobs}) {
4122 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
4125 if (defined $arg->{maxvolfiles}) {
4126 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
4129 if (defined $arg->{maxvolbytes}) {
4130 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
4133 if (defined $arg->{poolrecycle}) {
4134 $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
4137 my $b = $self->get_bconsole();
4140 content => $b->send_cmd($update),
4141 title => "Update a volume ",
4147 my $media = $self->dbh_quote($arg->{media});
4149 my $loc = CGI::param('location') || '';
4151 $loc = $self->dbh_quote($loc); # is checked by db
4152 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
4154 if (!$arg->{qcomment}) {
4155 $arg->{qcomment} = "''";
4157 push @q, "Comment=$arg->{qcomment}";
4162 SET " . join (',', @q) . "
4163 WHERE Media.VolumeName = $media
4165 $self->dbh_do($query);
4167 $self->update_media();
4173 $self->can_do('r_autochanger_mgnt');
4175 my $ach = CGI::param('ach') ;
4176 $ach = $self->ach_get($ach);
4178 return $self->error("Bad autochanger name");
4182 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
4183 $b->update_slots($ach->{name});
4190 $self->can_do('r_view_log');
4192 my $arg = $self->get_form('jobid', 'limit', 'offset');
4193 unless ($arg->{jobid}) {
4194 return $self->error("Can't get jobid");
4197 if ($arg->{limit} == 100) {
4198 $arg->{limit} = 1000;
4200 # get security filter
4201 my $filter = $self->get_client_filter();
4204 SELECT Job.Name as name, Client.Name as clientname
4205 FROM Job INNER JOIN Client USING (ClientId) $filter
4206 WHERE JobId = $arg->{jobid}
4209 my $row = $self->dbh_selectrow_hashref($query);
4212 return $self->error("Can't find $arg->{jobid} in catalog");
4215 # display only Error and Warning messages
4217 if (CGI::param('error')) {
4218 $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning|ERR=' ";
4222 if (CGI::param('time') || $self->{info}->{display_log_time}) {
4223 $logtext = $self->dbh_strcat('Time', " ' ' ", 'LogText');
4225 $logtext = 'LogText';
4229 SELECT count(1) AS nbline, JobId AS jobid,
4230 GROUP_CONCAT($logtext $self->{sql}->{CONCAT_SEP}) AS logtxt
4232 SELECT JobId, Time, LogText
4234 WHERE ( Log.JobId = $arg->{jobid}
4236 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
4237 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
4241 OFFSET $arg->{offset}
4247 my $log = $self->dbh_selectrow_hashref($query);
4249 return $self->error("Can't get log for jobid $arg->{jobid}");
4252 $self->display({ lines=> $log->{logtxt},
4253 nbline => $log->{nbline},
4254 jobid => $arg->{jobid},
4255 name => $row->{name},
4256 client => $row->{clientname},
4257 offset => $arg->{offset},
4258 limit => $arg->{limit},
4259 }, 'display_log.tpl');
4265 $self->can_do('r_media_mgnt');
4266 my $arg = $self->get_form('storage', 'pool', 'nb', 'media', 'offset');
4267 my $b = $self->get_bconsole();
4269 if (!$arg->{storage} || !$arg->{pool} || not defined $arg->{nb} || !$arg->{media} || !$arg->{offset}) {
4270 CGI::param(offset => 0);
4271 $arg = $self->get_form('db_pools');
4272 $arg->{storage} = [ map { { name => $_ } }$b->list_storage()];
4273 $self->display($arg, 'add_media.tpl');
4278 if ($arg->{nb} > 0) {
4279 $arg->{offset} = $arg->{offset}?$arg->{offset}:1;
4280 $cmd = "add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n$arg->{nb}\n$arg->{media}\n$arg->{offset}\n";
4282 $cmd = "add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n0\n$arg->{media}\n";
4288 CGI::param('media', '');
4289 CGI::param('re_media', $arg->{media});
4290 $self->display_media();
4296 $self->can_do('r_autochanger_mgnt');
4298 my $arg = $self->get_form('ach', 'slots', 'drive');
4300 unless ($arg->{ach}) {
4301 return $self->error("Can't find autochanger name");
4304 my $a = $self->ach_get($arg->{ach});
4306 return $self->error("Can't find autochanger name in configuration");
4309 my $storage = $a->get_drive_name($arg->{drive});
4311 return $self->error("Can't get your drive name");
4317 if ($arg->{slots}) {
4318 $slots = join(",", @{ $arg->{slots} });
4319 $slots_sql = " AND Slot IN ($slots) ";
4320 $t += 60*scalar( @{ $arg->{slots} }) ;
4323 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
4324 print "<h1>This command can take long time, be patient...</h1>";
4326 $b->label_barcodes(storage => $storage,
4327 drive => $arg->{drive},
4335 SET LocationId = (SELECT LocationId
4337 WHERE Location = '$arg->{ach}')
4339 WHERE (LocationId = 0 OR LocationId IS NULL)
4348 $self->can_do('r_purge');
4350 my @volume = CGI::param('media');
4353 return $self->error("Can't get media selection");
4356 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4358 foreach my $v (@volume) {
4360 content => $b->purge_volume($v),
4361 title => "Purge media",
4362 name => "purge volume=$v",
4371 $self->can_do('r_prune');
4373 my @volume = CGI::param('media');
4375 return $self->error("Can't get media selection");
4378 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4380 foreach my $v (@volume) {
4382 content => $b->prune_volume($v),
4383 title => "Prune volume",
4384 name => "prune volume=$v",
4393 $self->can_do('r_cancel_job');
4395 my $arg = $self->get_form('jobid');
4396 unless ($arg->{jobid}) {
4397 return $self->error("Can't get jobid");
4400 my $b = $self->get_bconsole();
4402 content => $b->cancel($arg->{jobid}),
4403 title => "Cancel job",
4404 name => "cancel jobid=$arg->{jobid}",
4410 # Warning, we display current fileset
4413 my $arg = $self->get_form('fileset');
4415 if ($arg->{fileset}) {
4416 my $b = $self->get_bconsole();
4417 my $ret = $b->get_fileset($arg->{fileset});
4418 $self->display({ fileset => $arg->{fileset},
4420 }, "fileset_view.tpl");
4422 $self->error("Can't get fileset name");
4426 sub director_show_sched
4429 $self->can_do('r_view_job');
4430 my $arg = $self->get_form('days');
4432 my $b = $self->get_bconsole();
4433 my $ret = $b->director_get_sched( $arg->{days} );
4438 }, "scheduled_job.tpl");
4441 sub enable_disable_job
4443 my ($self, $what) = @_ ;
4444 $self->can_do('r_run_job');
4446 my $name = CGI::param('job') || '';
4447 unless ($name =~ /^[\w\d\.\-\s]+$/) {
4448 return $self->error("Can't find job name");
4451 my $b = $self->get_bconsole();
4461 content => $b->send_cmd("$cmd job=\"$name\""),
4462 title => "$cmd $name",
4463 name => "$cmd job=\"$name\"",
4470 return new Bconsole(pref => $self->{info});
4476 $self->can_do('r_run_job');
4478 my $b = $self->get_bconsole();
4480 my $joblist = [ map { { name => $_ } } $b->list_job() ];
4482 $self->display({ Jobs => $joblist }, "run_job.tpl");
4487 my ($self, $ouput) = @_;
4490 foreach my $l (split(/\r\n/, $ouput)) {
4491 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4497 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4503 foreach my $k (keys %arg) {
4504 $lowcase{lc($k)} = $arg{$k} ;
4513 $self->can_do('r_run_job');
4515 my $b = $self->get_bconsole();
4517 my $job = CGI::param('job') || '';
4519 # we take informations from director, and we overwrite with user wish
4520 my $info = $b->send_cmd("show job=\"$job\"");
4521 my $attr = $self->run_parse_job($info);
4523 my $arg = $self->get_form(qw/pool level client fileset storage media/);
4525 if (!$arg->{pool} and $arg->{media}) {
4526 my $r = $self->dbh_selectrow_hashref("
4527 SELECT Pool.Name AS name
4528 FROM Media JOIN Pool USING (PoolId)
4529 WHERE Media.VolumeName = '$arg->{media}'
4530 AND Pool.Name != 'Scratch'
4533 $arg->{pool} = $r->{name};
4537 my %job_opt = (%$attr, %$arg);
4539 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
4541 my $pools = [ map { { name => $_ } } $b->list_pool() ];
4542 my $clients = [ map { { name => $_ } }$b->list_client()];
4543 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
4544 my $storages= [ map { { name => $_ } }$b->list_storage()];
4549 clients => $clients,
4550 filesets => $filesets,
4551 storages => $storages,
4553 }, "run_job_mod.tpl");
4559 $self->can_do('r_run_job');
4561 my $b = $self->get_bconsole();
4563 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
4573 $self->can_do('r_run_job');
4575 my $b = $self->get_bconsole();
4577 # TODO: check input (don't use pool, level)
4579 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
4580 my $job = CGI::param('job') || '';
4581 my $storage = CGI::param('storage') || '';
4583 my $jobid = $b->run(job => $job,
4584 client => $arg->{client},
4585 priority => $arg->{priority},
4586 level => $arg->{level},
4587 storage => $storage,
4588 pool => $arg->{pool},
4589 fileset => $arg->{fileset},
4590 when => $arg->{when},
4595 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>";
4598 sub display_next_job
4602 my $arg = $self->get_form(qw/job begin end/);
4604 return $self->error("Can't get job name");
4607 my $b = $self->get_bconsole();
4609 my $job = $b->send_cmd("show job=\"$arg->{job}\"");
4610 if ($job !~ /Schedule: name=([\w\d\-]+)/s) {
4611 return $self->error("Can't get $arg->{job} schedule");
4615 if ($job =~ /Pool: name=([\w\d\-]+) PoolType=/) {
4619 my $sched = new Bweb::Sched(bconsole => $b, name => $jsched,
4620 begin => $arg->{begin}, end => $arg->{end});
4622 my $ss = $sched->get_scheds($jsched);
4625 foreach my $s (@$ss) {
4626 my $level = $sched->get_level($s);
4627 my $pool = $sched->get_pool($s) || $jpool;
4628 my $evt = $sched->get_event($s);
4629 push @ret, map { "$_ : $pool ($level)\n" } @$evt;
4632 print "<b>$arg->{job}:</b><pre>", sort @ret, "</pre><br>";
4635 # check jobs against their schedule
4638 my ($self, $sched, $schedname, $job, $job_pool, $client) = @_;
4639 return undef if (!$self->can_view_client($client));
4641 my $sch = $sched->get_scheds($schedname);
4642 return undef if (!$sch);
4644 my $end = $sched->{end}; # this backup must have start before the next one
4646 foreach my $s (@$sch) {
4647 my $pool = $sched->get_pool($s) || $job_pool;
4648 my $level = $sched->get_level($s);
4649 my ($l) = ($level =~ m/^(.)/); # we keep the first letter
4650 my $evts = $sched->get_event($s);
4652 foreach my $evt (reverse @$evts) {
4653 my $all = $self->dbh_selectrow_hashref("
4655 FROM Job JOIN Pool USING (PoolId) JOIN Client USING (ClientId)
4656 WHERE Job.StartTime >= '$evt'
4657 AND Job.StartTime < '$end'
4659 AND Job.Name = '$job'
4660 AND Job.JobStatus = 'T'
4661 AND Job.Level = '$l'
4662 " . ($pool?" AND Pool.Name = '$pool' ":'') . "
4663 AND Client.Name = '$client'
4669 push @{$self->{tmp}}, {date => $evt, level => $level,
4670 type => 'Backup', name => $job,
4671 pool => $pool, volume => $pool};
4678 sub display_missing_job
4681 my $arg = $self->get_form(qw/begin end/);
4683 if (!$arg->{begin}) { # TODO: change this
4684 $arg->{begin} = strftime('%F %T', localtime(time - 24*60*60 ));
4687 $arg->{end} = strftime('%F %T', localtime(time));
4689 $self->{tmp} = []; # check_job use this for result
4691 my $bconsole = $self->get_bconsole();
4693 my $sched = new Bweb::Sched(bconsole => $bconsole,
4694 begin => $arg->{begin},
4695 end => $arg->{end});
4697 my $job = $bconsole->send_cmd("show job");
4698 my ($jname, $jsched, $jclient, $jpool);
4699 foreach my $j (split(/\r?\n/, $job)) {
4700 if ($j =~ /Job: name=([\w\d\-]+?) JobType=/i) {
4701 if ($jname and $jsched) {
4702 $self->check_job($sched, $jsched, $jname, $jpool, $jclient);
4705 $jclient = $jpool = $jsched = undef;
4706 } elsif ($j =~ /Client: name=(.+?) address=/i) {
4708 } elsif ($j =~ /Pool: name=([\w\d\-]+) PoolType=/i) {
4710 } elsif ($j =~ /Schedule: name=([\w\d\-]+)/i) {
4716 title => "Missing Job (since $arg->{begin} to $arg->{end})",
4717 list => $self->{tmp},
4718 }, "scheduled_job.tpl");
4720 delete $self->{tmp};