1 ################################################################
6 Bweb - A Bacula web interface
7 Bacula® - The Network Backup Solution
9 Copyright (C) 2000-2007 Free Software Foundation Europe e.V.
11 The main author of Bweb is Eric Bollengier.
12 The main author of Bacula is Kern Sibbald, with contributions from
13 many others, a complete list can be found in the file AUTHORS.
15 This program is Free Software; you can redistribute it and/or
16 modify it under the terms of version two of the GNU General Public
17 License as published by the Free Software Foundation plus additions
18 that are listed in the file LICENSE.
20 This program is distributed in the hope that it will be useful, but
21 WITHOUT ANY WARRANTY; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 General Public License for more details.
25 You should have received a copy of the GNU General Public License
26 along with this program; if not, write to the Free Software
27 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
30 Bacula® is a registered trademark of John Walker.
31 The licensor of Bacula is the Free Software Foundation Europe
32 (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
33 Switzerland, email:ftf@fsfeurope.org.
45 Bweb::Gui - Base package for all Bweb object
49 This package define base fonction like new, display, etc..
54 our $template_dir='/usr/share/bweb/tpl';
58 new - creation a of new Bweb object
62 This function take an hash of argument and place them
65 IE : $obj = new Obj(name => 'test', age => '10');
67 $obj->{name} eq 'test' and $obj->{age} eq 10
73 my ($class, %arg) = @_;
78 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
85 my ($self, $what) = @_;
89 print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
91 print "<pre>$what</pre>";
98 error - display an error to the user
102 this function set $self->{error} with arg, display a message with
103 error.tpl and return 0
108 return $self->error("Can't use this file");
115 my ($self, $what) = @_;
116 $self->{error} = $what;
117 $self->display($self, 'error.tpl');
123 display - display an html page with HTML::Template
127 this function is use to render all html codes. it takes an
128 ref hash as arg in which all param are usable in template.
130 it will use global template_dir to search the template file.
132 hash keys are not sensitive. See HTML::Template for more
133 explanations about the hash ref. (it's can be quiet hard to understand)
137 $ref = { name => 'me', age => 26 };
138 $self->display($ref, "people.tpl");
144 my ($self, $hash, $tpl) = @_ ;
146 my $template = HTML::Template->new(filename => $tpl,
147 path =>[$template_dir],
148 die_on_bad_params => 0,
149 case_sensitive => 0);
151 foreach my $var (qw/limit offset/) {
153 unless ($hash->{$var}) {
154 my $value = CGI::param($var) || '';
156 if ($value =~ /^(\d+)$/) {
157 $template->param($var, $1) ;
162 $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
163 $template->param('loginname', CGI::remote_user());
165 $template->param($hash);
166 print $template->output();
170 ################################################################
172 package Bweb::Config;
174 use base q/Bweb::Gui/;
178 Bweb::Config - read, write, display, modify configuration
182 this package is used for manage configuration
186 $conf = new Bweb::Config(config_file => '/path/to/conf');
197 =head1 PACKAGE VARIABLE
199 %k_re - hash of all acceptable option.
203 this variable permit to check all option with a regexp.
207 our %k_re = ( dbi => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
208 user => qr/^([\w\d\.-]+)$/i,
209 password => qr/^(.*)$/i,
210 fv_write_path => qr!^([/\w\d\.-]*)$!,
211 template_dir => qr!^([/\w\d\.-]+)$!,
212 debug => qr/^(on)?$/,
213 email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
214 graph_font => qr!^([/\w\d\.-]+.ttf)$!,
215 bconsole => qr!^(.+)?$!,
216 syslog_file => qr!^(.+)?$!,
217 log_dir => qr!^(.+)?$!,
218 stat_job_table => qr!^(\w*)$!,
219 display_log_time => qr!^(on)?$!,
220 enable_security => qr/^(on)?$/,
221 enable_security_acl => qr/^(on)?$/,
226 load - load config_file
230 this function load the specified config_file.
238 unless (open(FP, $self->{config_file}))
240 return $self->error("can't load config_file $self->{config_file} : $!");
242 my $f=''; my $tmpbuffer;
243 while(read FP,$tmpbuffer,4096)
251 no strict; # I have no idea of the contents of the file
258 return $self->error("If you update from an old bweb install, your must reload this page and if it's fail again, you have to configure bweb again...") ;
261 foreach my $k (keys %$VAR1) {
262 $self->{$k} = $VAR1->{$k};
270 load_old - load old configuration format
278 unless (open(FP, $self->{config_file}))
280 return $self->error("$self->{config_file} : $!");
283 while (my $line = <FP>)
286 my ($k, $v) = split(/\s*=\s*/, $line, 2);
298 save - save the current configuration to config_file
306 if ($self->{ach_list}) {
307 # shortcut for display_begin
308 $self->{achs} = [ map {{ name => $_ }}
309 keys %{$self->{ach_list}}
313 unless (open(FP, ">$self->{config_file}"))
315 return $self->error("$self->{config_file} : $!\n" .
316 "You must add this to your config file\n"
317 . Data::Dumper::Dumper($self));
320 print FP Data::Dumper::Dumper($self);
328 edit, view, modify - html form ouput
336 $self->display($self, "config_edit.tpl");
342 $self->display($self, "config_view.tpl");
350 # we need to reset checkbox first
352 $self->{display_log_time} = 0;
353 $self->{enable_security} = 0;
354 $self->{enable_security_acl} = 0;
356 foreach my $k (CGI::param())
358 next unless (exists $k_re{$k}) ;
359 my $val = CGI::param($k);
360 if ($val =~ $k_re{$k}) {
363 $self->{error} .= "bad parameter : $k = [$val]";
369 if ($self->{error}) { # an error as occured
370 $self->display($self, 'error.tpl');
378 ################################################################
380 package Bweb::Client;
382 use base q/Bweb::Gui/;
386 Bweb::Client - Bacula FD
390 this package is use to do all Client operations like, parse status etc...
394 $client = new Bweb::Client(name => 'zog-fd');
395 $client->status(); # do a 'status client=zog-fd'
401 display_running_job - Html display of a running job
405 this function is used to display information about a current job
409 sub display_running_job
411 my ($self, $conf, $jobid) = @_ ;
413 my $status = $self->status($conf);
416 if ($status->{$jobid}) {
417 $self->display($status->{$jobid}, "client_job_status.tpl");
420 for my $id (keys %$status) {
421 $self->display($status->{$id}, "client_job_status.tpl");
428 $client = new Bweb::Client(name => 'plume-fd');
430 $client->status($bweb);
434 dirty hack to parse "status client=xxx-fd"
438 JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
439 Backup Job started: 06-jun-06 17:22
440 Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
441 Files Examined=10,697
442 Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
448 JobName => Full_plume.2006-06-06_17.22.23,
451 Bytes => 194,484,132,
461 my ($self, $conf) = @_ ;
463 if (defined $self->{cur_jobs}) {
464 return $self->{cur_jobs} ;
468 my $b = new Bconsole(pref => $conf);
469 my $ret = $b->send_cmd("st client=$self->{name}");
473 for my $r (split(/\n/, $ret)) {
475 $r =~ s/(^\s+|\s+$)//g;
476 if ($r =~ /JobId (\d+) Job (\S+)/) {
478 $arg->{$jobid} = { @param, JobId => $jobid } ;
482 @param = ( JobName => $2 );
484 } elsif ($r =~ /=.+=/) {
485 push @param, split(/\s+|\s*=\s*/, $r) ;
487 } elsif ($r =~ /=/) { # one per line
488 push @param, split(/\s*=\s*/, $r) ;
490 } elsif ($r =~ /:/) { # one per line
491 push @param, split(/\s*:\s*/, $r, 2) ;
495 if ($jobid and @param) {
496 $arg->{$jobid} = { @param,
498 Client => $self->{name},
502 $self->{cur_jobs} = $arg ;
508 ################################################################
510 package Bweb::Autochanger;
512 use base q/Bweb::Gui/;
516 Bweb::Autochanger - Object to manage Autochanger
520 this package will parse the mtx output and manage drives.
524 $auto = new Bweb::Autochanger(precmd => 'sudo');
526 $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
530 $auto->slot_is_full(10);
531 $auto->transfer(10, 11);
537 my ($class, %arg) = @_;
540 name => '', # autochanger name
541 label => {}, # where are volume { label1 => 40, label2 => drive0 }
542 drive => [], # drive use [ 'media1', 'empty', ..]
543 slot => [], # slot use [ undef, 'empty', 'empty', ..] no slot 0
544 io => [], # io slot number list [ 41, 42, 43...]
545 info => {slot => 0, # informations (slot, drive, io)
549 mtxcmd => '/usr/sbin/mtx',
551 device => '/dev/changer',
552 precmd => '', # ssh command
553 bweb => undef, # link to bacula web object (use for display)
556 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
563 status - parse the output of mtx status
567 this function will launch mtx status and parse the output. it will
568 give a perlish view of the autochanger content.
570 it uses ssh if the autochanger is on a other host.
577 my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
579 # TODO : reset all infos
580 $self->{info}->{drive} = 0;
581 $self->{info}->{slot} = 0;
582 $self->{info}->{io} = 0;
584 #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
587 # Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
588 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
589 #Data Transfer Element 1:Empty
590 # Storage Element 1:Empty
591 # Storage Element 2:Full :VolumeTag=000002
592 # Storage Element 3:Empty
593 # Storage Element 4:Full :VolumeTag=000004
594 # Storage Element 5:Full :VolumeTag=000001
595 # Storage Element 6:Full :VolumeTag=000003
596 # Storage Element 7:Empty
597 # Storage Element 41 IMPORT/EXPORT:Empty
598 # Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
603 # Storage Element 7:Empty
604 # Storage Element 2:Full :VolumeTag=000002
605 if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
608 $self->set_empty_slot($1);
610 $self->set_slot($1, $4);
613 } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
616 $self->set_empty_drive($1);
618 $self->set_drive($1, $4, $6);
621 } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
624 $self->set_empty_io($1);
626 $self->set_io($1, $4);
629 # Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
631 } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
632 $self->{info}->{drive} = $1;
633 $self->{info}->{slot} = $2;
634 if ($l =~ /(\d+)\s+Import/) {
635 $self->{info}->{io} = $1 ;
637 $self->{info}->{io} = 0;
642 $self->debug($self) ;
647 my ($self, $slot) = @_;
650 if ($self->{slot}->[$slot] eq 'loaded') {
654 my $label = $self->{slot}->[$slot] ;
656 return $self->is_media_loaded($label);
661 my ($self, $drive, $slot) = @_;
663 return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
664 return 0 if ($self->slot_is_full($slot)) ;
666 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
669 my $content = $self->get_slot($slot);
670 print "content = $content<br/> $drive => $slot<br/>";
671 $self->set_empty_drive($drive);
672 $self->set_slot($slot, $content);
675 $self->{error} = $out;
680 # TODO: load/unload have to use mtx script from bacula
683 my ($self, $drive, $slot) = @_;
685 return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
686 return 0 unless ($self->slot_is_full($slot)) ;
688 print "Loading drive $drive with slot $slot<br/>\n";
689 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
692 my $content = $self->get_slot($slot);
693 print "content = $content<br/> $slot => $drive<br/>";
694 $self->set_drive($drive, $slot, $content);
697 $self->{error} = $out;
705 my ($self, $media) = @_;
707 unless ($self->{label}->{$media}) {
711 if ($self->{label}->{$media} =~ /drive\d+/) {
721 return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
726 my ($self, $slot, $tag) = @_;
727 $self->{slot}->[$slot] = $tag || 'full';
728 push @{ $self->{io} }, $slot;
731 $self->{label}->{$tag} = $slot;
737 my ($self, $slot) = @_;
739 push @{ $self->{io} }, $slot;
741 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
742 $self->{slot}->[$slot] = 'empty';
748 my ($self, $slot) = @_;
749 return $self->{slot}->[$slot];
754 my ($self, $slot, $tag) = @_;
755 $self->{slot}->[$slot] = $tag || 'full';
758 $self->{label}->{$tag} = $slot;
764 my ($self, $slot) = @_;
766 unless ($self->{slot}->[$slot]) { # can be loaded (parse before)
767 $self->{slot}->[$slot] = 'empty';
773 my ($self, $drive) = @_;
774 $self->{drive}->[$drive] = 'empty';
779 my ($self, $drive, $slot, $tag) = @_;
780 $self->{drive}->[$drive] = $tag || $slot;
782 $self->{slot}->[$slot] = $tag || 'loaded';
785 $self->{label}->{$tag} = "drive$drive";
791 my ($self, $slot) = @_;
793 # slot don't exists => full
794 if (not defined $self->{slot}->[$slot]) {
798 if ($self->{slot}->[$slot] eq 'empty') {
801 return 1; # vol, full, loaded
804 sub slot_get_first_free
807 for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
808 return $slot unless ($self->slot_is_full($slot));
812 sub io_get_first_free
816 foreach my $slot (@{ $self->{io} }) {
817 return $slot unless ($self->slot_is_full($slot));
824 my ($self, $media) = @_;
826 return $self->{label}->{$media} ;
831 my ($self, $media) = @_;
833 return defined $self->{label}->{$media} ;
838 my ($self, $slot) = @_;
840 unless ($self->slot_is_full($slot)) {
841 print "Autochanger $self->{name} slot $slot is empty\n";
846 if ($self->is_slot_loaded($slot)) {
849 print "Autochanger $self->{name} $slot is currently in use\n";
853 # autochanger must have I/O
854 unless ($self->have_io()) {
855 print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
859 my $dst = $self->io_get_first_free();
862 print "Autochanger $self->{name} you must empty I/O first\n";
865 $self->transfer($slot, $dst);
870 my ($self, $src, $dst) = @_ ;
871 if ($self->{debug}) {
872 print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
874 my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
877 my $content = $self->get_slot($src);
878 $self->{slot}->[$src] = 'empty';
879 $self->set_slot($dst, $content);
882 $self->{error} = $out;
889 my ($self, $index) = @_;
890 return $self->{drive_name}->[$index];
893 # TODO : do a tapeinfo request to get informations
903 for my $slot (@{$self->{io}})
905 if ($self->is_slot_loaded($slot)) {
906 print "$slot is currently loaded\n";
910 if ($self->slot_is_full($slot))
912 my $free = $self->slot_get_first_free() ;
913 print "move $slot to $free :\n";
916 if ($self->transfer($slot, $free)) {
917 print "<img src='/bweb/T.png' alt='ok'><br/>\n";
919 print "<img src='/bweb/E.png' alt='ok' title='$self->{error}'><br/>\n";
923 $self->{error} = "<img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'><br/>\n";
929 # TODO : this is with mtx status output,
930 # we can do an other function from bacula view (with StorageId)
934 my $bweb = $self->{bweb};
936 # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
937 my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
940 SELECT Media.VolumeName AS volumename,
941 Media.VolStatus AS volstatus,
942 Media.LastWritten AS lastwritten,
943 Media.VolBytes AS volbytes,
944 Media.MediaType AS mediatype,
946 Media.InChanger AS inchanger,
948 $bweb->{sql}->{FROM_UNIXTIME}(
949 $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
950 + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
953 INNER JOIN Pool USING (PoolId)
955 WHERE Media.VolumeName IN ($media_list)
958 my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
960 # TODO : verify slot and bacula slot
964 for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
966 if ($self->slot_is_full($slot)) {
968 my $vol = $self->{slot}->[$slot];
969 if (defined $all->{$vol}) { # TODO : autochanger without barcodes
971 my $bslot = $all->{$vol}->{slot} ;
972 my $inchanger = $all->{$vol}->{inchanger};
974 # if bacula slot or inchanger flag is bad, we display a message
975 if ($bslot != $slot or !$inchanger) {
976 push @to_update, $slot;
979 $all->{$vol}->{realslot} = $slot;
981 push @{ $param }, $all->{$vol};
983 } else { # empty or no label
984 push @{ $param }, {realslot => $slot,
985 volstatus => 'Unknown',
986 volumename => $self->{slot}->[$slot]} ;
989 push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
993 my $i=0; my $drives = [] ;
994 foreach my $d (@{ $self->{drive} }) {
995 $drives->[$i] = { index => $i,
996 load => $self->{drive}->[$i],
997 name => $self->{drive_name}->[$i],
1002 $bweb->display({ Name => $self->{name},
1003 nb_drive => $self->{info}->{drive},
1004 nb_io => $self->{info}->{io},
1007 Update => scalar(@to_update) },
1015 ################################################################
1019 use base q/Bweb::Gui/;
1023 Bweb - main Bweb package
1027 this package is use to compute and display informations
1032 use POSIX qw/strftime/;
1034 our $config_file='/etc/bacula/bweb.conf';
1040 %sql_func - hash to make query mysql/postgresql compliant
1046 UNIX_TIMESTAMP => '',
1047 FROM_UNIXTIME => '',
1048 TO_SEC => " interval '1 second' * ",
1049 SEC_TO_INT => "SEC_TO_INT",
1052 STARTTIME_DAY => " date_trunc('day', Job.StartTime) ",
1053 STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1054 STARTTIME_MONTH => " date_trunc('month', Job.StartTime) ",
1055 STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1056 STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1057 STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1058 STARTTIME_PWEEK => " date_part('week', Job.StartTime) ",
1059 DB_SIZE => " SELECT pg_database_size(current_database()) ",
1060 CAT_POOL_TYPE => " MediaType || '_' || Pool.Name ",
1063 UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1064 FROM_UNIXTIME => 'FROM_UNIXTIME',
1067 SEC_TO_TIME => 'SEC_TO_TIME',
1068 MATCH => " REGEXP ",
1069 STARTTIME_DAY => " DATE_FORMAT(StartTime, '%Y-%m-%d') ",
1070 STARTTIME_HOUR => " DATE_FORMAT(StartTime, '%Y-%m-%d %H') ",
1071 STARTTIME_MONTH => " DATE_FORMAT(StartTime, '%Y-%m') ",
1072 STARTTIME_PHOUR=> " DATE_FORMAT(StartTime, '%H') ",
1073 STARTTIME_PDAY => " DATE_FORMAT(StartTime, '%d') ",
1074 STARTTIME_PMONTH => " DATE_FORMAT(StartTime, '%m') ",
1075 STARTTIME_PWEEK => " DATE_FORMAT(StartTime, '%v') ",
1076 # with mysql < 5, you have to play with the ugly SHOW command
1077 DB_SIZE => " SELECT 0 ",
1078 # works only with mysql 5
1079 # DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1080 CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1088 $self->{dbh}->disconnect();
1093 sub dbh_selectall_arrayref
1095 my ($self, $query) = @_;
1096 $self->connect_db();
1097 $self->debug($query);
1098 return $self->{dbh}->selectall_arrayref($query);
1103 my ($self, @what) = @_;
1104 return join(',', $self->dbh_quote(@what)) ;
1109 my ($self, @what) = @_;
1111 $self->connect_db();
1113 return map { $self->{dbh}->quote($_) } @what;
1115 return $self->{dbh}->quote($what[0]) ;
1121 my ($self, $query) = @_ ;
1122 $self->connect_db();
1123 $self->debug($query);
1124 return $self->{dbh}->do($query);
1127 sub dbh_selectall_hashref
1129 my ($self, $query, $join) = @_;
1131 $self->connect_db();
1132 $self->debug($query);
1133 return $self->{dbh}->selectall_hashref($query, $join) ;
1136 sub dbh_selectrow_hashref
1138 my ($self, $query) = @_;
1140 $self->connect_db();
1141 $self->debug($query);
1142 return $self->{dbh}->selectrow_hashref($query) ;
1147 my ($self, @what) = @_;
1148 if ($self->{conf}->{connection_string} =~ /dbi:mysql/i) {
1149 return 'CONCAT(' . join(',', @what) . ')' ;
1151 return join(' || ', @what);
1157 my ($self, $query) = @_;
1158 $self->debug($query, up => 1);
1159 return $self->{dbh}->prepare($query);
1165 my @unit = qw(B KB MB GB TB);
1166 my $val = shift || 0;
1168 my $format = '%i %s';
1169 while ($val / 1024 > 1) {
1173 $format = ($i>0)?'%0.1f %s':'%i %s';
1174 return sprintf($format, $val, $unit[$i]);
1177 # display Day, Hour, Year
1183 $val /= 60; # sec -> min
1185 if ($val / 60 <= 1) {
1189 $val /= 60; # min -> hour
1190 if ($val / 24 <= 1) {
1191 return "$val hours";
1194 $val /= 24; # hour -> day
1195 if ($val / 365 < 2) {
1199 $val /= 365 ; # day -> year
1201 return "$val years";
1207 my $val = shift || 0;
1209 if ($val == 1 or $val eq "yes") {
1211 } elsif ($val == 2 or $val eq "archived") {
1218 # get Day, Hour, Year
1224 unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1228 my %times = ( m => 60,
1234 my $mult = $times{$2} || 0;
1244 unless ($self->{dbh}) {
1245 $self->{dbh} = DBI->connect($self->{info}->{dbi},
1246 $self->{info}->{user},
1247 $self->{info}->{password});
1249 $self->error("Can't connect to your database:\n$DBI::errstr\n")
1250 unless ($self->{dbh});
1252 $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1254 if ($self->{info}->{dbi} =~ /^dbi:Pg/i) {
1255 $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1262 my ($class, %arg) = @_;
1264 dbh => undef, # connect_db();
1266 dbi => '', # DBI:Pg:database=bacula;host=127.0.0.1
1272 map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1274 if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1275 $self->{sql} = $sql_func{$1};
1278 $self->{loginname} = CGI::remote_user();
1279 $self->{debug} = $self->{info}->{debug};
1280 $Bweb::Gui::template_dir = $self->{info}->{template_dir};
1288 $self->display($self->{info}, "begin.tpl");
1294 $self->display($self->{info}, "end.tpl");
1300 my $where=''; # by default
1302 my $arg = $self->get_form("client", "qre_client",
1303 "jclient_groups", "qnotingroup");
1305 if ($arg->{qre_client}) {
1306 $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1307 } elsif ($arg->{client}) {
1308 $where = "WHERE Name = '$arg->{client}' ";
1309 } elsif ($arg->{jclient_groups}) {
1310 # $filter could already contains client_group_member
1312 JOIN client_group_member USING (ClientId)
1313 JOIN client_group USING (client_group_id)
1314 WHERE client_group_name IN ($arg->{jclient_groups}) ";
1315 } elsif ($arg->{qnotingroup}) {
1318 (SELECT 1 FROM client_group_member
1319 WHERE Client.ClientId = client_group_member.ClientId
1325 SELECT Name AS name,
1327 AutoPrune AS autoprune,
1328 FileRetention AS fileretention,
1329 JobRetention AS jobretention
1330 FROM Client " . $self->get_client_filter() .
1333 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1335 my $dsp = { ID => $cur_id++,
1336 clients => [ values %$all] };
1338 $self->display($dsp, "client_list.tpl") ;
1343 my ($self, %arg) = @_;
1350 "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1352 ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1354 $self->{sql}->{TO_SEC}($arg{age})
1357 $label = "last " . human_sec($arg{age});
1360 if ($arg{groupby}) {
1361 $limit .= " GROUP BY $arg{groupby} ";
1365 $limit .= " ORDER BY $arg{order} ";
1369 $limit .= " LIMIT $arg{limit} ";
1370 $label .= " limited to $arg{limit}";
1374 $limit .= " OFFSET $arg{offset} ";
1375 $label .= " with $arg{offset} offset ";
1379 $label = 'no filter';
1382 return ($limit, $label);
1387 $bweb->get_form(...) - Get useful stuff
1391 This function get and check parameters against regexp.
1393 If word begin with 'q', the return will be quoted or join quoted
1394 if it's end with 's'.
1399 $bweb->get_form('jobid', 'qclient', 'qpools') ;
1402 qclient => 'plume-fd',
1403 qpools => "'plume-fd', 'test-fd', '...'",
1410 my ($self, @what) = @_;
1411 my %what = map { $_ => 1 } @what;
1433 my %opt_ss =( # string with space
1437 my %opt_s = ( # default to ''
1458 my %opt_p = ( # option with path
1465 my %opt_r = (regexwhere => 1);
1467 my %opt_d = ( # option with date
1472 foreach my $i (@what) {
1473 if (exists $opt_i{$i}) {# integer param
1474 my $value = CGI::param($i) || $opt_i{$i} ;
1475 if ($value =~ /^(\d+)$/) {
1478 } elsif ($opt_s{$i}) { # simple string param
1479 my $value = CGI::param($i) || '';
1480 if ($value =~ /^([\w\d\.-]+)$/) {
1483 } elsif ($opt_ss{$i}) { # simple string param (with space)
1484 my $value = CGI::param($i) || '';
1485 if ($value =~ /^([\w\d\.\-\s]+)$/) {
1488 } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1489 my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1491 $ret{$i} = $self->dbh_join(@value) ;
1494 } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1495 my $value = CGI::param($1) ;
1497 $ret{$i} = $self->dbh_quote($value);
1500 } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1501 $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1502 grep { ! /^\s*$/ } CGI::param($1) ];
1503 } elsif (exists $opt_p{$i}) {
1504 my $value = CGI::param($i) || '';
1505 if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1508 } elsif (exists $opt_r{$i}) {
1509 my $value = CGI::param($i) || '';
1510 if ($value =~ /^([^'"']+)$/) {
1513 } elsif (exists $opt_d{$i}) {
1514 my $value = CGI::param($i) || '';
1515 if ($value =~ /^\s*(\d+\s+\w+)$/) {
1522 foreach my $s (CGI::param('slot')) {
1523 if ($s =~ /^(\d+)$/) {
1524 push @{$ret{slots}}, $s;
1530 my $when = CGI::param('when') || '';
1531 if ($when =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
1536 if ($what{db_clients}) {
1538 if ($what{filter}) {
1539 # get security filter only if asked
1540 $filter = $self->get_client_filter();
1544 SELECT Client.Name as clientname
1548 my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1549 $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1553 if ($what{db_client_groups}) {
1555 if ($what{filter}) {
1556 # get security filter only if asked
1557 $filter = $self->get_client_group_filter();
1561 SELECT client_group_name AS name
1562 FROM client_group $filter
1565 my $grps = $self->dbh_selectall_hashref($query, 'name');
1566 $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1570 if ($what{db_usernames}) {
1576 my $users = $self->dbh_selectall_hashref($query, 'username');
1577 $ret{db_usernames} = [sort {$a->{username} cmp $b->{username} }
1581 if ($what{db_roles}) {
1587 my $r = $self->dbh_selectall_hashref($query, 'rolename');
1588 $ret{db_roles} = [sort {$a->{rolename} cmp $b->{rolename} }
1592 if ($what{db_mediatypes}) {
1594 SELECT MediaType as mediatype
1598 my $media = $self->dbh_selectall_hashref($query, 'mediatype');
1599 $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1603 if ($what{db_locations}) {
1605 SELECT Location as location, Cost as cost
1608 my $loc = $self->dbh_selectall_hashref($query, 'location');
1609 $ret{db_locations} = [ sort { $a->{location}
1615 if ($what{db_pools}) {
1616 my $query = "SELECT Name as name FROM Pool";
1618 my $all = $self->dbh_selectall_hashref($query, 'name') ;
1619 $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1622 if ($what{db_filesets}) {
1624 SELECT FileSet.FileSet AS fileset
1628 my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1630 $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1631 values %$filesets] ;
1634 if ($what{db_jobnames}) {
1636 if ($what{filter}) {
1637 $filter = " JOIN Client USING (ClientId) " . $self->get_client_filter();
1640 SELECT DISTINCT Job.Name AS jobname
1644 my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1646 $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1647 values %$jobnames] ;
1650 if ($what{db_devices}) {
1652 SELECT Device.Name AS name
1656 my $devices = $self->dbh_selectall_hashref($query, 'name');
1658 $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1669 my $fields = $self->get_form(qw/age level status clients filesets
1670 graph gtype type filter db_clients
1671 limit db_filesets width height
1672 qclients qfilesets qjobnames db_jobnames/);
1675 my $url = CGI::url(-full => 0,
1678 $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1680 # this organisation is to keep user choice between 2 click
1681 # TODO : fileset and client selection doesn't work
1690 sub get_selected_media_location
1694 my $media = $self->get_form('jmedias');
1696 unless ($media->{jmedias}) {
1701 SELECT Media.VolumeName AS volumename, Location.Location AS location
1702 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1703 WHERE Media.VolumeName IN ($media->{jmedias})
1706 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1708 # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1717 my ($self, $in) = @_ ;
1719 my $media = $self->get_selected_media_location();
1725 my $elt = $self->get_form('db_locations');
1727 $self->display({ ID => $cur_id++,
1728 enabled => human_enabled($in),
1729 %$elt, # db_locations
1731 sort { $a->{volumename} cmp $b->{volumename} } values %$media
1741 my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
1743 $self->display($elt, "help_extern.tpl");
1746 sub help_extern_compute
1750 my $number = CGI::param('limit') || '' ;
1751 unless ($number =~ /^(\d+)$/) {
1752 return $self->error("Bad arg number : $number ");
1755 my ($sql, undef) = $self->get_param('pools',
1756 'locations', 'mediatypes');
1759 SELECT Media.VolumeName AS volumename,
1760 Media.VolStatus AS volstatus,
1761 Media.LastWritten AS lastwritten,
1762 Media.MediaType AS mediatype,
1763 Media.VolMounts AS volmounts,
1765 Media.Recycle AS recycle,
1766 $self->{sql}->{FROM_UNIXTIME}(
1767 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1768 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1771 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1772 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1774 WHERE Media.InChanger = 1
1775 AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
1777 ORDER BY expire DESC, recycle, Media.VolMounts DESC
1781 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1783 $self->display({ Media => [ values %$all ] },
1784 "help_extern_compute.tpl");
1791 my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
1792 $self->display($param, "help_intern.tpl");
1795 sub help_intern_compute
1799 my $number = CGI::param('limit') || '' ;
1800 unless ($number =~ /^(\d+)$/) {
1801 return $self->error("Bad arg number : $number ");
1804 my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
1806 if (CGI::param('expired')) {
1808 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1809 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1815 SELECT Media.VolumeName AS volumename,
1816 Media.VolStatus AS volstatus,
1817 Media.LastWritten AS lastwritten,
1818 Media.MediaType AS mediatype,
1819 Media.VolMounts AS volmounts,
1821 $self->{sql}->{FROM_UNIXTIME}(
1822 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
1823 + $self->{sql}->{TO_SEC}(Media.VolRetention)
1826 INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
1827 LEFT JOIN Location ON (Location.LocationId = Media.LocationId)
1829 WHERE Media.InChanger <> 1
1830 AND Media.VolStatus IN ('Purged', 'Full', 'Append')
1831 AND Media.Recycle = 1
1833 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
1837 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1839 $self->display({ Media => [ values %$all ] },
1840 "help_intern_compute.tpl");
1846 my ($self, %arg) = @_ ;
1848 my ($limit, $label) = $self->get_limit(%arg);
1852 (SELECT count(Pool.PoolId) FROM Pool) AS nb_pool,
1853 (SELECT count(Media.MediaId) FROM Media) AS nb_media,
1854 (SELECT count(Job.JobId) FROM Job) AS nb_job,
1855 (SELECT sum(VolBytes) FROM Media) AS nb_bytes,
1856 ($self->{sql}->{DB_SIZE}) AS db_size,
1857 (SELECT count(Job.JobId)
1859 WHERE Job.JobStatus IN ('E','e','f','A')
1862 (SELECT count(Client.ClientId) FROM Client) AS nb_client
1865 my $row = $self->dbh_selectrow_hashref($query) ;
1867 $row->{nb_bytes} = human_size($row->{nb_bytes});
1869 $row->{db_size} = human_size($row->{db_size});
1870 $row->{label} = $label;
1872 $self->display($row, "general.tpl");
1877 my ($self, @what) = @_ ;
1878 my %elt = map { $_ => 1 } @what;
1883 if ($elt{clients}) {
1884 my @clients = grep { ! /^\s*$/ } CGI::param('client');
1886 $ret{clients} = \@clients;
1887 my $str = $self->dbh_join(@clients);
1888 $limit .= "AND Client.Name IN ($str) ";
1892 if ($elt{client_groups}) {
1893 my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
1895 $ret{client_groups} = \@clients;
1896 my $str = $self->dbh_join(@clients);
1897 $limit .= "AND client_group_name IN ($str) ";
1901 if ($elt{filesets}) {
1902 my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
1904 $ret{filesets} = \@filesets;
1905 my $str = $self->dbh_join(@filesets);
1906 $limit .= "AND FileSet.FileSet IN ($str) ";
1910 if ($elt{mediatypes}) {
1911 my @media = grep { ! /^\s*$/ } CGI::param('mediatype');
1913 $ret{mediatypes} = \@media;
1914 my $str = $self->dbh_join(@media);
1915 $limit .= "AND Media.MediaType IN ($str) ";
1920 my $client = CGI::param('client');
1921 $ret{client} = $client;
1922 $client = $self->dbh_join($client);
1923 $limit .= "AND Client.Name = $client ";
1927 my $level = CGI::param('level') || '';
1928 if ($level =~ /^(\w)$/) {
1930 $limit .= "AND Job.Level = '$1' ";
1935 my $jobid = CGI::param('jobid') || '';
1937 if ($jobid =~ /^(\d+)$/) {
1939 $limit .= "AND Job.JobId = '$1' ";
1944 my $status = CGI::param('status') || '';
1945 if ($status =~ /^(\w)$/) {
1948 $limit .= "AND Job.JobStatus IN ('f','E') ";
1949 } elsif ($1 eq 'W') {
1950 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
1952 $limit .= "AND Job.JobStatus = '$1' ";
1957 if ($elt{volstatus}) {
1958 my $status = CGI::param('volstatus') || '';
1959 if ($status =~ /^(\w+)$/) {
1961 $limit .= "AND Media.VolStatus = '$1' ";
1965 if ($elt{locations}) {
1966 my @location = grep { ! /^\s*$/ } CGI::param('location') ;
1968 $ret{locations} = \@location;
1969 my $str = $self->dbh_join(@location);
1970 $limit .= "AND Location.Location IN ($str) ";
1975 my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
1977 $ret{pools} = \@pool;
1978 my $str = $self->dbh_join(@pool);
1979 $limit .= "AND Pool.Name IN ($str) ";
1983 if ($elt{location}) {
1984 my $location = CGI::param('location') || '';
1986 $ret{location} = $location;
1987 $location = $self->dbh_quote($location);
1988 $limit .= "AND Location.Location = $location ";
1993 my $pool = CGI::param('pool') || '';
1996 $pool = $self->dbh_quote($pool);
1997 $limit .= "AND Pool.Name = $pool ";
2001 if ($elt{jobtype}) {
2002 my $jobtype = CGI::param('jobtype') || '';
2003 if ($jobtype =~ /^(\w)$/) {
2005 $limit .= "AND Job.Type = '$1' ";
2009 return ($limit, %ret);
2020 my ($self, %arg) = @_ ;
2021 $self->can_do('r_view_job');
2023 $arg{order} = ' Job.JobId DESC ';
2025 my ($limit, $label) = $self->get_limit(%arg);
2026 my ($where, undef) = $self->get_param('clients',
2035 if (CGI::param('client_group')) {
2037 JOIN client_group_member USING (ClientId)
2038 JOIN client_group USING (client_group_id)
2041 my $filter = $self->get_client_filter();
2044 SELECT Job.JobId AS jobid,
2045 Client.Name AS client,
2046 FileSet.FileSet AS fileset,
2047 Job.Name AS jobname,
2049 StartTime AS starttime,
2051 Pool.Name AS poolname,
2052 JobFiles AS jobfiles,
2053 JobBytes AS jobbytes,
2054 JobStatus AS jobstatus,
2055 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2056 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2059 JobErrors AS joberrors
2061 FROM Client $filter $cgq,
2062 Job LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2063 LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2064 WHERE Client.ClientId=Job.ClientId
2065 AND Job.JobStatus NOT IN ('R', 'C')
2070 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2072 $self->display({ Filter => $label,
2076 sort { $a->{jobid} <=> $b->{jobid} }
2083 # display job informations
2084 sub display_job_zoom
2086 my ($self, $jobid) = @_ ;
2087 $self->can_do('r_view_job');
2089 $jobid = $self->dbh_quote($jobid);
2091 # get security filter
2092 my $filter = $self->get_client_filter();
2095 SELECT DISTINCT Job.JobId AS jobid,
2096 Client.Name AS client,
2097 Job.Name AS jobname,
2098 FileSet.FileSet AS fileset,
2100 Pool.Name AS poolname,
2101 StartTime AS starttime,
2102 JobFiles AS jobfiles,
2103 JobBytes AS jobbytes,
2104 JobStatus AS jobstatus,
2105 JobErrors AS joberrors,
2106 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2107 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2109 FROM Client $filter,
2110 Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2111 LEFT JOIN Pool ON (Job.PoolId = Pool.PoolId)
2112 WHERE Client.ClientId=Job.ClientId
2113 AND Job.JobId = $jobid
2116 my $row = $self->dbh_selectrow_hashref($query) ;
2118 # display all volumes associate with this job
2120 SELECT Media.VolumeName as volumename
2121 FROM Job,Media,JobMedia
2122 WHERE Job.JobId = $jobid
2123 AND JobMedia.JobId=Job.JobId
2124 AND JobMedia.MediaId=Media.MediaId
2127 my $all = $self->dbh_selectall_hashref($query, 'volumename');
2129 $row->{volumes} = [ values %$all ] ;
2131 $self->display($row, "display_job_zoom.tpl");
2134 sub display_job_group
2136 my ($self, %arg) = @_;
2137 $self->can_do('r_view_job');
2139 my ($limit, $label) = $self->get_limit(groupby => 'client_group_name', %arg);
2141 my ($where, undef) = $self->get_param('client_groups',
2144 my $filter = $self->get_client_group_filter();
2147 SELECT client_group_name AS client_group_name,
2148 COALESCE(jobok.jobfiles,0) + COALESCE(joberr.jobfiles,0) AS jobfiles,
2149 COALESCE(jobok.jobbytes,0) + COALESCE(joberr.jobbytes,0) AS jobbytes,
2150 COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2151 COALESCE(jobok.nbjobs,0) AS nbjobok,
2152 COALESCE(joberr.nbjobs,0) AS nbjoberr,
2153 COALESCE(jobok.duration, '0:0:0') AS duration
2155 FROM client_group $filter LEFT JOIN (
2156 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2157 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2158 SUM(JobErrors) AS joberrors,
2159 SUM($self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2160 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2163 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2164 JOIN client_group USING (client_group_id)
2166 WHERE JobStatus = 'T'
2169 ) AS jobok USING (client_group_name) LEFT JOIN
2172 SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2173 SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2174 SUM(JobErrors) AS joberrors
2175 FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2176 JOIN client_group USING (client_group_id)
2178 WHERE JobStatus IN ('f','E', 'A')
2181 ) AS joberr USING (client_group_name)
2185 my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2187 my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2190 $self->display($rep, "display_job_group.tpl");
2195 my ($self, %arg) = @_ ;
2197 my ($limit, $label) = $self->get_limit(%arg);
2198 my ($where, %elt) = $self->get_param('pools',
2203 my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2205 if ($arg->{jmedias}) {
2206 $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2208 if ($arg->{qre_media}) {
2209 $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2211 if ($arg->{expired}) {
2213 AND VolStatus = 'Full'
2214 AND ( $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2215 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2216 ) < NOW() " . $where ;
2220 SELECT Media.VolumeName AS volumename,
2221 Media.VolBytes AS volbytes,
2222 Media.VolStatus AS volstatus,
2223 Media.MediaType AS mediatype,
2224 Media.InChanger AS online,
2225 Media.LastWritten AS lastwritten,
2226 Location.Location AS location,
2227 (volbytes*100/COALESCE(media_avg_size.size,-1)) AS volusage,
2228 Pool.Name AS poolname,
2229 $self->{sql}->{FROM_UNIXTIME}(
2230 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2231 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2234 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2235 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2236 Media.MediaType AS MediaType
2238 WHERE Media.VolStatus = 'Full'
2239 GROUP BY Media.MediaType
2240 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2242 WHERE Media.PoolId=Pool.PoolId
2247 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2249 $self->display({ ID => $cur_id++,
2251 Location => $elt{location},
2252 Media => [ values %$all ],
2254 "display_media.tpl");
2257 sub display_allmedia
2261 my $pool = $self->get_form('db_pools');
2263 foreach my $name (@{ $pool->{db_pools} }) {
2264 CGI::param('pool', $name->{name});
2265 $self->display_media();
2269 sub display_media_zoom
2273 my $media = $self->get_form('jmedias');
2275 unless ($media->{jmedias}) {
2276 return $self->error("Can't get media selection");
2280 SELECT InChanger AS online,
2281 Media.Enabled AS enabled,
2282 VolBytes AS nb_bytes,
2283 VolumeName AS volumename,
2284 VolStatus AS volstatus,
2285 VolMounts AS nb_mounts,
2286 Media.VolUseDuration AS voluseduration,
2287 Media.MaxVolJobs AS maxvoljobs,
2288 Media.MaxVolFiles AS maxvolfiles,
2289 Media.MaxVolBytes AS maxvolbytes,
2290 VolErrors AS nb_errors,
2291 Pool.Name AS poolname,
2292 Location.Location AS location,
2293 Media.Recycle AS recycle,
2294 Media.VolRetention AS volretention,
2295 Media.LastWritten AS lastwritten,
2296 Media.VolReadTime/1000000 AS volreadtime,
2297 Media.VolWriteTime/1000000 AS volwritetime,
2298 Media.RecycleCount AS recyclecount,
2299 Media.Comment AS comment,
2300 $self->{sql}->{FROM_UNIXTIME}(
2301 $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2302 + $self->{sql}->{TO_SEC}(Media.VolRetention)
2305 Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2306 WHERE Pool.PoolId = Media.PoolId
2307 AND VolumeName IN ($media->{jmedias})
2310 my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2312 foreach my $media (values %$all) {
2313 my $mq = $self->dbh_quote($media->{volumename});
2316 SELECT DISTINCT Job.JobId AS jobid,
2318 Job.StartTime AS starttime,
2321 Job.JobFiles AS files,
2322 Job.JobBytes AS bytes,
2323 Job.jobstatus AS status
2324 FROM Media,JobMedia,Job
2325 WHERE Media.VolumeName=$mq
2326 AND Media.MediaId=JobMedia.MediaId
2327 AND JobMedia.JobId=Job.JobId
2330 my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2333 SELECT LocationLog.Date AS date,
2334 Location.Location AS location,
2335 LocationLog.Comment AS comment
2336 FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2337 WHERE Media.MediaId = LocationLog.MediaId
2338 AND Media.VolumeName = $mq
2342 my $log = $self->dbh_selectall_arrayref($query) ;
2344 $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2347 $self->display({ jobs => [ values %$jobs ],
2348 LocationLog => $logtxt,
2350 "display_media_zoom.tpl");
2357 $self->can_do('r_location_mgnt');
2359 my $loc = $self->get_form('qlocation');
2360 unless ($loc->{qlocation}) {
2361 return $self->error("Can't get location");
2365 SELECT Location.Location AS location,
2366 Location.Cost AS cost,
2367 Location.Enabled AS enabled
2369 WHERE Location.Location = $loc->{qlocation}
2372 my $row = $self->dbh_selectrow_hashref($query);
2374 $self->display({ ID => $cur_id++,
2375 %$row }, "location_edit.tpl") ;
2381 $self->can_do('r_location_mgnt');
2383 my $arg = $self->get_form(qw/qlocation qnewlocation cost/) ;
2384 unless ($arg->{qlocation}) {
2385 return $self->error("Can't get location");
2387 unless ($arg->{qnewlocation}) {
2388 return $self->error("Can't get new location name");
2390 unless ($arg->{cost}) {
2391 return $self->error("Can't get new cost");
2394 my $enabled = CGI::param('enabled') || '';
2395 $enabled = $enabled?1:0;
2398 UPDATE Location SET Cost = $arg->{cost},
2399 Location = $arg->{qnewlocation},
2401 WHERE Location.Location = $arg->{qlocation}
2404 $self->dbh_do($query);
2406 $self->location_display();
2412 $self->can_do('r_location_mgnt');
2414 my $arg = $self->get_form(qw/qlocation/) ;
2416 unless ($arg->{qlocation}) {
2417 return $self->error("Can't get location");
2421 SELECT count(Media.MediaId) AS nb
2422 FROM Media INNER JOIN Location USING (LocationID)
2423 WHERE Location = $arg->{qlocation}
2426 my $res = $self->dbh_selectrow_hashref($query);
2429 return $self->error("Sorry, the location must be empty");
2433 DELETE FROM Location WHERE Location = $arg->{qlocation} LIMIT 1
2436 $self->dbh_do($query);
2438 $self->location_display();
2444 $self->can_do('r_location_mgnt');
2446 my $arg = $self->get_form(qw/qlocation cost/) ;
2448 unless ($arg->{qlocation}) {
2449 $self->display({}, "location_add.tpl");
2452 unless ($arg->{cost}) {
2453 return $self->error("Can't get new cost");
2456 my $enabled = CGI::param('enabled') || '';
2457 $enabled = $enabled?1:0;
2460 INSERT INTO Location (Location, Cost, Enabled)
2461 VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2464 $self->dbh_do($query);
2466 $self->location_display();
2469 sub location_display
2474 SELECT Location.Location AS location,
2475 Location.Cost AS cost,
2476 Location.Enabled AS enabled,
2477 (SELECT count(Media.MediaId)
2479 WHERE Media.LocationId = Location.LocationId
2484 my $location = $self->dbh_selectall_hashref($query, 'location');
2486 $self->display({ ID => $cur_id++,
2487 Locations => [ values %$location ] },
2488 "display_location.tpl");
2495 my $media = $self->get_selected_media_location();
2500 my $arg = $self->get_form('db_locations', 'qnewlocation');
2502 $self->display({ email => $self->{info}->{email_media},
2504 media => [ values %$media ],
2506 "update_location.tpl");
2509 ###########################################################
2514 $self->can_do('r_group_mgnt');
2516 my $grp = $self->get_form(qw/qclient_group db_clients/);
2518 unless ($grp->{qclient_group}) {
2519 return $self->error("Can't get group");
2524 FROM Client JOIN client_group_member using (clientid)
2525 JOIN client_group using (client_group_id)
2526 WHERE client_group_name = $grp->{qclient_group}
2529 my $row = $self->dbh_selectall_hashref($query, "name");
2531 $self->display({ ID => $cur_id++,
2532 client_group => $grp->{qclient_group},
2534 client_group_member => [ values %$row]},
2541 $self->can_do('r_group_mgnt');
2543 my $arg = $self->get_form(qw/qclient_group jclients qnewgroup/);
2544 unless ($arg->{qclient_group}) {
2545 return $self->error("Can't get groups");
2548 $self->{dbh}->begin_work();
2551 DELETE FROM client_group_member
2552 WHERE client_group_id IN
2553 (SELECT client_group_id
2555 WHERE client_group_name = $arg->{qclient_group})
2557 $self->dbh_do($query);
2560 INSERT INTO client_group_member (clientid, client_group_id)
2562 (SELECT client_group_id
2564 WHERE client_group_name = $arg->{qclient_group})
2565 FROM Client WHERE Name IN ($arg->{jclients})
2568 $self->dbh_do($query);
2570 if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2573 SET client_group_name = $arg->{qnewgroup}
2574 WHERE client_group_name = $arg->{qclient_group}
2577 $self->dbh_do($query);
2580 $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2582 $self->display_groups();
2588 $self->can_do('r_group_mgnt');
2590 my $arg = $self->get_form(qw/qclient_group/);
2592 unless ($arg->{qclient_group}) {
2593 return $self->error("Can't get groups");
2596 $self->{dbh}->begin_work();
2599 DELETE FROM client_group_member
2600 WHERE client_group_id IN
2601 (SELECT client_group_id
2603 WHERE client_group_name = $arg->{qclient_group});
2605 DELETE FROM bweb_client_group_acl
2606 WHERE client_group_id IN
2607 (SELECT client_group_id
2609 WHERE client_group_name = $arg->{qclient_group});
2611 DELETE FROM client_group
2612 WHERE client_group_name = $arg->{qclient_group};
2614 $self->dbh_do($query);
2616 $self->{dbh}->commit();
2618 $self->display_groups();
2625 $self->can_do('r_group_mgnt');
2627 my $arg = $self->get_form(qw/qclient_group/) ;
2629 unless ($arg->{qclient_group}) {
2630 $self->display({}, "groups_add.tpl");
2635 INSERT INTO client_group (client_group_name)
2636 VALUES ($arg->{qclient_group})
2639 $self->dbh_do($query);
2641 $self->display_groups();
2648 my $arg = $self->get_form(qw/db_client_groups/) ;
2650 if ($self->{dbh}->errstr) {
2651 return $self->error("Can't use groups with bweb, read INSTALL to enable them");
2656 $self->display({ ID => $cur_id++,
2658 "display_groups.tpl");
2661 ###########################################################
2666 if (not $self->{info}->{enable_security}) {
2669 # admin is a special user that can do everything
2670 if ($self->{loginname} eq 'admin') {
2673 if (!$self->{loginname}) {
2677 if (defined $self->{security}) {
2680 $self->{security} = {};
2681 my $u = $self->dbh_quote($self->{loginname});
2684 SELECT use_acl, rolename
2686 JOIN bweb_role_member USING (userid)
2687 JOIN bweb_role USING (roleid)
2690 my $rows = $self->dbh_selectall_arrayref($query);
2691 # do cache with this role
2695 foreach my $r (@$rows) {
2696 $self->{security}->{$r->[1]}=1;
2699 $self->{security}->{use_acl} = $rows->[0]->[0];
2703 # TODO: avoir un mode qui coupe le programme avec une page d'erreur
2704 # we can also get all security and fill {security} hash
2707 my ($self, $action) = @_;
2708 # is security enabled in configuration ?
2709 if (not $self->{info}->{enable_security}) {
2712 # admin is a special user that can do everything
2713 if ($self->{loginname} eq 'admin') {
2717 if (!$self->{loginname}) {
2718 $self->error("Can't do $action, your are not logged. " .
2719 "Check security with your administrator");
2720 $self->display_end();
2724 if (!$self->{security}->{$action}) {
2725 $self->error("$self->{loginname} sorry, but this action ($action) " .
2726 "is not permited. " .
2727 "Check security with your administrator");
2728 $self->display_end();
2738 if (!$self->{info}->{enable_security} or
2739 !$self->{info}->{enable_security_acl})
2744 if ($self->get_roles()) {
2745 return $self->{security}->{use_acl};
2751 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
2752 sub get_client_filter
2755 if ($self->use_filter()) {
2756 my $u = $self->dbh_quote($self->{loginname});
2758 JOIN (SELECT ClientId FROM client_group_member
2759 JOIN client_group USING (client_group_id)
2760 JOIN bweb_client_group_acl USING (client_group_id)
2761 JOIN bweb_user USING (userid)
2762 WHERE bweb_user.username = $u
2763 ) AS filter USING (ClientId)";
2769 #JOIN client_group USING (client_group_id)" . $b->get_client_group_filter()
2770 sub get_client_group_filter
2773 if ($self->use_filter()) {
2774 my $u = $self->dbh_quote($self->{loginname});
2776 JOIN (SELECT client_group_id
2777 FROM bweb_client_group_acl
2778 JOIN bweb_user USING (userid)
2779 WHERE bweb_user.username = $u
2780 ) AS filter USING (client_group_id)";
2786 # role and username have to be quoted before
2787 # role and username can be a quoted list
2790 my ($self, $role, $username) = @_;
2791 $self->can_do("r_user_mgnt");
2793 my $nb = $self->dbh_do("
2794 DELETE FROM bweb_role_member
2795 WHERE roleid = (SELECT roleid FROM bweb_role
2796 WHERE rolename IN ($role))
2797 AND userid = (SELECT userid FROM bweb_user
2798 WHERE username IN ($username))");
2802 # role and username have to be quoted before
2803 # role and username can be a quoted list
2806 my ($self, $role, $username) = @_;
2807 $self->can_do("r_user_mgnt");
2809 my $nb = $self->dbh_do("
2810 INSERT INTO bweb_role_member (roleid, userid)
2811 SELECT roleid, userid FROM bweb_role, bweb_user
2812 WHERE rolename IN ($role)
2813 AND username IN ($username)
2818 # role and username have to be quoted before
2819 # role and username can be a quoted list
2822 my ($self, $copy, $user) = @_;
2823 $self->can_do("r_user_mgnt");
2825 my $nb = $self->dbh_do("
2826 INSERT INTO bweb_role_member (roleid, userid)
2827 SELECT roleid, a.userid
2828 FROM bweb_user AS a, bweb_role_member
2829 JOIN bweb_user USING (userid)
2830 WHERE bweb_user.username = $copy
2831 AND a.username = $user");
2835 # username can be a join quoted list of usernames
2838 my ($self, $username) = @_;
2839 $self->can_do("r_user_mgnt");
2842 DELETE FROM bweb_role_member
2846 WHERE username in ($username))");
2848 DELETE FROM bweb_client_group_acl
2852 WHERE username IN ($username))");
2859 $self->can_do("r_user_mgnt");
2861 my $arg = $self->get_form(qw/jusernames/);
2863 unless ($arg->{jusernames}) {
2864 return $self->error("Can't get user");
2867 $self->{dbh}->begin_work();
2869 $self->revoke_all($arg->{jusernames});
2871 DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
2873 $self->{dbh}->commit();
2875 $self->display_users();
2881 $self->can_do("r_user_mgnt");
2883 # we don't quote username directly to check that it is conform
2884 my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate qcopy_username jclient_groups/) ;
2886 if (not $arg->{qcreate}) {
2887 $arg = $self->get_form(qw/db_roles db_usernames db_client_groups/);
2888 $self->display($arg, "display_user.tpl");
2892 my $u = $self->dbh_quote($arg->{username});
2894 $arg->{use_acl}=(CGI::param('use_acl')?'true':'false');
2896 if (!$arg->{qpasswd}) {
2897 $arg->{qpasswd} = "''";
2899 if (!$arg->{qcomment}) {
2900 $arg->{qcomment} = "''";
2903 # will fail if user already exists
2906 SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment},
2907 use_acl=$arg->{use_acl}
2908 WHERE username = $u")
2911 INSERT INTO bweb_user (username, passwd, use_acl, comment)
2912 VALUES ($u, $arg->{qpasswd}, $arg->{use_acl}, $arg->{qcomment})");
2914 $self->{dbh}->begin_work();
2916 $self->revoke_all($u);
2918 if ($arg->{qcopy_username}) {
2919 $self->grant_like($arg->{qcopy_username}, $u);
2921 $self->grant($arg->{jrolenames}, $u);
2925 INSERT INTO bweb_client_group_acl (client_group_id, userid)
2926 SELECT client_group_id, userid
2927 FROM client_group, bweb_user
2928 WHERE client_group_name IN ($arg->{jclient_groups})
2933 $self->{dbh}->commit();
2935 $self->display_users();
2938 # TODO: we miss a matrix with all user/roles
2942 $self->can_do("r_user_mgnt");
2944 my $arg = $self->get_form(qw/db_usernames/) ;
2946 if ($self->{dbh}->errstr) {
2947 return $self->error("Can't use users with bweb, read INSTALL to enable them");
2950 $self->display({ ID => $cur_id++,
2952 "display_users.tpl");
2958 $self->can_do("r_user_mgnt");
2960 my $arg = $self->get_form('username');
2961 my $user = $self->dbh_quote($arg->{username});
2963 my $userp = $self->dbh_selectrow_hashref("
2964 SELECT username, passwd, comment, use_acl
2966 WHERE username = $user
2970 return $self->error("Can't find $user in catalog");
2972 $arg = $self->get_form(qw/db_usernames db_client_groups/);
2973 my $arg2 = $self->get_form(qw/filter db_client_groups/);
2976 #------------+--------
2981 my $role = $self->dbh_selectall_hashref("
2982 SELECT rolename, temp.userid
2984 LEFT JOIN (SELECT roleid, userid
2985 FROM bweb_user JOIN bweb_role_member USING (userid)
2986 WHERE username = $user) AS temp USING (roleid)
2991 db_usernames => $arg->{db_usernames},
2992 username => $userp->{username},
2993 comment => $userp->{comment},
2994 passwd => $userp->{passwd},
2995 use_acl => $userp->{use_acl},
2996 db_client_groups => $arg->{db_client_groups},
2997 client_group => $arg2->{db_client_groups},
2998 db_roles => [ values %$role],
2999 }, "display_user.tpl");
3003 ###########################################################
3005 sub get_media_max_size
3007 my ($self, $type) = @_;
3009 "SELECT avg(VolBytes) AS size
3011 WHERE Media.VolStatus = 'Full'
3012 AND Media.MediaType = '$type'
3015 my $res = $self->selectrow_hashref($query);
3018 return $res->{size};
3028 my $media = $self->get_form('qmedia');
3030 unless ($media->{qmedia}) {
3031 return $self->error("Can't get media");
3035 SELECT Media.Slot AS slot,
3036 PoolMedia.Name AS poolname,
3037 Media.VolStatus AS volstatus,
3038 Media.InChanger AS inchanger,
3039 Location.Location AS location,
3040 Media.VolumeName AS volumename,
3041 Media.MaxVolBytes AS maxvolbytes,
3042 Media.MaxVolJobs AS maxvoljobs,
3043 Media.MaxVolFiles AS maxvolfiles,
3044 Media.VolUseDuration AS voluseduration,
3045 Media.VolRetention AS volretention,
3046 Media.Comment AS comment,
3047 PoolRecycle.Name AS poolrecycle,
3048 Media.Enabled AS enabled
3050 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
3051 LEFT JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
3052 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
3054 WHERE Media.VolumeName = $media->{qmedia}
3057 my $row = $self->dbh_selectrow_hashref($query);
3058 $row->{volretention} = human_sec($row->{volretention});
3059 $row->{voluseduration} = human_sec($row->{voluseduration});
3060 $row->{enabled} = human_enabled($row->{enabled});
3062 my $elt = $self->get_form(qw/db_pools db_locations/);
3067 }, "update_media.tpl");
3073 $self->can_do('r_media_mgnt');
3075 my $arg = $self->get_form('jmedias', 'qnewlocation') ;
3077 unless ($arg->{jmedias}) {
3078 return $self->error("Can't get selected media");
3081 unless ($arg->{qnewlocation}) {
3082 return $self->error("Can't get new location");
3087 SET LocationId = (SELECT LocationId
3089 WHERE Location = $arg->{qnewlocation})
3090 WHERE Media.VolumeName IN ($arg->{jmedias})
3093 my $nb = $self->dbh_do($query);
3095 print "$nb media updated, you may have to update your autochanger.";
3097 $self->display_media();
3103 $self->can_do('r_media_mgnt');
3105 my $media = $self->get_selected_media_location();
3107 return $self->error("Can't get media selection");
3109 my $newloc = CGI::param('newlocation');
3111 my $user = CGI::param('user') || 'unknown';
3112 my $comm = CGI::param('comment') || '';
3113 $comm = $self->dbh_quote("$user: $comm");
3115 my $arg = $self->get_form('enabled');
3116 my $en = human_enabled($arg->{enabled});
3117 my $b = $self->get_bconsole();
3120 foreach my $vol (keys %$media) {
3122 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
3124 NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$vol'),
3125 (SELECT LocationId FROM Location WHERE Location = '$media->{$vol}->{location}'),
3126 (SELECT VolStatus FROM Media WHERE VolumeName = '$vol')
3129 $self->dbh_do($query);
3130 $self->debug($query);
3131 $b->send_cmd("update volume=\"$vol\" enabled=$en");
3136 $q->param('action', 'update_location');
3137 my $url = $q->url(-full => 1, -query=>1);
3139 $self->display({ email => $self->{info}->{email_media},
3141 newlocation => $newloc,
3142 # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3143 media => [ values %$media ],
3145 "change_location.tpl");
3149 sub display_client_stats
3151 my ($self, %arg) = @_ ;
3152 $self->can_do('r_view_stats');
3154 my $client = $self->dbh_quote($arg{clientname});
3155 # get security filter
3156 my $filter = $self->get_client_filter();
3158 my ($limit, $label) = $self->get_limit(%arg);
3161 count(Job.JobId) AS nb_jobs,
3162 sum(Job.JobBytes) AS nb_bytes,
3163 sum(Job.JobErrors) AS nb_err,
3164 sum(Job.JobFiles) AS nb_files,
3165 Client.Name AS clientname
3166 FROM Job JOIN Client USING (ClientId) $filter
3168 Client.Name = $client
3170 GROUP BY Client.Name
3173 my $row = $self->dbh_selectrow_hashref($query);
3175 $row->{ID} = $cur_id++;
3176 $row->{label} = $label;
3177 $row->{grapharg} = "client";
3179 $self->display($row, "display_client_stats.tpl");
3183 sub display_group_stats
3185 my ($self, %arg) = @_ ;
3187 my $carg = $self->get_form(qw/qclient_group/);
3189 unless ($carg->{qclient_group}) {
3190 return $self->error("Can't get group");
3193 my ($limit, $label) = $self->get_limit(%arg);
3197 count(Job.JobId) AS nb_jobs,
3198 sum(Job.JobBytes) AS nb_bytes,
3199 sum(Job.JobErrors) AS nb_err,
3200 sum(Job.JobFiles) AS nb_files,
3201 client_group.client_group_name AS clientname
3202 FROM Job JOIN Client USING (ClientId)
3203 JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
3204 JOIN client_group USING (client_group_id)
3206 client_group.client_group_name = $carg->{qclient_group}
3208 GROUP BY client_group.client_group_name
3211 my $row = $self->dbh_selectrow_hashref($query);
3213 $row->{ID} = $cur_id++;
3214 $row->{label} = $label;
3215 $row->{grapharg} = "client_group";
3217 $self->display($row, "display_client_stats.tpl");
3220 # poolname can be undef
3223 my ($self, $poolname) = @_ ;
3227 my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3228 if ($arg->{jmediatypes}) {
3229 $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3230 $whereA = "AND MediaType IN ($arg->{jmediatypes}) ";
3233 # TODO : afficher les tailles et les dates
3236 SELECT subq.volmax AS volmax,
3237 subq.volnum AS volnum,
3238 subq.voltotal AS voltotal,
3240 Pool.Recycle AS recycle,
3241 Pool.VolRetention AS volretention,
3242 Pool.VolUseDuration AS voluseduration,
3243 Pool.MaxVolJobs AS maxvoljobs,
3244 Pool.MaxVolFiles AS maxvolfiles,
3245 Pool.MaxVolBytes AS maxvolbytes,
3246 subq.PoolId AS PoolId,
3247 subq.MediaType AS mediatype,
3248 $self->{sql}->{CAT_POOL_TYPE} AS uniq
3251 SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3252 count(Media.MediaId) AS volnum,
3253 sum(Media.VolBytes) AS voltotal,
3254 Media.PoolId AS PoolId,
3255 Media.MediaType AS MediaType
3257 LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3258 Media.MediaType AS MediaType
3260 WHERE Media.VolStatus = 'Full'
3261 GROUP BY Media.MediaType
3262 ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3263 GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3265 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3269 my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3272 SELECT Pool.Name AS name,
3273 sum(VolBytes) AS size
3274 FROM Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3275 WHERE Media.VolStatus IN ('Recycled', 'Purged')
3279 my $empty = $self->dbh_selectall_hashref($query, 'name');
3281 foreach my $p (values %$all) {
3282 if ($p->{volmax} > 0) { # mysql returns 0.0000
3283 # we remove Recycled/Purged media from pool usage
3284 if (defined $empty->{$p->{name}}) {
3285 $p->{voltotal} -= $empty->{$p->{name}}->{size};
3287 $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
3289 $p->{poolusage} = 0;
3293 SELECT VolStatus AS volstatus, count(MediaId) AS nb
3295 WHERE PoolId=$p->{poolid}
3296 AND Media.MediaType = '$p->{mediatype}'
3300 my $content = $self->dbh_selectall_hashref($query, 'volstatus');
3301 foreach my $t (values %$content) {
3302 $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
3307 $self->display({ ID => $cur_id++,
3308 MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
3309 Pools => [ values %$all ]},
3310 "display_pool.tpl");
3313 sub display_running_job
3316 $self->can_do('r_view_running_job');
3318 my $arg = $self->get_form('client', 'jobid');
3320 if (!$arg->{client} and $arg->{jobid}) {
3321 # get security filter
3322 my $filter = $self->get_client_filter();
3325 SELECT Client.Name AS name
3326 FROM Job INNER JOIN Client USING (ClientId) $filter
3327 WHERE Job.JobId = $arg->{jobid}
3330 my $row = $self->dbh_selectrow_hashref($query);
3333 $arg->{client} = $row->{name};
3334 CGI::param('client', $arg->{client});
3338 if ($arg->{client}) {
3339 my $cli = new Bweb::Client(name => $arg->{client});
3340 $cli->display_running_job($self->{info}, $arg->{jobid});
3341 if ($arg->{jobid}) {
3342 $self->get_job_log();
3345 $self->error("Can't get client or jobid");
3349 sub display_running_jobs
3351 my ($self, $display_action) = @_;
3352 $self->can_do('r_view_running_job');
3354 # get security filter
3355 my $filter = $self->get_client_filter();
3358 SELECT Job.JobId AS jobid,
3359 Job.Name AS jobname,
3361 Job.StartTime AS starttime,
3362 Job.JobFiles AS jobfiles,
3363 Job.JobBytes AS jobbytes,
3364 Job.JobStatus AS jobstatus,
3365 $self->{sql}->{SEC_TO_TIME}( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
3366 - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
3368 Client.Name AS clientname
3369 FROM Job INNER JOIN Client USING (ClientId) $filter
3371 JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
3373 my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
3375 $self->display({ ID => $cur_id++,
3376 display_action => $display_action,
3377 Jobs => [ values %$all ]},
3378 "running_job.tpl") ;
3381 # return the autochanger list to update
3385 $self->can_do('r_media_mgnt');
3388 my $arg = $self->get_form('jmedias');
3390 unless ($arg->{jmedias}) {
3391 return $self->error("Can't get media selection");
3395 SELECT Media.VolumeName AS volumename,
3396 Storage.Name AS storage,
3397 Location.Location AS location,
3399 FROM Media INNER JOIN Storage ON (Media.StorageId = Storage.StorageId)
3400 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
3401 WHERE Media.VolumeName IN ($arg->{jmedias})
3402 AND Media.InChanger = 1
3405 my $all = $self->dbh_selectall_hashref($query, 'volumename');
3407 foreach my $vol (values %$all) {
3408 my $a = $self->ach_get($vol->{location});
3410 $ret{$vol->{location}} = 1;
3412 unless ($a->{have_status}) {
3414 $a->{have_status} = 1;
3417 print "eject $vol->{volumename} from $vol->{storage} : ";
3418 if ($a->send_to_io($vol->{slot})) {
3419 print "<img src='/bweb/T.png' alt='ok'><br/>";
3421 print "<img src='/bweb/E.png' alt='err'><br/>";
3431 my ($to, $subject, $content) = (CGI::param('email'),
3432 CGI::param('subject'),
3433 CGI::param('content'));
3434 $to =~ s/[^\w\d\.\@<>,]//;
3435 $subject =~ s/[^\w\d\.\[\]]/ /;
3437 open(MAIL, "|mail -s '$subject' '$to'") ;
3438 print MAIL $content;
3448 my $arg = $self->get_form('jobid', 'client');
3450 print CGI::header('text/brestore');
3451 print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
3452 print "client=$arg->{client}\n" if ($arg->{client});
3453 print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
3457 # TODO : move this to Bweb::Autochanger ?
3458 # TODO : make this internal to not eject tape ?
3464 my ($self, $name) = @_;
3467 return $self->error("Can't get your autochanger name ach");
3470 unless ($self->{info}->{ach_list}) {
3471 return $self->error("Could not find any autochanger");
3474 my $a = $self->{info}->{ach_list}->{$name};
3477 $self->error("Can't get your autochanger $name from your ach_list");
3482 $a->{debug} = $self->{debug};
3489 my ($self, $ach) = @_;
3490 $self->can_do('r_configure');
3492 $self->{info}->{ach_list}->{$ach->{name}} = $ach;
3494 $self->{info}->save();
3502 $self->can_do('r_configure');
3504 my $arg = $self->get_form('ach');
3506 or !$self->{info}->{ach_list}
3507 or !$self->{info}->{ach_list}->{$arg->{ach}})
3509 return $self->error("Can't get autochanger name");
3512 my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
3516 [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
3518 my $b = $self->get_bconsole();
3520 my @storages = $b->list_storage() ;
3522 $ach->{devices} = [ map { { name => $_ } } @storages ];
3524 $self->display($ach, "ach_add.tpl");
3525 delete $ach->{drives};
3526 delete $ach->{devices};
3533 $self->can_do('r_configure');
3535 my $arg = $self->get_form('ach');
3538 or !$self->{info}->{ach_list}
3539 or !$self->{info}->{ach_list}->{$arg->{ach}})
3541 return $self->error("Can't get autochanger name");
3544 delete $self->{info}->{ach_list}->{$arg->{ach}} ;
3546 $self->{info}->save();
3547 $self->{info}->view();
3553 $self->can_do('r_configure');
3555 my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
3557 my $b = $self->get_bconsole();
3558 my @storages = $b->list_storage() ;
3560 unless ($arg->{ach}) {
3561 $arg->{devices} = [ map { { name => $_ } } @storages ];
3562 return $self->display($arg, "ach_add.tpl");
3566 foreach my $drive (CGI::param('drives'))
3568 unless (grep(/^$drive$/,@storages)) {
3569 return $self->error("Can't find $drive in storage list");
3572 my $index = CGI::param("index_$drive");
3573 unless (defined $index and $index =~ /^(\d+)$/) {
3574 return $self->error("Can't get $drive index");
3577 $drives[$index] = $drive;
3581 return $self->error("Can't get drives from Autochanger");
3584 my $a = new Bweb::Autochanger(name => $arg->{ach},
3585 precmd => $arg->{precmd},
3586 drive_name => \@drives,
3587 device => $arg->{device},
3588 mtxcmd => $arg->{mtxcmd});
3590 $self->ach_register($a) ;
3592 $self->{info}->view();
3598 $self->can_do('r_delete_job');
3600 my $arg = $self->get_form('jobid');
3602 if ($arg->{jobid}) {
3603 my $b = $self->get_bconsole();
3604 my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
3608 title => "Delete a job ",
3609 name => "delete jobid=$arg->{jobid}",
3617 $self->can_do('r_media_mgnt');
3619 my $arg = $self->get_form(qw/media volstatus inchanger pool
3620 slot volretention voluseduration
3621 maxvoljobs maxvolfiles maxvolbytes
3622 qcomment poolrecycle enabled
3625 unless ($arg->{media}) {
3626 return $self->error("Can't find media selection");
3629 my $update = "update volume=$arg->{media} ";
3631 if ($arg->{volstatus}) {
3632 $update .= " volstatus=$arg->{volstatus} ";
3635 if ($arg->{inchanger}) {
3636 $update .= " inchanger=yes " ;
3638 $update .= " slot=$arg->{slot} ";
3641 $update .= " slot=0 inchanger=no ";
3644 if ($arg->{enabled}) {
3645 $update .= " enabled=$arg->{enabled} ";
3649 $update .= " pool=$arg->{pool} " ;
3652 if (defined $arg->{volretention}) {
3653 $update .= " volretention=\"$arg->{volretention}\" " ;
3656 if (defined $arg->{voluseduration}) {
3657 $update .= " voluse=\"$arg->{voluseduration}\" " ;
3660 if (defined $arg->{maxvoljobs}) {
3661 $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
3664 if (defined $arg->{maxvolfiles}) {
3665 $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
3668 if (defined $arg->{maxvolbytes}) {
3669 $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
3672 if (defined $arg->{poolrecycle}) {
3673 $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
3676 my $b = $self->get_bconsole();
3679 content => $b->send_cmd($update),
3680 title => "Update a volume ",
3686 my $media = $self->dbh_quote($arg->{media});
3688 my $loc = CGI::param('location') || '';
3690 $loc = $self->dbh_quote($loc); # is checked by db
3691 push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
3693 if (!$arg->{qcomment}) {
3694 $arg->{qcomment} = "''";
3696 push @q, "Comment=$arg->{qcomment}";
3701 SET " . join (',', @q) . "
3702 WHERE Media.VolumeName = $media
3704 $self->dbh_do($query);
3706 $self->update_media();
3712 $self->can_do('r_autochanger_mgnt');
3714 my $ach = CGI::param('ach') ;
3715 $ach = $self->ach_get($ach);
3717 return $self->error("Bad autochanger name");
3721 my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
3722 $b->update_slots($ach->{name});
3729 $self->can_do('r_view_log');
3731 my $arg = $self->get_form('jobid', 'limit', 'offset');
3732 unless ($arg->{jobid}) {
3733 return $self->error("Can't get jobid");
3736 if ($arg->{limit} == 100) {
3737 $arg->{limit} = 1000;
3739 # get security filter
3740 my $filter = $self->get_client_filter();
3743 SELECT Job.Name as name, Client.Name as clientname
3744 FROM Job INNER JOIN Client USING (ClientId) $filter
3745 WHERE JobId = $arg->{jobid}
3748 my $row = $self->dbh_selectrow_hashref($query);
3751 return $self->error("Can't find $arg->{jobid} in catalog");
3754 # display only Error and Warning messages
3756 if (CGI::param('error')) {
3757 $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning' ";
3761 if (CGI::param('time') || $self->{info}->{display_log_time}) {
3762 $logtext = 'LogText';
3764 $logtext = $self->dbh_strcat('Time', ' ', 'LogText')
3768 SELECT count(1) AS nbline, JobId AS jobid, group_concat($logtext) AS lines
3770 SELECT JobId, Time, LogText
3772 WHERE ( Log.JobId = $arg->{jobid}
3773 OR (Log.JobId = 0 AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
3774 AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
3779 OFFSET $arg->{offset}
3785 my $log = $self->dbh_selectrow_hashref($query);
3787 return $self->error("Can't get log for jobid $arg->{jobid}");
3790 $self->display({ lines=> $log->{lines},
3791 nbline => $log->{nbline},
3792 jobid => $arg->{jobid},
3793 name => $row->{name},
3794 client => $row->{clientname},
3795 offset => $arg->{offset},
3796 limit => $arg->{limit},
3797 }, 'display_log.tpl');
3803 $self->can_do('r_autochanger_mgnt');
3805 my $arg = $self->get_form('ach', 'slots', 'drive');
3807 unless ($arg->{ach}) {
3808 return $self->error("Can't find autochanger name");
3811 my $a = $self->ach_get($arg->{ach});
3813 return $self->error("Can't find autochanger name in configuration");
3816 my $storage = $a->get_drive_name($arg->{drive});
3818 return $self->error("Can't get your drive name");
3824 if ($arg->{slots}) {
3825 $slots = join(",", @{ $arg->{slots} });
3826 $slots_sql = " AND Slot IN ($slots) ";
3827 $t += 60*scalar( @{ $arg->{slots} }) ;
3830 my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3831 print "<h1>This command can take long time, be patient...</h1>";
3833 $b->label_barcodes(storage => $storage,
3834 drive => $arg->{drive},
3842 SET LocationId = (SELECT LocationId
3844 WHERE Location = '$arg->{ach}')
3846 WHERE (LocationId = 0 OR LocationId IS NULL)
3855 $self->can_do('r_purge');
3857 my @volume = CGI::param('media');
3860 return $self->error("Can't get media selection");
3863 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3865 foreach my $v (@volume) {
3867 content => $b->purge_volume($v),
3868 title => "Purge media",
3869 name => "purge volume=$v",
3878 $self->can_do('r_prune');
3880 my @volume = CGI::param('media');
3882 return $self->error("Can't get media selection");
3885 my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3887 foreach my $v (@volume) {
3889 content => $b->prune_volume($v),
3890 title => "Prune volume",
3891 name => "prune volume=$v",
3900 $self->can_do('r_cancel_job');
3902 my $arg = $self->get_form('jobid');
3903 unless ($arg->{jobid}) {
3904 return $self->error("Can't get jobid");
3907 my $b = $self->get_bconsole();
3909 content => $b->cancel($arg->{jobid}),
3910 title => "Cancel job",
3911 name => "cancel jobid=$arg->{jobid}",
3917 # Warning, we display current fileset
3920 my $arg = $self->get_form('fileset');
3922 if ($arg->{fileset}) {
3923 my $b = $self->get_bconsole();
3924 my $ret = $b->get_fileset($arg->{fileset});
3925 $self->display({ fileset => $arg->{fileset},
3927 }, "fileset_view.tpl");
3929 $self->error("Can't get fileset name");
3933 sub director_show_sched
3937 my $arg = $self->get_form('days');
3939 my $b = $self->get_bconsole();
3940 my $ret = $b->director_get_sched( $arg->{days} );
3945 }, "scheduled_job.tpl");
3948 sub enable_disable_job
3950 my ($self, $what) = @_ ;
3951 $self->can_do('r_run_job');
3953 my $name = CGI::param('job') || '';
3954 unless ($name =~ /^[\w\d\.\-\s]+$/) {
3955 return $self->error("Can't find job name");
3958 my $b = $self->get_bconsole();
3968 content => $b->send_cmd("$cmd job=\"$name\""),
3969 title => "$cmd $name",
3970 name => "$cmd job=\"$name\"",
3977 return new Bconsole(pref => $self->{info});
3983 $self->can_do('r_run_job');
3985 my $b = $self->get_bconsole();
3987 my $joblist = [ map { { name => $_ } } $b->list_job() ];
3989 $self->display({ Jobs => $joblist }, "run_job.tpl");
3994 my ($self, $ouput) = @_;
3997 foreach my $l (split(/\r\n/, $ouput)) {
3998 if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4004 if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4010 foreach my $k (keys %arg) {
4011 $lowcase{lc($k)} = $arg{$k} ;
4020 $self->can_do('r_run_job');
4022 my $b = $self->get_bconsole();
4024 my $job = CGI::param('job') || '';
4026 # we take informations from director, and we overwrite with user wish
4027 my $info = $b->send_cmd("show job=\"$job\"");
4028 my $attr = $self->run_parse_job($info);
4030 my $arg = $self->get_form('pool', 'level', 'client', 'fileset', 'storage');
4031 my %job_opt = (%$attr, %$arg);
4033 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
4035 my $pools = [ map { { name => $_ } } $b->list_pool() ];
4036 my $clients = [ map { { name => $_ } }$b->list_client()];
4037 my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
4038 my $storages= [ map { { name => $_ } }$b->list_storage()];
4043 clients => $clients,
4044 filesets => $filesets,
4045 storages => $storages,
4047 }, "run_job_mod.tpl");
4053 $self->can_do('r_run_job');
4055 my $b = $self->get_bconsole();
4057 my $jobs = [ map {{ name => $_ }} $b->list_job() ];
4067 $self->can_do('r_run_job');
4069 my $b = $self->get_bconsole();
4071 # TODO: check input (don't use pool, level)
4073 my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
4074 my $job = CGI::param('job') || '';
4075 my $storage = CGI::param('storage') || '';
4077 my $jobid = $b->run(job => $job,
4078 client => $arg->{client},
4079 priority => $arg->{priority},
4080 level => $arg->{level},
4081 storage => $storage,
4082 pool => $arg->{pool},
4083 fileset => $arg->{fileset},
4084 when => $arg->{when},
4087 print $jobid, $b->{error};
4089 print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";