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 my ($self, $what) = @_;
100 my $old = $self->{debug};
103 $self->{debug} = $old;
108 error - display an error to the user
112 this function set $self->{error} with arg, display a message with
113 error.tpl and return 0
118 return $self->error("Can't use this file");
125 my ($self, $what) = @_;
126 $self->{error} = $what;
127 $self->display($self, 'error.tpl');
133 display - display an html page with HTML::Template
137 this function is use to render all html codes. it takes an
138 ref hash as arg in which all param are usable in template.
140 it will use user template_dir then global template_dir
141 to search the template file.
143 hash keys are not sensitive. See HTML::Template for more
144 explanations about the hash ref. (it's can be quiet hard to understand)
148 $ref = { name => 'me', age => 26 };
149 $self->display($ref, "people.tpl");
155 my ($self, $hash, $tpl) = @_ ;
156 my $dir = $self->{template_dir} || $template_dir;
157 my $lang = $self->{lang} || 'en';
158 my $template = HTML::Template->new(filename => $tpl,
159 path =>["$dir/$lang",
161 die_on_bad_params => 0,
162 case_sensitive => 0);
164 foreach my $var (qw/limit offset/) {
166 unless ($hash->{$var}) {
167 my $value = CGI::param($var) || '';
169 if ($value =~ /^(\d+)$/) {
170 $template->param($var, $1) ;
175 $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
176 $template->param('loginname', CGI::remote_user());
178 $template->param($hash);
179 print $template->output();
183 ################################################################
185 package Bweb::Config;
187 use base q/Bweb::Gui/;
191 Bweb::Config - read, write, display, modify configuration
195 this package is used for manage configuration
199 $conf = new Bweb::Config(config_file => '/path/to/conf');
210 =head1 PACKAGE VARIABLE
212 %k_re - hash of all acceptable option.
216 this variable permit to check all option with a regexp.
220 our %k_re = ( dbi => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
221 user => qr/^([\w\d\.-]+)$/i,
222 password => qr/^(.*)$/,
223 fv_write_path => qr!^([/\w\d\.-]*)$!,
224 template_dir => qr!^([/\w\d\.-]+)$!,
225 debug => qr/^(on)?$/,
226 lang => qr/^(\w\w)?$/,
227 email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
228 graph_font => qr!^([/\w\d\.-]+.ttf)$!,
229 bconsole => qr!^(.+)?$!,
230 syslog_file => qr!^(.+)?$!,
231 log_dir => qr!^(.+)?$!,
232 wiki_url => qr!(.*)$!,
233 stat_job_table => qr!^(\w*)$!,
234 display_log_time => qr!^(on)?$!,
235 enable_security => qr/^(on)?$/,
236 enable_security_acl => qr/^(on)?$/,
241 load - load config_file
245 this function load the specified config_file.
253 unless (open(FP, $self->{config_file}))
255 return $self->error("can't load config_file $self->{config_file} : $!");
257 my $f=''; my $tmpbuffer;
258 while(read FP,$tmpbuffer,4096)
266 no strict; # I have no idea of the contents of the file
273 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...") ;
276 foreach my $k (keys %$VAR1) {
277 $self->{$k} = $VAR1->{$k};
285 load_old - load old configuration format
293 unless (open(FP, $self->{config_file}))
295 return $self->error("$self->{config_file} : $!");
298 while (my $line = <FP>)
301 my ($k, $v) = split(/\s*=\s*/, $line, 2);
313 save - save the current configuration to config_file
321 if ($self->{ach_list}) {
322 # shortcut for display_begin
323 $self->{achs} = [ map {{ name => $_ }}
324 keys %{$self->{ach_list}}
328 unless (open(FP, ">$self->{config_file}"))
330 return $self->error("$self->{config_file} : $!\n" .
331 "You must add this to your config file\n"
332 . Data::Dumper::Dumper($self));
335 print FP Data::Dumper::Dumper($self);
343 edit, view, modify - html form ouput
351 $self->display($self, "config_edit.tpl");
357 $self->display($self, "config_view.tpl");
365 # we need to reset checkbox first
367 $self->{display_log_time} = 0;
368 $self->{enable_security} = 0;
369 $self->{enable_security_acl} = 0;
371 foreach my $k (CGI::param())
373 next unless (exists $k_re{$k}) ;
374 my $val = CGI::param($k);
375 if ($val =~ $k_re{$k}) {
378 $self->{error} .= "bad parameter : $k = [$val]";
384 if ($self->{error}) { # an error as occured
385 $self->display($self, 'error.tpl');
393 ################################################################
395 package Bweb::Client;
397 use base q/Bweb::Gui/;
401 Bweb::Client - Bacula FD
405 this package is use to do all Client operations like, parse status etc...
409 $client = new Bweb::Client(name => 'zog-fd');
410 $client->status(); # do a 'status client=zog-fd'
416 display_running_job - Html display of a running job
420 this function is used to display information about a current job
424 sub display_running_job
426 my ($self, $bweb, $jobid, $infos) = @_ ;
427 my $status = $self->status($bweb->{info});
430 if ($status->{$jobid}) {
431 $status = $status->{$jobid};
432 $status->{last_jobbytes} = $infos->{jobbytes};
433 $status->{last_jobfiles} = $infos->{jobfiles};
434 $status->{corr_jobbytes} = $infos->{corr_jobbytes};
435 $status->{corr_jobfiles} = $infos->{corr_jobfiles};
436 $status->{jobbytes}=$status->{Bytes};
437 $status->{jobbytes} =~ s![^\d]!!g;
438 $status->{jobfiles}=$status->{'Files Examined'};
439 $status->{jobfiles} =~ s/,//g;
440 $bweb->display($status, "client_job_status.tpl");
443 for my $id (keys %$status) {
444 $bweb->display($status->{$id}, "client_job_status.tpl");
451 $client = new Bweb::Client(name => 'plume-fd');
453 $client->status($bweb);
457 dirty hack to parse "status client=xxx-fd"
461 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
462 Backup Job started: 06-jun-06 17:22
463 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
464 Files Examined=10,697
465 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
471 JobName => Full_plume.2006-06-06_17.22.23,
474 Bytes => 194,484,132,
484 my ($self, $conf) = @_ ;
486 if (defined $self->{cur_jobs}) {
487 return $self->{cur_jobs} ;
491 my $b = new Bconsole(pref => $conf);
492 my $ret = $b->send_cmd("st client=$self->{name}");
496 for my $r (split(/\n/, $ret)) {
498 $r =~ s/(^\s+|\s+$)//g;
499 if ($r =~ /JobId (\d+) Job (\S+)/) {
501 $arg->{$jobid} = { @param, JobId => $jobid } ;
505 @param = ( JobName => $2 );
507 } elsif ($r =~ /=.+=/) {
508 push @param, split(/\s+|\s*=\s*/, $r) ;
510 } elsif ($r =~ /=/) { # one per line
511 push @param, split(/\s*=\s*/, $r) ;
513 } elsif ($r =~ /:/) { # one per line
514 push @param, split(/\s*:\s*/, $r, 2) ;
518 if ($jobid and @param) {
519 $arg->{$jobid} = { @param,
521 Client => $self->{name},
525 $self->{cur_jobs} = $arg ;
531 ################################################################
533 package Bweb::Autochanger;
535 use base q/Bweb::Gui/;
539 Bweb::Autochanger - Object to manage Autochanger
543 this package will parse the mtx output and manage drives.
547 $auto = new Bweb::Autochanger(precmd => 'sudo');
549 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
553 $auto->slot_is_full(10);
554 $auto->transfer(10, 11);
560 my ($class, %arg) = @_;
563 name => '', # autochanger name
564 label => {}, # where are volume { label1 => 40, label2 => drive0 }
565 drive => [], # drive use [ 'media1', 'empty', ..]
566 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
567 io => [], # io slot number list [ 41, 42, 43...]
568 info => {slot => 0, # informations (slot, drive, io)
572 mtxcmd => '/usr/sbin/mtx',
574 device => '/dev/changer',
575 precmd => '', # ssh command
576 bweb => undef, # link to bacula web object (use for display)
579 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
586 status - parse the output of mtx status
590 this function will launch mtx status and parse the output. it will
591 give a perlish view of the autochanger content.
593 it uses ssh if the autochanger is on a other host.
600 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
602 # TODO : reset all infos
603 $self->{info}->{drive} = 0;
604 $self->{info}->{slot} = 0;
605 $self->{info}->{io} = 0;
607 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
610 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
611 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
612 #Data Transfer Element 1:Empty
613 # Storage Element 1:Empty
614 # Storage Element 2:Full :VolumeTag=000002
615 # Storage Element 3:Empty
616 # Storage Element 4:Full :VolumeTag=000004
617 # Storage Element 5:Full :VolumeTag=000001
618 # Storage Element 6:Full :VolumeTag=000003
619 # Storage Element 7:Empty
620 # Storage Element 41 IMPORT/EXPORT:Empty
621 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
626 # Storage Element 7:Empty
627 # Storage Element 2:Full :VolumeTag=000002
628 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
631 $self->set_empty_slot($1);
633 $self->set_slot($1, $4);
636 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
639 $self->set_empty_drive($1);
641 $self->set_drive($1, $4, $6);
644 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
647 $self->set_empty_io($1);
649 $self->set_io($1, $4);
652 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
654 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
655 $self->{info}->{drive} = $1;
656 $self->{info}->{slot} = $2;
657 if ($l =~ /(\d+)\s+Import/) {
658 $self->{info}->{io} = $1 ;
660 $self->{info}->{io} = 0;
665 $self->debug($self) ;
670 my ($self, $slot) = @_;
673 if ($self->{slot}->[$slot] eq 'loaded') {
677 my $label = $self->{slot}->[$slot] ;
679 return $self->is_media_loaded($label);
684 my ($self, $drive, $slot) = @_;
686 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
687 return 0 if ($self->slot_is_full($slot)) ;
689 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
692 my $content = $self->get_slot($slot);
693 print "content = $content<br/> $drive => $slot<br/>";
694 $self->set_empty_drive($drive);
695 $self->set_slot($slot, $content);
698 $self->{error} = $out;
703 # TODO: load/unload have to use mtx script from bacula
706 my ($self, $drive, $slot) = @_;
708 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
709 return 0 unless ($self->slot_is_full($slot)) ;
711 print "Loading drive $drive with slot $slot<br/>\n";
712 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
715 my $content = $self->get_slot($slot);
716 print "content = $content<br/> $slot => $drive<br/>";
717 $self->set_drive($drive, $slot, $content);
720 $self->{error} = $out;
728 my ($self, $media) = @_;
730 unless ($self->{label}->{$media}) {
734 if ($self->{label}->{$media} =~ /drive\d+/) {
744 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
749 my ($self, $slot, $tag) = @_;
750 $self->{slot}->[$slot] = $tag || 'full';
751 push @{ $self->{io} }, $slot;
754 $self->{label}->{$tag} = $slot;
760 my ($self, $slot) = @_;
762 push @{ $self->{io} }, $slot;
764 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
765 $self->{slot}->[$slot] = 'empty';
771 my ($self, $slot) = @_;
772 return $self->{slot}->[$slot];
777 my ($self, $slot, $tag) = @_;
778 $self->{slot}->[$slot] = $tag || 'full';
781 $self->{label}->{$tag} = $slot;
787 my ($self, $slot) = @_;
789 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
790 $self->{slot}->[$slot] = 'empty';
796 my ($self, $drive) = @_;
797 $self->{drive}->[$drive] = 'empty';
802 my ($self, $drive, $slot, $tag) = @_;
803 $self->{drive}->[$drive] = $tag || $slot;
805 $self->{slot}->[$slot] = $tag || 'loaded';
808 $self->{label}->{$tag} = "drive$drive";
814 my ($self, $slot) = @_;
816 # slot don't exists => full
817 if (not defined $self->{slot}->[$slot]) {
821 if ($self->{slot}->[$slot] eq 'empty') {
824 return 1; # vol, full, loaded
827 sub slot_get_first_free
830 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
831 return $slot unless ($self->slot_is_full($slot));
835 sub io_get_first_free
839 foreach my $slot (@{ $self->{io} }) {
840 return $slot unless ($self->slot_is_full($slot));
847 my ($self, $media) = @_;
849 return $self->{label}->{$media} ;
854 my ($self, $media) = @_;
856 return defined $self->{label}->{$media} ;
861 my ($self, $slot) = @_;
863 unless ($self->slot_is_full($slot)) {
864 print "Autochanger $self->{name} slot $slot is empty\n";
869 if ($self->is_slot_loaded($slot)) {
872 print "Autochanger $self->{name} $slot is currently in use\n";
876 # autochanger must have I/O
877 unless ($self->have_io()) {
878 print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
882 my $dst = $self->io_get_first_free();
885 print "Autochanger $self->{name} you must empty I/O first\n";
888 $self->transfer($slot, $dst);
893 my ($self, $src, $dst) = @_ ;
894 if ($self->{debug}) {
895 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
897 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
900 my $content = $self->get_slot($src);
901 $self->{slot}->[$src] = 'empty';
902 $self->set_slot($dst, $content);
905 $self->{error} = $out;
912 my ($self, $index) = @_;
913 return $self->{drive_name}->[$index];
916 # TODO : do a tapeinfo request to get informations
926 for my $slot (@{$self->{io}})
928 if ($self->is_slot_loaded($slot)) {
929 print "$slot is currently loaded\n";
933 if ($self->slot_is_full($slot))
935 my $free = $self->slot_get_first_free() ;
936 print "move $slot to $free :\n";
939 if ($self->transfer($slot, $free)) {
940 print "<img src='/bweb/T.png' alt='ok'><br/>\n";
942 print "<img src='/bweb/E.png' alt='ok' title='$self->{error}'><br/>\n";
946 $self->{error} = "<img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'><br/>\n";
952 # TODO : this is with mtx status output,
953 # we can do an other function from bacula view (with StorageId)
957 my $bweb = $self->{bweb};
959 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
960 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
963 SELECT Media.VolumeName AS volumename,
964 Media.VolStatus AS volstatus,
965 Media.LastWritten AS lastwritten,
966 Media.VolBytes AS volbytes,
967 Media.MediaType AS mediatype,
969 Media.InChanger AS inchanger,
971 $bweb->{sql}->{FROM_UNIXTIME}(
972 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
973 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
976 INNER JOIN Pool USING (PoolId)
978 WHERE Media.VolumeName IN ($media_list)
981 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
983 # TODO : verify slot and bacula slot
987 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
989 if ($self->slot_is_full($slot)) {
991 my $vol = $self->{slot}->[$slot];
992 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
994 my $bslot = $all->{$vol}->{slot} ;
995 my $inchanger = $all->{$vol}->{inchanger};
997 # if bacula slot or inchanger flag is bad, we display a message
998 if ($bslot != $slot or !$inchanger) {
999 push @to_update, $slot;
1002 $all->{$vol}->{realslot} = $slot;
1004 push @{ $param }, $all->{$vol};
1006 } else { # empty or no label
1007 push @{ $param }, {realslot => $slot,
1008 volstatus => 'Unknown',
1009 volumename => $self->{slot}->[$slot]} ;
1012 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
1016 my $i=0; my $drives = [] ;
1017 foreach my $d (@{ $self->{drive} }) {
1018 $drives->[$i] = { index => $i,
1019 load => $self->{drive}->[$i],
1020 name => $self->{drive_name}->[$i],
1025 $bweb->display({ Name => $self->{name},
1026 nb_drive => $self->{info}->{drive},
1027 nb_io => $self->{info}->{io},
1030 Update => scalar(@to_update) },
1037 ################################################################
1039 package Bweb::Sched;
1040 use base q/Bweb::Gui/;
1044 Bweb::Sched() - Bweb package that parse show schedule ouput
1046 new Bweb::Sched(format => '%Y-%m-%d', year => 2008);
1050 my $b = $bweb->get_bconsole();
1051 my $s = $b->send_cmd("show schedule");
1052 my $sched = new Bweb::Sched(begin => '2007-01-01', end => '2007-01-02 12:00');
1053 $sched->parse_scheds(split(/\r?\n/, $s));
1064 'level' => 'Differential',
1071 my ($class, @arg) = @_;
1072 my $self = $class->SUPER::new(@arg);
1074 # we compare the current schedule date with begin and end
1075 # in a float form ex: 20071212.1243 > 20070101
1076 if ($self->{begin} and $self->{end}) {
1077 ($self->{fbegin}, $self->{fend}) = ($self->{begin}, $self->{end});
1078 $self->{fbegin} =~ s/(-|:)//g; $self->{fbegin} =~ s/ /./;
1079 $self->{fend} =~ s/(-|:)//g; $self->{fend} =~ s/ /./;
1082 bless($self,$class);
1084 if ($self->{bconsole}) {
1085 my $sel = $self->{name}?"=\"$self->{name}\"":'';
1086 my $b = $self->{bconsole};
1087 my $out = $b->send_cmd("show schedule$sel");
1088 $self->parse_scheds(split(/\r?\n/, $out));
1089 undef $self->{bconsole}; # useless now
1095 # cleanup and add a schedule
1098 my ($self, $name, $info) = @_;
1099 # bacula uses dates that start from 0, we start from 1
1100 foreach (@{$info->{mday}},@{$info->{month}}) { $_++ };
1103 $info->{event} = [ $self->get_events($info, $self->{format}) ];
1105 foreach my $i (qw/hour mday month wday wom woy mins/) {
1109 push @{$self->{schedules}->{$name}}, $info;
1112 # return the name of all schedules
1115 my ($self, $name) = @_;
1117 return keys %{ $self->{schedules} };
1120 # return an array of all schedule
1123 my ($self, $sched) = @_;
1124 return $self->{schedules}->{$sched};
1127 # return an ref array of all events
1128 # [ '2007-12-19 04:05', '2007-12-19 04:05' ]
1131 my ($self, $sched) = @_;
1132 return $sched->{event};
1135 # return the pool name
1138 my ($self, $sched) = @_;
1139 return $sched->{pool} || '';
1142 # return the level name (Incremental, Differential, Full)
1145 my ($self, $sched) = @_;
1146 return $sched->{level};
1149 # parse bacula sched bitmap
1152 my ($self, @output) = @_;
1159 foreach my $ligne (@output) {
1160 if ($ligne =~ /Schedule: name=(.+)/) {
1161 if ($name and $elt) {
1162 $elt->{level} = $run;
1163 $self->add_sched($name, $elt);
1168 elsif ($ligne =~ /Run Level=(.+)/) {
1169 if ($name and $elt) {
1170 $elt->{level} = $run;
1171 $self->add_sched($name, $elt);
1176 elsif ($ligne =~ /(hour|mday|month|mins)=(.+)/) {
1177 # All theses lines have the same format
1179 my ($k,$v) = ($1,$2);
1180 # we get all values (0 1 4 9)
1181 $elt->{$k}=[split (/\s/,$v)];
1183 # we make a bitmap for this kind of data (0 0 1 0 0 0 1) for a quick access
1184 elsif ($ligne =~ /(wday|wom|woy)=(.+)/) {
1185 my ($k,$v) = ($1,$2);
1186 foreach my $e (split (/\s/,$v)) {
1190 elsif ($ligne =~ /Pool: name=(.+?) PoolType/) {
1195 if ($name and $elt) {
1196 $elt->{level} = $run;
1197 $self->add_sched($name, $elt);
1201 use Date::Calc qw(:all);
1203 # read bacula schedule bitmap and get $format date string
1207 my ($self, $s,$format) = @_;
1208 my $year = $self->{year} || ((localtime)[5] + 1900);
1209 $format = $format || '%u-%02u-%02u %02u:%02u';
1211 foreach my $m (@{$s->{month}}) # mois de l'annee
1213 foreach my $md (@{$s->{mday}}) # jour du mois
1215 # print " m=$m md=$md\n";
1216 # we check if this day exists (31 fev)
1217 next if (!check_date($year,$m,$md));
1218 # print " check_date ok\n";
1220 my $w = ($md-1)/7; # we use the same thing than bacula
1221 next if (! $s->{wom}->[$w]);
1222 # print " wom ok\n";
1224 # on recupere le jour de la semaine
1225 my $wd = Day_of_Week($year,$m,$md);
1227 my ($w1,undef) = Week_of_Year($year,$m,$wd);
1228 next if (! $s->{woy}->[$w1-1]); # bacula 0-51
1229 # print " woy ok\n";
1231 $wd = 0 if ($wd == 7) ; # sunday is 0 on bacula
1232 next if (! $s->{wday}->[$wd]);
1233 # print " wday ok\n";
1235 foreach my $h (@{$s->{hour}}) # hour of the day
1237 foreach my $min (@{$s->{mins}}) # minute
1239 if ($self->{fbegin}) {
1241 my $d = sprintf('%d%0.2d%0.2d.%0.2d%0.2d',
1242 $year,$m,$md,$h,$min);
1243 next if ($d < $self->{fbegin} or $d > $self->{fend});
1245 push @ret, sprintf($format, $year,$m,$md,$h,$min);
1254 ################################################################
1258 use base q/Bweb::Gui/;
1262 Bweb - main Bweb package
1266 this package is use to compute and display informations
1271 use POSIX qw/strftime/;
1273 our $config_file='/etc/bacula/bweb.conf';
1279 %sql_func - hash to make query mysql/postgresql compliant
1285 UNIX_TIMESTAMP => '',
1286 FROM_UNIXTIME => '',
1287 TO_SEC => " interval '1 second' * ",
1288 SEC_TO_INT => "SEC_TO_INT",
1291 STARTTIME_SEC => " date_trunc('sec', Job.StartTime) ",
1292 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1293 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1294 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1295 STARTTIME_WEEK => " date_trunc('week', Job.StartTime) ",
1296 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1297 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1298 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1299 STARTTIME_PWEEK => " date_part('week', Job.StartTime) ",
1300 DB_SIZE => " SELECT pg_database_size(current_database()) ",
1301 CAT_POOL_TYPE => " MediaType || '_' || Pool.Name ",
1305 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1306 FROM_UNIXTIME => 'FROM_UNIXTIME',
1309 SEC_TO_TIME => 'SEC_TO_TIME',
1310 MATCH => " REGEXP ",
1311 STARTTIME_SEC => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %T') ",
1312 STARTTIME_DAY => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d') ",
1313 STARTTIME_HOUR => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %H') ",
1314 STARTTIME_MONTH => " DATE_FORMAT(Job.StartTime, '%Y-%m') ",
1315 STARTTIME_WEEK => " DATE_FORMAT(Job.StartTime, '%Y-%v') ",
1316 STARTTIME_PHOUR=> " DATE_FORMAT(Job.StartTime, '%H') ",
1317 STARTTIME_PDAY => " DATE_FORMAT(Job.StartTime, '%d') ",
1318 STARTTIME_PMONTH => " DATE_FORMAT(Job.StartTime, '%m') ",
1319 STARTTIME_PWEEK => " DATE_FORMAT(Job.StartTime, '%v') ",
1320 # with mysql < 5, you have to play with the ugly SHOW command
1321 DB_SIZE => " SELECT 0 ",
1322 # works only with mysql 5
1323 # DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1324 CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1325 CONCAT_SEP => " SEPARATOR '' ",
1332 return $self->{info}->{dbi} =~ /dbi:mysql/i;
1339 $self->{dbh}->disconnect();
1344 sub dbh_selectall_arrayref
1346 my ($self, $query) = @_;
1347 $self->connect_db();
1348 $self->debug($query);
1349 return $self->{dbh}->selectall_arrayref($query);
1354 my ($self, @what) = @_;
1355 return join(',', $self->dbh_quote(@what)) ;
1360 my ($self, @what) = @_;
1362 $self->connect_db();
1364 return map { $self->{dbh}->quote($_) } @what;
1366 return $self->{dbh}->quote($what[0]) ;
1372 my ($self, $query) = @_ ;
1373 $self->connect_db();
1374 $self->debug($query);
1375 return $self->{dbh}->do($query);
1378 sub dbh_selectall_hashref
1380 my ($self, $query, $join) = @_;
1382 $self->connect_db();
1383 $self->debug($query);
1384 return $self->{dbh}->selectall_hashref($query, $join) ;
1387 sub dbh_selectrow_hashref
1389 my ($self, $query) = @_;
1391 $self->connect_db();
1392 $self->debug($query);
1393 return $self->{dbh}->selectrow_hashref($query) ;
1398 my ($self, @what) = @_;
1399 if ($self->dbh_is_mysql()) {
1400 return 'CONCAT(' . join(',', @what) . ')' ;
1402 return join(' || ', @what);
1408 my ($self, $query) = @_;
1409 $self->debug($query, up => 1);
1410 return $self->{dbh}->prepare($query);
1416 my @unit = qw(B KB MB GB TB);
1417 my $val = shift || 0;
1419 my $format = '%i %s';
1420 while ($val / 1024 > 1) {
1424 $format = ($i>0)?'%0.1f %s':'%i %s';
1425 return sprintf($format, $val, $unit[$i]);
1428 # display Day, Hour, Year
1434 $val /= 60; # sec -> min
1436 if ($val / 60 <= 1) {
1440 $val /= 60; # min -> hour
1441 if ($val / 24 <= 1) {
1442 return "$val hours";
1445 $val /= 24; # hour -> day
1446 if ($val / 365 < 2) {
1450 $val /= 365 ; # day -> year
1452 return "$val years";
1458 my $val = shift || 0;
1460 if ($val eq '1' or $val eq "yes") {
1462 } elsif ($val eq '2' or $val eq "archived") {
1470 sub from_human_enabled
1472 my $val = shift || 0;
1474 if ($val eq '1' or $val eq "yes") {
1476 } elsif ($val eq '2' or $val eq "archived") {
1483 # get Day, Hour, Year
1489 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1493 my %times = ( m => 60,
1499 my $mult = $times{$2} || 0;
1509 unless ($self->{dbh}) {
1511 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1512 $self->{info}->{user},
1513 $self->{info}->{password});
1515 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1516 unless ($self->{dbh});
1518 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1520 if ($self->dbh_is_mysql()) {
1521 $self->{dbh}->do("SET group_concat_max_len=1000000");
1523 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1530 my ($class, %arg) = @_;
1532 dbh => undef, # connect_db();
1534 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1540 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1542 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1543 $self->{sql} = $sql_func{$1};
1546 $self->{loginname} = CGI::remote_user();
1547 $self->{debug} = $self->{info}->{debug};
1548 $self->{lang} = $self->{info}->{lang};
1549 $self->{template_dir} = $self->{info}->{template_dir};
1557 if ($self->{info}->{enable_security}) {
1558 $self->get_roles(); # get lang
1560 $self->display($self->{info}, "begin.tpl");
1566 $self->display($self->{info}, "end.tpl");
1572 my $arg = $self->get_form("qclient");
1573 my $f1 = $self->get_client_group_filter();
1574 my $f2 = $self->get_client_filter();
1576 # client_group_name | here
1577 #-------------------+-----
1582 SELECT client_group_name, max(here) AS here FROM (
1583 SELECT client_group_name, 1 AS here
1585 JOIN client_group_member USING (client_group_id)
1586 JOIN Client USING (ClientId) $f2
1587 WHERE Name = $arg->{qclient}
1589 SELECT client_group_name, 0
1590 FROM client_group $f1
1592 GROUP by client_group_name";
1594 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
1596 $self->display({ client_group => [ values %$all ], %$arg }, "client_edit.tpl");
1602 my $where=''; # by default
1604 my $arg = $self->get_form("client", "qre_client",
1605 "jclient_groups", "qnotingroup");
1607 if ($arg->{qre_client}) {
1608 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1609 } elsif ($arg->{client}) {
1610 $where = "WHERE Name = '$arg->{client}' ";
1611 } elsif ($arg->{jclient_groups}) {
1612 # $filter could already contains client_group_member
1614 JOIN client_group_member USING (ClientId)
1615 JOIN client_group USING (client_group_id)
1616 WHERE client_group_name IN ($arg->{jclient_groups}) ";
1617 } elsif ($arg->{qnotingroup}) {
1620 (SELECT 1 FROM client_group_member
1621 WHERE Client.ClientId = client_group_member.ClientId
1627 SELECT Name AS name,
1629 AutoPrune AS autoprune,
1630 FileRetention AS fileretention,
1631 JobRetention AS jobretention
1632 FROM Client " . $self->get_client_filter() .
1635 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1637 my $dsp = { ID => $cur_id++,
1638 clients => [ values %$all] };
1640 $self->display($dsp, "client_list.tpl") ;
1645 my ($self, %arg) = @_;
1650 if ($arg{since} and $arg{age}) {
1651 my $now = "$self->{sql}->{UNIX_TIMESTAMP}(TIMESTAMP '$arg{since}')";
1653 AND $self->{sql}->{UNIX_TIMESTAMP}(StartTime) > $now
1654 AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime) < ($now + $self->{sql}->{TO_SEC}($arg{age}))";
1655 $label .= "since $arg{since} and during " . human_sec($arg{age});
1657 } elsif ($arg{age}) {
1659 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1661 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1663 $self->{sql}->{TO_SEC}($arg{age})
1666 $label = "last " . human_sec($arg{age});
1669 if ($arg{groupby}) {
1670 $limit .= " GROUP BY $arg{groupby} ";
1674 $limit .= " ORDER BY $arg{order} ";
1678 $limit .= " LIMIT $arg{limit} ";
1679 $label .= " limited to $arg{limit}";
1683 $limit .= " OFFSET $arg{offset} ";
1684 $label .= " with $arg{offset} offset ";
1688 $label = 'no filter';
1691 return ($limit, $label);
1696 $bweb->get_form(...) - Get useful stuff
1700 This function get and check parameters against regexp.
1702 If word begin with 'q', the return will be quoted or join quoted
1703 if it's end with 's'.
1708 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1711 qclient => 'plume-fd',
1712 qpools => "'plume-fd', 'test-fd', '...'",
1719 my ($self, @what) = @_;
1720 my %what = map { $_ => 1 } @what;
1743 my %opt_ss =( # string with space
1747 my %opt_s = ( # default to ''
1769 my %opt_p = ( # option with path
1776 my %opt_r = (regexwhere => 1);
1777 my %opt_d = ( # option with date
1781 my %opt_t = (when => 2, # option with time
1782 begin => 1, # 1 hh:min are optionnal
1783 end => 1, # 2 hh:min are required
1786 foreach my $i (@what) {
1787 if (exists $opt_i{$i}) {# integer param
1788 my $value = CGI::param($i) || $opt_i{$i} ;
1789 if ($value =~ /^(\d+)$/) {
1792 } elsif ($opt_s{$i}) { # simple string param
1793 my $value = CGI::param($i) || '';
1794 if ($value =~ /^([\w\d\.-]+)$/) {
1797 } elsif ($opt_ss{$i}) { # simple string param (with space)
1798 my $value = CGI::param($i) || '';
1799 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1802 } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1803 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1805 $ret{$i} = $self->dbh_join(@value) ;
1808 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1809 my $value = CGI::param($1) ;
1811 $ret{$i} = $self->dbh_quote($value);
1814 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1815 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1816 grep { ! /^\s*$/ } CGI::param($1) ];
1817 } elsif (exists $opt_p{$i}) {
1818 my $value = CGI::param($i) || '';
1819 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1822 } elsif (exists $opt_r{$i}) {
1823 my $value = CGI::param($i) || '';
1824 if ($value =~ /^([^'"']+)$/) {
1827 } elsif (exists $opt_d{$i}) {
1828 my $value = CGI::param($i) || '';
1829 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1832 } elsif (exists $opt_t{$i}) { # 1: hh:min optionnal, 2: hh:min required
1833 my $when = CGI::param($i) || '';
1834 if ($when =~ /(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?)/) {
1835 if ($opt_t{$i} == 1 or defined $2) {
1842 if ($what{storage_cmd}) {
1843 if (!grep {/^$ret{storage_cmd}$/} ('mount', 'umount', 'release','status')) {
1844 delete $ret{storage_cmd};
1849 foreach my $s (CGI::param('slot')) {
1850 if ($s =~ /^(\d+)$/) {
1851 push @{$ret{slots}}, $s;
1857 my $age = $ret{age} || $opt_i{age};
1858 my $since = CGI::param('since') || strftime('%F %T', localtime(time - $age));
1859 if ($since =~ /^(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?)$/) {
1865 my $lang = CGI::param('lang') || 'en';
1866 if ($lang =~ /^(\w\w)$/) {
1871 if ($what{db_clients}) {
1873 if ($what{filter}) {
1874 # get security filter only if asked
1875 $filter = $self->get_client_filter();
1879 SELECT Client.Name as clientname
1883 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1884 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1888 if ($what{db_client_groups}) {
1890 if ($what{filter}) {
1891 # get security filter only if asked
1892 $filter = $self->get_client_group_filter();
1896 SELECT client_group_name AS name, comment AS comment
1897 FROM client_group $filter
1899 my $grps = $self->dbh_selectall_hashref($query, 'name');
1900 $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1904 if ($what{db_usernames}) {
1906 SELECT username, comment
1909 my $users = $self->dbh_selectall_hashref($query, 'username');
1910 $ret{db_usernames} = [sort {$a->{username} cmp $b->{username} }
1914 if ($what{db_roles}) {
1916 SELECT rolename, comment
1919 my $r = $self->dbh_selectall_hashref($query, 'rolename');
1920 $ret{db_roles} = [sort {$a->{rolename} cmp $b->{rolename} }
1924 if ($what{db_mediatypes}) {
1926 SELECT MediaType as mediatype
1929 my $media = $self->dbh_selectall_hashref($query, 'mediatype');
1930 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1934 if ($what{db_locations}) {
1936 SELECT Location as location, Cost as cost
1939 my $loc = $self->dbh_selectall_hashref($query, 'location');
1940 $ret{db_locations} = [ sort { $a->{location}
1946 if ($what{db_pools}) {
1947 my $query = "SELECT Name as name FROM Pool";
1949 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1950 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1953 if ($what{db_filesets}) {
1955 SELECT FileSet.FileSet AS fileset
1958 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1960 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1961 values %$filesets] ;
1964 if ($what{db_jobnames}) {
1966 if ($what{filter}) {
1967 $filter = " JOIN Client USING (ClientId) " . $self->get_client_filter();
1970 SELECT DISTINCT Job.Name AS jobname
1973 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1975 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1976 values %$jobnames] ;
1979 if ($what{db_devices}) {
1981 SELECT Device.Name AS name
1984 my $devices = $self->dbh_selectall_hashref($query, 'name');
1986 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1996 $self->can_do('r_view_stat');
1997 my $fields = $self->get_form(qw/age level status clients filesets
1998 graph gtype type filter db_clients
1999 limit db_filesets width height
2000 qclients qfilesets qjobnames db_jobnames/);
2002 my $url = CGI::url(-full => 0,
2005 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
2007 # this organisation is to keep user choice between 2 click
2008 # TODO : fileset and client selection doesn't work
2015 if ($fields->{gtype} eq 'balloon') {
2016 system("./bgraph.pl");
2020 sub get_selected_media_location
2024 my $media = $self->get_form('jmedias');
2026 unless ($media->{jmedias}) {
2031 SELECT Media.VolumeName AS volumename, Location.Location AS location
2032 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2033 WHERE Media.VolumeName IN ($media->{jmedias})
2036 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2038 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
2047 my ($self, $in) = @_ ;
2048 $self->can_do('r_media_mgnt');
2049 my $media = $self->get_selected_media_location();
2055 my $elt = $self->get_form('db_locations');
2057 $self->display({ ID => $cur_id++,
2058 enabled => human_enabled($in),
2059 %$elt, # db_locations
2061 sort { $a->{volumename} cmp $b->{volumename} } values %$media
2070 $self->can_do('r_media_mgnt');
2072 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
2074 $self->display($elt, "help_extern.tpl");
2077 sub help_extern_compute
2080 $self->can_do('r_media_mgnt');
2082 my $number = CGI::param('limit') || '' ;
2083 unless ($number =~ /^(\d+)$/) {
2084 return $self->error("Bad arg number : $number ");
2087 my ($sql, undef) = $self->get_param('pools',
2088 'locations', 'mediatypes');
2091 SELECT Media.VolumeName AS volumename,
2092 Media.VolStatus AS volstatus,
2093 Media.LastWritten AS lastwritten,
2094 Media.MediaType AS mediatype,
2095 Media.VolMounts AS volmounts,
2097 Media.Recycle AS recycle,
2098 $self->{sql}->{FROM_UNIXTIME}(
2099 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2100 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2103 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2104 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2106 WHERE Media.InChanger = 1
2107 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
2109 ORDER BY expire DESC, recycle, Media.VolMounts DESC
2113 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2115 $self->display({ Media => [ values %$all ] },
2116 "help_extern_compute.tpl");
2122 $self->can_do('r_media_mgnt');
2124 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
2125 $self->display($param, "help_intern.tpl");
2128 sub help_intern_compute
2131 $self->can_do('r_media_mgnt');
2133 my $number = CGI::param('limit') || '' ;
2134 unless ($number =~ /^(\d+)$/) {
2135 return $self->error("Bad arg number : $number ");
2138 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
2140 if (CGI::param('expired')) {
2142 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2143 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2149 SELECT Media.VolumeName AS volumename,
2150 Media.VolStatus AS volstatus,
2151 Media.LastWritten AS lastwritten,
2152 Media.MediaType AS mediatype,
2153 Media.VolMounts AS volmounts,
2155 $self->{sql}->{FROM_UNIXTIME}(
2156 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2157 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2160 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2161 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
2163 WHERE Media.InChanger <> 1
2164 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
2165 AND Media.Recycle = 1
2167 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
2171 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2173 $self->display({ Media => [ values %$all ] },
2174 "help_intern_compute.tpl");
2180 my ($self, %arg) = @_ ;
2182 my ($limit, $label) = $self->get_limit(%arg);
2186 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
2187 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
2188 (SELECT count(Job.JobId) FROM Job) AS nb_job,
2189 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
2190 ($self->{sql}->{DB_SIZE}) AS db_size,
2191 (SELECT count(Job.JobId)
2193 WHERE Job.JobStatus IN ('E','e','f','A')
2196 (SELECT count(Client.ClientId) FROM Client) AS nb_client
2199 my $row = $self->dbh_selectrow_hashref($query) ;
2201 $row->{nb_bytes} = human_size($row->{nb_bytes});
2203 $row->{db_size} = human_size($row->{db_size});
2204 $row->{label} = $label;
2206 $self->display($row, "general.tpl");
2211 my ($self, @what) = @_ ;
2212 my %elt = map { $_ => 1 } @what;
2217 if ($elt{clients}) {
2218 my @clients = grep { ! /^\s*$/ } CGI::param('client');
2220 $ret{clients} = \@clients;
2221 my $str = $self->dbh_join(@clients);
2222 $limit .= "AND Client.Name IN ($str) ";
2226 if ($elt{client_groups}) {
2227 my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
2229 $ret{client_groups} = \@clients;
2230 my $str = $self->dbh_join(@clients);
2231 $limit .= "AND client_group_name IN ($str) ";
2235 if ($elt{filesets}) {
2236 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
2238 $ret{filesets} = \@filesets;
2239 my $str = $self->dbh_join(@filesets);
2240 $limit .= "AND FileSet.FileSet IN ($str) ";
2244 if ($elt{mediatypes}) {
2245 my @media = grep { ! /^\s*$/ } CGI::param('mediatype');
2247 $ret{mediatypes} = \@media;
2248 my $str = $self->dbh_join(@media);
2249 $limit .= "AND Media.MediaType IN ($str) ";
2254 my $client = CGI::param('client');
2255 $ret{client} = $client;
2256 $client = $self->dbh_join($client);
2257 $limit .= "AND Client.Name = $client ";
2261 my $level = CGI::param('level') || '';
2262 if ($level =~ /^(\w)$/) {
2264 $limit .= "AND Job.Level = '$1' ";
2269 my $jobid = CGI::param('jobid') || '';
2271 if ($jobid =~ /^(\d+)$/) {
2273 $limit .= "AND Job.JobId = '$1' ";
2278 my $status = CGI::param('status') || '';
2279 if ($status =~ /^(\w)$/) {
2282 $limit .= "AND Job.JobStatus IN ('f','E') ";
2283 } elsif ($1 eq 'W') {
2284 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
2286 $limit .= "AND Job.JobStatus = '$1' ";
2291 if ($elt{volstatus}) {
2292 my $status = CGI::param('volstatus') || '';
2293 if ($status =~ /^(\w+)$/) {
2295 $limit .= "AND Media.VolStatus = '$1' ";
2299 if ($elt{locations}) {
2300 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
2302 $ret{locations} = \@location;
2303 my $str = $self->dbh_join(@location);
2304 $limit .= "AND Location.Location IN ($str) ";
2309 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
2311 $ret{pools} = \@pool;
2312 my $str = $self->dbh_join(@pool);
2313 $limit .= "AND Pool.Name IN ($str) ";
2317 if ($elt{location}) {
2318 my $location = CGI::param('location') || '';
2320 $ret{location} = $location;
2321 $location = $self->dbh_quote($location);
2322 $limit .= "AND Location.Location = $location ";
2327 my $pool = CGI::param('pool') || '';
2330 $pool = $self->dbh_quote($pool);
2331 $limit .= "AND Pool.Name = $pool ";
2335 if ($elt{jobtype}) {
2336 my $jobtype = CGI::param('jobtype') || '';
2337 if ($jobtype =~ /^(\w)$/) {
2339 $limit .= "AND Job.Type = '$1' ";
2343 return ($limit, %ret);
2354 my ($self, %arg) = @_ ;
2355 return if $self->cant_do('r_view_job');
2357 $arg{order} = ' Job.JobId DESC ';
2359 my ($limit, $label) = $self->get_limit(%arg);
2360 my ($where, undef) = $self->get_param('clients',
2369 if (CGI::param('client_group')) {
2371 JOIN client_group_member USING (ClientId)
2372 JOIN client_group USING (client_group_id)
2375 my $filter = $self->get_client_filter();
2378 SELECT Job.JobId AS jobid,
2379 Client.Name AS client,
2380 FileSet.FileSet AS fileset,
2381 Job.Name AS jobname,
2383 StartTime AS starttime,
2385 Pool.Name AS poolname,
2386 JobFiles AS jobfiles,
2387 JobBytes AS jobbytes,
2388 JobStatus AS jobstatus,
2389 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2390 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2393 JobErrors AS joberrors
2395 FROM Client $filter $cgq,
2396 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2397 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2398 WHERE Client.ClientId=Job.ClientId
2399 AND Job.JobStatus NOT IN ('R', 'C')
2404 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2406 $self->display({ Filter => $label,
2410 sort { $a->{jobid} <=> $b->{jobid} }
2417 # display job informations
2418 sub display_job_zoom
2420 my ($self, $jobid) = @_ ;
2421 $self->can_do('r_view_job');
2423 $jobid = $self->dbh_quote($jobid);
2425 # get security filter
2426 my $filter = $self->get_client_filter();
2429 SELECT DISTINCT Job.JobId AS jobid,
2430 Client.Name AS client,
2431 Job.Name AS jobname,
2432 FileSet.FileSet AS fileset,
2434 Pool.Name AS poolname,
2435 StartTime AS starttime,
2436 JobFiles AS jobfiles,
2437 JobBytes AS jobbytes,
2438 JobStatus AS jobstatus,
2439 JobErrors AS joberrors,
2440 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2441 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2443 FROM Client $filter,
2444 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2445 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2446 WHERE Client.ClientId=Job.ClientId
2447 AND Job.JobId = $jobid
2450 my $row = $self->dbh_selectrow_hashref($query) ;
2452 # display all volumes associate with this job
2454 SELECT Media.VolumeName as volumename
2455 FROM Job,Media,JobMedia
2456 WHERE Job.JobId = $jobid
2457 AND JobMedia.JobId=Job.JobId
2458 AND JobMedia.MediaId=Media.MediaId
2461 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2463 $row->{volumes} = [ values %$all ] ;
2464 $row->{wiki_url} = $self->{info}->{wiki_url};
2466 $self->display($row, "display_job_zoom.tpl");
2469 sub display_job_group
2471 my ($self, %arg) = @_;
2472 $self->can_do('r_view_job');
2474 my ($limit, $label) = $self->get_limit(groupby => 'client_group_name', %arg);
2476 my ($where, undef) = $self->get_param('client_groups',
2479 my $filter = $self->get_client_group_filter();
2482 SELECT client_group_name AS client_group_name,
2483 COALESCE(jobok.jobfiles,0) + COALESCE(joberr.jobfiles,0) AS jobfiles,
2484 COALESCE(jobok.jobbytes,0) + COALESCE(joberr.jobbytes,0) AS jobbytes,
2485 COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2486 COALESCE(jobok.nbjobs,0) AS nbjobok,
2487 COALESCE(joberr.nbjobs,0) AS nbjoberr,
2488 COALESCE(jobok.duration, '0:0:0') AS duration
2490 FROM client_group $filter LEFT JOIN (
2491 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2492 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2493 SUM(JobErrors) AS joberrors,
2494 SUM($self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2495 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2498 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2499 JOIN client_group USING (client_group_id)
2501 WHERE JobStatus = 'T'
2504 ) AS jobok USING (client_group_name) LEFT JOIN
2507 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2508 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2509 SUM(JobErrors) AS joberrors
2510 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2511 JOIN client_group USING (client_group_id)
2513 WHERE JobStatus IN ('f','E', 'A')
2516 ) AS joberr USING (client_group_name)
2520 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2522 my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2525 $self->display($rep, "display_job_group.tpl");
2530 my ($self, %arg) = @_ ;
2531 $self->can_do('r_view_media');
2533 my ($limit, $label) = $self->get_limit(%arg);
2534 my ($where, %elt) = $self->get_param('pools',
2539 my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2541 if ($arg->{jmedias}) {
2542 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2544 if ($arg->{qre_media}) {
2545 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2547 if ($arg->{expired}) {
2549 AND VolStatus = 'Full'
2550 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2551 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2552 ) < NOW() " . $where ;
2556 SELECT Media.VolumeName AS volumename,
2557 Media.VolBytes AS volbytes,
2558 Media.VolStatus AS volstatus,
2559 Media.MediaType AS mediatype,
2560 Media.InChanger AS online,
2561 Media.LastWritten AS lastwritten,
2562 Location.Location AS location,
2563 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2564 Pool.Name AS poolname,
2565 $self->{sql}->{FROM_UNIXTIME}(
2566 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2567 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2570 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2571 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2572 Media.MediaType AS MediaType
2574 WHERE Media.VolStatus = 'Full'
2575 GROUP BY Media.MediaType
2576 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2578 WHERE Media.PoolId=Pool.PoolId
2583 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2585 $self->display({ ID => $cur_id++,
2587 Location => $elt{location},
2588 Media => [ values %$all ],
2590 "display_media.tpl");
2593 sub display_allmedia
2597 my $pool = $self->get_form('db_pools');
2599 foreach my $name (@{ $pool->{db_pools} }) {
2600 CGI::param('pool', $name->{name});
2601 $self->display_media();
2605 sub display_media_zoom
2609 my $media = $self->get_form('jmedias');
2611 unless ($media->{jmedias}) {
2612 return $self->error("Can't get media selection");
2616 SELECT InChanger AS online,
2617 Media.Enabled AS enabled,
2618 VolBytes AS nb_bytes,
2619 VolumeName AS volumename,
2620 VolStatus AS volstatus,
2621 VolMounts AS nb_mounts,
2622 Media.VolUseDuration AS voluseduration,
2623 Media.MaxVolJobs AS maxvoljobs,
2624 Media.MaxVolFiles AS maxvolfiles,
2625 Media.MaxVolBytes AS maxvolbytes,
2626 VolErrors AS nb_errors,
2627 Pool.Name AS poolname,
2628 Location.Location AS location,
2629 Media.Recycle AS recycle,
2630 Media.VolRetention AS volretention,
2631 Media.LastWritten AS lastwritten,
2632 Media.VolReadTime/1000000 AS volreadtime,
2633 Media.VolWriteTime/1000000 AS volwritetime,
2634 Media.RecycleCount AS recyclecount,
2635 Media.Comment AS comment,
2636 $self->{sql}->{FROM_UNIXTIME}(
2637 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2638 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2641 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2642 WHERE Pool.PoolId = Media.PoolId
2643 AND VolumeName IN ($media->{jmedias})
2646 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2648 foreach my $media (values %$all) {
2649 my $mq = $self->dbh_quote($media->{volumename});
2652 SELECT DISTINCT Job.JobId AS jobid,
2654 Job.StartTime AS starttime,
2657 Job.JobFiles AS files,
2658 Job.JobBytes AS bytes,
2659 Job.jobstatus AS status
2660 FROM Media,JobMedia,Job
2661 WHERE Media.VolumeName=$mq
2662 AND Media.MediaId=JobMedia.MediaId
2663 AND JobMedia.JobId=Job.JobId
2666 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2669 SELECT LocationLog.Date AS date,
2670 Location.Location AS location,
2671 LocationLog.Comment AS comment
2672 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2673 WHERE Media.MediaId = LocationLog.MediaId
2674 AND Media.VolumeName = $mq
2678 my $log = $self->dbh_selectall_arrayref($query) ;
2680 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2683 $self->display({ jobs => [ values %$jobs ],
2684 LocationLog => $logtxt,
2686 "display_media_zoom.tpl");
2693 $self->can_do('r_location_mgnt');
2695 my $loc = $self->get_form('qlocation');
2696 unless ($loc->{qlocation}) {
2697 return $self->error("Can't get location");
2701 SELECT Location.Location AS location,
2702 Location.Cost AS cost,
2703 Location.Enabled AS enabled
2705 WHERE Location.Location = $loc->{qlocation}
2708 my $row = $self->dbh_selectrow_hashref($query);
2709 $row->{enabled} = human_enabled($row->{enabled});
2710 $self->display({ ID => $cur_id++,
2711 %$row }, "location_edit.tpl") ;
2717 $self->can_do('r_location_mgnt');
2719 my $arg = $self->get_form(qw/qlocation qnewlocation cost enabled/) ;
2720 unless ($arg->{qlocation}) {
2721 return $self->error("Can't get location");
2723 unless ($arg->{qnewlocation}) {
2724 return $self->error("Can't get new location name");
2726 unless ($arg->{cost}) {
2727 return $self->error("Can't get new cost");
2730 my $enabled = from_human_enabled($arg->{enabled});
2733 UPDATE Location SET Cost = $arg->{cost},
2734 Location = $arg->{qnewlocation},
2736 WHERE Location.Location = $arg->{qlocation}
2739 $self->dbh_do($query);
2741 $self->location_display();
2747 $self->can_do('r_location_mgnt');
2749 my $arg = $self->get_form(qw/qlocation/) ;
2751 unless ($arg->{qlocation}) {
2752 return $self->error("Can't get location");
2756 SELECT count(Media.MediaId) AS nb
2757 FROM Media INNER JOIN Location USING (LocationID)
2758 WHERE Location = $arg->{qlocation}
2761 my $res = $self->dbh_selectrow_hashref($query);
2764 return $self->error("Sorry, the location must be empty");
2768 DELETE FROM Location WHERE Location = $arg->{qlocation}
2771 $self->dbh_do($query);
2773 $self->location_display();
2779 $self->can_do('r_location_mgnt');
2781 my $arg = $self->get_form(qw/qlocation cost/) ;
2783 unless ($arg->{qlocation}) {
2784 $self->display({}, "location_add.tpl");
2787 unless ($arg->{cost}) {
2788 return $self->error("Can't get new cost");
2791 my $enabled = CGI::param('enabled') || '';
2792 $enabled = from_human_enabled($enabled);
2795 INSERT INTO Location (Location, Cost, Enabled)
2796 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2799 $self->dbh_do($query);
2801 $self->location_display();
2804 sub location_display
2809 SELECT Location.Location AS location,
2810 Location.Cost AS cost,
2811 Location.Enabled AS enabled,
2812 (SELECT count(Media.MediaId)
2814 WHERE Media.LocationId = Location.LocationId
2819 my $location = $self->dbh_selectall_hashref($query, 'location');
2821 $self->display({ ID => $cur_id++,
2822 Locations => [ values %$location ] },
2823 "display_location.tpl");
2830 my $media = $self->get_selected_media_location();
2835 my $arg = $self->get_form('db_locations', 'qnewlocation');
2837 $self->display({ email => $self->{info}->{email_media},
2839 media => [ values %$media ],
2841 "update_location.tpl");
2844 ###########################################################
2849 my $arg = $self->get_form(qw/jclient_groups qclient/);
2851 unless ($arg->{qclient}) {
2852 return $self->error("Can't get client name");
2855 $self->can_do('r_group_mgnt');
2857 my $f1 = $self->get_client_filter();
2858 my $f2 = $self->get_client_group_filter();
2860 $self->{dbh}->begin_work();
2863 DELETE FROM client_group_member
2867 WHERE Client.Name = $arg->{qclient})
2869 $self->dbh_do($query);
2871 if ($arg->{jclient_groups}) {
2873 INSERT INTO client_group_member (client_group_id, ClientId)
2874 (SELECT client_group_id, (SELECT ClientId
2876 WHERE Name = $arg->{qclient})
2877 FROM client_group $f2 WHERE client_group_name IN ($arg->{jclient_groups})
2880 $self->dbh_do($query);
2883 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2885 $self->display_clients();
2891 my $grp = $self->get_form(qw/qclient_group db_clients/);
2893 unless ($grp->{qclient_group}) {
2894 $self->can_do('r_group_mgnt');
2895 $self->display({ ID => $cur_id++,
2896 client_group => "''",
2898 }, "groups_edit.tpl");
2902 unless ($self->cant_do('r_group_mgnt')) {
2903 $self->can_do('r_view_group');
2908 FROM Client JOIN client_group_member using (ClientId)
2909 JOIN client_group using (client_group_id)
2910 WHERE client_group_name = $grp->{qclient_group}
2913 my $row = $self->dbh_selectall_hashref($query, "name");
2915 $self->display({ ID => $cur_id++,
2916 client_group => $grp->{qclient_group},
2918 client_group_member => [ values %$row]},
2925 $self->can_do('r_group_mgnt');
2927 my $arg = $self->get_form(qw/qclient_group jclients qnewgroup qcomment/);
2929 if (!$arg->{qclient_group} and $arg->{qnewgroup}) {
2931 INSERT INTO client_group (client_group_name, comment)
2932 VALUES ($arg->{qnewgroup}, $arg->{qcomment})
2934 $self->dbh_do($query);
2935 $arg->{qclient_group} = $arg->{qnewgroup};
2938 unless ($arg->{qclient_group}) {
2939 return $self->error("Can't get groups");
2942 $self->{dbh}->begin_work();
2945 DELETE FROM client_group_member
2946 WHERE client_group_id IN
2947 (SELECT client_group_id
2949 WHERE client_group_name = $arg->{qclient_group})
2951 $self->dbh_do($query);
2953 if ($arg->{jclients}) {
2955 INSERT INTO client_group_member (ClientId, client_group_id)
2957 (SELECT client_group_id
2959 WHERE client_group_name = $arg->{qclient_group})
2960 FROM Client WHERE Name IN ($arg->{jclients})
2963 $self->dbh_do($query);
2965 if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2968 SET client_group_name = $arg->{qnewgroup}, comment = $arg->{qcomment}
2969 WHERE client_group_name = $arg->{qclient_group}
2972 $self->dbh_do($query);
2975 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2977 $self->display_groups();
2983 $self->can_do('r_group_mgnt');
2985 my $arg = $self->get_form(qw/qclient_group/);
2987 unless ($arg->{qclient_group}) {
2988 return $self->error("Can't get groups");
2991 $self->{dbh}->begin_work();
2994 DELETE FROM client_group_member
2995 WHERE client_group_id IN
2996 (SELECT client_group_id
2998 WHERE client_group_name = $arg->{qclient_group})");
3001 DELETE FROM bweb_client_group_acl
3002 WHERE client_group_id IN
3003 (SELECT client_group_id
3005 WHERE client_group_name = $arg->{qclient_group})");
3008 DELETE FROM client_group
3009 WHERE client_group_name = $arg->{qclient_group}");
3011 $self->{dbh}->commit();
3012 $self->display_groups();
3020 if ($self->cant_do('r_group_mgnt')) {
3021 $arg = $self->get_form(qw/db_client_groups filter/) ;
3023 $arg = $self->get_form(qw/db_client_groups/) ;
3026 if ($self->{dbh}->errstr) {
3027 return $self->error("Can't use groups with bweb, read INSTALL to enable them");
3032 $self->display({ ID => $cur_id++,
3034 "display_groups.tpl");
3037 ###########################################################
3042 if (not $self->{info}->{enable_security}) {
3045 # admin is a special user that can do everything
3046 if ($self->{loginname} eq 'admin') {
3049 if (!$self->{loginname}) {
3050 $self->error("Can't get your login name");
3051 $self->display_end();
3055 if (defined $self->{security}) {
3058 $self->{security} = {};
3059 my $u = $self->dbh_quote($self->{loginname});
3062 SELECT use_acl, rolename, tpl
3064 JOIN bweb_role_member USING (userid)
3065 JOIN bweb_role USING (roleid)
3068 my $rows = $self->dbh_selectall_arrayref($query);
3069 # do cache with this role
3070 if (!$rows or !scalar(@$rows)) {
3071 $self->error("Can't get $self->{loginname}'s roles");
3072 $self->display_end();
3075 foreach my $r (@$rows) {
3076 $self->{security}->{$r->[1]}=1;
3078 $self->{security}->{use_acl} = $rows->[0]->[0];
3079 if ($rows->[0]->[2] =~ /^(\w\w)$/) {
3087 my ($self, $client) = @_;
3089 my $filter = $self->get_client_filter();
3093 my $cont = $self->dbh_selectrow_hashref("
3096 WHERE Name = '$client'
3098 return defined $cont;
3103 my ($self, $action) = @_;
3104 # is security enabled in configuration ?
3105 if (not $self->{info}->{enable_security}) {
3108 # admin is a special user that can do everything
3109 if ($self->{loginname} eq 'admin') {
3113 if (!$self->{loginname}) {
3114 $self->{error} = "Can't do $action, your are not logged. " .
3115 "Check security with your administrator";
3118 if (!$self->get_roles()) {
3121 if (!$self->{security}->{$action}) {
3123 "$self->{loginname} sorry, but this action ($action) " .
3124 "is not permited. " .
3125 "Check security with your administrator";
3131 # make like an assert (program die)
3134 my ($self, $action) = @_;
3135 if ($self->cant_do($action)) {
3136 $self->error($self->{error});
3137 $self->display_end();
3147 if (!$self->{info}->{enable_security} or
3148 !$self->{info}->{enable_security_acl})
3153 if ($self->get_roles()) {
3154 return $self->{security}->{use_acl};
3160 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
3161 sub get_client_filter
3163 my ($self, $login) = @_;
3166 $u = $self->dbh_quote($login);
3167 } elsif ($self->use_filter()) {
3168 $u = $self->dbh_quote($self->{loginname});
3173 JOIN (SELECT ClientId FROM client_group_member
3174 JOIN client_group USING (client_group_id)
3175 JOIN bweb_client_group_acl USING (client_group_id)
3176 JOIN bweb_user USING (userid)
3177 WHERE bweb_user.username = $u
3178 ) AS filter USING (ClientId)";
3181 #JOIN client_group USING (client_group_id)" . $b->get_client_group_filter()
3182 sub get_client_group_filter
3184 my ($self, $login) = @_;
3187 $u = $self->dbh_quote($login);
3188 } elsif ($self->use_filter()) {
3189 $u = $self->dbh_quote($self->{loginname});
3194 JOIN (SELECT client_group_id
3195 FROM bweb_client_group_acl
3196 JOIN bweb_user USING (userid)
3197 WHERE bweb_user.username = $u
3198 ) AS filter USING (client_group_id)";
3201 # role and username have to be quoted before
3202 # role and username can be a quoted list
3205 my ($self, $role, $username) = @_;
3206 $self->can_do("r_user_mgnt");
3208 my $nb = $self->dbh_do("
3209 DELETE FROM bweb_role_member
3210 WHERE roleid = (SELECT roleid FROM bweb_role
3211 WHERE rolename IN ($role))
3212 AND userid = (SELECT userid FROM bweb_user
3213 WHERE username IN ($username))");
3217 # role and username have to be quoted before
3218 # role and username can be a quoted list
3221 my ($self, $role, $username) = @_;
3222 $self->can_do("r_user_mgnt");
3224 my $nb = $self->dbh_do("
3225 INSERT INTO bweb_role_member (roleid, userid)
3226 SELECT roleid, userid FROM bweb_role, bweb_user
3227 WHERE rolename IN ($role)
3228 AND username IN ($username)
3233 # role and username have to be quoted before
3234 # role and username can be a quoted list
3237 my ($self, $copy, $user) = @_;
3238 $self->can_do("r_user_mgnt");
3240 my $nb = $self->dbh_do("
3241 INSERT INTO bweb_role_member (roleid, userid)
3242 SELECT roleid, a.userid
3243 FROM bweb_user AS a, bweb_role_member
3244 JOIN bweb_user USING (userid)
3245 WHERE bweb_user.username = $copy
3246 AND a.username = $user");
3250 # username can be a join quoted list of usernames
3253 my ($self, $username) = @_;
3254 $self->can_do("r_user_mgnt");
3257 DELETE FROM bweb_role_member
3261 WHERE username in ($username))");
3263 DELETE FROM bweb_client_group_acl
3267 WHERE username IN ($username))");
3274 $self->can_do("r_user_mgnt");
3276 my $arg = $self->get_form(qw/jusernames/);
3278 unless ($arg->{jusernames}) {
3279 return $self->error("Can't get user");
3282 $self->{dbh}->begin_work();
3284 $self->revoke_all($arg->{jusernames});
3286 DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
3288 $self->{dbh}->commit();
3290 $self->display_users();
3296 $self->can_do("r_user_mgnt");
3298 # we don't quote username directly to check that it is conform
3299 my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate
3300 lang qcopy_username jclient_groups/) ;
3302 if (not $arg->{qcreate}) {
3303 $arg = $self->get_form(qw/db_roles db_usernames db_client_groups/);
3304 $self->display($arg, "display_user.tpl");
3308 my $u = $self->dbh_quote($arg->{username});
3310 $arg->{use_acl}=(CGI::param('use_acl')?'true':'false');
3312 if (!$arg->{qpasswd}) {
3313 $arg->{qpasswd} = "''";
3315 if (!$arg->{qcomment}) {
3316 $arg->{qcomment} = "''";
3319 # will fail if user already exists
3320 # UPDATE with mysql dbi does not return if update is ok
3323 SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment},
3324 use_acl=$arg->{use_acl}, tpl='$arg->{lang}'
3325 WHERE username = $u")
3326 # and (! $self->dbh_is_mysql() )
3329 INSERT INTO bweb_user (username, passwd, use_acl, comment, tpl)
3330 VALUES ($u, $arg->{qpasswd}, $arg->{use_acl},
3331 $arg->{qcomment}, '$arg->{lang}')");
3333 $self->{dbh}->begin_work();
3335 $self->revoke_all($u);
3337 if ($arg->{qcopy_username}) {
3338 $self->grant_like($arg->{qcopy_username}, $u);
3340 $self->grant($arg->{jrolenames}, $u);
3343 if ($arg->{jclient_groups}) {
3345 INSERT INTO bweb_client_group_acl (client_group_id, userid)
3346 SELECT client_group_id, userid
3347 FROM client_group, bweb_user
3348 WHERE client_group_name IN ($arg->{jclient_groups})
3353 $self->{dbh}->commit();
3355 $self->display_users();
3358 # TODO: we miss a matrix with all user/roles
3362 $self->can_do("r_user_mgnt");
3364 my $arg = $self->get_form(qw/db_usernames/) ;
3366 if ($self->{dbh}->errstr) {
3367 return $self->error("Can't use users with bweb, read INSTALL to enable them");
3370 $self->display({ ID => $cur_id++,
3372 "display_users.tpl");
3378 $self->can_do("r_user_mgnt");
3380 my $arg = $self->get_form('username');
3381 my $user = $self->dbh_quote($arg->{username});
3383 my $userp = $self->dbh_selectrow_hashref("
3384 SELECT username, passwd, comment, use_acl, tpl
3386 WHERE username = $user
3389 return $self->error("Can't find $user in catalog");
3391 my $filter = $self->get_client_group_filter($arg->{username});
3392 my $scg = $self->dbh_selectall_hashref("
3393 SELECT client_group_name AS name
3394 FROM client_group $filter
3398 #------------+--------
3403 my $role = $self->dbh_selectall_hashref("
3404 SELECT rolename, max(here) AS userid FROM (
3405 SELECT rolename, 1 AS here
3407 JOIN bweb_role_member USING (userid)
3408 JOIN bweb_role USING (roleid)
3409 WHERE username = $user
3414 GROUP by rolename", 'rolename');
3416 $arg = $self->get_form(qw/db_usernames db_client_groups/);
3419 db_usernames => $arg->{db_usernames},
3420 username => $userp->{username},
3421 comment => $userp->{comment},
3422 passwd => $userp->{passwd},
3423 lang => $userp->{tpl},
3424 use_acl => $userp->{use_acl},
3425 db_client_groups => $arg->{db_client_groups},
3426 client_group => [ values %$scg ],
3427 db_roles => [ values %$role],
3428 }, "display_user.tpl");
3432 ###########################################################
3434 sub get_media_max_size
3436 my ($self, $type) = @_;
3438 "SELECT avg(VolBytes) AS size
3440 WHERE Media.VolStatus = 'Full'
3441 AND Media.MediaType = '$type'
3444 my $res = $self->selectrow_hashref($query);
3447 return $res->{size};
3457 my $media = $self->get_form('qmedia');
3459 unless ($media->{qmedia}) {
3460 return $self->error("Can't get media");
3464 SELECT Media.Slot AS slot,
3465 PoolMedia.Name AS poolname,
3466 Media.VolStatus AS volstatus,
3467 Media.InChanger AS inchanger,
3468 Location.Location AS location,
3469 Media.VolumeName AS volumename,
3470 Media.MaxVolBytes AS maxvolbytes,
3471 Media.MaxVolJobs AS maxvoljobs,
3472 Media.MaxVolFiles AS maxvolfiles,
3473 Media.VolUseDuration AS voluseduration,
3474 Media.VolRetention AS volretention,
3475 Media.Comment AS comment,
3476 PoolRecycle.Name AS poolrecycle,
3477 Media.Enabled AS enabled
3479 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
3480 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
3481 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
3483 WHERE Media.VolumeName = $media->{qmedia}
3486 my $row = $self->dbh_selectrow_hashref($query);
3487 $row->{volretention} = human_sec($row->{volretention});
3488 $row->{voluseduration} = human_sec($row->{voluseduration});
3489 $row->{enabled} = human_enabled($row->{enabled});
3491 my $elt = $self->get_form(qw/db_pools db_locations/);
3496 }, "update_media.tpl");
3502 $self->can_do('r_media_mgnt');
3504 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
3506 unless ($arg->{jmedias}) {
3507 return $self->error("Can't get selected media");
3510 unless ($arg->{qnewlocation}) {
3511 return $self->error("Can't get new location");
3516 SET LocationId = (SELECT LocationId
3518 WHERE Location = $arg->{qnewlocation})
3519 WHERE Media.VolumeName IN ($arg->{jmedias})
3522 my $nb = $self->dbh_do($query);
3524 print "$nb media updated, you may have to update your autochanger.";
3526 $self->display_media();
3532 $self->can_do('r_media_mgnt');
3534 my $media = $self->get_selected_media_location();
3536 return $self->error("Can't get media selection");
3538 my $newloc = CGI::param('newlocation');
3540 my $user = CGI::param('user') || 'unknown';
3541 my $comm = CGI::param('comment') || '';
3542 $comm = $self->dbh_quote("$user: $comm");
3544 my $arg = $self->get_form('enabled');
3545 my $en = from_human_enabled($arg->{enabled});
3546 my $b = $self->get_bconsole();
3549 foreach my $vol (keys %$media) {
3551 INSERT INTO LocationLog (Date,Comment,MediaId,LocationId,NewEnabled,NewVolStatus)
3552 SELECT NOW(), $comm, Media.MediaId, Location.LocationId, $en, VolStatus
3553 FROM Media, Location
3554 WHERE Media.VolumeName = '$vol'
3555 AND Location.Location = '$media->{$vol}->{location}'
3557 $self->dbh_do($query);
3558 $self->debug($query);
3559 $b->send_cmd("update volume=\"$vol\" enabled=$en");
3564 $q->param('action', 'update_location');
3565 my $url = $q->url(-full => 1, -query=>1);
3567 $self->display({ email => $self->{info}->{email_media},
3569 newlocation => $newloc,
3570 # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3571 media => [ values %$media ],
3573 "change_location.tpl");
3577 sub display_client_stats
3579 my ($self, %arg) = @_ ;
3580 $self->can_do('r_view_stat');
3582 my $client = $self->dbh_quote($arg{clientname});
3583 # get security filter
3584 my $filter = $self->get_client_filter();
3586 my ($limit, $label) = $self->get_limit(%arg);
3589 count(Job.JobId) AS nb_jobs,
3590 sum(Job.JobBytes) AS nb_bytes,
3591 sum(Job.JobErrors) AS nb_err,
3592 sum(Job.JobFiles) AS nb_files,
3593 Client.Name AS clientname
3594 FROM Job JOIN Client USING (ClientId) $filter
3596 Client.Name = $client
3598 GROUP BY Client.Name
3601 my $row = $self->dbh_selectrow_hashref($query);
3603 $row->{ID} = $cur_id++;
3604 $row->{label} = $label;
3605 $row->{grapharg} = "client";
3607 $self->display($row, "display_client_stats.tpl");
3611 sub _display_group_stats
3613 my ($self, %arg) = @_ ;
3615 my $carg = $self->get_form(qw/qclient_group/);
3617 unless ($carg->{qclient_group}) {
3618 return $self->error("Can't get group");
3621 my ($limit, $label) = $self->get_limit(%arg);
3625 count(Job.JobId) AS nb_jobs,
3626 sum(Job.JobBytes) AS nb_bytes,
3627 sum(Job.JobErrors) AS nb_err,
3628 sum(Job.JobFiles) AS nb_files,
3629 client_group.client_group_name AS clientname
3630 FROM Job JOIN Client USING (ClientId)
3631 JOIN client_group_member ON (Client.ClientId = client_group_member.ClientId)
3632 JOIN client_group USING (client_group_id)
3634 client_group.client_group_name = $carg->{qclient_group}
3636 GROUP BY client_group.client_group_name
3639 my $row = $self->dbh_selectrow_hashref($query);
3641 $row->{ID} = $cur_id++;
3642 $row->{label} = $label;
3643 $row->{grapharg} = "client_group";
3645 $self->display($row, "display_client_stats.tpl");
3648 # [ name, num, value, joberrors, nb_job ] =>
3650 # [ { name => 'ALL',
3651 # events => [ { num => 1, label => '2007-01',
3652 # value => 'T', title => 10 },
3653 # { num => 2, label => '2007-02',
3654 # value => 'R', title => 11 },
3657 # { name => 'Other',
3661 sub make_overview_tab
3663 my ($self, $q) = @_;
3664 my $ret = $self->dbh_selectall_arrayref($q);
3668 for my $elt (@$ret) {
3669 if ($cur_name and $cur_name ne $elt->[0]) { # order by name, num
3670 push @items, { name => $cur_name, events => $events};
3673 $cur_name = $elt->[0];
3675 { num => $elt->[1], status => $elt->[2],
3676 joberrors => $elt->[3], title => "$elt->[4] jobs"};
3678 push @items, { name => $cur_name, events => $events};
3682 sub get_time_overview
3684 my ($self, $arg) = @_; # want since et age from get_form();
3685 my $type = $arg->{type} || 'day';
3686 if ($type =~ /^(day|week|hour|month)$/) {
3692 my $jobt = $self->{info}->{stat_job_table} || 'Job';
3693 my $stime1 = $self->{sql}->{"STARTTIME_P" . $type}; # get 1,2,3
3694 $stime1 =~ s/Job.StartTime/date/;
3695 my $stime2 = $self->{sql}->{"STARTTIME_" . $type}; # get 2007-01-03, 2007-01-23
3697 my ($limit, $label) = $self->get_limit('since' => $arg->{since},
3698 'age' => $arg->{age});
3699 return ($stime1, $stime2, $limit, $label, $jobt);
3702 # lu ma me je ve sa di
3703 # groupe1 v v x w v v v overview
3704 # |-- s1 v v v v v v v overview_zoom
3705 # |-- s2 v v x v v v v
3706 # `-- s3 v v v w v v v
3707 sub display_overview_zoom
3710 $self->can_do('r_view_stat');
3712 my $arg = $self->get_form(qw/jclient_groups age since type level/);
3714 if (!$arg->{jclient_groups}) {
3715 return $self->error("Can't get client_group selection");
3717 my ($filter2, undef) = $self->get_param(qw/level jobtype/);
3718 my ($stime1, $stime2, $limit, $label, $jobt) = $self->get_time_overview($arg);
3720 my $filter = $self->get_client_filter();
3722 SELECT name, $stime1 AS num,
3723 JobStatus AS value, joberrors, nb_job
3725 SELECT $stime2 AS date,
3726 Client.Name AS name,
3727 MAX(severity) AS severity,
3729 SUM(JobErrors) AS joberrors
3731 JOIN client_group_member USING (ClientId)
3732 JOIN client_group USING (client_group_id)
3733 JOIN Client USING (ClientId) $filter
3734 JOIN Status USING (JobStatus)
3735 WHERE client_group_name IN ($arg->{jclient_groups})
3738 GROUP BY Client.Name, date
3739 ) AS sub JOIN Status USING (severity)
3742 my $items = $self->make_overview_tab($q);
3743 $self->display({label => $label,
3744 action => "job;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client=",
3745 items => $items}, "overview.tpl");
3748 sub display_overview
3751 $self->can_do('r_view_stat');
3753 my $arg = $self->get_form(qw/jclient_groups age since type level/);
3754 my ($filter2, undef) = $self->get_param(qw/client_groups level jobtype/);
3755 my $filter3 = $self->get_client_group_filter();
3756 my ($stime1, $stime2, $filter1, $label, $jobt) = $self->get_time_overview($arg);
3759 SELECT name, $stime1 AS num,
3760 JobStatus AS value, joberrors, nb_job
3762 SELECT $stime2 AS date,
3763 client_group_name AS name,
3764 MAX(severity) AS severity,
3766 SUM(JobErrors) AS joberrors
3768 JOIN client_group_member USING (ClientId)
3769 JOIN client_group USING (client_group_id) $filter3
3770 JOIN Status USING (JobStatus)
3771 WHERE true $filter1 $filter2
3772 GROUP BY client_group_name, date
3773 ) AS sub JOIN Status USING (severity)
3776 my $items = $self->make_overview_tab($q);
3777 $self->display({label=>$label,
3778 action => "overview_zoom;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client_group=",
3779 items => $items}, "overview.tpl");
3783 # poolname can be undef
3786 my ($self, $poolname) = @_ ;
3787 $self->can_do('r_view_media');
3792 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3793 if ($arg->{jmediatypes}) {
3794 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3795 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
3798 # TODO : afficher les tailles et les dates
3801 SELECT subq.volmax AS volmax,
3802 subq.volnum AS volnum,
3803 subq.voltotal AS voltotal,
3805 Pool.Recycle AS recycle,
3806 Pool.VolRetention AS volretention,
3807 Pool.VolUseDuration AS voluseduration,
3808 Pool.MaxVolJobs AS maxvoljobs,
3809 Pool.MaxVolFiles AS maxvolfiles,
3810 Pool.MaxVolBytes AS maxvolbytes,
3811 subq.PoolId AS PoolId,
3812 subq.MediaType AS mediatype,
3813 $self->{sql}->{CAT_POOL_TYPE} AS uniq
3816 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3817 count(Media.MediaId) AS volnum,
3818 sum(Media.VolBytes) AS voltotal,
3819 Media.PoolId AS PoolId,
3820 Media.MediaType AS MediaType
3822 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3823 Media.MediaType AS MediaType
3825 WHERE Media.VolStatus = 'Full'
3826 GROUP BY Media.MediaType
3827 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3828 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3830 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3834 my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3837 SELECT Pool.Name AS name,
3838 sum(VolBytes) AS size
3839 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3840 WHERE Media.VolStatus IN ('Recycled', 'Purged')
3844 my $empty = $self->dbh_selectall_hashref($query, 'name');
3846 foreach my $p (values %$all) {
3847 if ($p->{volmax} > 0) { # mysql returns 0.0000
3848 # we remove Recycled/Purged media from pool usage
3849 if (defined $empty->{$p->{name}}) {
3850 $p->{voltotal} -= $empty->{$p->{name}}->{size};
3852 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
3854 $p->{poolusage} = 0;
3858 SELECT VolStatus AS volstatus, count(MediaId) AS nb
3860 WHERE PoolId=$p->{poolid}
3861 AND Media.MediaType = '$p->{mediatype}'
3865 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
3866 foreach my $t (values %$content) {
3867 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
3872 $self->display({ ID => $cur_id++,
3873 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
3874 Pools => [ values %$all ]},
3875 "display_pool.tpl");
3878 # With this function, we get an estimation of next jobfiles/jobbytes count
3879 sub get_estimate_query
3881 my ($self, $mode, $job, $level) = @_;
3882 # get security filter
3883 my $filter = $self->get_client_filter();
3887 if ($self->dbh_is_mysql()) { # mysql doesn't have statistics functions
3889 SELECT jobname AS jobname,
3890 0.1 AS corr_jobbytes, AVG(jobbytes) AS jobbytes,
3891 COUNT(1) AS nb_jobbytes ";
3893 # postgresql have functions that permit to handle lineal regression
3895 # REGR_SLOPE(Y,X) = get x
3896 # REGR_INTERCEPT(Y,X) = get b
3897 # and we need y when x=now()
3898 # CORR gives the correlation
3899 # (TODO: display progress bar only if CORR > 0.8)
3900 my $now = scalar(time);
3902 SELECT temp.jobname AS jobname,
3903 CORR(jobbytes,jobtdate) AS corr_jobbytes,
3904 ($now*REGR_SLOPE(jobbytes,jobtdate)
3905 + REGR_INTERCEPT(jobbytes,jobtdate)) AS jobbytes,
3906 COUNT(1) AS nb_jobbytes ";
3908 # if it's a differential, we need to compare since the last full
3910 # F D D D F D D D F I I I I D I I I
3912 # | # # # # # # | # #
3913 # | # # # # # # # # | # # # # # # # # #
3914 # +----------------- +-------------------
3916 if ($level eq 'D') {
3918 AND Job.StartTime > (
3921 WHERE Job.Name = '$job'
3923 AND Job.JobStatus = 'T'
3924 ORDER BY Job.StartTime DESC LIMIT 1
3931 SELECT Job.Name AS jobname,
3932 JobBytes AS jobbytes,
3933 JobTDate AS jobtdate
3934 FROM Job INNER JOIN Client USING (ClientId) $filter
3935 WHERE Job.Name = '$job'
3936 AND Job.Level = '$level'
3937 AND Job.JobStatus = 'T'
3939 ORDER BY StartTime DESC
3941 ) AS temp GROUP BY temp.jobname
3944 if ($mode eq 'jobfiles') {
3945 $query =~ s/jobbytes/jobfiles/g;
3946 $query =~ s/JobBytes/JobFiles/g;
3951 sub display_running_job
3954 return if $self->cant_do('r_view_running_job');
3956 my $arg = $self->get_form('jobid');
3958 return $self->error("Can't get jobid") unless ($arg->{jobid});
3960 # get security filter
3961 my $filter = $self->get_client_filter();
3964 SELECT Client.Name AS name, Job.Name AS jobname,
3965 Job.Level AS level, Type AS type
3966 FROM Job INNER JOIN Client USING (ClientId) $filter
3967 WHERE Job.JobId = $arg->{jobid}
3970 my $row = $self->dbh_selectrow_hashref($query);
3973 $arg->{client} = $row->{name};
3975 return $self->error("Can't get client");
3978 if ($row->{type} eq 'B') {
3979 # for jobfiles, we use only last Full backup. status client= returns
3980 # all files that have been checked
3981 my $query1 = $self->get_estimate_query('jobfiles', $row->{jobname}, 'F');
3982 my $query2 = $self->get_estimate_query('jobbytes',
3983 $row->{jobname}, $row->{level});
3985 # LEFT JOIN because we always have a previous Full
3987 SELECT corr_jobbytes, jobbytes, corr_jobfiles, jobfiles
3988 FROM ($query1) AS A LEFT JOIN ($query2) AS B USING (jobname)
3990 $row = $self->dbh_selectrow_hashref($query);
3993 $row->{jobbytes} = $row->{jobfiles} = 0;
3996 my $cli = new Bweb::Client(name => $arg->{client});
3997 $cli->display_running_job($self, $arg->{jobid}, $row);
3998 if ($arg->{jobid}) {
3999 $self->get_job_log();
4003 sub display_running_jobs
4005 my ($self, $display_action) = @_;
4006 return if $self->cant_do('r_view_running_job');
4008 # get security filter
4009 my $filter = $self->get_client_filter();
4012 SELECT Job.JobId AS jobid,
4013 Job.Name AS jobname,
4015 Job.StartTime AS starttime,
4016 Job.JobFiles AS jobfiles,
4017 Job.JobBytes AS jobbytes,
4018 Job.JobStatus AS jobstatus,
4019 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
4020 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
4022 Client.Name AS clientname
4023 FROM Job INNER JOIN Client USING (ClientId) $filter
4025 JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
4027 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
4029 $self->display({ ID => $cur_id++,
4030 display_action => $display_action,
4031 Jobs => [ values %$all ]},
4032 "running_job.tpl") ;
4035 sub display_group_stats
4038 my $arg = $self->get_form('age', 'since');
4039 return if $self->cant_do('r_view_stat');
4041 my $filter = $self->get_client_group_filter();
4043 my ($limit, $label) = $self->get_limit(%$arg);
4046 SELECT client_group_name AS name, nb_byte, nb_file, nb_job, nb_resto
4049 SELECT sum(JobBytes) AS nb_byte,
4050 sum(JobFiles) AS nb_file,
4051 count(1) AS nb_job, client_group_name
4052 FROM job_old JOIN client_group_member USING (ClientId)
4053 JOIN client_group USING (client_group_id) $filter
4054 WHERE JobStatus = 'T' AND Type IN ('M', 'B', 'g')
4056 GROUP BY client_group_name ORDER BY client_group_name
4060 SELECT count(1) AS nb_resto, client_group_name
4061 FROM job_old JOIN client_group_member USING (ClientId)
4062 JOIN client_group USING (client_group_id)
4063 WHERE JobStatus = 'T' AND Type = 'R'
4065 GROUP BY client_group_name ORDER BY client_group_name
4067 ) AS T2 USING (client_group_name)
4069 $self->debug($query);
4070 my $all = $self->dbh_selectall_hashref($query, 'name') ;
4073 $self->display({ ID => $cur_id++,
4075 Stats => [ values %$all ]},
4076 "display_stats.tpl") ;
4079 # return the autochanger list to update
4083 $self->can_do('r_media_mgnt');
4086 my $arg = $self->get_form('jmedias');
4088 unless ($arg->{jmedias}) {
4089 return $self->error("Can't get media selection");
4093 SELECT Media.VolumeName AS volumename,
4094 Storage.Name AS storage,
4095 Location.Location AS location,
4097 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
4098 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
4099 WHERE Media.VolumeName IN ($arg->{jmedias})
4100 AND Media.InChanger = 1
4103 my $all = $self->dbh_selectall_hashref($query, 'volumename');
4105 foreach my $vol (values %$all) {
4106 my $a = $self->ach_get($vol->{location});
4108 $ret{$vol->{location}} = 1;
4110 unless ($a->{have_status}) {
4112 $a->{have_status} = 1;
4115 print "eject $vol->{volumename} from $vol->{storage} : ";
4116 if ($a->send_to_io($vol->{slot})) {
4117 print "<img src='/bweb/T.png' alt='ok'><br/>";
4119 print "<img src='/bweb/E.png' alt='err'><br/>";
4129 my ($to, $subject, $content) = (CGI::param('email'),
4130 CGI::param('subject'),
4131 CGI::param('content'));
4132 $to =~ s/[^\w\d\.\@<>,]//;
4133 $subject =~ s/[^\w\d\.\[\]]/ /;
4135 open(MAIL, "|mail -s '$subject' '$to'") ;
4136 print MAIL $content;
4146 my $arg = $self->get_form('jobid', 'client');
4148 print CGI::header('text/brestore');
4149 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
4150 print "client=$arg->{client}\n" if ($arg->{client});
4151 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
4155 # TODO : move this to Bweb::Autochanger ?
4156 # TODO : make this internal to not eject tape ?
4162 my ($self, $name) = @_;
4165 return $self->error("Can't get your autochanger name ach");
4168 unless ($self->{info}->{ach_list}) {
4169 return $self->error("Could not find any autochanger");
4172 my $a = $self->{info}->{ach_list}->{$name};
4175 $self->error("Can't get your autochanger $name from your ach_list");
4180 $a->{debug} = $self->{debug};
4187 my ($self, $ach) = @_;
4188 $self->can_do('r_configure');
4190 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
4192 $self->{info}->save();
4200 $self->can_do('r_configure');
4202 my $arg = $self->get_form('ach');
4204 or !$self->{info}->{ach_list}
4205 or !$self->{info}->{ach_list}->{$arg->{ach}})
4207 return $self->error("Can't get autochanger name");
4210 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
4214 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
4216 my $b = $self->get_bconsole();
4218 my @storages = $b->list_storage() ;
4220 $ach->{devices} = [ map { { name => $_ } } @storages ];
4222 $self->display($ach, "ach_add.tpl");
4223 delete $ach->{drives};
4224 delete $ach->{devices};
4231 $self->can_do('r_configure');
4233 my $arg = $self->get_form('ach');
4236 or !$self->{info}->{ach_list}
4237 or !$self->{info}->{ach_list}->{$arg->{ach}})
4239 return $self->error("Can't get autochanger name");
4242 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
4244 $self->{info}->save();
4245 $self->{info}->view();
4251 $self->can_do('r_configure');
4253 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
4255 my $b = $self->get_bconsole();
4256 my @storages = $b->list_storage() ;
4258 unless ($arg->{ach}) {
4259 $arg->{devices} = [ map { { name => $_ } } @storages ];
4260 return $self->display($arg, "ach_add.tpl");
4264 foreach my $drive (CGI::param('drives'))
4266 unless (grep(/^$drive$/,@storages)) {
4267 return $self->error("Can't find $drive in storage list");
4270 my $index = CGI::param("index_$drive");
4271 unless (defined $index and $index =~ /^(\d+)$/) {
4272 return $self->error("Can't get $drive index");
4275 $drives[$index] = $drive;
4279 return $self->error("Can't get drives from Autochanger");
4282 my $a = new Bweb::Autochanger(name => $arg->{ach},
4283 precmd => $arg->{precmd},
4284 drive_name => \@drives,
4285 device => $arg->{device},
4286 mtxcmd => $arg->{mtxcmd});
4288 $self->ach_register($a) ;
4290 $self->{info}->view();
4296 $self->can_do('r_delete_job');
4298 my $arg = $self->get_form('jobid');
4300 if ($arg->{jobid}) {
4301 my $b = $self->get_bconsole();
4302 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
4306 title => "Delete a job ",
4307 name => "delete jobid=$arg->{jobid}",
4315 $self->can_do('r_media_mgnt');
4317 my $arg = $self->get_form(qw/media volstatus inchanger pool
4318 slot volretention voluseduration
4319 maxvoljobs maxvolfiles maxvolbytes
4320 qcomment poolrecycle enabled
4323 unless ($arg->{media}) {
4324 return $self->error("Can't find media selection");
4327 my $update = "update volume=$arg->{media} ";
4329 if ($arg->{volstatus}) {
4330 $update .= " volstatus=$arg->{volstatus} ";
4333 if ($arg->{inchanger}) {
4334 $update .= " inchanger=yes " ;
4336 $update .= " slot=$arg->{slot} ";
4339 $update .= " slot=0 inchanger=no ";
4342 if ($arg->{enabled}) {
4343 $update .= " enabled=$arg->{enabled} ";
4347 $update .= " pool=$arg->{pool} " ;
4350 if (defined $arg->{volretention}) {
4351 $update .= " volretention=\"$arg->{volretention}\" " ;
4354 if (defined $arg->{voluseduration}) {
4355 $update .= " voluse=\"$arg->{voluseduration}\" " ;
4358 if (defined $arg->{maxvoljobs}) {
4359 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
4362 if (defined $arg->{maxvolfiles}) {
4363 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
4366 if (defined $arg->{maxvolbytes}) {
4367 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
4370 if (defined $arg->{poolrecycle}) {
4371 $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
4374 my $b = $self->get_bconsole();
4377 content => $b->send_cmd($update),
4378 title => "Update a volume ",
4384 my $media = $self->dbh_quote($arg->{media});
4386 my $loc = CGI::param('location') || '';
4388 $loc = $self->dbh_quote($loc); # is checked by db
4389 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
4391 if (!$arg->{qcomment}) {
4392 $arg->{qcomment} = "''";
4394 push @q, "Comment=$arg->{qcomment}";
4399 SET " . join (',', @q) . "
4400 WHERE Media.VolumeName = $media
4402 $self->dbh_do($query);
4404 $self->update_media();
4410 $self->can_do('r_autochanger_mgnt');
4412 my $ach = CGI::param('ach') ;
4413 $ach = $self->ach_get($ach);
4415 return $self->error("Bad autochanger name");
4419 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
4420 $b->update_slots($ach->{name});
4427 $self->can_do('r_view_log');
4429 my $arg = $self->get_form('jobid', 'limit', 'offset');
4430 unless ($arg->{jobid}) {
4431 return $self->error("Can't get jobid");
4434 if ($arg->{limit} == 100) {
4435 $arg->{limit} = 1000;
4437 # get security filter
4438 my $filter = $self->get_client_filter();
4441 SELECT Job.Name as name, Client.Name as clientname
4442 FROM Job INNER JOIN Client USING (ClientId) $filter
4443 WHERE JobId = $arg->{jobid}
4446 my $row = $self->dbh_selectrow_hashref($query);
4449 return $self->error("Can't find $arg->{jobid} in catalog");
4452 # display only Error and Warning messages
4454 if (CGI::param('error')) {
4455 $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning|ERR=' ";
4459 if (CGI::param('time') || $self->{info}->{display_log_time}) {
4460 $logtext = $self->dbh_strcat('Time', " ' ' ", 'LogText');
4462 $logtext = 'LogText';
4466 SELECT count(1) AS nbline, JobId AS jobid,
4467 GROUP_CONCAT($logtext $self->{sql}->{CONCAT_SEP}) AS logtxt
4469 SELECT JobId, Time, LogText
4471 WHERE ( Log.JobId = $arg->{jobid}
4473 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
4474 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
4478 OFFSET $arg->{offset}
4484 my $log = $self->dbh_selectrow_hashref($query);
4486 return $self->error("Can't get log for jobid $arg->{jobid}");
4489 $self->display({ lines=> $log->{logtxt},
4490 nbline => $log->{nbline},
4491 jobid => $arg->{jobid},
4492 name => $row->{name},
4493 client => $row->{clientname},
4494 offset => $arg->{offset},
4495 limit => $arg->{limit},
4496 }, 'display_log.tpl');
4502 $self->can_do('r_media_mgnt');
4503 my $arg = $self->get_form('storage', 'pool', 'nb', 'media', 'offset');
4504 my $b = $self->get_bconsole();
4506 if (!$arg->{storage} || !$arg->{pool} || not defined $arg->{nb} || !$arg->{media} || !$arg->{offset}) {
4507 CGI::param(offset => 0);
4508 $arg = $self->get_form('db_pools');
4509 $arg->{storage} = [ map { { name => $_ } }$b->list_storage()];
4510 $self->display($arg, 'add_media.tpl');
4515 if ($arg->{nb} > 0) {
4516 $arg->{offset} = $arg->{offset}?$arg->{offset}:1;
4517 $cmd = "add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n$arg->{nb}\n$arg->{media}\n$arg->{offset}\n";
4519 $cmd = "add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n0\n$arg->{media}\n";
4525 CGI::param('media', '');
4526 CGI::param('re_media', $arg->{media});
4527 $self->display_media();
4533 $self->can_do('r_autochanger_mgnt');
4535 my $arg = $self->get_form('ach', 'slots', 'drive');
4537 unless ($arg->{ach}) {
4538 return $self->error("Can't find autochanger name");
4541 my $a = $self->ach_get($arg->{ach});
4543 return $self->error("Can't find autochanger name in configuration");
4546 my $storage = $a->get_drive_name($arg->{drive});
4548 return $self->error("Can't get your drive name");
4554 if ($arg->{slots}) {
4555 $slots = join(",", @{ $arg->{slots} });
4556 $slots_sql = " AND Slot IN ($slots) ";
4557 $t += 60*scalar( @{ $arg->{slots} }) ;
4560 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
4561 print "<h1>This command can take long time, be patient...</h1>";
4563 $b->label_barcodes(storage => $storage,
4564 drive => $arg->{drive},
4572 SET LocationId = (SELECT LocationId
4574 WHERE Location = '$arg->{ach}')
4576 WHERE (LocationId = 0 OR LocationId IS NULL)
4585 $self->can_do('r_purge');
4587 my @volume = CGI::param('media');
4590 return $self->error("Can't get media selection");
4593 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4595 foreach my $v (@volume) {
4597 content => $b->purge_volume($v),
4598 title => "Purge media",
4599 name => "purge volume=$v",
4608 $self->can_do('r_prune');
4610 my @volume = CGI::param('media');
4612 return $self->error("Can't get media selection");
4615 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4617 foreach my $v (@volume) {
4619 content => $b->prune_volume($v),
4620 title => "Prune volume",
4621 name => "prune volume=$v",
4630 $self->can_do('r_cancel_job');
4632 my $arg = $self->get_form('jobid');
4633 unless ($arg->{jobid}) {
4634 return $self->error("Can't get jobid");
4637 my $b = $self->get_bconsole();
4639 content => $b->cancel($arg->{jobid}),
4640 title => "Cancel job",
4641 name => "cancel jobid=$arg->{jobid}",
4647 # Warning, we display current fileset
4650 my $arg = $self->get_form('fileset');
4652 if ($arg->{fileset}) {
4653 my $b = $self->get_bconsole();
4654 my $ret = $b->get_fileset($arg->{fileset});
4655 $self->display({ fileset => $arg->{fileset},
4657 }, "fileset_view.tpl");
4659 $self->error("Can't get fileset name");
4663 sub director_show_sched
4666 $self->can_do('r_view_job');
4667 my $arg = $self->get_form('days');
4669 my $b = $self->get_bconsole();
4670 my $ret = $b->director_get_sched( $arg->{days} );
4675 }, "scheduled_job.tpl");
4678 sub enable_disable_job
4680 my ($self, $what) = @_ ;
4681 $self->can_do('r_run_job');
4683 my $name = CGI::param('job') || '';
4684 unless ($name =~ /^[\w\d\.\-\s]+$/) {
4685 return $self->error("Can't find job name");
4688 my $b = $self->get_bconsole();
4698 content => $b->send_cmd("$cmd job=\"$name\""),
4699 title => "$cmd $name",
4700 name => "$cmd job=\"$name\"",
4707 return new Bconsole(pref => $self->{info});
4713 $self->can_do('r_storage_mgnt');
4714 my $arg = $self->get_form(qw/storage storage_cmd drive/);
4715 my $b = $self->get_bconsole();
4717 if ($arg->{storage} and $arg->{storage_cmd}) {
4718 my $cmd = "$arg->{storage_cmd} storage=\"$arg->{storage}\" drive=$arg->{drive}";
4719 my $ret = $b->send_cmd($cmd);
4723 title => "Storage ",
4727 my $storages= [ map { { name => $_ } } $b->list_storage()];
4728 $self->display({ storage => $storages}, "cmd_storage.tpl");
4735 $self->can_do('r_run_job');
4737 my $b = $self->get_bconsole();
4739 my $joblist = [ map { { name => $_ } } $b->list_job() ];
4741 $self->display({ Jobs => $joblist }, "run_job.tpl");
4746 my ($self, $ouput) = @_;
4749 foreach my $l (split(/\r\n/, $ouput)) {
4750 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4756 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4762 foreach my $k (keys %arg) {
4763 $lowcase{lc($k)} = $arg{$k} ;
4772 $self->can_do('r_run_job');
4774 my $b = $self->get_bconsole();
4776 my $job = CGI::param('job') || '';
4778 # we take informations from director, and we overwrite with user wish
4779 my $info = $b->send_cmd("show job=\"$job\"");
4780 my $attr = $self->run_parse_job($info);
4782 my $arg = $self->get_form(qw/pool level client fileset storage media/);
4784 if (!$arg->{pool} and $arg->{media}) {
4785 my $r = $self->dbh_selectrow_hashref("
4786 SELECT Pool.Name AS name
4787 FROM Media JOIN Pool USING (PoolId)
4788 WHERE Media.VolumeName = '$arg->{media}'
4789 AND Pool.Name != 'Scratch'
4792 $arg->{pool} = $r->{name};
4796 my %job_opt = (%$attr, %$arg);
4798 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
4800 my $pools = [ map { { name => $_ } } $b->list_pool() ];
4801 my $clients = [ map { { name => $_ } }$b->list_client()];
4802 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
4803 my $storages= [ map { { name => $_ } }$b->list_storage()];
4808 clients => $clients,
4809 filesets => $filesets,
4810 storages => $storages,
4812 }, "run_job_mod.tpl");
4818 $self->can_do('r_run_job');
4820 my $b = $self->get_bconsole();
4822 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
4832 $self->can_do('r_run_job');
4834 my $b = $self->get_bconsole();
4836 # TODO: check input (don't use pool, level)
4838 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
4839 my $job = CGI::param('job') || '';
4840 my $storage = CGI::param('storage') || '';
4842 my $jobid = $b->run(job => $job,
4843 client => $arg->{client},
4844 priority => $arg->{priority},
4845 level => $arg->{level},
4846 storage => $storage,
4847 pool => $arg->{pool},
4848 fileset => $arg->{fileset},
4849 when => $arg->{when},
4854 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>";
4857 sub display_next_job
4861 my $arg = $self->get_form(qw/job begin end/);
4863 return $self->error("Can't get job name");
4866 my $b = $self->get_bconsole();
4868 my $job = $b->send_cmd("show job=\"$arg->{job}\"");
4869 my $attr = $self->run_parse_job($job);
4871 if (!$attr->{schedule}) {
4872 return $self->error("Can't get $arg->{job} schedule");
4874 my $jpool=$attr->{pool} || '';
4876 my $sched = new Bweb::Sched(bconsole => $b, name => $attr->{schedule},
4877 begin => $arg->{begin}, end => $arg->{end});
4879 my $ss = $sched->get_scheds($attr->{schedule});
4882 foreach my $s (@$ss) {
4883 my $level = $sched->get_level($s);
4884 my $pool = $sched->get_pool($s) || $jpool;
4885 my $evt = $sched->get_event($s);
4886 push @ret, map { "$_ : $pool ($level)\n" } @$evt;
4889 print "<b>$arg->{job}:</b><pre>", sort @ret, "</pre><br>";
4892 # check jobs against their schedule
4895 my ($self, $sched, $schedname, $job, $job_pool, $client) = @_;
4896 return undef if (!$self->can_view_client($client));
4898 my $sch = $sched->get_scheds($schedname);
4899 return undef if (!$sch);
4901 my $end = $sched->{end}; # this backup must have start before the next one
4903 foreach my $s (@$sch) {
4904 my $pool = $sched->get_pool($s) || $job_pool;
4905 my $level = $sched->get_level($s);
4906 my ($l) = ($level =~ m/^(.)/); # we keep the first letter
4907 my $evts = $sched->get_event($s);
4909 foreach my $evt (reverse @$evts) {
4910 my $all = $self->dbh_selectrow_hashref("
4912 FROM Job JOIN Pool USING (PoolId) JOIN Client USING (ClientId)
4913 WHERE Job.StartTime >= '$evt'
4914 AND Job.StartTime < '$end'
4916 AND Job.Name = '$job'
4917 AND Job.JobStatus = 'T'
4918 AND Job.Level = '$l'
4919 " . ($pool?" AND Pool.Name = '$pool' ":'') . "
4920 AND Client.Name = '$client'
4926 push @{$self->{tmp}}, {date => $evt, level => $level,
4927 type => 'Backup', name => $job,
4928 pool => $pool, volume => $pool};
4935 sub display_missing_job
4938 my $arg = $self->get_form(qw/begin end/);
4940 if (!$arg->{begin}) { # TODO: change this
4941 $arg->{begin} = strftime('%F %T', localtime(time - 24*60*60 ));
4944 $arg->{end} = strftime('%F %T', localtime(time));
4946 $self->{tmp} = []; # check_job use this for result
4948 my $bconsole = $self->get_bconsole();
4950 my $sched = new Bweb::Sched(bconsole => $bconsole,
4951 begin => $arg->{begin},
4952 end => $arg->{end});
4954 my $job = $bconsole->send_cmd("show job");
4955 my ($jname, $jsched, $jclient, $jpool);
4956 foreach my $j (split(/\r?\n/, $job)) {
4957 if ($j =~ /Job: name=([\w\d\-]+?) JobType=/i) {
4958 if ($jname and $jsched) {
4959 $self->check_job($sched, $jsched, $jname, $jpool, $jclient);
4962 $jclient = $jpool = $jsched = undef;
4963 } elsif ($j =~ /Client: name=(.+?) address=/i) {
4965 } elsif ($j =~ /Pool: name=([\w\d\-]+) PoolType=/i) {
4967 } elsif ($j =~ /Schedule: name=([\w\d\-]+)/i) {
4973 title => "Missing Job (since $arg->{begin} to $arg->{end})",
4974 list => $self->{tmp},
4975 }, "scheduled_job.tpl");
4977 delete $self->{tmp};