1 ################################################################
6 Bweb - A Bacula web interface
7 Bacula® - The Network Backup Solution
9 Copyright (C) 2006-2011 Free Software Foundation Europe e.V.
11 The main author of Bweb is Eric Bollengier.
12 The main author of Bacula is Kern Sibbald, with contributions from
13 many others, a complete list can be found in the file AUTHORS.
14 This program is Free Software; you can redistribute it and/or
15 modify it under the terms of version three of the GNU Affero General Public
16 License as published by the Free Software Foundation and included
19 This program is distributed in the hope that it will be useful, but
20 WITHOUT ANY WARRANTY; without even the implied warranty of
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 Affero General Public License for more details.
24 You should have received a copy of the GNU Affero General Public License
25 along with this program; if not, write to the Free Software
26 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
29 Bacula® is a registered trademark of Kern Sibbald.
30 The licensor of Bacula is the Free Software Foundation Europe
31 (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zürich,
32 Switzerland, email:ftf@fsfeurope.org.
40 Bweb::Gui - Base package for all Bweb object
44 This package define base fonction like new, display, etc..
49 our $template_dir='/usr/share/bweb/tpl';
53 new - creation a of new Bweb object
57 This function take an hash of argument and place them
60 IE : $obj = new Obj(name => 'test', age => '10');
62 $obj->{name} eq 'test' and $obj->{age} eq 10
68 my ($class, %arg) = @_;
74 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
81 my ($self, $what) = @_;
85 print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
87 print "<pre>$what</pre>";
94 open(FP, ">>/tmp/log");
95 print FP Data::Dumper::Dumper(\@_);
101 my ($self, $what) = @_;
103 my $old = $self->{debug};
106 $self->{debug} = $old;
111 error - display an error to the user
115 this function set $self->{error} with arg, display a message with
116 error.tpl and return 0
121 return $self->error("Can't use this file");
128 my ($self, $what) = @_;
129 $self->{error} = $what;
130 $self->display($self, 'error.tpl');
134 # send content type the first time, see man CGI to overwrite
136 my $send_content_type_done=0;
137 sub send_content_type
139 my ($self, %arg) = @_;
140 my $info = $self->{info} || $self;
142 if (!$send_content_type_done) { # display it once
143 $send_content_type_done = 1;
145 %arg = (-type => 'text/html', %arg);
146 print CGI::header(%arg);
152 display - display an html page with HTML::Template
156 this function is use to render all html codes. it takes an
157 ref hash as arg in which all param are usable in template.
159 it will use user template_dir then global template_dir
160 to search the template file.
162 hash keys are not sensitive. See HTML::Template for more
163 explanations about the hash ref. (it's can be quiet hard to understand)
165 It uses the following variables: template_dir lang director
169 $ref = { name => 'me', age => 26 };
170 $self->display($ref, "people.tpl");
176 my ($self, $hash, $tpl) = @_ ;
177 my $info = $self->{info} || $self;
179 my $dir = $info->{template_dir} || $template_dir;
180 my $lang = $self->{current_lang} || $info->{lang} || 'en';
181 my $template = HTML::Template->new(filename => $tpl,
182 path =>["$dir/$lang",
185 die_on_bad_params => 0,
186 case_sensitive => 0);
188 foreach my $var (qw/limit offset/) {
190 unless ($hash->{$var}) {
191 my $value = CGI::param($var) || '';
193 if ($value =~ /^(\d+)$/) {
194 $template->param($var, $1) ;
199 $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
200 $template->param('loginname', CGI::remote_user());
202 $template->param($hash);
203 $self->send_content_type();
204 print $template->output();
208 ################################################################
210 package Bweb::Config;
212 use base q/Bweb::Gui/;
216 Bweb::Config - read, write, display, modify configuration
220 this package is used for manage configuration
224 $conf = new Bweb::Config(config_file => '/path/to/conf');
235 =head1 PACKAGE VARIABLE
237 %k_re - hash of all acceptable option.
241 this variable permit to check all option with a regexp.
245 our %k_re = ( dbi => qr/^(dbi:(Pg|mysql|SQLite):(?:\w+=[\w\d\.\/\-]+;?)+)$/i,
246 user => qr/^([\w\d\.-]+)$/i,
247 password => qr/^(.*)$/,
248 fv_write_path => qr!^([/\w\d\.-]*)$!,
249 template_dir => qr!^([/\w\d\.-]+)$!,
250 debug => qr/^(on)?$/,
251 lang => qr/^(\w\w)?$/,
252 email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
253 graph_font => qr!^([/\w\d\.-]+.ttf)?$!,
254 bconsole => qr!^(.+)?$!,
255 wiki_url => qr!(.*)$!,
256 stat_job_table => qr!^(\w*)$!,
257 display_log_time => qr!^(on)?$!,
258 enable_security => qr/^(on)?$/,
259 enable_security_acl => qr/^(on)?$/,
260 default_age => qr/^((?:\d+(?:[ywdhms]\s*?)?)+)\s*$/,
261 name => qr/^([\w\s\d\.\-]+)$/,
262 dir_ver => qr/^(\d+(\.\d+)?)$/,
267 url => qr!^(https?://[\w\.\d/@?;]+)$!,
272 load - load config_file
276 this function load the specified config_file.
284 unless (open(FP, $self->{config_file}))
286 return $self->error("can't load config_file $self->{config_file} : $!");
288 my $f=''; my $tmpbuffer;
289 while(read FP,$tmpbuffer,4096)
297 no strict; # I have no idea of the contents of the file
302 return $self->error("Something is wrong with your configuration file...") ;
305 # keep a backup of the original config
306 foreach my $k (keys %$VAR1) {
307 if (exists $k_re{$k} and defined $VAR1->{$k}) {
308 $self->{main_conf}->{$k} = $VAR1->{$k};
316 save - save the current configuration to config_file
324 if ($self->{ach_list}) {
325 # shortcut for display_begin
326 $self->{achs} = [ map {{ name => $_ }}
327 keys %{$self->{ach_list}}
331 unless (open(FP, ">$self->{config_file}"))
333 return $self->error("$self->{config_file} : $!\n" .
334 "You must add this to your config file\n"
335 . Data::Dumper::Dumper($self));
338 print FP Data::Dumper::Dumper($self);
346 edit, view, modify - html form ouput
354 $self->display($self, "config_edit.tpl");
360 $self->display($self, "config_view.tpl");
368 # we need to reset checkbox first
370 $self->{display_log_time} = 0;
371 $self->{enable_security} = 0;
372 $self->{enable_security_acl} = 0;
374 foreach my $k (CGI::param())
376 next unless (exists $k_re{$k}) ;
377 my $val = CGI::param($k);
378 if ($val =~ $k_re{$k}) {
381 $self->{error} .= "bad parameter : $k = [$val]";
387 if ($self->{error}) { # an error as occured
388 $self->display($self, 'error.tpl');
396 ################################################################
398 package Bweb::Client;
400 use base q/Bweb::Gui/;
404 Bweb::Client - Bacula FD
408 this package is use to do all Client operations like, parse status etc...
412 $client = new Bweb::Client(name => 'zog-fd');
413 $client->status(); # do a 'status client=zog-fd'
419 display_running_job - Html display of a running job
423 this function is used to display information about a current job
427 sub display_running_job
429 my ($self, $bweb, $jobid, $infos) = @_ ;
430 my $status = $self->status($bweb->{info});
433 if ($status->{$jobid}) {
434 $status = $status->{$jobid};
435 $status->{last_jobbytes} = $infos->{jobbytes};
436 $status->{last_jobfiles} = $infos->{jobfiles};
437 $status->{corr_jobbytes} = $infos->{corr_jobbytes};
438 $status->{corr_jobfiles} = $infos->{corr_jobfiles};
439 $status->{jobbytes}=$status->{Bytes};
440 $status->{jobbytes} =~ s![^\d]!!g;
441 $status->{jobfiles}=$status->{'Files Examined'};
442 $status->{jobfiles} =~ s/,//g;
443 $bweb->display($status, "client_job_status.tpl");
446 for my $id (keys %$status) {
447 $bweb->display($status->{$id}, "client_job_status.tpl");
454 $client = new Bweb::Client(name => 'plume-fd');
456 $client->status($bweb);
460 dirty hack to parse "status client=xxx-fd"
464 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
465 Backup Job started: 06-jun-06 17:22
466 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
467 Files Examined=10,697
468 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
474 JobName => Full_plume.2006-06-06_17.22.23,
477 Bytes => 194,484,132,
487 my ($self, $conf) = @_ ;
489 if (defined $self->{cur_jobs}) {
490 return $self->{cur_jobs} ;
494 my $b = new Bconsole(pref => $conf);
495 my $ret = $b->send_cmd("st client=$self->{name}");
499 for my $r (split(/\n/, $ret)) {
501 $r =~ s/(^\s+|\s+$)//g;
502 if ($r =~ /JobId (\d+) Job (\S+)/) {
504 $arg->{$jobid} = { @param, JobId => $jobid } ;
508 @param = ( JobName => $2 );
510 } elsif ($r =~ /=.+=/) {
511 push @param, split(/\s+|\s*=\s*/, $r) ;
513 } elsif ($r =~ /=/) { # one per line
514 push @param, split(/\s*=\s*/, $r) ;
516 } elsif ($r =~ /:/) { # one per line
517 push @param, split(/\s*:\s*/, $r, 2) ;
521 if ($jobid and @param) {
522 $arg->{$jobid} = { @param,
524 Client => $self->{name},
528 $self->{cur_jobs} = $arg ;
534 ################################################################
536 package Bweb::Autochanger;
538 use base q/Bweb::Gui/;
542 Bweb::Autochanger - Object to manage Autochanger
546 this package will parse the mtx output and manage drives.
550 $auto = new Bweb::Autochanger(precmd => 'sudo');
552 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
556 $auto->slot_is_full(10);
557 $auto->transfer(10, 11);
563 my ($class, %arg) = @_;
566 name => '', # autochanger name
567 label => {}, # where are volume { label1 => 40, label2 => drive0 }
568 drive => [], # drive use [ 'media1', 'empty', ..]
569 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
570 io => [], # io slot number list [ 41, 42, 43...]
571 info => {slot => 0, # informations (slot, drive, io)
575 mtxcmd => '/usr/sbin/mtx',
577 device => '/dev/changer',
578 precmd => '', # ssh command
579 bweb => undef, # link to bacula web object (use for display)
582 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
589 status - parse the output of mtx status
593 this function will launch mtx status and parse the output. it will
594 give a perlish view of the autochanger content.
596 it uses ssh if the autochanger is on a other host.
603 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
605 # TODO : reset all infos
606 $self->{info}->{drive} = 0;
607 $self->{info}->{slot} = 0;
608 $self->{info}->{io} = 0;
610 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
613 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
614 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
615 #Data Transfer Element 1:Empty
616 # Storage Element 1:Empty
617 # Storage Element 2:Full :VolumeTag=000002
618 # Storage Element 3:Empty
619 # Storage Element 4:Full :VolumeTag=000004
620 # Storage Element 5:Full :VolumeTag=000001
621 # Storage Element 6:Full :VolumeTag=000003
622 # Storage Element 7:Empty
623 # Storage Element 41 IMPORT/EXPORT:Empty
624 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
629 # Storage Element 7:Empty
630 # Storage Element 2:Full :VolumeTag=000002
631 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d.-]+))?/){
634 $self->set_empty_slot($1);
636 $self->set_slot($1, $4);
639 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d.-]+))?)?/) {
642 $self->set_empty_drive($1);
644 $self->set_drive($1, $4, $6);
647 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w.-]+))?/)
650 $self->set_empty_io($1);
652 $self->set_io($1, $4);
655 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
657 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
658 $self->{info}->{drive} = $1;
659 $self->{info}->{slot} = $2;
660 if ($l =~ /(\d+)\s+Import/) {
661 $self->{info}->{io} = $1 ;
663 $self->{info}->{io} = 0;
668 $self->debug($self) ;
673 my ($self, $slot) = @_;
676 if ($self->{slot}->[$slot] eq 'loaded') {
680 my $label = $self->{slot}->[$slot] ;
682 return $self->is_media_loaded($label);
687 my ($self, $drive, $slot) = @_;
689 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
690 return 0 if ($self->slot_is_full($slot)) ;
692 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
695 my $content = $self->get_slot($slot);
696 print "content = $content<br/> $drive => $slot<br/>";
697 $self->set_empty_drive($drive);
698 $self->set_slot($slot, $content);
701 $self->{error} = $out;
706 # TODO: load/unload have to use mtx script from bacula
709 my ($self, $drive, $slot) = @_;
711 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
712 return 0 unless ($self->slot_is_full($slot)) ;
714 print "Loading drive $drive with slot $slot<br/>\n";
715 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
718 my $content = $self->get_slot($slot);
719 print "content = $content<br/> $slot => $drive<br/>";
720 $self->set_drive($drive, $slot, $content);
723 $self->{error} = $out;
731 my ($self, $media) = @_;
733 unless ($self->{label}->{$media}) {
737 if ($self->{label}->{$media} =~ /drive\d+/) {
747 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
752 my ($self, $slot, $tag) = @_;
753 $self->{slot}->[$slot] = $tag || 'full';
754 push @{ $self->{io} }, $slot;
757 $self->{label}->{$tag} = $slot;
763 my ($self, $slot) = @_;
765 push @{ $self->{io} }, $slot;
767 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
768 $self->{slot}->[$slot] = 'empty';
774 my ($self, $slot) = @_;
775 return $self->{slot}->[$slot];
780 my ($self, $slot, $tag) = @_;
781 $self->{slot}->[$slot] = $tag || 'full';
784 $self->{label}->{$tag} = $slot;
790 my ($self, $slot) = @_;
792 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
793 $self->{slot}->[$slot] = 'empty';
799 my ($self, $drive) = @_;
800 $self->{drive}->[$drive] = 'empty';
805 my ($self, $drive, $slot, $tag) = @_;
806 $self->{drive}->[$drive] = $tag || $slot;
807 $self->{drive_slot}->[$drive] = $slot;
809 $self->{slot}->[$slot] = $tag || 'loaded';
812 $self->{label}->{$tag} = "drive$drive";
818 my ($self, $slot) = @_;
820 # slot don't exists => full
821 if (not defined $self->{slot}->[$slot]) {
825 if ($self->{slot}->[$slot] eq 'empty') {
828 return 1; # vol, full, loaded
831 sub slot_get_first_free
834 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
835 return $slot unless ($self->slot_is_full($slot));
839 sub io_get_first_free
843 foreach my $slot (@{ $self->{io} }) {
844 return $slot unless ($self->slot_is_full($slot));
851 my ($self, $media) = @_;
853 return $self->{label}->{$media} ;
858 my ($self, $media) = @_;
860 return defined $self->{label}->{$media} ;
865 my ($self, $slot) = @_;
867 unless ($self->slot_is_full($slot)) {
868 print "Autochanger $self->{name} slot $slot is empty<br>\n";
873 if ($self->is_slot_loaded($slot)) {
876 print "Autochanger $self->{name} $slot is currently in use<br>\n";
880 # autochanger must have I/O
881 unless ($self->have_io()) {
882 print "Autochanger $self->{name} don't have I/O, you can take media yourself<br>\n";
886 my $dst = $self->io_get_first_free();
889 print "Autochanger $self->{name} mailbox is full, you must empty I/O first<br>\n";
893 $self->transfer($slot, $dst);
898 my ($self, $src, $dst) = @_ ;
899 if ($self->{debug}) {
900 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
902 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
905 my $content = $self->get_slot($src);
906 $self->{slot}->[$src] = 'empty';
907 $self->set_slot($dst, $content);
910 $self->{error} = $out;
917 my ($self, $index) = @_;
918 return $self->{drive_name}->[$index];
921 # TODO : do a tapeinfo request to get informations
931 print "<table><tr>\n";
932 for my $slot (@{$self->{io}})
934 if ($self->is_slot_loaded($slot)) {
935 print "<td></td><td>Slot $slot is currently loaded</td></tr>\n";
939 if ($self->slot_is_full($slot))
941 my $free = $self->slot_get_first_free() ;
942 print "</tr><tr><td>move slot $slot to $free :</td>";
945 if ($self->transfer($slot, $free)) {
946 print "<td><img src='/bweb/T.png' alt='ok'></td>\n";
948 print "<td><img src='/bweb/E.png' alt='ok' title='$self->{error}'></td>\n";
952 $self->{error} = "<td><img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'></td>\n";
956 print "</tr></table>\n";
959 # TODO : this is with mtx status output,
960 # we can do an other function from bacula view (with StorageId)
964 my $bweb = $self->{bweb};
966 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
967 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
970 SELECT Media.VolumeName AS volumename,
971 Media.VolStatus AS volstatus,
972 Media.LastWritten AS lastwritten,
973 Media.VolBytes AS volbytes,
974 Media.MediaType AS mediatype,
976 Media.InChanger AS inchanger,
978 $self->{sql}->{MEDIA_EXPIRE} AS expire
980 INNER JOIN Pool USING (PoolId)
982 WHERE Media.VolumeName IN ($media_list)
985 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
987 # TODO : verify slot and bacula slot
991 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
993 if ($self->slot_is_full($slot)) {
995 my $vol = $self->{slot}->[$slot];
996 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
998 my $bslot = $all->{$vol}->{slot} ;
999 my $inchanger = $all->{$vol}->{inchanger};
1001 # if bacula slot or inchanger flag is bad, we display a message
1002 if ($bslot != $slot or !$inchanger) {
1003 push @to_update, $slot;
1006 $all->{$vol}->{realslot} = $slot;
1008 push @{ $param }, $all->{$vol};
1010 } else { # empty or no label
1011 push @{ $param }, {realslot => $slot,
1012 volstatus => 'Unknown',
1013 volumename => $self->{slot}->[$slot]} ;
1016 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
1020 my $i=0; my $drives = [] ;
1021 foreach my $d (@{ $self->{drive} }) {
1022 $drives->[$i] = { index => $i,
1023 load => $self->{drive}->[$i],
1024 name => $self->{drive_name}->[$i],
1029 $bweb->display({ Name => $self->{name},
1030 nb_drive => $self->{info}->{drive},
1031 nb_io => $self->{info}->{io},
1034 Update => scalar(@to_update) },
1041 ################################################################
1043 package Bweb::Sched;
1044 use base q/Bweb::Gui/;
1048 Bweb::Sched() - Bweb package that parse show schedule ouput
1050 new Bweb::Sched(format => '%Y-%m-%d', year => 2008);
1054 my $b = $bweb->get_bconsole();
1055 my $s = $b->send_cmd("show schedule");
1056 my $sched = new Bweb::Sched(begin => '2007-01-01', end => '2007-01-02 12:00');
1057 $sched->parse_scheds(split(/\r?\n/, $s));
1068 'level' => 'Differential',
1075 my ($class, @arg) = @_;
1076 my $self = $class->SUPER::new(@arg);
1078 # we compare the current schedule date with begin and end
1079 # in a float form ex: 20071212.1243 > 20070101
1080 if ($self->{begin} and $self->{end}) {
1081 ($self->{fbegin}, $self->{fend}) = ($self->{begin}, $self->{end});
1082 $self->{fbegin} =~ s/(-|:)//g; $self->{fbegin} =~ s/ /./;
1083 $self->{fend} =~ s/(-|:)//g; $self->{fend} =~ s/ /./;
1086 bless($self,$class);
1088 if ($self->{bconsole}) {
1089 my $sel = $self->{name}?"=\"$self->{name}\"":'';
1090 my $b = $self->{bconsole};
1091 my $out = $b->send_cmd("show schedule$sel");
1092 $self->{show_output}=$out;
1093 $self->parse_scheds(split(/\r?\n/, $out));
1094 undef $self->{bconsole}; # useless now
1100 # cleanup and add a schedule
1103 my ($self, $name, $info) = @_;
1104 # bacula uses dates that start from 0, we start from 1
1105 foreach (@{$info->{mday}},@{$info->{month}}) { $_++ };
1108 $info->{event} = [ $self->get_events($info, $self->{format}) ];
1110 foreach my $i (qw/hour mday month wday wom woy mins/) {
1114 push @{$self->{schedules}->{$name}}, $info;
1117 # return the name of all schedules
1120 my ($self, $name) = @_;
1122 return keys %{ $self->{schedules} };
1125 # return an array of all schedule
1128 my ($self, $sched) = @_;
1129 return $self->{schedules}->{$sched};
1132 # return an ref array of all events
1133 # [ '2007-12-19 04:05', '2007-12-19 04:05' ]
1136 my ($self, $sched) = @_;
1137 return $sched->{event};
1140 # return the pool name
1143 my ($self, $sched) = @_;
1144 return $sched->{pool} || '';
1147 # return the level name (Incremental, Differential, Full)
1150 my ($self, $sched) = @_;
1151 return $sched->{level};
1154 # parse bacula sched bitmap
1157 my ($self, @output) = @_;
1164 foreach my $ligne (@output) {
1165 if ($ligne =~ /Schedule: name=(.+)/) {
1166 if ($name and $elt) {
1167 $elt->{level} = $run;
1168 $self->add_sched($name, $elt);
1173 elsif ($ligne =~ /Run Level=(.+)/) {
1174 if ($name and $elt) {
1175 $elt->{level} = $run;
1176 $self->add_sched($name, $elt);
1181 elsif ($ligne =~ /(hour|mday|month|mins)=(.+)/) {
1182 # All theses lines have the same format
1184 my ($k,$v) = ($1,$2);
1185 # we get all values (0 1 4 9)
1186 $elt->{$k}=[split (/\s/,$v)];
1188 # we make a bitmap for this kind of data (0 0 1 0 0 0 1) for a quick access
1189 elsif ($ligne =~ /(wday|wom|woy)=(.+)/) {
1190 my ($k,$v) = ($1,$2);
1191 foreach my $e (split (/\s/,$v)) {
1195 elsif ($ligne =~ /Pool: name=(.+?) PoolType/) {
1200 if ($name and $elt) {
1201 $elt->{level} = $run;
1202 $self->add_sched($name, $elt);
1206 use Date::Calc qw(:all);
1208 # read bacula schedule bitmap and get $format date string
1212 my ($self, $s,$format) = @_;
1213 my $year = $self->{year} || ((localtime($Bweb::btime))[5] + 1900);
1214 $format = $format || '%u-%02u-%02u %02u:%02u';
1216 foreach my $m (@{$s->{month}}) # mois de l'annee
1218 foreach my $md (@{$s->{mday}}) # jour du mois
1220 # print " m=$m md=$md\n";
1221 # we check if this day exists (31 fev)
1222 next if (!check_date($year,$m,$md));
1223 # print " check_date ok\n";
1225 my $w = ($md-1)/7; # we use the same thing than bacula
1226 next if (! $s->{wom}->[$w]);
1227 # print " wom ok\n";
1229 # on recupere le jour de la semaine
1230 my $wd = Day_of_Week($year,$m,$md);
1232 my ($w1,undef) = Week_of_Year($year,$m,$wd);
1233 next if (! $s->{woy}->[$w1-1]); # bacula 0-51
1234 # print " woy ok\n";
1236 $wd = 0 if ($wd == 7) ; # sunday is 0 on bacula
1237 next if (! $s->{wday}->[$wd]);
1238 # print " wday ok\n";
1240 foreach my $h (@{$s->{hour}}) # hour of the day
1242 foreach my $min (@{$s->{mins}}) # minute
1244 if ($self->{fbegin}) {
1246 my $d = sprintf('%d%0.2d%0.2d.%0.2d%0.2d',
1247 $year,$m,$md,$h,$min);
1248 next if ($d < $self->{fbegin} or $d > $self->{fend});
1250 push @ret, sprintf($format, $year,$m,$md,$h,$min);
1259 ################################################################
1263 use base q/Bweb::Gui/;
1267 Bweb - main Bweb package
1271 this package is use to compute and display informations
1276 use POSIX qw/strftime/;
1278 our $config_file= '/etc/bacula/bweb.conf';
1280 if ($ENV{BWEBCONF} && -f $ENV{BWEBCONF}) {
1281 $config_file = $ENV{BWEBCONF};
1288 %sql_func - hash to make query mysql/postgresql compliant
1294 UNIX_TIMESTAMP => '',
1295 FROM_UNIXTIME => '',
1296 TO_SEC => " interval '1 second' * ",
1297 SEC_TO_INT => "SEC_TO_INT",
1300 MEDIA_EXPIRE => "date_part('epoch', Media.LastWritten) + Media.VolRetention",
1301 ENDTIME_SEC => " date_part('epoch', EndTime) ",
1302 JOB_DURATION => " date_part('epoch', EndTime) - date_part('epoch', StartTime) ",
1303 STARTTIME_SEC => " date_part('epoch', Job.StartTime) ",
1304 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1305 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1306 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1307 STARTTIME_WEEK => " date_trunc('week', Job.StartTime) ",
1308 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1309 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1310 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1311 STARTTIME_PWEEK => " date_part('week', Job.StartTime) ",
1312 DB_SIZE => " SELECT pg_database_size(current_database()) ",
1313 CAT_POOL_TYPE => " MediaType || '_' || Pool.Name ",
1316 #NOW => "TIMESTAMP '2010-07-15 00:00:00' "
1319 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1320 FROM_UNIXTIME => 'FROM_UNIXTIME',
1323 SEC_TO_TIME => 'SEC_TO_TIME',
1324 MATCH => " REGEXP ",
1325 MEDIA_EXPIRE => 'UNIX_TIMESTAMP(Media.LastWritten)+Media.VolRetention',
1326 ENDTIME_SEC => " UNIX_TIMESTAMP(EndTime) ",
1327 JOB_DURATION => " UNIX_TIMESTAMP(EndTime) - UNIX_TIMESTAMP(StartTime) ",
1328 STARTTIME_SEC => " UNIX_TIMESTAMP(Job.StartTime) ",
1329 STARTTIME_DAY => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d') ",
1330 STARTTIME_HOUR => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %H') ",
1331 STARTTIME_MONTH => " DATE_FORMAT(Job.StartTime, '%Y-%m') ",
1332 STARTTIME_WEEK => " DATE_FORMAT(Job.StartTime, '%Y-%v') ",
1333 STARTTIME_PHOUR=> " DATE_FORMAT(Job.StartTime, '%H') ",
1334 STARTTIME_PDAY => " DATE_FORMAT(Job.StartTime, '%d') ",
1335 STARTTIME_PMONTH => " DATE_FORMAT(Job.StartTime, '%m') ",
1336 STARTTIME_PWEEK => " DATE_FORMAT(Job.StartTime, '%v') ",
1337 # with mysql < 5, you have to play with the ugly SHOW command
1338 #DB_SIZE => " SELECT 0 ",
1339 # works only with mysql 5
1340 DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1341 CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1342 CONCAT_SEP => " SEPARATOR '' ",
1346 UNIX_TIMESTAMP => '',
1347 FROM_UNIXTIME => '',
1351 MATCH => " REGEXP ",
1352 MEDIA_EXPIRE => "strftime('%s', Media.LastWritten) + Media.VolRetention",
1353 ENDTIME_SEC => " strftime('%s', EndTime) ",
1354 STARTTIME_SEC => " strftime('%s', Job.StartTime) ",
1355 JOB_DURATION => " strftime('%s', EndTime) - strftime('%s', StartTime)",
1357 STARTTIME_DAY => " strftime('%Y-%m-%d', Job.StartTime) ",
1358 STARTTIME_HOUR => " strftime('%Y-%m-%d %H', Job.StartTime) ",
1359 STARTTIME_MONTH => " strftime('%Y-%m', Job.StartTime) ",
1360 STARTTIME_WEEK => " strftime('%Y-%W', Job.StartTime) ",
1361 STARTTIME_PHOUR=> " strftime('%H', Job.StartTime) ",
1362 STARTTIME_PDAY => " strftime('%d', Job.StartTime) ",
1363 STARTTIME_PMONTH => " strftime('%m', Job.StartTime) ",
1364 STARTTIME_PWEEK => " strftime('%W', Job.StartTime) ",
1365 DB_SIZE => " SELECT 0 ",
1366 CAT_POOL_TYPE => " MediaType || Pool.Name ",
1368 NOW => "strftime('%Y-%m-%d %H:%M:%S', 'now')",
1372 use Exporter 'import';
1373 our @EXPORT_OK = qw($btime);
1375 #our $btime = 1279144800;
1381 return $self->{info}->{dbi} =~ /dbi:mysql/i;
1387 return $self->{info}->{dbi} =~ /dbi:sqlite/i;
1393 return $self->{info}->{dbi} =~ /dbi:pg/i;
1400 $self->{dbh}->disconnect();
1405 sub dbh_selectall_arrayref
1407 my ($self, $query) = @_;
1408 $self->connect_db();
1409 $self->debug($query);
1410 return $self->{dbh}->selectall_arrayref($query);
1415 my ($self, @what) = @_;
1416 return join(',', $self->dbh_quote(@what)) ;
1421 my ($self, @what) = @_;
1423 $self->connect_db();
1425 return map { $self->{dbh}->quote($_) } @what;
1427 return $self->{dbh}->quote($what[0]) ;
1433 my ($self, $query) = @_ ;
1434 $self->connect_db();
1435 $self->debug($query);
1436 return $self->{dbh}->do($query);
1439 # For sqlite, convert UNIX_TIMESTAMP(a) to strftime('%s', a)
1442 my ($self, $query) = @_ ;
1443 if ($self->dbh_is_sqlite()) {
1444 $query =~ s/UNIX_TIMESTAMP\(([^)]+)\)/strftime('%s', $1)/gs;
1449 sub dbh_selectall_hashref
1451 my ($self, $query, $join) = @_;
1453 $self->connect_db();
1454 $self->debug($query);
1455 return $self->{dbh}->selectall_hashref($query, $join) ;
1458 sub dbh_selectrow_hashref
1460 my ($self, $query) = @_;
1462 $self->connect_db();
1463 $self->debug($query);
1464 return $self->{dbh}->selectrow_hashref($query) ;
1469 my ($self, @what) = @_;
1470 if ($self->dbh_is_mysql()) {
1471 return 'CONCAT(' . join(',', @what) . ')' ;
1473 return join(' || ', @what);
1479 my ($self, $query) = @_;
1480 $self->debug($query, up => 1);
1481 return $self->{dbh}->prepare($query);
1487 my @unit = qw(B KB MB GB TB);
1488 my $val = shift || 0;
1490 my $format = '%i %s';
1491 while ($val / 1024 > 1) {
1495 $format = ($i>0)?'%0.1f %s':'%i %s';
1496 return sprintf($format, $val, $unit[$i]);
1503 if ($val =~ /^(?:\d+(?:[ywdhms]\s*)?)+\s*$/) {
1518 # display Day, Hour, Year
1524 $val /= 60; # sec -> min
1526 if ($val / 60 <= 1) {
1530 $val /= 60; # min -> hour
1531 if ($val / 24 <= 1) {
1532 return "$val hours";
1535 $val /= 24; # hour -> day
1536 if ($val / 365 < 2) {
1540 $val /= 365 ; # day -> year
1542 return "$val years";
1548 my $val = shift || 0;
1550 if ($val eq '1' or $val eq "yes") {
1552 } elsif ($val eq '2' or $val eq "archived") {
1560 sub from_human_enabled
1562 my $val = shift || 0;
1564 if ($val eq '1' or $val eq "yes") {
1566 } elsif ($val eq '2' or $val eq "archived") {
1573 # get Day, Hour, Year
1579 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1583 my %times = ( m => 60,
1589 my $mult = $times{$2} || 0;
1594 # get long term statistic table
1598 my $ret = $self->{info}->{stat_job_table} || 'JobHisto';
1599 if ($ret !~ m/^job$/i) {
1600 $ret = "(SELECT * FROM Job UNION SELECT * FROM $ret)";
1609 unless ($self->{dbh}) {
1611 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1612 $self->{info}->{user},
1613 $self->{info}->{password});
1615 return $self->error("Can't connect to your database:\n$DBI::errstr\n")
1616 unless ($self->{dbh});
1618 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1620 if ($self->dbh_is_mysql()) {
1621 $self->{dbh}->do("SET group_concat_max_len=1000000");
1622 } elsif ($self->dbh_is_pg()) {
1623 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1630 my ($class, %arg) = @_;
1632 dbh => undef, # connect_db();
1634 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1640 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1642 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1643 $self->{sql} = $sql_func{$1};
1646 $self->{loginname} = CGI::remote_user();
1647 $self->{debug} = $self->{info}->{debug};
1648 $self->{template_dir} = $self->{info}->{template_dir};
1650 my $args = $self->get_form('dir', 'lang');
1651 $self->set_lang($args->{lang});
1659 if ($self->{info}->{enable_security}) {
1660 $self->get_roles(); # get lang
1663 $self->display($self->{info}, "begin.tpl");
1669 $self->display($self->{info}, "end.tpl");
1675 my $arg = $self->get_form("qclient");
1676 my $f1 = $self->get_client_group_filter();
1677 my $f2 = $self->get_client_filter();
1679 # client_group_name | here
1680 #-------------------+-----
1685 SELECT client_group_name, max(here) AS here FROM (
1686 SELECT client_group_name, 1 AS here
1688 JOIN client_group_member USING (client_group_id)
1689 JOIN Client USING (ClientId) $f2
1690 WHERE Name = $arg->{qclient}
1692 SELECT client_group_name, 0
1693 FROM client_group $f1
1695 GROUP by client_group_name";
1697 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
1699 $self->display({ client_group => [ values %$all ], %$arg }, "client_edit.tpl");
1705 my $where=''; # by default
1707 my $arg = $self->get_form("client", "qre_client",
1708 "jclient_groups", "qnotingroup");
1710 if ($arg->{qre_client}) {
1711 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1712 } elsif ($arg->{client}) {
1713 $where = "WHERE Name = '$arg->{client}' ";
1714 } elsif ($arg->{jclient_groups}) {
1715 # $filter could already contains client_group_member
1717 JOIN client_group_member USING (ClientId)
1718 JOIN client_group USING (client_group_id)
1719 WHERE client_group_name IN ($arg->{jclient_groups}) ";
1720 } elsif ($arg->{qnotingroup}) {
1723 (SELECT 1 FROM client_group_member
1724 WHERE Client.ClientId = client_group_member.ClientId
1730 SELECT Name AS name,
1732 AutoPrune AS autoprune,
1733 FileRetention AS fileretention,
1734 JobRetention AS jobretention
1735 FROM Client " . $self->get_client_filter() .
1738 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1740 my $dsp = { ID => $cur_id++,
1741 clients => [ values %$all] };
1743 $self->display($dsp, "client_list.tpl") ;
1748 my ($self, %arg) = @_;
1752 my $sql = $self->{sql};
1754 if ($arg{since} and $arg{age}) {
1755 my $d = strftime('%Y-%m-%d %H:%M:%S', localtime($btime + $arg{age}));
1757 AND StartTime > '$arg{since}'
1758 AND EndTime < '$d' ";
1760 $label .= "since $arg{since} and during " . human_sec($arg{age});
1762 } elsif ($arg{age}) {
1763 my $when = $btime - $arg{age};
1764 $limit .= "AND JobTDate > $when";
1766 $label = "last " . human_sec($arg{age});
1769 if ($arg{groupby}) {
1770 $limit .= " GROUP BY $arg{groupby} ";
1774 $limit .= " ORDER BY $arg{order} ";
1778 $limit .= " LIMIT $arg{limit} ";
1779 $label .= " limited to $arg{limit}";
1783 $limit .= " OFFSET $arg{offset} ";
1784 $label .= " with $arg{offset} offset ";
1788 $label = 'no filter';
1791 return ($limit, $label);
1796 my ($what, $default) = @_;
1797 my %opt_cookies = ( dir => 1 );
1799 my $ret = CGI::param($what);
1801 if ($opt_cookies{$what} && !$ret) {
1802 $ret = CGI::cookie($what);
1805 $ret = $ret || $default;
1812 $bweb->get_form(...) - Get useful stuff
1816 This function get and check parameters against regexp.
1818 If word begin with 'q', the return will be quoted or join quoted
1819 if it's end with 's'.
1824 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1827 qclient => 'plume-fd',
1828 qpools => "'plume-fd', 'test-fd', '...'",
1835 my ($self, @what) = @_;
1836 my %what = map { $_ => 1 } @what;
1850 age => $self->{info}->{default_age},
1860 my %opt_ss =( # string with space
1867 my %opt_s = ( # default to ''
1889 my %opt_p = ( # option with path
1896 my %opt_r = (regexwhere => 1);
1897 my %opt_d = ( # option with date
1901 my %opt_t = (when => 2, # option with time
1902 begin => 1, # 1 hh:min are optionnal
1903 end => 1, # 2 hh:min are required
1906 foreach my $i (@what) {
1907 if (exists $opt_i{$i}) {# integer param
1908 my $value = get_item($i, $opt_i{$i}) ;
1909 if ($value =~ /^(\d+)$/) {
1911 } elsif ($i eq 'age' && # can have unit
1912 $value =~ /^(?:\d+(?:[ywdhms]\s*)?)+\s*$/) # 2y1h2m34s
1914 $ret{$i} = human_sec_unit($value);
1916 } elsif ($opt_s{$i}) { # simple string param
1917 my $value = get_item($i, '');
1918 if ($value =~ /^([\w\d\.-]+)$/) {
1921 } elsif ($opt_ss{$i}) { # simple string param (with space)
1922 my $value = get_item($i, '');
1923 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1926 } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1927 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1929 $ret{$i} = $self->dbh_join(@value) ;
1932 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1933 my $value = CGI::param($1) ;
1935 $ret{$i} = $self->dbh_quote($value);
1938 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1939 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1940 grep { ! /^\s*$/ } CGI::param($1) ];
1941 } elsif (exists $opt_p{$i}) {
1942 my $value = get_item($i, '');
1943 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1946 } elsif (exists $opt_r{$i}) {
1947 my $value = get_item($i, '');
1948 if ($value =~ /^([^'"']+)$/) {
1951 } elsif (exists $opt_d{$i}) {
1952 my $value = get_item($i, '');
1953 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1956 } elsif (exists $opt_t{$i}) { # 1: hh:min optionnal, 2: hh:min required
1957 my $when = get_item($i, '');
1958 if ($when =~ /(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}(:\d{2})?)?)/) {
1959 if ($opt_t{$i} == 1 or defined $2) {
1966 if ($what{comment}) {
1967 my $s = CGI::param('comment');
1969 $s =~ s/["\\'<>]/ /g; # strip some characters
1974 if ($what{storage_cmd}) {
1975 if (!grep {/^\Q$ret{storage_cmd}\E$/} ('mount', 'umount', 'release','status')) {
1976 delete $ret{storage_cmd};
1981 foreach my $s (CGI::param('slot')) {
1982 if ($s =~ /^(\d+)$/) {
1983 push @{$ret{slots}}, $s;
1989 my $age = $ret{age} || human_sec_unit($opt_i{age});
1990 my $since = CGI::param('since') || strftime('%F %T', localtime($btime - $age));
1991 if ($since =~ /^(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?)$/) {
1997 my $lang = get_item('lang', 'en');
1998 if ($lang =~ /^(\w\w)$/) {
2003 if ($what{db_clients}) {
2005 if ($what{filter}) {
2006 # get security filter only if asked
2007 $filter = $self->get_client_filter();
2011 SELECT Client.Name as clientname
2015 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
2016 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
2020 if ($what{db_client_groups}) {
2022 if ($what{filter}) {
2023 # get security filter only if asked
2024 $filter = $self->get_client_group_filter();
2028 SELECT client_group_name AS name, comment AS comment
2029 FROM client_group $filter
2031 my $grps = $self->dbh_selectall_hashref($query, 'name');
2032 $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
2036 if ($what{db_usernames}) {
2038 SELECT username, comment
2041 my $users = $self->dbh_selectall_hashref($query, 'username');
2042 $ret{db_usernames} = [sort {$a->{username} cmp $b->{username} }
2046 if ($what{db_roles}) {
2048 SELECT rolename, comment
2051 my $r = $self->dbh_selectall_hashref($query, 'rolename');
2052 $ret{db_roles} = [sort {$a->{rolename} cmp $b->{rolename} }
2056 if ($what{db_mediatypes}) {
2058 SELECT MediaType as mediatype
2061 my $media = $self->dbh_selectall_hashref($query, 'mediatype');
2062 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
2066 if ($what{db_locations}) {
2068 SELECT Location as location, Cost as cost
2071 my $loc = $self->dbh_selectall_hashref($query, 'location');
2072 $ret{db_locations} = [ sort { $a->{location}
2078 if ($what{db_pools}) {
2079 my $query = "SELECT Name as name FROM Pool";
2081 my $all = $self->dbh_selectall_hashref($query, 'name') ;
2082 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
2085 if ($what{db_filesets}) {
2087 SELECT FileSet.FileSet AS fileset
2090 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
2092 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
2093 values %$filesets] ;
2096 if ($what{db_jobnames}) {
2098 if ($what{filter}) {
2099 $filter = " JOIN Client USING (ClientId) " . $self->get_client_filter();
2102 SELECT DISTINCT Job.Name AS jobname
2105 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
2107 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
2108 values %$jobnames] ;
2111 if ($what{db_devices}) {
2113 SELECT Device.Name AS name
2116 my $devices = $self->dbh_selectall_hashref($query, 'name');
2118 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
2128 $self->can_do('r_view_stat');
2129 my $fields = $self->get_form(qw/age level status clients filesets
2130 graph gtype type filter db_clients
2131 limit db_filesets width height
2132 qclients qfilesets qjobnames db_jobnames/);
2134 my $url = CGI::url(-full => 0,
2137 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
2139 # this organisation is to keep user choice between 2 click
2140 # TODO : fileset and client selection doesn't work
2147 if ($fields->{gtype} and $fields->{gtype} eq 'balloon') {
2148 system("./bgraph.pl");
2152 sub get_selected_media_location
2156 my $media = $self->get_form('jmedias');
2158 unless ($media->{jmedias}) {
2163 SELECT Media.VolumeName AS volumename, Location.Location AS location
2164 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2165 WHERE Media.VolumeName IN ($media->{jmedias})
2168 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2170 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
2179 my ($self, $in) = @_ ;
2180 $self->can_do('r_media_mgnt');
2181 my $media = $self->get_selected_media_location();
2187 my $elt = $self->get_form('db_locations');
2189 $self->display({ ID => $cur_id++,
2190 enabled => human_enabled($in),
2191 %$elt, # db_locations
2193 sort { $a->{volumename} cmp $b->{volumename} } values %$media
2202 $self->can_do('r_media_mgnt');
2204 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
2206 $self->display($elt, "help_extern.tpl");
2209 sub help_extern_compute
2212 $self->can_do('r_media_mgnt');
2214 my $number = CGI::param('limit') || '' ;
2215 unless ($number =~ /^(\d+)$/) {
2216 return $self->error("Bad arg number : $number ");
2219 my ($sql, undef) = $self->get_param('pools',
2220 'locations', 'mediatypes');
2223 SELECT Media.VolumeName AS volumename,
2224 Media.VolStatus AS volstatus,
2225 Media.LastWritten AS lastwritten,
2226 Media.MediaType AS mediatype,
2227 Media.VolMounts AS volmounts,
2229 Media.Recycle AS recycle,
2230 $self->{sql}->{MEDIA_EXPIRE} AS expire
2232 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2233 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2235 WHERE Media.InChanger = 1
2236 AND Media.VolStatus IN ('Disabled', 'Error', 'Full', 'Used')
2238 ORDER BY expire DESC, recycle, Media.VolMounts DESC
2242 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2244 $self->display({ Media => [ values %$all ] },
2245 "help_extern_compute.tpl");
2251 $self->can_do('r_media_mgnt');
2253 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
2254 $self->display($param, "help_intern.tpl");
2257 sub help_intern_compute
2260 $self->can_do('r_media_mgnt');
2262 my $number = CGI::param('limit') || '' ;
2263 unless ($number =~ /^(\d+)$/) {
2264 return $self->error("Bad arg number : $number ");
2267 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
2269 if (CGI::param('expired')) {
2270 # we take only expired volumes or purged/recycle ones
2273 ( ($self->{sql}->{MEDIA_EXPIRE}) < $btime
2275 Media.VolStatus IN ('Purged', 'Recycle')
2282 SELECT Media.VolumeName AS volumename,
2283 Media.VolStatus AS volstatus,
2284 Media.LastWritten AS lastwritten,
2285 Media.MediaType AS mediatype,
2286 Media.VolMounts AS volmounts,
2288 $self->{sql}->{MEDIA_EXPIRE} AS expire
2290 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2291 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
2293 WHERE Media.InChanger <> 1
2294 AND Media.VolStatus IN ('Purged', 'Full', 'Append', 'Recycle')
2295 AND Media.Recycle = 1
2297 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
2301 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2303 $self->display({ Media => [ values %$all ] },
2304 "help_intern_compute.tpl");
2310 my ($self, %arg) = @_ ;
2312 my ($limit, $label) = $self->get_limit(%arg);
2313 my $filter = $self->get_client_filter();
2314 $filter = $filter? " JOIN Client USING (ClientId) $filter " : '';
2317 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
2318 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
2319 (SELECT count(Job.JobId) FROM Job) AS nb_job,
2320 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
2321 ($self->{sql}->{DB_SIZE}) AS db_size,
2322 (SELECT count(Job.JobId)
2324 WHERE Job.JobStatus IN ('E','e','f','A')
2327 (SELECT count(Client.ClientId) FROM Client) AS nb_client
2330 my $row = $self->dbh_selectrow_hashref($query) ;
2332 $row->{nb_bytes} = human_size($row->{nb_bytes});
2334 $row->{db_size} = human_size($row->{db_size});
2335 $row->{label} = $label;
2336 $row->{age} = $arg{age};
2338 $self->display($row, "general.tpl");
2343 my ($self, @what) = @_ ;
2344 my %elt = map { $_ => 1 } @what;
2349 if ($elt{clients}) {
2350 my @clients = grep { ! /^\s*$/ } CGI::param('client');
2352 $ret{clients} = \@clients;
2353 my $str = $self->dbh_join(@clients);
2354 $limit .= "AND Client.Name IN ($str) ";
2358 if ($elt{client_groups}) {
2359 my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
2361 $ret{client_groups} = \@clients;
2362 my $str = $self->dbh_join(@clients);
2363 $limit .= "AND client_group_name IN ($str) ";
2367 if ($elt{filesets}) {
2368 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
2370 $ret{filesets} = \@filesets;
2371 my $str = $self->dbh_join(@filesets);
2372 $limit .= "AND FileSet.FileSet IN ($str) ";
2376 if ($elt{mediatypes}) {
2377 my @media = grep { ! /^\s*$/ } CGI::param('mediatype');
2379 $ret{mediatypes} = \@media;
2380 my $str = $self->dbh_join(@media);
2381 $limit .= "AND Media.MediaType IN ($str) ";
2386 my $client = CGI::param('client');
2388 $ret{client} = $client;
2389 $client = $self->dbh_quote($client);
2390 $limit .= "AND Client.Name = $client ";
2395 my $level = CGI::param('level') || '';
2396 if ($level =~ /^(\w)$/) {
2398 $limit .= "AND Job.Level = '$1' ";
2403 my $jobid = CGI::param('jobid') || '';
2405 if ($jobid =~ /^(\d+)$/) {
2407 $limit .= "AND Job.JobId = '$1' ";
2412 my $status = CGI::param('status') || '';
2413 if ($status =~ /^(\w)$/) {
2416 $limit .= "AND Job.JobStatus IN ('E','e','f','A') ";
2417 } elsif ($1 eq 'W') {
2418 $limit .= "AND Job.JobStatus IN ('T', 'W') OR Job.JobErrors > 0 ";
2420 $limit .= "AND Job.JobStatus = '$1' ";
2425 if ($elt{volstatus}) {
2426 my $status = CGI::param('volstatus') || '';
2427 if ($status =~ /^(\w+)$/) {
2429 $limit .= "AND Media.VolStatus = '$1' ";
2433 if ($elt{locations}) {
2434 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
2436 $ret{locations} = \@location;
2437 my $str = $self->dbh_join(@location);
2438 $limit .= "AND Location.Location IN ($str) ";
2443 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
2445 $ret{pools} = \@pool;
2446 my $str = $self->dbh_join(@pool);
2447 $limit .= "AND Pool.Name IN ($str) ";
2451 if ($elt{location}) {
2452 my $location = CGI::param('location') || '';
2454 $ret{location} = $location;
2455 $location = $self->dbh_quote($location);
2456 $limit .= "AND Location.Location = $location ";
2461 my $pool = CGI::param('pool') || '';
2464 $pool = $self->dbh_quote($pool);
2465 $limit .= "AND Pool.Name = $pool ";
2469 if ($elt{jobtype}) {
2470 my $jobtype = CGI::param('jobtype') || '';
2471 if ($jobtype =~ /^(\w)$/) {
2473 $limit .= "AND Job.Type = '$1' ";
2477 return ($limit, %ret);
2488 my ($self, %arg) = @_ ;
2489 return if $self->cant_do('r_view_job');
2491 $arg{order} = ' Job.JobId DESC ';
2493 my ($limit, $label) = $self->get_limit(%arg);
2494 my ($where, undef) = $self->get_param('clients',
2503 if (CGI::param('client_group')) {
2505 JOIN client_group_member USING (ClientId)
2506 JOIN client_group USING (client_group_id)
2509 my $filter = $self->get_client_filter();
2510 my $comment = $self->get_db_field('Comment');
2511 my $rb = $self->get_db_field('ReadBytes');
2513 SELECT Job.JobId AS jobid,
2514 Client.Name AS client,
2515 FileSet.FileSet AS fileset,
2516 Job.Name AS jobname,
2518 StartTime AS starttime,
2520 Pool.Name AS poolname,
2521 JobFiles AS jobfiles,
2522 JobBytes AS jobbytes,
2523 JobStatus AS jobstatus,
2526 $comment AS comment,
2527 $self->{sql}->{JOB_DURATION} AS duration,
2528 JobErrors AS joberrors
2530 FROM Client $filter $cgq,
2531 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2532 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2533 WHERE Client.ClientId=Job.ClientId
2534 AND Job.JobStatus NOT IN ('R', 'C')
2539 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2541 $self->display({ Filter => $label,
2545 sort { $a->{jobid} <=> $b->{jobid} }
2552 # Adapt the code to the Schema version
2553 # TODO: can use the Version field
2556 my ($self, $what) = @_ ;
2558 my %feature = ('Comment' => 4, 'ReadBytes' => 4);
2559 my %replacement = ('Comment' => "''", 'ReadBytes' => 'JobBytes');
2561 if (!$self->{info}->{dir_ver} or
2562 $self->{info}->{dir_ver} >= $feature{$what})
2566 return $replacement{$what};
2570 # display job informations
2571 sub display_job_zoom
2573 my ($self, $jobid) = @_ ;
2574 $self->can_do('r_view_job');
2576 $jobid = $self->dbh_quote($jobid);
2578 # get security filter
2579 my $filter = $self->get_client_filter();
2580 my $comment = $self->get_db_field('Comment');
2581 my $rb = $self->get_db_field('ReadBytes');
2583 SELECT DISTINCT Job.JobId AS jobid,
2584 Client.Name AS client,
2585 Job.Name AS jobname,
2586 FileSet.FileSet AS fileset,
2588 Pool.Name AS poolname,
2589 StartTime AS starttime,
2590 JobFiles AS jobfiles,
2591 JobBytes AS jobbytes,
2592 JobStatus AS jobstatus,
2593 JobErrors AS joberrors,
2596 $comment AS comment,
2597 $self->{sql}->{JOB_DURATION} AS duration
2598 FROM Client $filter,
2599 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2600 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2601 WHERE Client.ClientId=Job.ClientId
2602 AND Job.JobId = $jobid
2605 my $row = $self->dbh_selectrow_hashref($query) ;
2607 # display all volumes associate with this job
2609 SELECT Media.VolumeName as volumename
2610 FROM Job,Media,JobMedia
2611 WHERE Job.JobId = $jobid
2612 AND JobMedia.JobId=Job.JobId
2613 AND JobMedia.MediaId=Media.MediaId
2616 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2618 $row->{volumes} = [ values %$all ] ;
2619 $row->{wiki_url} = $self->{info}->{wiki_url};
2621 $self->display($row, "display_job_zoom.tpl");
2624 sub display_job_group
2626 my ($self, %arg) = @_;
2627 $self->can_do('r_view_job');
2629 my ($limit, $label) = $self->get_limit(groupby => 'client_group_name', %arg);
2631 my ($where, undef) = $self->get_param('client_groups',
2634 my $filter = $self->get_client_group_filter();
2637 SELECT client_group_name AS client_group_name,
2638 COALESCE(jobok.jobfiles,0) + COALESCE(joberr.jobfiles,0) AS jobfiles,
2639 COALESCE(jobok.jobbytes,0) + COALESCE(joberr.jobbytes,0) AS jobbytes,
2640 COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2641 COALESCE(jobok.nbjobs,0) AS nbjobok,
2642 COALESCE(joberr.nbjobs,0) AS nbjoberr,
2643 COALESCE(jobok.duration, '0') AS duration
2645 FROM client_group $filter LEFT JOIN (
2646 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2647 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2648 SUM(JobErrors) AS joberrors,
2649 $self->{sql}->{JOB_DURATION} AS duration
2650 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2651 JOIN client_group USING (client_group_id)
2653 WHERE Type IN ('B', 'R') AND JobStatus IN ('T', 'W')
2656 ) AS jobok USING (client_group_name) LEFT JOIN
2659 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2660 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2661 SUM(JobErrors) AS joberrors
2662 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2663 JOIN client_group USING (client_group_id)
2665 WHERE Type IN ('B', 'R') AND JobStatus IN ('f','E', 'A')
2668 ) AS joberr USING (client_group_name)
2672 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2674 my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2677 $self->display($rep, "display_job_group.tpl");
2682 my ($self, %arg) = @_ ;
2683 $self->can_do('r_view_media');
2685 my ($limit, $label) = $self->get_limit(%arg);
2686 my ($where, %elt) = $self->get_param('pools',
2691 my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2693 if ($arg->{jmedias}) {
2694 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2696 if ($arg->{qre_media}) {
2697 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2699 if ($arg->{expired}) {
2701 AND VolStatus IN ('Full', 'Used')
2702 AND ( $self->{sql}->{MEDIA_EXPIRE} ) < $btime " . $where ;
2706 SELECT Media.VolumeName AS volumename,
2707 Media.VolBytes AS volbytes,
2708 Media.VolStatus AS volstatus,
2709 Media.MediaType AS mediatype,
2710 Media.InChanger AS online,
2711 Media.LastWritten AS lastwritten,
2712 Location.Location AS location,
2713 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2714 Pool.Name AS poolname,
2715 $self->{sql}->{MEDIA_EXPIRE} AS expire
2717 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2718 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2719 Media.MediaType AS MediaType
2721 WHERE Media.VolStatus = 'Full'
2722 GROUP BY Media.MediaType
2723 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2725 WHERE Media.PoolId=Pool.PoolId
2729 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2731 $self->display({ ID => $cur_id++,
2733 Location => $elt{location},
2734 Media => [ values %$all ],
2736 "display_media.tpl");
2739 sub display_allmedia
2743 my $pool = $self->get_form('db_pools');
2745 foreach my $name (@{ $pool->{db_pools} }) {
2746 CGI::param('pool', $name->{name});
2747 $self->display_media();
2751 sub display_media_zoom
2755 my $media = $self->get_form('jmedias');
2757 unless ($media->{jmedias}) {
2758 return $self->error("Can't get media selection");
2762 SELECT InChanger AS online,
2763 Media.Enabled AS enabled,
2764 VolBytes AS nb_bytes,
2765 VolumeName AS volumename,
2766 VolStatus AS volstatus,
2767 VolMounts AS nb_mounts,
2768 Media.VolUseDuration AS voluseduration,
2769 Media.MaxVolJobs AS maxvoljobs,
2770 Media.MaxVolFiles AS maxvolfiles,
2771 Media.MaxVolBytes AS maxvolbytes,
2772 VolErrors AS nb_errors,
2773 Pool.Name AS poolname,
2774 Location.Location AS location,
2775 Media.Recycle AS recycle,
2776 Media.VolRetention AS volretention,
2777 Media.LastWritten AS lastwritten,
2778 Media.VolReadTime/1000000 AS volreadtime,
2779 Media.VolWriteTime/1000000 AS volwritetime,
2780 Media.RecycleCount AS recyclecount,
2781 Media.Comment AS comment,
2782 $self->{sql}->{MEDIA_EXPIRE} AS expire
2784 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2785 WHERE Pool.PoolId = Media.PoolId
2786 AND VolumeName IN ($media->{jmedias})
2789 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2791 foreach my $media (values %$all) {
2792 my $mq = $self->dbh_quote($media->{volumename});
2795 SELECT DISTINCT Job.JobId AS jobid,
2797 Job.StartTime AS starttime,
2800 Job.JobFiles AS files,
2801 Job.JobBytes AS bytes,
2802 Job.jobstatus AS status
2803 FROM Media,JobMedia,Job
2804 WHERE Media.VolumeName=$mq
2805 AND Media.MediaId=JobMedia.MediaId
2806 AND JobMedia.JobId=Job.JobId
2809 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2812 SELECT LocationLog.Date AS date,
2813 Location.Location AS location,
2814 LocationLog.Comment AS comment
2815 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2816 WHERE Media.MediaId = LocationLog.MediaId
2817 AND Media.VolumeName = $mq
2821 my $log = $self->dbh_selectall_arrayref($query) ;
2823 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2826 $self->display({ jobs => [ values %$jobs ],
2827 LocationLog => $logtxt,
2829 "display_media_zoom.tpl");
2836 $self->can_do('r_location_mgnt');
2838 my $loc = $self->get_form('qlocation');
2839 unless ($loc->{qlocation}) {
2840 return $self->error("Can't get location");
2844 SELECT Location.Location AS location,
2845 Location.Cost AS cost,
2846 Location.Enabled AS enabled
2848 WHERE Location.Location = $loc->{qlocation}
2851 my $row = $self->dbh_selectrow_hashref($query);
2852 $row->{enabled} = human_enabled($row->{enabled});
2853 $self->display({ ID => $cur_id++,
2854 %$row }, "location_edit.tpl") ;
2860 $self->can_do('r_location_mgnt');
2862 my $arg = $self->get_form(qw/qlocation qnewlocation cost enabled/) ;
2863 unless ($arg->{qlocation}) {
2864 return $self->error("Can't get location");
2866 unless ($arg->{qnewlocation}) {
2867 return $self->error("Can't get new location name");
2869 unless ($arg->{cost}) {
2870 return $self->error("Can't get new cost");
2873 my $enabled = from_human_enabled($arg->{enabled});
2876 UPDATE Location SET Cost = $arg->{cost},
2877 Location = $arg->{qnewlocation},
2879 WHERE Location.Location = $arg->{qlocation}
2882 $self->dbh_do($query);
2884 $self->location_display();
2890 $self->can_do('r_location_mgnt');
2892 my $arg = $self->get_form(qw/qlocation/) ;
2894 unless ($arg->{qlocation}) {
2895 return $self->error("Can't get location");
2899 SELECT count(Media.MediaId) AS nb
2900 FROM Media INNER JOIN Location USING (LocationID)
2901 WHERE Location = $arg->{qlocation}
2904 my $res = $self->dbh_selectrow_hashref($query);
2907 return $self->error("Sorry, the location must be empty");
2911 DELETE FROM Location WHERE Location = $arg->{qlocation}
2914 $self->dbh_do($query);
2916 $self->location_display();
2922 $self->can_do('r_location_mgnt');
2924 my $arg = $self->get_form(qw/qlocation cost/) ;
2926 unless ($arg->{qlocation}) {
2927 $self->display({}, "location_add.tpl");
2930 unless ($arg->{cost}) {
2931 return $self->error("Can't get new cost");
2934 my $enabled = CGI::param('enabled') || '';
2935 $enabled = from_human_enabled($enabled);
2938 INSERT INTO Location (Location, Cost, Enabled)
2939 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2942 $self->dbh_do($query);
2944 $self->location_display();
2947 sub location_display
2952 SELECT Location.Location AS location,
2953 Location.Cost AS cost,
2954 Location.Enabled AS enabled,
2955 (SELECT count(Media.MediaId)
2957 WHERE Media.LocationId = Location.LocationId
2962 my $location = $self->dbh_selectall_hashref($query, 'location');
2963 $self->display({ ID => $cur_id++,
2964 Locations => [ values %$location ] },
2965 "display_location.tpl");
2972 my $media = $self->get_selected_media_location();
2977 my $arg = $self->get_form('db_locations', 'qnewlocation');
2979 $self->display({ email => $self->{info}->{email_media},
2981 media => [ values %$media ],
2983 "update_location.tpl");
2986 ###########################################################
2991 my $arg = $self->get_form(qw/jclient_groups qclient/);
2993 unless ($arg->{qclient}) {
2994 return $self->error("Can't get client name");
2997 $self->can_do('r_group_mgnt');
2999 my $f1 = $self->get_client_filter();
3000 my $f2 = $self->get_client_group_filter();
3002 $self->{dbh}->begin_work();
3005 DELETE FROM client_group_member
3009 WHERE Client.Name = $arg->{qclient})
3011 $self->dbh_do($query);
3013 if ($arg->{jclient_groups}) {
3015 INSERT INTO client_group_member (client_group_id, ClientId)
3016 (SELECT client_group_id, (SELECT ClientId
3018 WHERE Name = $arg->{qclient})
3019 FROM client_group $f2 WHERE client_group_name IN ($arg->{jclient_groups})
3022 $self->dbh_do($query);
3025 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
3027 $self->display_clients();
3033 my $grp = $self->get_form(qw/qclient_group db_clients/);
3035 unless ($grp->{qclient_group}) {
3036 $self->can_do('r_group_mgnt');
3037 $self->display({ ID => $cur_id++,
3038 client_group => "''",
3040 }, "groups_edit.tpl");
3044 unless ($self->cant_do('r_group_mgnt')) {
3045 $self->can_do('r_view_group');
3050 FROM Client JOIN client_group_member using (ClientId)
3051 JOIN client_group using (client_group_id)
3052 WHERE client_group_name = $grp->{qclient_group}
3055 my $row = $self->dbh_selectall_hashref($query, "name");
3057 $self->display({ ID => $cur_id++,
3058 client_group => $grp->{qclient_group},
3060 client_group_member => [ values %$row]},
3067 $self->can_do('r_group_mgnt');
3069 my $arg = $self->get_form(qw/qclient_group jclients qnewgroup qcomment/);
3070 if (!$arg->{qcomment}) {
3071 $arg->{qcomment} = "''";
3074 if (!$arg->{qclient_group} and $arg->{qnewgroup}) {
3076 INSERT INTO client_group (client_group_name, comment)
3077 VALUES ($arg->{qnewgroup}, $arg->{qcomment})
3079 $self->dbh_do($query);
3080 $arg->{qclient_group} = $arg->{qnewgroup};
3083 unless ($arg->{qclient_group}) {
3084 return $self->error("Can't get groups");
3087 $self->{dbh}->begin_work();
3090 DELETE FROM client_group_member
3091 WHERE client_group_id IN
3092 (SELECT client_group_id
3094 WHERE client_group_name = $arg->{qclient_group})
3096 $self->dbh_do($query);
3098 if ($arg->{jclients}) {
3100 INSERT INTO client_group_member (ClientId, client_group_id)
3102 (SELECT client_group_id
3104 WHERE client_group_name = $arg->{qclient_group})
3105 FROM Client WHERE Name IN ($arg->{jclients})
3108 $self->dbh_do($query);
3110 if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
3113 SET client_group_name = $arg->{qnewgroup}, comment = $arg->{qcomment}
3114 WHERE client_group_name = $arg->{qclient_group}
3117 $self->dbh_do($query);
3120 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
3122 $self->display_groups();
3128 $self->can_do('r_group_mgnt');
3130 my $arg = $self->get_form(qw/qclient_group/);
3132 unless ($arg->{qclient_group}) {
3133 return $self->error("Can't get groups");
3136 $self->{dbh}->begin_work();
3139 DELETE FROM client_group_member
3140 WHERE client_group_id IN
3141 (SELECT client_group_id
3143 WHERE client_group_name = $arg->{qclient_group})");
3146 DELETE FROM bweb_client_group_acl
3147 WHERE client_group_id IN
3148 (SELECT client_group_id
3150 WHERE client_group_name = $arg->{qclient_group})");
3153 DELETE FROM client_group
3154 WHERE client_group_name = $arg->{qclient_group}");
3156 $self->{dbh}->commit();
3157 $self->display_groups();
3165 if ($self->cant_do('r_group_mgnt')) {
3166 $arg = $self->get_form(qw/db_client_groups filter/) ;
3168 $arg = $self->get_form(qw/db_client_groups/) ;
3171 if ($self->{dbh}->errstr) {
3172 return $self->error("Can't use groups with bweb, read INSTALL to enable them");
3177 $self->display({ ID => $cur_id++,
3179 "display_groups.tpl");
3182 ###########################################################
3187 if (not $self->{info}->{enable_security}) {
3190 if (!$self->{loginname}) {
3191 $self->error("Can't get your login name");
3192 $self->display_end();
3195 # admin is a special user that can do everything
3196 if ($self->{loginname} eq 'admin') {
3200 if (defined $self->{security}) {
3203 $self->{security} = {};
3204 my $u = $self->dbh_quote($self->{loginname});
3207 SELECT use_acl, rolename, tpl
3209 JOIN bweb_role_member USING (userid)
3210 JOIN bweb_role USING (roleid)
3213 my $rows = $self->dbh_selectall_arrayref($query);
3214 # do cache with this role
3215 if (!$rows or !scalar(@$rows)) {
3216 $self->error("Can't get $self->{loginname}'s roles");
3217 $self->display_end();
3220 foreach my $r (@$rows) {
3221 $self->{security}->{$r->[1]}=1;
3223 $self->{security}->{use_acl} = $rows->[0]->[0];
3224 if ($rows->[0]->[2] =~ /^(\w\w)$/) {
3225 $self->set_lang($1);
3232 my ($self, $client) = @_;
3234 my $filter = $self->get_client_filter();
3238 my $cont = $self->dbh_selectrow_hashref("
3241 WHERE Name = '$client'
3243 return defined $cont;
3248 my ($self, $action) = @_;
3249 # is security enabled in configuration ?
3250 if (not $self->{info}->{enable_security}) {
3253 # admin is a special user that can do everything
3254 if ($self->{loginname} eq 'admin') {
3258 if (!$self->{loginname}) {
3259 $self->{error} = "Can't do $action, your are not logged. " .
3260 "Check security with your administrator";
3263 if (!$self->get_roles()) {
3266 if (!$self->{security}->{$action}) {
3268 "$self->{loginname} sorry, but this action ($action) " .
3269 "is not permited. " .
3270 "Check security with your administrator";
3276 # make like an assert (program die)
3279 my ($self, $action) = @_;
3280 if ($self->cant_do($action)) {
3281 $self->error($self->{error});
3282 $self->display_end();
3292 if (!$self->{info}->{enable_security} or
3293 !$self->{info}->{enable_security_acl})
3298 if ($self->get_roles()) {
3299 return $self->{security}->{use_acl};
3305 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
3306 sub get_client_filter
3308 my ($self, $login) = @_;
3311 $u = $self->dbh_quote($login);
3312 } elsif ($self->use_filter()) {
3313 $u = $self->dbh_quote($self->{loginname});
3318 JOIN (SELECT ClientId FROM client_group_member
3319 JOIN client_group USING (client_group_id)
3320 JOIN bweb_client_group_acl USING (client_group_id)
3321 JOIN bweb_user USING (userid)
3322 WHERE bweb_user.username = $u
3323 ) AS filter USING (ClientId)";
3326 #JOIN client_group USING (client_group_id)" . $b->get_client_group_filter()
3327 sub get_client_group_filter
3329 my ($self, $login) = @_;
3332 $u = $self->dbh_quote($login);
3333 } elsif ($self->use_filter()) {
3334 $u = $self->dbh_quote($self->{loginname});
3339 JOIN (SELECT client_group_id
3340 FROM bweb_client_group_acl
3341 JOIN bweb_user USING (userid)
3342 WHERE bweb_user.username = $u
3343 ) AS filter USING (client_group_id)";
3346 # role and username have to be quoted before
3347 # role and username can be a quoted list
3350 my ($self, $role, $username) = @_;
3351 $self->can_do("r_user_mgnt");
3353 my $nb = $self->dbh_do("
3354 DELETE FROM bweb_role_member
3355 WHERE roleid = (SELECT roleid FROM bweb_role
3356 WHERE rolename IN ($role))
3357 AND userid = (SELECT userid FROM bweb_user
3358 WHERE username IN ($username))");
3362 # role and username have to be quoted before
3363 # role and username can be a quoted list
3366 my ($self, $role, $username) = @_;
3367 $self->can_do("r_user_mgnt");
3369 my $nb = $self->dbh_do("
3370 INSERT INTO bweb_role_member (roleid, userid)
3371 SELECT roleid, userid FROM bweb_role, bweb_user
3372 WHERE rolename IN ($role)
3373 AND username IN ($username)
3378 # role and username have to be quoted before
3379 # role and username can be a quoted list
3382 my ($self, $copy, $user) = @_;
3383 $self->can_do("r_user_mgnt");
3385 my $nb = $self->dbh_do("
3386 INSERT INTO bweb_role_member (roleid, userid)
3387 SELECT roleid, a.userid
3388 FROM bweb_user AS a, bweb_role_member
3389 JOIN bweb_user USING (userid)
3390 WHERE bweb_user.username = $copy
3391 AND a.username = $user");
3395 # username can be a join quoted list of usernames
3398 my ($self, $username) = @_;
3399 $self->can_do("r_user_mgnt");
3402 DELETE FROM bweb_role_member
3406 WHERE username in ($username))");
3408 DELETE FROM bweb_client_group_acl
3412 WHERE username IN ($username))");
3419 $self->can_do("r_user_mgnt");
3421 my $arg = $self->get_form(qw/jusernames/);
3423 unless ($arg->{jusernames}) {
3424 return $self->error("Can't get user");
3427 $self->{dbh}->begin_work();
3429 $self->revoke_all($arg->{jusernames});
3431 DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
3433 $self->{dbh}->commit();
3435 $self->display_users();
3441 $self->can_do("r_user_mgnt");
3443 # we don't quote username directly to check that it is conform
3444 my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate
3445 lang qcopy_username jclient_groups/) ;
3447 if (not $arg->{qcreate}) {
3448 $arg = $self->get_form(qw/db_roles db_usernames db_client_groups/);
3449 $self->display($arg, "display_user.tpl");
3453 my $u = $self->dbh_quote($arg->{username});
3455 $arg->{use_acl}=(CGI::param('use_acl')?'true':'false');
3457 if (!$arg->{qpasswd}) {
3458 $arg->{qpasswd} = "''";
3460 if (!$arg->{qcomment}) {
3461 $arg->{qcomment} = "''";
3464 # will fail if user already exists
3465 # UPDATE with mysql dbi does not return if update is ok
3468 SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment},
3469 use_acl=$arg->{use_acl}, tpl='$arg->{lang}'
3470 WHERE username = $u")
3471 # and (! $self->dbh_is_mysql() )
3474 INSERT INTO bweb_user (username, passwd, use_acl, comment, tpl)
3475 VALUES ($u, $arg->{qpasswd}, $arg->{use_acl},
3476 $arg->{qcomment}, '$arg->{lang}')");
3478 $self->{dbh}->begin_work();
3480 $self->revoke_all($u);
3482 if ($arg->{qcopy_username}) {
3483 $self->grant_like($arg->{qcopy_username}, $u);
3485 $self->grant($arg->{jrolenames}, $u);
3488 if ($arg->{jclient_groups}) {
3490 INSERT INTO bweb_client_group_acl (client_group_id, userid)
3491 SELECT client_group_id, userid
3492 FROM client_group, bweb_user
3493 WHERE client_group_name IN ($arg->{jclient_groups})
3498 $self->{dbh}->commit();
3500 $self->display_users();
3503 # TODO: we miss a matrix with all user/roles
3507 $self->can_do("r_user_mgnt");
3509 my $arg = $self->get_form(qw/db_usernames/) ;
3511 if ($self->{dbh}->errstr) {
3512 return $self->error("Can't use users with bweb, read INSTALL to enable them");
3515 $self->display({ ID => $cur_id++,
3517 "display_users.tpl");
3523 $self->can_do("r_user_mgnt");
3525 my $arg = $self->get_form('username');
3526 my $user = $self->dbh_quote($arg->{username});
3528 my $userp = $self->dbh_selectrow_hashref("
3529 SELECT username, passwd, comment, use_acl, tpl
3531 WHERE username = $user
3534 return $self->error("Can't find $user in catalog");
3536 my $filter = $self->get_client_group_filter($arg->{username});
3537 my $scg = $self->dbh_selectall_hashref("
3538 SELECT client_group_name AS name
3539 FROM client_group $filter
3543 #------------+--------
3548 my $role = $self->dbh_selectall_hashref("
3549 SELECT rolename, max(here) AS userid FROM (
3550 SELECT rolename, 1 AS here
3552 JOIN bweb_role_member USING (userid)
3553 JOIN bweb_role USING (roleid)
3554 WHERE username = $user
3559 GROUP by rolename", 'rolename');
3561 $arg = $self->get_form(qw/db_usernames db_client_groups/);
3564 db_usernames => $arg->{db_usernames},
3565 username => $userp->{username},
3566 comment => $userp->{comment},
3567 passwd => $userp->{passwd},
3568 lang => $userp->{tpl},
3569 use_acl => $userp->{use_acl},
3570 db_client_groups => $arg->{db_client_groups},
3571 client_group => [ values %$scg ],
3572 db_roles => [ values %$role],
3573 }, "display_user.tpl");
3577 ###########################################################
3579 sub get_media_max_size
3581 my ($self, $type) = @_;
3583 "SELECT avg(VolBytes) AS size
3585 WHERE Media.VolStatus = 'Full'
3586 AND Media.MediaType = '$type'
3589 my $res = $self->selectrow_hashref($query);
3592 return $res->{size};
3602 my $media = $self->get_form('qmedia');
3604 unless ($media->{qmedia}) {
3605 return $self->error("Can't get media");
3609 SELECT Media.Slot AS slot,
3610 PoolMedia.Name AS poolname,
3611 Media.VolStatus AS volstatus,
3612 Media.InChanger AS inchanger,
3613 Location.Location AS location,
3614 Media.VolumeName AS volumename,
3615 Media.MaxVolBytes AS maxvolbytes,
3616 Media.MaxVolJobs AS maxvoljobs,
3617 Media.MaxVolFiles AS maxvolfiles,
3618 Media.VolUseDuration AS voluseduration,
3619 Media.VolRetention AS volretention,
3620 Media.Comment AS comment,
3621 PoolRecycle.Name AS poolrecycle,
3622 Media.Enabled AS enabled
3624 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
3625 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
3626 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
3628 WHERE Media.VolumeName = $media->{qmedia}
3631 my $row = $self->dbh_selectrow_hashref($query);
3632 $row->{volretention} = human_sec($row->{volretention});
3633 $row->{voluseduration} = human_sec($row->{voluseduration});
3634 $row->{enabled} = human_enabled($row->{enabled});
3636 my $elt = $self->get_form(qw/db_pools db_locations/);
3641 }, "update_media.tpl");
3647 $self->can_do('r_media_mgnt');
3649 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
3651 unless ($arg->{jmedias}) {
3652 return $self->error("Can't get selected media");
3655 unless ($arg->{qnewlocation}) {
3656 return $self->error("Can't get new location");
3661 SET LocationId = (SELECT LocationId
3663 WHERE Location = $arg->{qnewlocation})
3664 WHERE Media.VolumeName IN ($arg->{jmedias})
3667 my $nb = $self->dbh_do($query);
3669 print "$nb media updated, you may have to update your autochanger.";
3671 $self->display_media();
3677 $self->can_do('r_media_mgnt');
3679 my $media = $self->get_selected_media_location();
3681 return $self->error("Can't get media selection");
3683 my $newloc = CGI::param('newlocation');
3685 my $user = CGI::param('user') || 'unknown';
3686 my $comm = CGI::param('comment') || '';
3687 $comm = $self->dbh_quote("$user: $comm");
3689 my $arg = $self->get_form('enabled');
3690 my $en = from_human_enabled($arg->{enabled});
3691 my $b = $self->get_bconsole();
3694 foreach my $vol (keys %$media) {
3696 INSERT INTO LocationLog (Date,Comment,MediaId,LocationId,NewEnabled,NewVolStatus)
3697 SELECT $self->{sql}->{NOW}, $comm, Media.MediaId, Location.LocationId,
3699 FROM Media, Location
3700 WHERE Media.VolumeName = '$vol'
3701 AND Location.Location = '$media->{$vol}->{location}'
3703 $self->dbh_do($query);
3704 $self->debug($query);
3705 $b->send_cmd("update volume=\"$vol\" enabled=$en");
3710 $q->param('action', 'update_location');
3711 my $url = $q->url(-full => 1, -query=>1);
3713 $self->display({ email => $self->{info}->{email_media},
3715 newlocation => $newloc,
3716 # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3717 media => [ values %$media ],
3719 "change_location.tpl");
3723 sub display_client_stats
3725 my ($self, %arg) = @_ ;
3726 $self->can_do('r_view_stat');
3728 my $client = $self->dbh_quote($arg{clientname});
3729 # get security filter
3730 my $filter = $self->get_client_filter();
3732 my ($limit, $label) = $self->get_limit(%arg);
3735 count(Job.JobId) AS nb_jobs,
3736 sum(Job.JobBytes) AS nb_bytes,
3737 sum(Job.JobErrors) AS nb_err,
3738 sum(Job.JobFiles) AS nb_files,
3739 Client.Name AS clientname
3740 FROM Job JOIN Client USING (ClientId) $filter
3742 Client.Name = $client
3744 GROUP BY Client.Name
3747 my $row = $self->dbh_selectrow_hashref($query);
3749 $row->{ID} = $cur_id++;
3750 $row->{label} = $label;
3751 $row->{grapharg} = "client";
3752 $row->{age} = $arg{age};
3754 $self->display($row, "display_client_stats.tpl");
3758 sub _display_group_stats
3760 my ($self, %arg) = @_ ;
3762 my $carg = $self->get_form(qw/qclient_group/);
3764 unless ($carg->{qclient_group}) {
3765 return $self->error("Can't get group");
3767 my $jobt = $self->get_stat_table();
3768 my ($limit, $label) = $self->get_limit(%arg);
3772 count(Job.JobId) AS nb_jobs,
3773 sum(Job.JobBytes) AS nb_bytes,
3774 sum(Job.JobErrors) AS nb_err,
3775 sum(Job.JobFiles) AS nb_files,
3776 client_group.client_group_name AS clientname
3778 JOIN Client USING (ClientId)
3779 JOIN client_group_member ON (Client.ClientId = client_group_member.ClientId)
3780 JOIN client_group USING (client_group_id)
3782 client_group.client_group_name = $carg->{qclient_group}
3784 GROUP BY client_group.client_group_name
3787 my $row = $self->dbh_selectrow_hashref($query);
3789 $row->{ID} = $cur_id++;
3790 $row->{label} = $label;
3791 $row->{grapharg} = "client_group";
3793 $self->display($row, "display_client_stats.tpl");
3796 # [ name, num, value, joberrors, nb_job ] =>
3798 # [ { name => 'ALL',
3799 # events => [ { num => 1, label => '2007-01',
3800 # value => 'T', title => 10 },
3801 # { num => 2, label => '2007-02',
3802 # value => 'R', title => 11 },
3805 # { name => 'Other',
3809 sub make_overview_tab
3811 my ($self, $q) = @_;
3812 my $ret = $self->dbh_selectall_arrayref($q);
3816 for my $elt (@$ret) {
3817 if ($cur_name and $cur_name ne $elt->[0]) { # order by name, num
3818 push @items, { name => $cur_name, events => $events};
3821 $cur_name = $elt->[0];
3823 { num => $elt->[1], status => $elt->[2],
3824 joberrors => $elt->[3], title => "$elt->[4] jobs", date => $elt->[5]};
3826 push @items, { name => $cur_name, events => $events};
3830 sub get_time_overview
3832 my ($self, $arg) = @_; # want since et age from get_form();
3833 my $type = $arg->{type} || 'day';
3834 if ($type =~ /^(day|week|hour|month)$/) {
3840 my $jobt = $self->get_stat_table();
3841 my $stime1 = $self->{sql}->{"STARTTIME_P" . $type}; # get 1, 2, 3, 4
3842 $stime1 =~ s/Job.StartTime/date/;
3843 my $stime2 = $self->{sql}->{"STARTTIME_" . $type}; # get 2007-01-03, 2007-01-23
3845 my ($limit, $label) = $self->get_limit('since' => $arg->{since},
3846 'age' => $arg->{age});
3847 return ($stime1, $stime2, $limit, $label, $jobt);
3850 # lu ma me je ve sa di
3851 # groupe1 v v x w v v v overview
3852 # |-- s1 v v v v v v v overview_zoom
3853 # |-- s2 v v x v v v v
3854 # `-- s3 v v v w v v v
3855 sub display_overview_zoom
3858 $self->can_do('r_view_stat');
3860 my $arg = $self->get_form(qw/jclient_groups age since type level/);
3861 $arg->{type} = $arg->{type} || 'day';
3863 if (!$arg->{jclient_groups}) {
3864 return $self->error("Can't get client_group selection");
3866 my ($filter2, undef) = $self->get_param(qw/level jobtype/);
3867 my ($stime1, $stime2, $limit, $label, $jobt) = $self->get_time_overview($arg);
3869 my $filter = $self->get_client_filter();
3871 SELECT name, $stime1 AS num,
3872 JobStatus AS value, joberrors, nb_job, date
3874 SELECT $stime2 AS date,
3875 Client.Name AS name,
3876 MAX(severity) AS severity,
3878 SUM(JobErrors) AS joberrors
3880 JOIN client_group_member USING (ClientId)
3881 JOIN client_group USING (client_group_id)
3882 JOIN Client USING (ClientId) $filter
3883 JOIN Status USING (JobStatus)
3884 WHERE client_group_name IN ($arg->{jclient_groups})
3885 AND JobStatus IN ('T', 'W', 'f', 'A', 'e', 'E')
3887 GROUP BY Client.Name, date
3888 ) AS sub JOIN Status USING (severity)
3891 my $items = $self->make_overview_tab($q);
3892 $self->display({label => $label,
3893 type => $arg->{type},
3894 action => "job;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client=",
3895 items => $items}, "overview.tpl");
3898 sub display_overview
3901 $self->can_do('r_view_stat');
3903 my $arg = $self->get_form(qw/jclient_groups age since type level/);
3904 $arg->{type} = $arg->{type} || 'day';
3905 my ($filter2, undef) = $self->get_param(qw/client_groups level jobtype/);
3906 my $filter3 = $self->get_client_group_filter();
3907 my ($stime1, $stime2, $filter1, $label, $jobt) = $self->get_time_overview($arg);
3910 SELECT name, $stime1 AS num,
3911 Status.JobStatus AS value, joberrors, nb_job, date
3913 SELECT $stime2 AS date,
3914 client_group_name AS name,
3915 MAX(severity) AS severity,
3917 SUM(JobErrors) AS joberrors
3919 JOIN client_group_member USING (ClientId)
3920 JOIN client_group USING (client_group_id) $filter3
3921 JOIN Status USING (JobStatus)
3922 WHERE Job.JobStatus IN ('T', 'W', 'f', 'A', 'e', 'E')
3924 GROUP BY client_group_name, date
3925 ) AS sub JOIN Status USING (severity)
3928 my $items = $self->make_overview_tab($q);
3929 $self->display({label=>$label,
3930 type => $arg->{type},
3931 action => "overview_zoom;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client_group=",
3932 items => $items}, "overview.tpl");
3936 # poolname can be undef
3939 my ($self, $poolname) = @_ ;
3940 $self->can_do('r_view_media');
3945 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3946 if ($arg->{jmediatypes}) {
3947 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3948 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
3951 # TODO : afficher les tailles et les dates
3954 SELECT subq.volmax AS volmax,
3955 subq.volnum AS volnum,
3956 subq.voltotal AS voltotal,
3958 Pool.Recycle AS recycle,
3959 Pool.VolRetention AS volretention,
3960 Pool.VolUseDuration AS voluseduration,
3961 Pool.MaxVolJobs AS maxvoljobs,
3962 Pool.MaxVolFiles AS maxvolfiles,
3963 Pool.MaxVolBytes AS maxvolbytes,
3964 subq.PoolId AS PoolId,
3965 subq.MediaType AS mediatype,
3966 $self->{sql}->{CAT_POOL_TYPE} AS uniq
3969 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3970 count(Media.MediaId) AS volnum,
3971 sum(Media.VolBytes) AS voltotal,
3972 Media.PoolId AS PoolId,
3973 Media.MediaType AS MediaType
3975 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3976 Media.MediaType AS MediaType
3978 WHERE Media.VolStatus = 'Full'
3979 GROUP BY Media.MediaType
3980 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3981 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3983 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3987 my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3990 SELECT Pool.Name AS name,
3991 sum(VolBytes) AS size
3992 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3993 WHERE Media.VolStatus IN ('Recycled', 'Purged')
3997 my $empty = $self->dbh_selectall_hashref($query, 'name');
3999 foreach my $p (values %$all) {
4000 if ($p->{volmax} > 0) { # mysql returns 0.0000
4001 # we remove Recycled/Purged media from pool usage
4002 if (defined $empty->{$p->{name}}) {
4003 $p->{voltotal} -= $empty->{$p->{name}}->{size};
4005 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
4007 $p->{poolusage} = 0;
4011 SELECT VolStatus AS volstatus, count(MediaId) AS nb
4013 WHERE PoolId=$p->{poolid}
4014 AND Media.MediaType = '$p->{mediatype}'
4018 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
4019 foreach my $t (values %$content) {
4020 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
4025 $self->display({ ID => $cur_id++,
4026 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
4027 Pools => [ values %$all ]},
4028 "display_pool.tpl");
4031 # With this function, we get an estimation of next jobfiles/jobbytes count
4032 sub get_estimate_query
4034 my ($self, $mode, $job, $level) = @_;
4035 # get security filter
4036 my $filter = $self->get_client_filter();
4040 if ($self->dbh_is_mysql()) { # mysql doesn't have statistics functions
4042 SELECT jobname AS jobname,
4043 0.1 AS corr_jobbytes, AVG(jobbytes) AS jobbytes,
4044 COUNT(1) AS nb_jobbytes ";
4046 # postgresql have functions that permit to handle lineal regression
4048 # REGR_SLOPE(Y,X) = get x
4049 # REGR_INTERCEPT(Y,X) = get b
4050 # and we need y when x=now()
4051 # CORR gives the correlation
4052 # (TODO: display progress bar only if CORR > 0.8)
4055 SELECT temp.jobname AS jobname,
4056 COALESCE(CORR(jobbytes,jobtdate),0) AS corr_jobbytes,
4057 ($now*REGR_SLOPE(jobbytes,jobtdate)
4058 + REGR_INTERCEPT(jobbytes,jobtdate)) AS jobbytes,
4059 COUNT(1) AS nb_jobbytes ";
4061 # if it's a differential, we need to compare since the last full
4063 # F D D D F D D D F I I I I D I I I
4065 # | # # # # # # | # #
4066 # | # # # # # # # # | # # # # # # # # #
4067 # +----------------- +-------------------
4069 if ($level eq 'D') {
4071 AND Job.StartTime > (
4074 WHERE Job.Name = '$job'
4076 AND Job.JobStatus IN ('T', 'W')
4077 ORDER BY Job.StartTime DESC LIMIT 1
4084 SELECT Job.Name AS jobname,
4085 JobBytes AS jobbytes,
4086 JobTDate AS jobtdate
4087 FROM Job INNER JOIN Client USING (ClientId) $filter
4088 WHERE Job.Name = '$job'
4089 AND Job.Level = '$level'
4090 AND Job.JobStatus IN ('T', 'W')
4092 ORDER BY StartTime DESC
4094 ) AS temp GROUP BY temp.jobname
4097 if ($mode eq 'jobfiles') {
4098 $query =~ s/jobbytes/jobfiles/g;
4099 $query =~ s/JobBytes/JobFiles/g;
4104 sub display_running_job
4107 return if $self->cant_do('r_view_running_job');
4109 my $arg = $self->get_form('jobid');
4111 return $self->error("Can't get jobid") unless ($arg->{jobid});
4113 # get security filter
4114 my $filter = $self->get_client_filter();
4117 SELECT Client.Name AS name, Job.Name AS jobname,
4118 Job.Level AS level, Type AS type, JobStatus AS jobstatus
4119 FROM Job INNER JOIN Client USING (ClientId) $filter
4120 WHERE Job.JobId = $arg->{jobid}
4123 my $row = $self->dbh_selectrow_hashref($query);
4126 $arg->{client} = $row->{name};
4128 return $self->error("Can't get client");
4131 my $status = $row->{jobstatus};
4133 if ($status =~ /[TfAaEWD]/) {
4134 $self->display_job_zoom($arg->{jobid});
4135 $self->get_job_log();
4139 if ($row->{type} eq 'B') {
4140 # for jobfiles, we use only last Full backup. status client= returns
4141 # all files that have been checked
4142 my $query1 = $self->get_estimate_query('jobfiles', $row->{jobname}, 'F');
4143 my $query2 = $self->get_estimate_query('jobbytes',
4144 $row->{jobname}, $row->{level});
4146 # LEFT JOIN because we always have a previous Full
4148 SELECT corr_jobbytes, jobbytes, corr_jobfiles, jobfiles
4149 FROM ($query1) AS A LEFT JOIN ($query2) AS B USING (jobname)
4151 $row = $self->dbh_selectrow_hashref($query);
4154 $row->{jobbytes} = $row->{jobfiles} = 0;
4157 if ($status =~ /[RBSmMsjlL]/) {
4158 my $cli = new Bweb::Client(name => $arg->{client});
4159 $cli->display_running_job($self, $arg->{jobid}, $row);
4161 if ($arg->{jobid}) {
4162 $self->get_job_log();
4166 sub display_running_jobs
4168 my ($self, $display_action) = @_;
4169 return if $self->cant_do('r_view_running_job');
4171 # get security filter
4172 my $filter = $self->get_client_filter();
4175 SELECT Job.JobId AS jobid,
4176 Job.Name AS jobname,
4178 Job.StartTime AS starttime,
4179 Job.JobFiles AS jobfiles,
4180 Job.JobBytes AS jobbytes,
4181 Job.JobStatus AS jobstatus,
4182 $btime - Job.JobTDate AS duration,
4183 Client.Name AS clientname
4184 FROM Job INNER JOIN Client USING (ClientId) $filter
4186 JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
4188 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
4190 $self->display({ ID => $cur_id++,
4191 display_action => $display_action,
4192 Jobs => [ values %$all ]},
4193 "running_job.tpl") ;
4196 sub display_group_stats
4199 my $arg = $self->get_form('age', 'since');
4200 return if $self->cant_do('r_view_stat');
4202 my $filter = $self->get_client_group_filter();
4204 my $jobt = $self->get_stat_table();
4206 my ($limit, $label) = $self->get_limit(%$arg);
4207 my ($where, undef) = $self->get_param('client_groups', 'level');
4210 SELECT client_group_name AS name, nb_byte, nb_file, nb_job, nb_err, nb_resto
4213 SELECT sum(JobBytes) AS nb_byte,
4214 sum(JobFiles) AS nb_file,
4215 count(1) AS nb_job, client_group_name
4216 FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4217 JOIN client_group USING (client_group_id) $filter
4218 WHERE JobStatus IN ('T', 'W') AND Type IN ('M', 'B', 'g')
4220 GROUP BY client_group_name ORDER BY client_group_name
4224 SELECT count(1) AS nb_err, client_group_name
4225 FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4226 JOIN client_group USING (client_group_id)
4227 WHERE JobStatus IN ('E','e','f','A') AND Type = 'B'
4229 GROUP BY client_group_name ORDER BY client_group_name
4231 ) AS T3 USING (client_group_name) LEFT JOIN (
4233 SELECT count(1) AS nb_resto, client_group_name
4234 FROM $jobt AS Job JOIN client_group_member USING (ClientId)
4235 JOIN client_group USING (client_group_id)
4236 WHERE JobStatus IN ('T','W') AND Type = 'R'
4238 GROUP BY client_group_name ORDER BY client_group_name
4240 ) AS T2 USING (client_group_name)
4242 $self->debug($query);
4243 my $all = $self->dbh_selectall_hashref($query, 'name') ;
4246 $self->display({ ID => $cur_id++,
4248 Stats => [ values %$all ]},
4249 "display_stats.tpl") ;
4252 # return the autochanger list to update
4256 $self->can_do('r_media_mgnt');
4259 my $arg = $self->get_form('jmedias');
4261 unless ($arg->{jmedias}) {
4262 return $self->error("Can't get media selection");
4266 SELECT Media.VolumeName AS volumename,
4267 Storage.Name AS storage,
4268 Location.Location AS location,
4270 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
4271 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
4272 WHERE Media.VolumeName IN ($arg->{jmedias})
4273 AND Media.InChanger = 1
4276 my $all = $self->dbh_selectall_hashref($query, 'volumename');
4278 foreach my $vol (values %$all) {
4279 my $a = $self->ach_get($vol->{location});
4281 $ret{$vol->{location}} = 1;
4283 unless ($a->{have_status}) {
4285 $a->{have_status} = 1;
4288 print "eject $vol->{volumename} from $vol->{storage} : ";
4289 if ($a->send_to_io($vol->{slot})) {
4290 print "<img src='/bweb/T.png' alt='ok'><br/>";
4292 print "<img src='/bweb/E.png' alt='err'><br/>";
4302 my ($to, $subject, $content) = (CGI::param('email'),
4303 CGI::param('subject'),
4304 CGI::param('content'));
4305 $to =~ s/[^\w\d\.\@<>,]//;
4306 $subject =~ s/[^\w\d\.\[\]]/ /;
4308 open(MAIL, "|mail -s '$subject' '$to'") ;
4309 print MAIL $content;
4319 my $arg = $self->get_form('jobid', 'client');
4321 print CGI::header('text/brestore');
4322 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
4323 print "client=$arg->{client}\n" if ($arg->{client});
4324 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
4328 # TODO : move this to Bweb::Autochanger ?
4329 # TODO : make this internal to not eject tape ?
4335 $self->can_do('r_view_job');
4337 my $arg = $self->get_form(qw/limit offset jobid/);
4338 if (!$arg->{jobid}) {
4339 return $self->error("Can't get jobid");
4343 title => "Content of JobId $arg->{jobid} ",
4344 name => "list files jobid=$arg->{jobid}",
4349 my $b = new Bconsole(pref => $self->{info},timeout => 60);
4352 $b->send_cmd("list files jobid=$arg->{jobid} limit=$arg->{limit}"); # TODO: add offset
4361 my ($self, $name) = @_;
4364 return $self->error("Can't get your autochanger name ach");
4367 unless ($self->{info}->{ach_list}) {
4368 return $self->error("Could not find any autochanger");
4371 my $a = $self->{info}->{ach_list}->{$name};
4374 $self->error("Can't get your autochanger $name from your ach_list");
4379 $a->{debug} = $self->{debug};
4386 my ($self, $ach) = @_;
4387 $self->can_do('r_configure');
4389 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
4391 $self->{info}->save();
4399 $self->can_do('r_configure');
4401 my $arg = $self->get_form('ach');
4403 or !$self->{info}->{ach_list}
4404 or !$self->{info}->{ach_list}->{$arg->{ach}})
4406 return $self->error("Can't get autochanger name");
4409 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
4413 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
4415 my $b = $self->get_bconsole();
4417 my @storages = $b->list_storage() ;
4419 $ach->{devices} = [ map { { name => $_ } } @storages ];
4421 $self->display($ach, "ach_add.tpl");
4422 delete $ach->{drives};
4423 delete $ach->{devices};
4430 $self->can_do('r_configure');
4432 my $arg = $self->get_form('ach');
4435 or !$self->{info}->{ach_list}
4436 or !$self->{info}->{ach_list}->{$arg->{ach}})
4438 return $self->error("Can't get autochanger name");
4441 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
4443 $self->{info}->save();
4444 $self->{info}->view();
4450 $self->can_do('r_configure');
4452 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
4454 my $b = $self->get_bconsole();
4455 my @storages = $b->list_storage() ;
4457 unless ($arg->{ach}) {
4458 $arg->{devices} = [ map { { name => $_ } } @storages ];
4459 return $self->display($arg, "ach_add.tpl");
4463 foreach my $drive (CGI::param('drives'))
4465 unless (grep(/^$drive$/,@storages)) {
4466 return $self->error("Can't find $drive in storage list");
4469 my $index = CGI::param("index_$drive");
4470 unless (defined $index and $index =~ /^(\d+)$/) {
4471 return $self->error("Can't get $drive index");
4474 $drives[$index] = $drive;
4478 return $self->error("Can't get drives from Autochanger");
4481 my $a = new Bweb::Autochanger(name => $arg->{ach},
4482 precmd => $arg->{precmd},
4483 drive_name => \@drives,
4484 device => $arg->{device},
4485 mtxcmd => $arg->{mtxcmd});
4487 $self->ach_register($a) ;
4489 $self->{info}->view();
4495 $self->can_do('r_delete_job');
4497 my $arg = $self->get_form('jobid');
4499 if ($arg->{jobid}) {
4500 my $b = $self->get_bconsole();
4501 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
4505 title => "Delete a job ",
4506 name => "delete jobid=$arg->{jobid}",
4515 $self->can_do('r_media_mgnt');
4517 my $arg = $self->get_form(qw/media volstatus inchanger pool
4518 slot volretention voluseduration
4519 maxvoljobs maxvolfiles maxvolbytes
4520 qcomment poolrecycle enabled
4523 unless ($arg->{media}) {
4524 return $self->error("Can't find media selection");
4527 my $update = "update volume=$arg->{media} ";
4529 if ($arg->{volstatus}) {
4530 $update .= " volstatus=$arg->{volstatus} ";
4533 if ($arg->{inchanger}) {
4534 $update .= " inchanger=yes " ;
4536 $update .= " slot=$arg->{slot} ";
4539 $update .= " slot=0 inchanger=no ";
4542 if ($arg->{enabled}) {
4543 $update .= " enabled=$arg->{enabled} ";
4547 $update .= " pool=$arg->{pool} " ;
4550 if (defined $arg->{volretention}) {
4551 $update .= " volretention=\"$arg->{volretention}\" " ;
4554 if (defined $arg->{voluseduration}) {
4555 $update .= " voluse=\"$arg->{voluseduration}\" " ;
4558 if (defined $arg->{maxvoljobs}) {
4559 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
4562 if (defined $arg->{maxvolfiles}) {
4563 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
4566 if (defined $arg->{maxvolbytes}) {
4567 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
4570 if (defined $arg->{poolrecycle}) {
4571 $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
4574 my $b = $self->get_bconsole();
4577 content => $b->send_cmd($update),
4578 title => "Update a volume ",
4586 my $media = $self->dbh_quote($arg->{media});
4588 my $loc = CGI::param('location') || '';
4590 $loc = $self->dbh_quote($loc); # is checked by db
4591 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
4593 if (!$arg->{qcomment}) {
4594 $arg->{qcomment} = "''";
4596 push @q, "Comment=$arg->{qcomment}";
4601 SET " . join (',', @q) . "
4602 WHERE Media.VolumeName = $media
4604 $self->dbh_do($query);
4606 $self->update_media();
4612 $self->can_do('r_autochanger_mgnt');
4614 my $ach = CGI::param('ach') ;
4615 $ach = $self->ach_get($ach);
4617 return $self->error("Bad autochanger name");
4621 title => "Scanning autochanger content ",
4622 name => "update slots",
4626 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
4627 $b->update_slots($ach->{name});
4637 $self->can_do('r_view_log');
4639 my $arg = $self->get_form('jobid', 'limit', 'offset');
4640 unless ($arg->{jobid}) {
4641 return $self->error("Can't get jobid");
4644 if ($arg->{limit} == 100) {
4645 $arg->{limit} = 1000;
4647 # get security filter
4648 my $filter = $self->get_client_filter();
4651 SELECT Job.Name as name, Client.Name as clientname
4652 FROM Job INNER JOIN Client USING (ClientId) $filter
4653 WHERE JobId = $arg->{jobid}
4656 my $row = $self->dbh_selectrow_hashref($query);
4659 return $self->error("Can't find $arg->{jobid} in catalog");
4662 # display only Error and Warning messages
4664 if (CGI::param('error')) {
4665 $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning|ERR=' ";
4669 if (CGI::param('time') || $self->{info}->{display_log_time}) {
4670 $logtext = $self->dbh_strcat('Time', " ' ' ", 'LogText');
4672 $logtext = 'LogText';
4676 SELECT count(1) AS nbline,
4677 GROUP_CONCAT($logtext $self->{sql}->{CONCAT_SEP}) AS logtxt, id
4679 SELECT 1 AS id, Time, LogText
4681 WHERE ( Log.JobId = $arg->{jobid}
4683 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
4684 AND Time <= (SELECT COALESCE(EndTime,$self->{sql}->{NOW})
4685 FROM Job WHERE JobId=$arg->{jobid})
4689 OFFSET $arg->{offset}
4695 my $log = $self->dbh_selectrow_hashref($query);
4697 return $self->error("Can't get log for jobid $arg->{jobid}, check that
4698 your 'Messages' resources include 'catalog = all' and you loaded Bweb SQL
4699 functions in your Catalog.");
4701 $log->{logtxt} =~ s/(\0|\\,)//g;
4702 $self->display({ lines=> $log->{logtxt},
4703 nbline => $log->{nbline},
4704 jobid => $arg->{jobid},
4705 name => $row->{name},
4706 client => $row->{clientname},
4707 offset => $arg->{offset},
4708 limit => $arg->{limit},
4709 }, 'display_log.tpl');
4712 sub cancel_future_job
4715 $self->can_do('r_cancel_job');
4717 my $arg = $self->get_form(qw/job pool level client when/);
4719 if ( !$arg->{job} or !$arg->{pool} or !$arg->{level}
4720 or !$arg->{client} or !$arg->{when})
4722 return $self->error("Can't get enough information to mark this job as canceled");
4725 $arg->{level} =~ s/^(.).+/$1/; # we keep the first letter
4726 my $jobtable = $self->{info}->{stat_job_table} || 'JobHisto';
4728 if ($jobtable =~ /^Job$/i) {
4729 return $self->error("Can add records only in history table");
4731 my $jname = "$arg->{job}.$arg->{when}";
4734 my $found = $self->dbh_selectrow_hashref("
4739 AND Name = '$arg->{job}'
4742 return $self->error("$jname is already in history table");
4746 INSERT INTO $jobtable
4747 (JobId, Name, Job, Type, Level, JobStatus, SchedTime, StartTime, EndTime,
4748 RealEndTime, ClientId, PoolId)
4750 (0, '$arg->{job}', '$jname', 'B', '$arg->{level}', 'A',
4751 '$arg->{when}', '$arg->{when}', '$arg->{when}', '$arg->{when}',
4752 (SELECT ClientId FROM Client WHERE Name = '$arg->{client}'),
4753 (SELECT PoolId FROM Pool WHERE Name = '$arg->{pool}')
4756 $self->display({ Filter => "Dummy record for $jname",
4760 client => $arg->{client},
4761 jobname => $arg->{job},
4762 pool => $arg->{pool},
4763 level => $arg->{level},
4764 starttime => $arg->{when},
4778 $self->can_do('r_media_mgnt');
4779 my $arg = $self->get_form('storage', 'pool', 'nb', 'media', 'offset');
4780 my $b = $self->get_bconsole();
4782 if (!$arg->{storage} || !$arg->{pool} || not defined $arg->{nb} || !$arg->{media} || !$arg->{offset}) {
4783 CGI::param(offset => 0);
4784 $arg = $self->get_form('db_pools');
4785 $arg->{storage} = [ map { { name => $_ } }$b->list_storage()];
4786 $self->display($arg, 'add_media.tpl');
4790 $b->send("add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n");
4791 if ($arg->{nb} > 0) {
4792 $arg->{offset} = $arg->{offset}?$arg->{offset}:1;
4793 $b->send("$arg->{nb}\n");
4794 $b->send("$arg->{media}\n");
4795 $b->send("$arg->{offset}\n");
4799 $b->send("$arg->{media}\n");
4804 #$b->expect_it('-re','^[*]');
4806 CGI::param('media', '');
4807 CGI::param('re_media', $arg->{media});
4808 $self->display_media();
4814 $self->can_do('r_autochanger_mgnt');
4816 my $arg = $self->get_form('ach', 'slots', 'drive', 'pool');
4818 unless ($arg->{ach}) {
4819 return $self->error("Can't find autochanger name");
4822 my $a = $self->ach_get($arg->{ach});
4824 return $self->error("Can't find autochanger name in configuration");
4827 my $storage = $a->get_drive_name($arg->{drive});
4829 return $self->error("Can't get your drive name");
4835 if ($arg->{slots}) {
4836 $slots = join(",", @{ $arg->{slots} });
4837 $slots_sql = " AND Slot IN ($slots) ";
4838 $t += 60*scalar( @{ $arg->{slots} }) ;
4840 my $pool = $arg->{pool} || 'Scratch';
4841 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
4842 print "<h1>This command can take long time, be patient...</h1>";
4844 $b->label_barcodes(storage => $storage,
4845 drive => $arg->{drive},
4853 SET LocationId = (SELECT LocationId
4855 WHERE Location = '$arg->{ach}')
4857 WHERE (LocationId = 0 OR LocationId IS NULL)
4866 $self->can_do('r_purge');
4868 my @volume = CGI::param('media');
4871 return $self->error("Can't get media selection");
4874 my $b = $self->get_bconsole(timeout => 60);
4876 foreach my $v (@volume) {
4878 content => $b->purge_volume($v),
4879 title => "Purge media",
4880 name => "purge volume=$v",
4890 $self->can_do('r_prune');
4892 my @volume = CGI::param('media');
4894 return $self->error("Can't get media selection");
4897 my $b = $self->get_bconsole(timeout => 60);
4899 foreach my $v (@volume) {
4901 content => $b->prune_volume($v),
4902 title => "Prune volume",
4903 name => "prune volume=$v",
4913 $self->can_do('r_cancel_job');
4915 my $arg = $self->get_form('jobid');
4916 unless ($arg->{jobid}) {
4917 return $self->error("Can't get jobid");
4920 my $b = $self->get_bconsole();
4922 content => $b->cancel($arg->{jobid}),
4923 title => "Cancel job",
4924 name => "cancel jobid=$arg->{jobid}",
4931 # Warning, we display current fileset
4934 my $arg = $self->get_form('fileset');
4936 if ($arg->{fileset}) {
4937 my $b = $self->get_bconsole();
4938 my $ret = $b->get_fileset($arg->{fileset});
4939 $self->display({ fileset => $arg->{fileset},
4941 }, "fileset_view.tpl");
4943 $self->error("Can't get fileset name");
4947 sub director_show_sched
4950 $self->can_do('r_view_job');
4951 my $arg = $self->get_form('days');
4953 my $b = $self->get_bconsole();
4954 my $ret = $b->director_get_sched( $arg->{days} );
4959 }, "scheduled_job.tpl");
4962 sub enable_disable_job
4964 my ($self, $what) = @_ ;
4965 $self->can_do('r_run_job');
4967 my $arg = $self->get_form('job');
4969 return $self->error("Can't find job name");
4972 my $b = $self->get_bconsole();
4982 content => $b->send_cmd("$cmd job=\"$arg->{job}\""),
4983 title => "$cmd $arg->{job}",
4984 name => "$cmd job=\"$arg->{job}\"",
4991 my ($self, $lang) = @_;
4992 $self->{current_lang} = $lang;
4997 my ($self, @opts) = @_;
4998 return new Bconsole(pref => $self->{info}, @opts);
5004 $self->can_do('r_storage_mgnt');
5005 my $arg = $self->get_form(qw/storage storage_cmd drive slot/);
5006 my $b = $self->get_bconsole();
5008 if ($arg->{storage} and $arg->{storage_cmd}) {
5009 my $cmd = "$arg->{storage_cmd} storage=\"$arg->{storage}\" drive=$arg->{drive} slot=$arg->{slot}";
5010 my $ret = $b->send_cmd($cmd);
5014 title => "Storage ",
5019 my $storages= [ map { { name => $_ } } $b->list_storage()];
5020 $self->display({ storage => $storages}, "cmd_storage.tpl");
5027 $self->can_do('r_run_job');
5029 my $b = $self->get_bconsole();
5031 my $joblist = [ map { { name => $_ } } $b->list_backup() ];
5033 $self->display({ Jobs => $joblist }, "run_job.tpl");
5038 my ($self, $ouput) = @_;
5041 $self->debug($ouput);
5042 foreach my $l (split(/\r?\n/, $ouput)) {
5044 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
5050 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
5056 foreach my $k (keys %arg) {
5057 $lowcase{lc($k)} = $arg{$k} ;
5059 $self->debug(\%lowcase);
5066 $self->can_do('r_run_job');
5068 my $b = $self->get_bconsole();
5069 my $arg = $self->get_form(qw/pool level client fileset storage media job comment/);
5072 return $self->error("Can't get job name");
5075 # we take informations from director, and we overwrite with user wish
5076 my $info = $b->send_cmd("show job=\"$arg->{job}\"");
5077 my $attr = $self->run_parse_job($info);
5079 if (!$arg->{pool} and $arg->{media}) {
5080 my $r = $self->dbh_selectrow_hashref("
5081 SELECT Pool.Name AS name
5082 FROM Media JOIN Pool USING (PoolId)
5083 WHERE Media.VolumeName = '$arg->{media}'
5084 AND Pool.Name != 'Scratch'
5087 $arg->{pool} = $r->{name};
5091 my %job_opt = (%$attr, %$arg);
5093 my $jobs = [ map {{ name => $_ }} $b->list_backup() ];
5095 my $pools = [ map { { name => $_ } } $b->list_pool() ];
5096 my $clients = [ map { { name => $_ } }$b->list_client()];
5097 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
5098 my $storages= [ map { { name => $_ } }$b->list_storage()];
5103 clients => $clients,
5104 filesets => $filesets,
5105 storages => $storages,
5107 }, "run_job_mod.tpl");
5113 $self->can_do('r_run_job');
5115 my $b = $self->get_bconsole();
5117 my $jobs = [ map {{ name => $_ }} $b->list_backup() ];
5119 return $self->error("Bconsole returns an error, check your setup. ERR=$b->{error}");
5129 $self->can_do('r_run_job');
5131 my $b = $self->get_bconsole();
5133 # TODO: check input (don't use pool, level)
5135 my $arg = $self->get_form(qw/pool level client priority when
5136 fileset job storage comment/);
5138 return $self->error("Can't get your job name");
5141 my $jobid = $b->run(job => $arg->{job},
5142 client => $arg->{client},
5143 priority => $arg->{priority},
5144 level => $arg->{level},
5145 storage => $arg->{storage},
5146 pool => $arg->{pool},
5147 fileset => $arg->{fileset},
5148 when => $arg->{when},
5149 comment => $arg->{comment}
5154 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>";
5157 sub display_next_job
5161 my $arg = $self->get_form(qw/job begin end/);
5163 return $self->error("Can't get job name");
5166 my $b = $self->get_bconsole();
5168 my $job = $b->send_cmd("show job=\"$arg->{job}\"");
5169 my $attr = $self->run_parse_job($job);
5171 if (!$attr->{schedule}) {
5172 return $self->error("Can't get $arg->{job} schedule");
5174 my $jpool=$attr->{pool} || '';
5176 my $sched = new Bweb::Sched(bconsole => $b, name => $attr->{schedule},
5177 begin => $arg->{begin}, end => $arg->{end});
5179 my $ss = $sched->get_scheds($attr->{schedule});
5182 foreach my $s (@$ss) {
5183 my $level = $sched->get_level($s);
5184 my $pool = $sched->get_pool($s) || $jpool;
5185 my $evt = $sched->get_event($s);
5186 push @ret, map { "$_ : $pool ($level)\n" } @$evt;
5189 print "<b>$arg->{job}:</b><pre>", sort @ret, "</pre><br>";
5192 # permit to verify for higher level backup
5193 # we attempt a Increment, we made a Full, that ok
5194 # TODO: Pool may have change
5195 sub get_higher_level
5197 my ($self, $level) = @_;
5198 if ($level eq 'F') {
5200 } elsif ($level eq 'D') {
5202 } elsif ($level eq 'I') {
5203 return "'F', 'D', 'I'";
5208 # check jobs against their schedule
5211 my ($self, $sched, $schedname, $job, $job_pool, $client, $type) = @_;
5212 return undef if (!$self->can_view_client($client));
5214 $self->debug("checking $job, $job_pool, $client, $type, $schedname");
5216 my $sch = $sched->get_scheds($schedname);
5217 return undef if (!$sch);
5220 foreach my $s (@$sch) {
5222 if ($type eq 'B') { # we take the pool only for backup job
5223 $pool = $sched->get_pool($s) || $job_pool;
5225 my $level = $sched->get_level($s);
5226 my ($l) = ($level =~ m/^(.)/); # we keep the first letter
5227 $l = $self->get_higher_level($l);
5228 my $evts = $sched->get_event($s);
5229 my $end = $sched->{end}; # this backup must have start before the next one
5230 foreach my $evt (reverse @$evts) {
5231 my $all = $self->dbh_selectrow_hashref("
5234 JOIN Client USING (ClientId) LEFT JOIN Pool USING (PoolId)
5235 WHERE Job.StartTime >= '$evt'
5236 AND Job.StartTime < '$end'
5237 AND Job.Name = '$job'
5238 AND Job.Type = '$type'
5239 AND Job.JobStatus IN ('T', 'W')
5240 AND Job.Level IN ($l)
5241 " . ($pool?" AND Pool.Name = '$pool' ":'') . "
5242 AND Client.Name = '$client'
5246 $self->debug("found job record for $job on $client");
5248 push @{$self->{tmp}}, {date => $evt, level => $level,
5249 type => 'Backup', name => $job,
5250 pool => $pool, volume => $pool,
5258 sub display_missing_job
5261 my $arg = $self->get_form(qw/begin end age/);
5263 if (!$arg->{begin}) { # TODO: change this
5264 $arg->{begin} = strftime('%F %T', localtime($btime - $arg->{age}));
5267 $arg->{end} = strftime('%F %T', localtime($btime));
5269 $self->{tmp} = []; # check_job use this for result
5271 my $bconsole = $self->get_bconsole();
5273 my $sched = new Bweb::Sched(bconsole => $bconsole,
5274 begin => $arg->{begin},
5275 end => $arg->{end});
5276 $self->debug($sched);
5277 my $job = $bconsole->send_cmd("show job");
5278 my ($jname, $jsched, $jclient, $jpool, $jtype);
5279 foreach my $j (split(/\r?\n/, $job)) {
5280 if ($j =~ /Job: name=([\w\d\-]+?) JobType=(\d+)/i) {
5281 if ($jname and $jsched) {
5282 $self->check_job($sched, $jsched, $jname,
5283 $jpool, $jclient, $jtype);
5287 $jclient = $jpool = $jsched = undef;
5288 } elsif ($j =~ /Client: name=(.+?) address=/i) {
5290 } elsif ($j =~ /Pool: name=([\w\d\-]+) PoolType=/i) {
5292 } elsif ($j =~ /Schedule: name=([\w\d\-]+)/i) {
5298 title => "Missing Jobs (from $arg->{begin} to $arg->{end})",
5299 list => $self->{tmp},
5300 wiki_url => $self->{info}->{wiki_url},
5302 }, "scheduled_job.tpl");
5304 delete $self->{tmp};