git.sur5r.net Git - bacula/bacula/blob - gui/bweb/lib/Bweb.pm

   1 ################################################################
   2 use strict;
   3
   4 =head1 LICENSE
   5
   6    Bweb - A Bacula web interface
   7    Bacula® - The Network Backup Solution
   8
   9    Copyright (C) 2000-2007 Free Software Foundation Europe e.V.
  10
  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
  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.
  19
  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.
  24
  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
  28    02110-1301, USA.
  29
  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.
  34
  35 =head1 VERSION
  36
  37     $Id$
  38
  39 =cut
  40
  41 package Bweb::Gui;
  42
  43 =head1 PACKAGE
  44
  45     Bweb::Gui - Base package for all Bweb object
  46
  47 =head2 DESCRIPTION
  48
  49     This package define base fonction like new, display, etc..
  50
  51 =cut
  52
  53 use HTML::Template;
  54 our $template_dir='/usr/share/bweb/tpl';
  55
  56 =head1 FUNCTION
  57
  58     new - creation a of new Bweb object
  59
  60 =head2 DESCRIPTION
  61
  62     This function take an hash of argument and place them
  63     on bless ref
  64
  65     IE : $obj = new Obj(name => 'test', age => '10');
  66
  67          $obj->{name} eq 'test' and $obj->{age} eq 10
  68
  69 =cut
  70
  71 sub new
  72 {
  73     my ($class, %arg) = @_;
  74     my $self = bless {
  75         name => undef,
  76     }, $class;
  77
  78     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
  79
  80     return $self;
  81 }
  82
  83 sub debug
  84 {
  85     my ($self, $what) = @_;
  86
  87     if ($self->{debug}) {
  88         if (ref $what) {
  89             print "<pre>" . Data::Dumper::Dumper($what) . "</pre>";
  90         } else {
  91             print "<pre>$what</pre>";
  92         }
  93     }
  94 }
  95
  96 =head1 FUNCTION
  97
  98     error - display an error to the user
  99
 100 =head2 DESCRIPTION
 101
 102     this function set $self->{error} with arg, display a message with
 103     error.tpl and return 0
 104
 105 =head2 EXAMPLE
 106
 107     unless (...) {
 108         return $self->error("Can't use this file");
 109     }
 110
 111 =cut
 112
 113 sub error
 114 {
 115     my ($self, $what) = @_;
 116     $self->{error} = $what;
 117     $self->display($self, 'error.tpl');
 118     return 0;
 119 }
 120
 121 =head1 FUNCTION
 122
 123     display - display an html page with HTML::Template
 124
 125 =head2 DESCRIPTION
 126
 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.
 129
 130     it will use user template_dir then global template_dir
 131     to search the template file.
 132
 133     hash keys are not sensitive. See HTML::Template for more
 134     explanations about the hash ref. (it's can be quiet hard to understand)
 135
 136 =head2 EXAMPLE
 137
 138     $ref = { name => 'me', age => 26 };
 139     $self->display($ref, "people.tpl");
 140
 141 =cut
 142
 143 sub display
 144 {
 145     my ($self, $hash, $tpl) = @_ ;
 146     my $dir = $self->{template_dir} || $template_dir;
 147     my $lang = $self->{lang} || 'en';
 148     my $template = HTML::Template->new(filename => $tpl,
 149                                        path =>["$dir/$lang",
 150                                                $dir],
 151                                        die_on_bad_params => 0,
 152                                        case_sensitive => 0);
 153
 154     foreach my $var (qw/limit offset/) {
 155
 156         unless ($hash->{$var}) {
 157             my $value = CGI::param($var) || '';
 158
 159             if ($value =~ /^(\d+)$/) {
 160                 $template->param($var, $1) ;
 161             }
 162         }
 163     }
 164
 165     $template->param('thisurl', CGI::url(-relative => 1, -query=>1));
 166     $template->param('loginname', CGI::remote_user());
 167
 168     $template->param($hash);
 169     print $template->output();
 170 }
 171 1;
 172
 173 ################################################################
 174
 175 package Bweb::Config;
 176
 177 use base q/Bweb::Gui/;
 178
 179 =head1 PACKAGE
 180
 181     Bweb::Config - read, write, display, modify configuration
 182
 183 =head2 DESCRIPTION
 184
 185     this package is used for manage configuration
 186
 187 =head2 USAGE
 188
 189     $conf = new Bweb::Config(config_file => '/path/to/conf');
 190     $conf->load();
 191
 192     $conf->edit();
 193
 194     $conf->save();
 195
 196 =cut
 197
 198 use CGI;
 199
 200 =head1 PACKAGE VARIABLE
 201
 202     %k_re - hash of all acceptable option.
 203
 204 =head2 DESCRIPTION
 205
 206     this variable permit to check all option with a regexp.
 207
 208 =cut
 209
 210 our %k_re = ( dbi      => qr/^(dbi:(Pg|mysql):(?:\w+=[\w\d\.-]+;?)+)$/i,
 211               user     => qr/^([\w\d\.-]+)$/i,
 212               password => qr/^(.*)$/,
 213               fv_write_path => qr!^([/\w\d\.-]*)$!,
 214               template_dir => qr!^([/\w\d\.-]+)$!,
 215               debug    => qr/^(on)?$/,
 216               lang     => qr/^(\w\w)?$/,
 217               email_media => qr/^([\w\d\.-]+@[\d\w\.-]+)$/,
 218               graph_font  => qr!^([/\w\d\.-]+.ttf)$!,
 219               bconsole    => qr!^(.+)?$!,
 220               syslog_file => qr!^(.+)?$!,
 221               log_dir     => qr!^(.+)?$!,
 222               wiki_url    => qr!(.*)$!,
 223               stat_job_table => qr!^(\w*)$!,
 224               display_log_time => qr!^(on)?$!,
 225               enable_security => qr/^(on)?$/,
 226               enable_security_acl => qr/^(on)?$/,
 227               );
 228
 229 =head1 FUNCTION
 230
 231     load - load config_file
 232
 233 =head2 DESCRIPTION
 234
 235     this function load the specified config_file.
 236
 237 =cut
 238
 239 sub load
 240 {
 241     my ($self) = @_ ;
 242
 243     unless (open(FP, $self->{config_file}))
 244     {
 245         return $self->error("can't load config_file $self->{config_file} : $!");
 246     }
 247     my $f=''; my $tmpbuffer;
 248     while(read FP,$tmpbuffer,4096)
 249     {
 250         $f .= $tmpbuffer;
 251     }
 252     close(FP);
 253
 254     my $VAR1;
 255
 256     no strict; # I have no idea of the contents of the file
 257     eval "$f" ;
 258     use strict;
 259
 260     if ($f and $@) {
 261         $self->load_old();
 262         $self->save();
 263         return $self->error("If you update from an old bweb install, your must reload this page and if it's fail again, you have to configure bweb again...") ;
 264     }
 265
 266     foreach my $k (keys %$VAR1) {
 267         $self->{$k} = $VAR1->{$k};
 268     }
 269
 270     return 1;
 271 }
 272
 273 =head1 FUNCTION
 274
 275     load_old - load old configuration format
 276
 277 =cut
 278
 279 sub load_old
 280 {
 281     my ($self) = @_ ;
 282
 283     unless (open(FP, $self->{config_file}))
 284     {
 285         return $self->error("$self->{config_file} : $!");
 286     }
 287
 288     while (my $line = <FP>)
 289     {
 290         chomp($line);
 291         my ($k, $v) = split(/\s*=\s*/, $line, 2);
 292         if ($k_re{$k}) {
 293             $self->{$k} = $v;
 294         }
 295     }
 296
 297     close(FP);
 298     return 1;
 299 }
 300
 301 =head1 FUNCTION
 302
 303     save - save the current configuration to config_file
 304
 305 =cut
 306
 307 sub save
 308 {
 309     my ($self) = @_ ;
 310
 311     if ($self->{ach_list}) {
 312         # shortcut for display_begin
 313         $self->{achs} = [ map {{ name => $_ }}
 314                           keys %{$self->{ach_list}}
 315                         ];
 316     }
 317
 318     unless (open(FP, ">$self->{config_file}"))
 319     {
 320         return $self->error("$self->{config_file} : $!\n" .
 321                             "You must add this to your config file\n"
 322                             . Data::Dumper::Dumper($self));
 323     }
 324
 325     print FP Data::Dumper::Dumper($self);
 326
 327     close(FP);
 328     return 1;
 329 }
 330
 331 =head1 FUNCTIONS
 332
 333     edit, view, modify - html form ouput
 334
 335 =cut
 336
 337 sub edit
 338 {
 339     my ($self) = @_ ;
 340
 341     $self->display($self, "config_edit.tpl");
 342 }
 343
 344 sub view
 345 {
 346     my ($self) = @_ ;
 347     $self->display($self, "config_view.tpl");
 348 }
 349
 350 sub modify
 351 {
 352     my ($self) = @_;
 353
 354     $self->{error} = '';
 355     # we need to reset checkbox first
 356     $self->{debug} = 0;
 357     $self->{display_log_time} = 0;
 358     $self->{enable_security} = 0;
 359     $self->{enable_security_acl} = 0;
 360
 361     foreach my $k (CGI::param())
 362     {
 363         next unless (exists $k_re{$k}) ;
 364         my $val = CGI::param($k);
 365         if ($val =~ $k_re{$k}) {
 366             $self->{$k} = $1;
 367         } else {
 368             $self->{error} .= "bad parameter : $k = [$val]";
 369         }
 370     }
 371
 372     $self->view();
 373
 374     if ($self->{error}) {       # an error as occured
 375         $self->display($self, 'error.tpl');
 376     } else {
 377         $self->save();
 378     }
 379 }
 380
 381 1;
 382
 383 ################################################################
 384
 385 package Bweb::Client;
 386
 387 use base q/Bweb::Gui/;
 388
 389 =head1 PACKAGE
 390
 391     Bweb::Client - Bacula FD
 392
 393 =head2 DESCRIPTION
 394
 395     this package is use to do all Client operations like, parse status etc...
 396
 397 =head2 USAGE
 398
 399     $client = new Bweb::Client(name => 'zog-fd');
 400     $client->status();            # do a 'status client=zog-fd'
 401
 402 =cut
 403
 404 =head1 FUNCTION
 405
 406     display_running_job - Html display of a running job
 407
 408 =head2 DESCRIPTION
 409
 410     this function is used to display information about a current job
 411
 412 =cut
 413
 414 sub display_running_job
 415 {
 416     my ($self, $conf, $jobid) = @_ ;
 417
 418     my $status = $self->status($conf);
 419
 420     if ($jobid) {
 421         if ($status->{$jobid}) {
 422             $self->display($status->{$jobid}, "client_job_status.tpl");
 423         }
 424     } else {
 425         for my $id (keys %$status) {
 426             $self->display($status->{$id}, "client_job_status.tpl");
 427         }
 428     }
 429 }
 430
 431 =head1 FUNCTION
 432
 433     $client = new Bweb::Client(name => 'plume-fd');
 434
 435     $client->status($bweb);
 436
 437 =head2 DESCRIPTION
 438
 439     dirty hack to parse "status client=xxx-fd"
 440
 441 =head2 INPUT
 442
 443    JobId 105 Job Full_plume.2006-06-06_17.22.23 is running.
 444        Backup Job started: 06-jun-06 17:22
 445        Files=8,971 Bytes=194,484,132 Bytes/sec=7,480,158
 446        Files Examined=10,697
 447        Processing file: /home/eric/.openoffice.org2/user/config/standard.sod
 448        SDReadSeqNo=5 fd=5
 449
 450 =head2 OUTPUT
 451
 452     $VAR1 = { 105 => {
 453                 JobName => Full_plume.2006-06-06_17.22.23,
 454                 JobId => 105,
 455                 Files => 8,971,
 456                 Bytes => 194,484,132,
 457                 ...
 458               },
 459               ...
 460     };
 461
 462 =cut
 463
 464 sub status
 465 {
 466     my ($self, $conf) = @_ ;
 467
 468     if (defined $self->{cur_jobs}) {
 469         return $self->{cur_jobs} ;
 470     }
 471
 472     my $arg = {};
 473     my $b = new Bconsole(pref => $conf);
 474     my $ret = $b->send_cmd("st client=$self->{name}");
 475     my @param;
 476     my $jobid;
 477
 478     for my $r (split(/\n/, $ret)) {
 479         chomp($r);
 480         $r =~ s/(^\s+|\s+$)//g;
 481         if ($r =~ /JobId (\d+) Job (\S+)/) {
 482             if ($jobid) {
 483                 $arg->{$jobid} = { @param, JobId => $jobid } ;
 484             }
 485
 486             $jobid = $1;
 487             @param = ( JobName => $2 );
 488
 489         } elsif ($r =~ /=.+=/) {
 490             push @param, split(/\s+|\s*=\s*/, $r) ;
 491
 492         } elsif ($r =~ /=/) {   # one per line
 493             push @param, split(/\s*=\s*/, $r) ;
 494
 495         } elsif ($r =~ /:/) {   # one per line
 496             push @param, split(/\s*:\s*/, $r, 2) ;
 497         }
 498     }
 499
 500     if ($jobid and @param) {
 501         $arg->{$jobid} = { @param,
 502                            JobId => $jobid,
 503                            Client => $self->{name},
 504                        } ;
 505     }
 506
 507     $self->{cur_jobs} = $arg ;
 508
 509     return $arg;
 510 }
 511 1;
 512
 513 ################################################################
 514
 515 package Bweb::Autochanger;
 516
 517 use base q/Bweb::Gui/;
 518
 519 =head1 PACKAGE
 520
 521     Bweb::Autochanger - Object to manage Autochanger
 522
 523 =head2 DESCRIPTION
 524
 525     this package will parse the mtx output and manage drives.
 526
 527 =head2 USAGE
 528
 529     $auto = new Bweb::Autochanger(precmd => 'sudo');
 530     or
 531     $auto = new Bweb::Autochanger(precmd => 'ssh root@robot');
 532
 533     $auto->status();
 534
 535     $auto->slot_is_full(10);
 536     $auto->transfer(10, 11);
 537
 538 =cut
 539
 540 sub new
 541 {
 542     my ($class, %arg) = @_;
 543
 544     my $self = bless {
 545         name  => '',    # autochanger name
 546         label => {},    # where are volume { label1 => 40, label2 => drive0 }
 547         drive => [],    # drive use [ 'media1', 'empty', ..]
 548         slot  => [],    # slot use [ undef, 'empty', 'empty', ..] no slot 0
 549         io    => [],    # io slot number list [ 41, 42, 43...]
 550         info  => {slot => 0,    # informations (slot, drive, io)
 551                   io   => 0,
 552                   drive=> 0,
 553                  },
 554         mtxcmd => '/usr/sbin/mtx',
 555         debug => 0,
 556         device => '/dev/changer',
 557         precmd => '',   # ssh command
 558         bweb => undef,  # link to bacula web object (use for display)
 559     } ;
 560
 561     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
 562
 563     return $self;
 564 }
 565
 566 =head1 FUNCTION
 567
 568     status - parse the output of mtx status
 569
 570 =head2 DESCRIPTION
 571
 572     this function will launch mtx status and parse the output. it will
 573     give a perlish view of the autochanger content.
 574
 575     it uses ssh if the autochanger is on a other host.
 576
 577 =cut
 578
 579 sub status
 580 {
 581     my ($self) = @_;
 582     my @out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} status` ;
 583
 584     # TODO : reset all infos
 585     $self->{info}->{drive} = 0;
 586     $self->{info}->{slot}  = 0;
 587     $self->{info}->{io}    = 0;
 588
 589     #my @out = `cat /home/eric/travail/brestore/plume/mtx` ;
 590
 591 #
 592 #  Storage Changer /dev/changer:2 Drives, 45 Slots ( 5 Import/Export )
 593 #Data Transfer Element 0:Full (Storage Element 1 Loaded):VolumeTag = 000000
 594 #Data Transfer Element 1:Empty
 595 #      Storage Element 1:Empty
 596 #      Storage Element 2:Full :VolumeTag=000002
 597 #      Storage Element 3:Empty
 598 #      Storage Element 4:Full :VolumeTag=000004
 599 #      Storage Element 5:Full :VolumeTag=000001
 600 #      Storage Element 6:Full :VolumeTag=000003
 601 #      Storage Element 7:Empty
 602 #      Storage Element 41 IMPORT/EXPORT:Empty
 603 #      Storage Element 41 IMPORT/EXPORT:Full :VolumeTag=000002
 604 #
 605
 606     for my $l (@out) {
 607
 608         #          Storage Element 7:Empty
 609         #          Storage Element 2:Full :VolumeTag=000002
 610         if ($l =~ /Storage Element (\d+):(Empty|Full)(\s+:VolumeTag=([\w\d]+))?/){
 611
 612             if ($2 eq 'Empty') {
 613                 $self->set_empty_slot($1);
 614             } else {
 615                 $self->set_slot($1, $4);
 616             }
 617
 618         } elsif ($l =~ /Data Transfer.+(\d+):(Full|Empty)(\s+.Storage Element (\d+) Loaded.(:VolumeTag = ([\w\d]+))?)?/) {
 619
 620             if ($2 eq 'Empty') {
 621                 $self->set_empty_drive($1);
 622             } else {
 623                 $self->set_drive($1, $4, $6);
 624             }
 625
 626         } elsif ($l =~ /Storage Element (\d+).+IMPORT\/EXPORT:(Empty|Full)( :VolumeTag=([\d\w]+))?/)
 627         {
 628             if ($2 eq 'Empty') {
 629                 $self->set_empty_io($1);
 630             } else {
 631                 $self->set_io($1, $4);
 632             }
 633
 634 #       Storage Changer /dev/changer:2 Drives, 30 Slots ( 1 Import/Export )
 635
 636         } elsif ($l =~ /Storage Changer .+:(\d+) Drives, (\d+) Slots/) {
 637             $self->{info}->{drive} = $1;
 638             $self->{info}->{slot} = $2;
 639             if ($l =~ /(\d+)\s+Import/) {
 640                 $self->{info}->{io} = $1 ;
 641             } else {
 642                 $self->{info}->{io} = 0;
 643             }
 644         }
 645     }
 646
 647     $self->debug($self) ;
 648 }
 649
 650 sub is_slot_loaded
 651 {
 652     my ($self, $slot) = @_;
 653
 654     # no barcodes
 655     if ($self->{slot}->[$slot] eq 'loaded') {
 656         return 1;
 657     }
 658
 659     my $label = $self->{slot}->[$slot] ;
 660
 661     return $self->is_media_loaded($label);
 662 }
 663
 664 sub unload
 665 {
 666     my ($self, $drive, $slot) = @_;
 667
 668     return 0 if (not defined $drive or $self->{drive}->[$drive] eq 'empty') ;
 669     return 0 if     ($self->slot_is_full($slot)) ;
 670
 671     my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} unload $slot $drive 2>&1`;
 672
 673     if ($? == 0) {
 674         my $content = $self->get_slot($slot);
 675         print "content = $content<br/> $drive => $slot<br/>";
 676         $self->set_empty_drive($drive);
 677         $self->set_slot($slot, $content);
 678         return 1;
 679     } else {
 680         $self->{error} = $out;
 681         return 0;
 682     }
 683 }
 684
 685 # TODO: load/unload have to use mtx script from bacula
 686 sub load
 687 {
 688     my ($self, $drive, $slot) = @_;
 689
 690     return 0 if (not defined $drive or $self->{drive}->[$drive] ne 'empty') ;
 691     return 0 unless ($self->slot_is_full($slot)) ;
 692
 693     print "Loading drive $drive with slot $slot<br/>\n";
 694     my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} load $slot $drive 2>&1`;
 695
 696     if ($? == 0) {
 697         my $content = $self->get_slot($slot);
 698         print "content = $content<br/> $slot => $drive<br/>";
 699         $self->set_drive($drive, $slot, $content);
 700         return 1;
 701     } else {
 702         $self->{error} = $out;
 703         print $out;
 704         return 0;
 705     }
 706 }
 707
 708 sub is_media_loaded
 709 {
 710     my ($self, $media) = @_;
 711
 712     unless ($self->{label}->{$media}) {
 713         return 0;
 714     }
 715
 716     if ($self->{label}->{$media} =~ /drive\d+/) {
 717         return 1;
 718     }
 719
 720     return 0;
 721 }
 722
 723 sub have_io
 724 {
 725     my ($self) = @_;
 726     return (defined $self->{info}->{io} and $self->{info}->{io} > 0);
 727 }
 728
 729 sub set_io
 730 {
 731     my ($self, $slot, $tag) = @_;
 732     $self->{slot}->[$slot] = $tag || 'full';
 733     push @{ $self->{io} }, $slot;
 734
 735     if ($tag) {
 736         $self->{label}->{$tag} = $slot;
 737     }
 738 }
 739
 740 sub set_empty_io
 741 {
 742     my ($self, $slot) = @_;
 743
 744     push @{ $self->{io} }, $slot;
 745
 746     unless ($self->{slot}->[$slot]) {       # can be loaded (parse before)
 747         $self->{slot}->[$slot] = 'empty';
 748     }
 749 }
 750
 751 sub get_slot
 752 {
 753     my ($self, $slot) = @_;
 754     return $self->{slot}->[$slot];
 755 }
 756
 757 sub set_slot
 758 {
 759     my ($self, $slot, $tag) = @_;
 760     $self->{slot}->[$slot] = $tag || 'full';
 761
 762     if ($tag) {
 763         $self->{label}->{$tag} = $slot;
 764     }
 765 }
 766
 767 sub set_empty_slot
 768 {
 769     my ($self, $slot) = @_;
 770
 771     unless ($self->{slot}->[$slot]) {       # can be loaded (parse before)
 772         $self->{slot}->[$slot] = 'empty';
 773     }
 774 }
 775
 776 sub set_empty_drive
 777 {
 778     my ($self, $drive) = @_;
 779     $self->{drive}->[$drive] = 'empty';
 780 }
 781
 782 sub set_drive
 783 {
 784     my ($self, $drive, $slot, $tag) = @_;
 785     $self->{drive}->[$drive] = $tag || $slot;
 786
 787     $self->{slot}->[$slot] = $tag || 'loaded';
 788
 789     if ($tag) {
 790         $self->{label}->{$tag} = "drive$drive";
 791     }
 792 }
 793
 794 sub slot_is_full
 795 {
 796     my ($self, $slot) = @_;
 797
 798     # slot don't exists => full
 799     if (not defined $self->{slot}->[$slot]) {
 800         return 0 ;
 801     }
 802
 803     if ($self->{slot}->[$slot] eq 'empty') {
 804         return 0;
 805     }
 806     return 1;                   # vol, full, loaded
 807 }
 808
 809 sub slot_get_first_free
 810 {
 811     my ($self) = @_;
 812     for (my $slot=1; $slot < $self->{info}->{slot}; $slot++) {
 813         return $slot unless ($self->slot_is_full($slot));
 814     }
 815 }
 816
 817 sub io_get_first_free
 818 {
 819     my ($self) = @_;
 820
 821     foreach my $slot (@{ $self->{io} }) {
 822         return $slot unless ($self->slot_is_full($slot));
 823     }
 824     return 0;
 825 }
 826
 827 sub get_media_slot
 828 {
 829     my ($self, $media) = @_;
 830
 831     return $self->{label}->{$media} ;
 832 }
 833
 834 sub have_media
 835 {
 836     my ($self, $media) = @_;
 837
 838     return defined $self->{label}->{$media} ;
 839 }
 840
 841 sub send_to_io
 842 {
 843     my ($self, $slot) = @_;
 844
 845     unless ($self->slot_is_full($slot)) {
 846         print "Autochanger $self->{name} slot $slot is empty\n";
 847         return 1;               # ok
 848     }
 849
 850     # first, eject it
 851     if ($self->is_slot_loaded($slot)) {
 852         # bconsole->umount
 853         # self->eject
 854         print "Autochanger $self->{name} $slot is currently in use\n";
 855         return 0;
 856     }
 857
 858     # autochanger must have I/O
 859     unless ($self->have_io()) {
 860         print "Autochanger $self->{name} don't have I/O, you can take media yourself\n";
 861         return 0;
 862     }
 863
 864     my $dst = $self->io_get_first_free();
 865
 866     unless ($dst) {
 867         print "Autochanger $self->{name} you must empty I/O first\n";
 868     }
 869
 870     $self->transfer($slot, $dst);
 871 }
 872
 873 sub transfer
 874 {
 875     my ($self, $src, $dst) = @_ ;
 876     if ($self->{debug}) {
 877         print "<pre>$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst</pre>\n";
 878     }
 879     my $out = `$self->{precmd} $self->{mtxcmd} -f $self->{device} transfer $src $dst 2>&1`;
 880
 881     if ($? == 0) {
 882         my $content = $self->get_slot($src);
 883         $self->{slot}->[$src] = 'empty';
 884         $self->set_slot($dst, $content);
 885         return 1;
 886     } else {
 887         $self->{error} = $out;
 888         return 0;
 889     }
 890 }
 891
 892 sub get_drive_name
 893 {
 894     my ($self, $index) = @_;
 895     return $self->{drive_name}->[$index];
 896 }
 897
 898 # TODO : do a tapeinfo request to get informations
 899 sub tapeinfo
 900 {
 901     my ($self) = @_;
 902 }
 903
 904 sub clear_io
 905 {
 906     my ($self) = @_;
 907
 908     for my $slot (@{$self->{io}})
 909     {
 910         if ($self->is_slot_loaded($slot)) {
 911             print "$slot is currently loaded\n";
 912             next;
 913         }
 914
 915         if ($self->slot_is_full($slot))
 916         {
 917             my $free = $self->slot_get_first_free() ;
 918             print "move $slot to $free :\n";
 919
 920             if ($free) {
 921                 if ($self->transfer($slot, $free)) {
 922                     print "<img src='/bweb/T.png' alt='ok'><br/>\n";
 923                 } else {
 924                     print "<img src='/bweb/E.png' alt='ok' title='$self->{error}'><br/>\n";
 925                 }
 926
 927             } else {
 928                 $self->{error} = "<img src='/bweb/E.png' alt='ok' title='E : Can t find free slot'><br/>\n";
 929             }
 930         }
 931     }
 932 }
 933
 934 # TODO : this is with mtx status output,
 935 # we can do an other function from bacula view (with StorageId)
 936 sub display_content
 937 {
 938     my ($self) = @_;
 939     my $bweb = $self->{bweb};
 940
 941     # $self->{label} => ('vol1', 'vol2', 'vol3', ..);
 942     my $media_list = $bweb->dbh_join( keys %{ $self->{label} });
 943
 944     my $query="
 945 SELECT Media.VolumeName  AS volumename,
 946        Media.VolStatus   AS volstatus,
 947        Media.LastWritten AS lastwritten,
 948        Media.VolBytes    AS volbytes,
 949        Media.MediaType   AS mediatype,
 950        Media.Slot        AS slot,
 951        Media.InChanger   AS inchanger,
 952        Pool.Name         AS name,
 953        $bweb->{sql}->{FROM_UNIXTIME}(
 954           $bweb->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
 955         + $bweb->{sql}->{TO_SEC}(Media.VolRetention)
 956        ) AS expire
 957 FROM Media
 958  INNER JOIN Pool USING (PoolId)
 959
 960 WHERE Media.VolumeName IN ($media_list)
 961 ";
 962
 963     my $all = $bweb->dbh_selectall_hashref($query, 'volumename') ;
 964
 965     # TODO : verify slot and bacula slot
 966     my $param = [];
 967     my @to_update;
 968
 969     for (my $slot=1; $slot <= $self->{info}->{slot} ; $slot++) {
 970
 971         if ($self->slot_is_full($slot)) {
 972
 973             my $vol = $self->{slot}->[$slot];
 974             if (defined $all->{$vol}) {    # TODO : autochanger without barcodes
 975
 976                 my $bslot = $all->{$vol}->{slot} ;
 977                 my $inchanger = $all->{$vol}->{inchanger};
 978
 979                 # if bacula slot or inchanger flag is bad, we display a message
 980                 if ($bslot != $slot or !$inchanger) {
 981                     push @to_update, $slot;
 982                 }
 983
 984                 $all->{$vol}->{realslot} = $slot;
 985
 986                 push @{ $param }, $all->{$vol};
 987
 988             } else {            # empty or no label
 989                 push @{ $param }, {realslot => $slot,
 990                                    volstatus => 'Unknown',
 991                                    volumename => $self->{slot}->[$slot]} ;
 992             }
 993         } else {                # empty
 994             push @{ $param }, {realslot => $slot, volumename => 'empty'} ;
 995         }
 996     }
 997
 998     my $i=0; my $drives = [] ;
 999     foreach my $d (@{ $self->{drive} }) {
1000         $drives->[$i] = { index => $i,
1001                           load  => $self->{drive}->[$i],
1002                           name  => $self->{drive_name}->[$i],
1003                       };
1004         $i++;
1005     }
1006
1007     $bweb->display({ Name   => $self->{name},
1008                      nb_drive => $self->{info}->{drive},
1009                      nb_io => $self->{info}->{io},
1010                      Drives => $drives,
1011                      Slots  => $param,
1012                      Update => scalar(@to_update) },
1013                    'ach_content.tpl');
1014
1015 }
1016
1017 1;
1018
1019 ################################################################
1020
1021 package Bweb::Sched;
1022 use base q/Bweb::Gui/;
1023
1024 =head1 PACKAGE
1025
1026     Bweb::Sched() - Bweb package that parse show schedule ouput
1027
1028     new Bweb::Sched(format => '%Y-%m-%d', year => 2008);
1029
1030 =head2 USAGE
1031
1032  my $b = $bweb->get_bconsole();
1033  my $s = $b->send_cmd("show schedule");
1034  my $sched = new Bweb::Sched(begin => '2007-01-01', end => '2007-01-02 12:00');
1035  $sched->parse_scheds(split(/\r?\n/, $s));
1036
1037
1038 $VAR1 = {
1039           'event' => [
1040                        '2007-01-04 04:05',
1041                        '2007-12-05 04:05',
1042                        '2007-12-12 04:05',
1043                        '2007-12-19 04:05',
1044                        '2007-12-26 04:05'
1045                      ],
1046           'level' => 'Differential',
1047           'pool' => 'Semaine'
1048         };
1049 =cut
1050
1051 sub new
1052 {
1053     my ($class, @arg) = @_;
1054     my $self = $class->SUPER::new(@arg);
1055
1056     # we compare the current schedule date with begin and end
1057     # in a float form ex: 20071212.1243 > 20070101
1058     if ($self->{begin} and $self->{end}) {
1059         ($self->{fbegin}, $self->{fend}) = ($self->{begin}, $self->{end});
1060         $self->{fbegin} =~ s/(-|:)//g;  $self->{fbegin} =~ s/ /./;
1061         $self->{fend}   =~ s/(-|:)//g;  $self->{fend}   =~ s/ /./;
1062     }
1063
1064     bless($self,$class);
1065
1066     if ($self->{bconsole}) {
1067         my $sel = $self->{name}?"=\"$self->{name}\"":'';
1068         my $b = $self->{bconsole};
1069         my $out = $b->send_cmd("show schedule$sel");
1070         $self->parse_scheds(split(/\r?\n/, $out));
1071         undef $self->{bconsole}; # useless now
1072     }
1073
1074     return $self;
1075 }
1076
1077 # cleanup and add a schedule
1078 sub add_sched
1079 {
1080     my ($self, $name, $info) = @_;
1081     # bacula uses dates that start from 0, we start from 1
1082     foreach (@{$info->{mday}},@{$info->{month}}) { $_++ };
1083
1084     # get events
1085     $info->{event} = [ $self->get_events($info, $self->{format}) ];
1086
1087     foreach my $i (qw/hour mday month wday wom woy mins/) {
1088         delete $info->{$i};
1089     }
1090
1091     push @{$self->{schedules}->{$name}}, $info;
1092 }
1093
1094 # return the name of all schedules
1095 sub list_scheds
1096 {
1097     my ($self, $name) = @_;
1098     my %ret;
1099     return keys %{ $self->{schedules} };
1100 }
1101
1102 # return an array of all schedule
1103 sub get_scheds
1104 {
1105     my ($self, $sched) = @_;
1106     return $self->{schedules}->{$sched};
1107 }
1108
1109 # return an ref array of all events
1110 # [ '2007-12-19 04:05', '2007-12-19 04:05' ]
1111 sub get_event
1112 {
1113     my ($self, $sched) = @_;
1114     return $sched->{event};
1115 }
1116
1117 # return the pool name
1118 sub get_pool
1119 {
1120     my ($self, $sched) = @_;
1121     return $sched->{pool} || '';
1122 }
1123
1124 # return the level name (Incremental, Differential, Full)
1125 sub get_level
1126 {
1127     my ($self, $sched) = @_;
1128     return $sched->{level};
1129 }
1130
1131 # parse bacula sched bitmap
1132 sub parse_scheds
1133 {
1134     my ($self, @output) = @_;
1135
1136     my $run;
1137     my $name;
1138     my $schedule;
1139     my $elt;
1140
1141     foreach my $ligne (@output) {
1142         if ($ligne =~ /Schedule: name=(.+)/) {
1143             if ($name and $elt) {
1144                 $elt->{level} = $run;
1145                 $self->add_sched($name, $elt);
1146                 $elt=undef;
1147             }
1148             $name = $1;
1149         }
1150         elsif ($ligne =~ /Run Level=(.+)/) {
1151             if ($name and $elt) {
1152                 $elt->{level} = $run;
1153                 $self->add_sched($name, $elt);
1154                 $elt=undef;
1155             }
1156             $run = $1;
1157         }
1158         elsif ($ligne =~ /(hour|mday|month|mins)=(.+)/) {
1159             # All theses lines have the same format
1160
1161             my ($k,$v) = ($1,$2);
1162             # we get all values (0 1 4 9)
1163             $elt->{$k}=[split (/\s/,$v)];
1164         }
1165         # we make a bitmap for this kind of data (0 0 1 0 0 0 1) for a quick access
1166         elsif ($ligne =~ /(wday|wom|woy)=(.+)/) {
1167             my ($k,$v) = ($1,$2);
1168             foreach my $e (split (/\s/,$v)) {
1169                 $elt->{$k}->[$e]=1;
1170             }
1171         }
1172         elsif ($ligne =~ /Pool: name=(.+?) PoolType/) {
1173             $elt->{pool} = $1;
1174         }
1175     }
1176
1177     if ($name and $elt) {
1178         $elt->{level} = $run;
1179         $self->add_sched($name, $elt);
1180     }
1181 }
1182
1183 use Date::Calc qw(:all);
1184
1185 # read bacula schedule bitmap and get $format date string
1186 sub get_events
1187 {
1188     use integer;
1189     my ($self, $s,$format) = @_;
1190     my $year = $self->{year} || ((localtime)[5] + 1900);
1191     $format = $format || '%u-%02u-%02u %02u:%02u';
1192     my @ret;
1193     foreach my $m (@{$s->{month}})              # mois de l'annee
1194     {
1195         foreach my $md (@{$s->{mday}})  # jour du mois
1196         {
1197 #           print "  m=$m md=$md\n";
1198             # we check if this day exists (31 fev)
1199             next if (!check_date($year,$m,$md));
1200 #           print "    check_date ok\n";
1201
1202             my $w = ($md-1)/7; # we use the same thing than bacula
1203             next if (! $s->{wom}->[$w]);
1204 #           print "      wom ok\n";
1205
1206             # on recupere le jour de la semaine
1207             my $wd = Day_of_Week($year,$m,$md);
1208
1209             my ($w1,undef) = Week_of_Year($year,$m,$wd);
1210             next if (! $s->{woy}->[$w1-1]); # bacula 0-51
1211 #           print "        woy ok\n";
1212
1213             $wd = 0 if ($wd == 7) ; # sunday is 0 on bacula
1214             next if (! $s->{wday}->[$wd]);
1215 #           print "          wday ok\n";
1216
1217             foreach my $h (@{$s->{hour}}) # hour of the day
1218             {
1219                 foreach my $min (@{$s->{mins}}) # minute
1220                 {
1221                     if ($self->{fbegin}) {
1222                         no integer;
1223                         my $d = sprintf('%d%0.2d%0.2d.%0.2d%0.2d',
1224                                         $year,$m,$md,$h,$min);
1225                         next if ($d < $self->{fbegin} or $d > $self->{fend});
1226                     }
1227                     push @ret, sprintf($format, $year,$m,$md,$h,$min);
1228                 }
1229             }
1230         }
1231     }
1232     return @ret;
1233 }
1234 1;
1235
1236 ################################################################
1237
1238 package Bweb;
1239
1240 use base q/Bweb::Gui/;
1241
1242 =head1 PACKAGE
1243
1244     Bweb - main Bweb package
1245
1246 =head2
1247
1248     this package is use to compute and display informations
1249
1250 =cut
1251
1252 use DBI;
1253 use POSIX qw/strftime/;
1254
1255 our $config_file='/etc/bacula/bweb.conf';
1256
1257 our $cur_id=0;
1258
1259 =head1 VARIABLE
1260
1261     %sql_func - hash to make query mysql/postgresql compliant
1262
1263 =cut
1264
1265 our %sql_func = (
1266           Pg => {
1267               UNIX_TIMESTAMP => '',
1268               FROM_UNIXTIME => '',
1269               TO_SEC => " interval '1 second' * ",
1270               SEC_TO_INT => "SEC_TO_INT",
1271               SEC_TO_TIME => '',
1272               MATCH => " ~* ",
1273               STARTTIME_SEC  => " date_trunc('sec', Job.StartTime) ",
1274               STARTTIME_DAY  => " date_trunc('day', Job.StartTime) ",
1275               STARTTIME_HOUR => " date_trunc('hour', Job.StartTime) ",
1276               STARTTIME_MONTH  => " date_trunc('month', Job.StartTime) ",
1277               STARTTIME_WEEK => " date_trunc('week', Job.StartTime) ",
1278               STARTTIME_PHOUR=> " date_part('hour', Job.StartTime) ",
1279               STARTTIME_PDAY => " date_part('day', Job.StartTime) ",
1280               STARTTIME_PMONTH => " date_part('month', Job.StartTime) ",
1281               STARTTIME_PWEEK => " date_part('week', Job.StartTime) ",
1282               DB_SIZE => " SELECT pg_database_size(current_database()) ",
1283               CAT_POOL_TYPE => " MediaType || '_' || Pool.Name ",
1284               CONCAT_SEP => "",
1285           },
1286           mysql => {
1287               UNIX_TIMESTAMP => 'UNIX_TIMESTAMP',
1288               FROM_UNIXTIME => 'FROM_UNIXTIME',
1289               SEC_TO_INT => '',
1290               TO_SEC => '',
1291               SEC_TO_TIME => 'SEC_TO_TIME',
1292               MATCH => " REGEXP ",
1293               STARTTIME_SEC => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %T') ",
1294               STARTTIME_DAY  => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d') ",
1295               STARTTIME_HOUR => " DATE_FORMAT(Job.StartTime, '%Y-%m-%d %H') ",
1296               STARTTIME_MONTH => " DATE_FORMAT(Job.StartTime, '%Y-%m') ",
1297               STARTTIME_WEEK => " DATE_FORMAT(Job.StartTime, '%Y-%v') ",
1298               STARTTIME_PHOUR=> " DATE_FORMAT(Job.StartTime, '%H') ",
1299               STARTTIME_PDAY => " DATE_FORMAT(Job.StartTime, '%d') ",
1300               STARTTIME_PMONTH => " DATE_FORMAT(Job.StartTime, '%m') ",
1301               STARTTIME_PWEEK => " DATE_FORMAT(Job.StartTime, '%v') ",
1302               # with mysql < 5, you have to play with the ugly SHOW command
1303               DB_SIZE => " SELECT 0 ",
1304               # works only with mysql 5
1305               # DB_SIZE => " SELECT sum(DATA_LENGTH) FROM INFORMATION_SCHEMA.TABLES ",
1306               CAT_POOL_TYPE => " CONCAT(MediaType,'_',Pool.Name) ",
1307               CONCAT_SEP => " SEPARATOR '' ",
1308           },
1309          );
1310
1311 sub dbh_is_mysql
1312 {
1313     my ($self) = @_;
1314     return $self->{info}->{dbi} =~ /dbi:mysql/i;
1315 }
1316
1317 sub dbh_disconnect
1318 {
1319     my ($self) = @_;
1320     if ($self->{dbh}) {
1321        $self->{dbh}->disconnect();
1322        undef $self->{dbh};
1323     }
1324 }
1325
1326 sub dbh_selectall_arrayref
1327 {
1328     my ($self, $query) = @_;
1329     $self->connect_db();
1330     $self->debug($query);
1331     return $self->{dbh}->selectall_arrayref($query);
1332 }
1333
1334 sub dbh_join
1335 {
1336     my ($self, @what) = @_;
1337     return join(',', $self->dbh_quote(@what)) ;
1338 }
1339
1340 sub dbh_quote
1341 {
1342     my ($self, @what) = @_;
1343
1344     $self->connect_db();
1345     if (wantarray) {
1346         return map { $self->{dbh}->quote($_) } @what;
1347     } else {
1348         return $self->{dbh}->quote($what[0]) ;
1349     }
1350 }
1351
1352 sub dbh_do
1353 {
1354     my ($self, $query) = @_ ;
1355     $self->connect_db();
1356     $self->debug($query);
1357     return $self->{dbh}->do($query);
1358 }
1359
1360 sub dbh_selectall_hashref
1361 {
1362     my ($self, $query, $join) = @_;
1363
1364     $self->connect_db();
1365     $self->debug($query);
1366     return $self->{dbh}->selectall_hashref($query, $join) ;
1367 }
1368
1369 sub dbh_selectrow_hashref
1370 {
1371     my ($self, $query) = @_;
1372
1373     $self->connect_db();
1374     $self->debug($query);
1375     return $self->{dbh}->selectrow_hashref($query) ;
1376 }
1377
1378 sub dbh_strcat
1379 {
1380     my ($self, @what) = @_;
1381     if ($self->dbh_is_mysql()) {
1382         return 'CONCAT(' . join(',', @what) . ')' ;
1383     } else {
1384         return join(' || ', @what);
1385     }
1386 }
1387
1388 sub dbh_prepare
1389 {
1390     my ($self, $query) = @_;
1391     $self->debug($query, up => 1);
1392     return $self->{dbh}->prepare($query);
1393 }
1394
1395 # display Mb/Gb/Kb
1396 sub human_size
1397 {
1398     my @unit = qw(B KB MB GB TB);
1399     my $val = shift || 0;
1400     my $i=0;
1401     my $format = '%i %s';
1402     while ($val / 1024 > 1) {
1403         $i++;
1404         $val /= 1024;
1405     }
1406     $format = ($i>0)?'%0.1f %s':'%i %s';
1407     return sprintf($format, $val, $unit[$i]);
1408 }
1409
1410 # display Day, Hour, Year
1411 sub human_sec
1412 {
1413     use integer;
1414
1415     my $val = shift;
1416     $val /= 60;                 # sec -> min
1417
1418     if ($val / 60 <= 1) {
1419         return "$val mins";
1420     }
1421
1422     $val /= 60;                 # min -> hour
1423     if ($val / 24 <= 1) {
1424         return "$val hours";
1425     }
1426
1427     $val /= 24;                 # hour -> day
1428     if ($val / 365 < 2) {
1429         return "$val days";
1430     }
1431
1432     $val /= 365 ;               # day -> year
1433
1434     return "$val years";
1435 }
1436
1437 # display Enabled
1438 sub human_enabled
1439 {
1440     my $val = shift || 0;
1441
1442     if ($val eq '1' or $val eq "yes") {
1443         return "yes";
1444     } elsif ($val eq '2' or $val eq "archived") {
1445         return "archived";
1446     } else {
1447         return  "no";
1448     }
1449 }
1450
1451 # display Enabled
1452 sub from_human_enabled
1453 {
1454     my $val = shift || 0;
1455
1456     if ($val eq '1' or $val eq "yes") {
1457         return 1;
1458     } elsif ($val eq '2' or $val eq "archived") {
1459         return 2;
1460     } else {
1461         return  0;
1462     }
1463 }
1464
1465 # get Day, Hour, Year
1466 sub from_human_sec
1467 {
1468     use integer;
1469
1470     my $val = shift;
1471     unless ($val =~ /^\s*(\d+)\s*(\w)\w*\s*$/) {
1472         return 0;
1473     }
1474
1475     my %times = ( m   => 60,
1476                   h   => 60*60,
1477                   d   => 60*60*24,
1478                   m   => 60*60*24*31,
1479                   y   => 60*60*24*365,
1480                   );
1481     my $mult = $times{$2} || 0;
1482
1483     return $1 * $mult;
1484 }
1485
1486
1487 sub connect_db
1488 {
1489     my ($self) = @_;
1490
1491     unless ($self->{dbh}) {
1492
1493         $self->{dbh} = DBI->connect($self->{info}->{dbi},
1494                                     $self->{info}->{user},
1495                                     $self->{info}->{password});
1496
1497         $self->error("Can't connect to your database:\n$DBI::errstr\n")
1498             unless ($self->{dbh});
1499
1500         $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
1501
1502         if ($self->dbh_is_mysql()) {
1503             $self->{dbh}->do("SET group_concat_max_len=1000000");
1504         } else {
1505             $self->{dbh}->do("SET datestyle TO 'ISO, YMD'");
1506         }
1507     }
1508 }
1509
1510 sub new
1511 {
1512     my ($class, %arg) = @_;
1513     my $self = bless ({
1514         dbh => undef,           # connect_db();
1515         info => {
1516             dbi   => '', # DBI:Pg:database=bacula;host=127.0.0.1
1517             user  => 'bacula',
1518             password => 'test',
1519         },
1520     },$class) ;
1521
1522     map { $self->{lc($_)} = $arg{$_} } keys %arg ;
1523
1524     if ($self->{info}->{dbi} =~ /DBI:(\w+):/i) {
1525         $self->{sql} = $sql_func{$1};
1526     }
1527
1528     $self->{loginname} = CGI::remote_user();
1529     $self->{debug} = $self->{info}->{debug};
1530     $self->{lang} = $self->{info}->{lang};
1531     $self->{template_dir} = $self->{info}->{template_dir};
1532
1533     return $self;
1534 }
1535
1536 sub display_begin
1537 {
1538     my ($self) = @_;
1539     if ($self->{info}->{enable_security}) {
1540         $self->get_roles();     # get lang
1541     }
1542     $self->display($self->{info}, "begin.tpl");
1543 }
1544
1545 sub display_end
1546 {
1547     my ($self) = @_;
1548     $self->display($self->{info}, "end.tpl");
1549 }
1550
1551 sub display_clients
1552 {
1553     my ($self) = @_;
1554     my $where='';       # by default
1555
1556     my $arg = $self->get_form("client", "qre_client",
1557                               "jclient_groups", "qnotingroup");
1558
1559     if ($arg->{qre_client}) {
1560         $where = "WHERE Name $self->{sql}->{MATCH} $arg->{qre_client} ";
1561     } elsif ($arg->{client}) {
1562         $where = "WHERE Name = '$arg->{client}' ";
1563     } elsif ($arg->{jclient_groups}) {
1564         # $filter could already contains client_group_member
1565         $where = "
1566  JOIN client_group_member USING (ClientId)
1567  JOIN client_group USING (client_group_id)
1568  WHERE client_group_name IN ($arg->{jclient_groups}) ";
1569     } elsif ($arg->{qnotingroup}) {
1570         $where =   "
1571   WHERE NOT EXISTS
1572    (SELECT 1 FROM client_group_member
1573      WHERE Client.ClientId = client_group_member.ClientId
1574    )
1575 ";
1576     }
1577
1578     my $query = "
1579 SELECT Name   AS name,
1580        Uname  AS uname,
1581        AutoPrune AS autoprune,
1582        FileRetention AS fileretention,
1583        JobRetention  AS jobretention
1584 FROM Client " . $self->get_client_filter() .
1585 $where ;
1586
1587     my $all = $self->dbh_selectall_hashref($query, 'name') ;
1588
1589     my $dsp = { ID => $cur_id++,
1590                 clients => [ values %$all] };
1591
1592     $self->display($dsp, "client_list.tpl") ;
1593 }
1594
1595 sub get_limit
1596 {
1597     my ($self, %arg) = @_;
1598
1599     my $limit = '';
1600     my $label = '';
1601
1602     if ($arg{since} and $arg{age}) {
1603         my $now = "$self->{sql}->{UNIX_TIMESTAMP}(TIMESTAMP '$arg{since}')";
1604         $limit .= "
1605  AND $self->{sql}->{UNIX_TIMESTAMP}(StartTime) > $now
1606  AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime) < ($now + $self->{sql}->{TO_SEC}($arg{age}))";
1607         $label .= "since $arg{since} and during " . human_sec($arg{age});
1608
1609     } elsif ($arg{age}) {
1610         $limit .=
1611   "AND $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
1612          >
1613        ( $self->{sql}->{UNIX_TIMESTAMP}(NOW())
1614          -
1615          $self->{sql}->{TO_SEC}($arg{age})
1616        )" ;
1617
1618         $label = "last " . human_sec($arg{age});
1619     }
1620
1621     if ($arg{groupby}) {
1622         $limit .= " GROUP BY $arg{groupby} ";
1623     }
1624
1625     if ($arg{order}) {
1626         $limit .= " ORDER BY $arg{order} ";
1627     }
1628
1629     if ($arg{limit}) {
1630         $limit .= " LIMIT $arg{limit} ";
1631         $label .= " limited to $arg{limit}";
1632     }
1633
1634     if ($arg{offset}) {
1635         $limit .= " OFFSET $arg{offset} ";
1636         $label .= " with $arg{offset} offset ";
1637     }
1638
1639     unless ($label) {
1640         $label = 'no filter';
1641     }
1642
1643     return ($limit, $label);
1644 }
1645
1646 =head1 FUNCTION
1647
1648     $bweb->get_form(...) - Get useful stuff
1649
1650 =head2 DESCRIPTION
1651
1652     This function get and check parameters against regexp.
1653
1654     If word begin with 'q', the return will be quoted or join quoted
1655     if it's end with 's'.
1656
1657
1658 =head2 EXAMPLE
1659
1660     $bweb->get_form('jobid', 'qclient', 'qpools') ;
1661
1662     { jobid    => 12,
1663       qclient  => 'plume-fd',
1664       qpools   => "'plume-fd', 'test-fd', '...'",
1665     }
1666
1667 =cut
1668
1669 sub get_form
1670 {
1671     my ($self, @what) = @_;
1672     my %what = map { $_ => 1 } @what;
1673     my %ret;
1674
1675     my %opt_i = (
1676                  limit  => 100,
1677                  cost   =>  10,
1678                  offset =>   0,
1679                  width  => 640,
1680                  height => 480,
1681                  jobid  =>   0,
1682                  slot   =>   0,
1683                  drive  =>   0,
1684                  priority => 10,
1685                  age    => 60*60*24*7,
1686                  days   => 1,
1687                  maxvoljobs  => 0,
1688                  maxvolbytes => 0,
1689                  maxvolfiles => 0,
1690                  filenameid => 0,
1691                  pathid => 0,
1692                  nb => 0,
1693                  );
1694
1695     my %opt_ss =(               # string with space
1696                  job     => 1,
1697                  storage => 1,
1698                  );
1699     my %opt_s = (               # default to ''
1700                  ach    => 1,
1701                  status => 1,
1702                  volstatus => 1,
1703                  inchanger => 1,
1704                  client => 1,
1705                  level  => 1,
1706                  pool   => 1,
1707                  media  => 1,
1708                  ach    => 1,
1709                  jobtype=> 1,
1710                  graph  => 1,
1711                  gtype  => 1,
1712                  type   => 1,
1713                  poolrecycle => 1,
1714                  replace => 1,
1715                  expired => 1,
1716                  enabled => 1,
1717                  username => 1,
1718                  rolename => 1,
1719                  storage_cmd => 1,
1720                  );
1721     my %opt_p = (               # option with path
1722                  fileset=> 1,
1723                  mtxcmd => 1,
1724                  precmd => 1,
1725                  device => 1,
1726                  where  => 1,
1727                  );
1728     my %opt_r = (regexwhere => 1);
1729     my %opt_d = (               # option with date
1730                  voluseduration=> 1,
1731                  volretention => 1,
1732                 );
1733     my %opt_t = (when => 2,     # option with time
1734                  begin => 1,    # 1 hh:min are optionnal
1735                  end => 1,      # 2 hh:min are required
1736                  );
1737
1738     foreach my $i (@what) {
1739         if (exists $opt_i{$i}) {# integer param
1740             my $value = CGI::param($i) || $opt_i{$i} ;
1741             if ($value =~ /^(\d+)$/) {
1742                 $ret{$i} = $1;
1743             }
1744         } elsif ($opt_s{$i}) {  # simple string param
1745             my $value = CGI::param($i) || '';
1746             if ($value =~ /^([\w\d\.-]+)$/) {
1747                 $ret{$i} = $1;
1748             }
1749         } elsif ($opt_ss{$i}) { # simple string param (with space)
1750             my $value = CGI::param($i) || '';
1751             if ($value =~ /^([\w\d\.\-\s]+)$/) {
1752                 $ret{$i} = $1;
1753             }
1754         } elsif ($i =~ /^j(\w+)s$/) { # quote join args "'arg1', 'arg2'"
1755             my @value = grep { ! /^\s*$/ } CGI::param($1) ;
1756             if (@value) {
1757                 $ret{$i} = $self->dbh_join(@value) ;
1758             }
1759
1760         } elsif ($i =~ /^q(\w+[^s])$/) { # 'arg1'
1761             my $value = CGI::param($1) ;
1762             if ($value) {
1763                 $ret{$i} = $self->dbh_quote($value);
1764             }
1765
1766         } elsif ($i =~ /^q(\w+)s$/) { #[ 'arg1', 'arg2']
1767             $ret{$i} = [ map { { name => $self->dbh_quote($_) } }
1768                                            grep { ! /^\s*$/ } CGI::param($1) ];
1769         } elsif (exists $opt_p{$i}) {
1770             my $value = CGI::param($i) || '';
1771             if ($value =~ /^([\w\d\.\/\s:\@\-]+)$/) {
1772                 $ret{$i} = $1;
1773             }
1774         } elsif (exists $opt_r{$i}) {
1775             my $value = CGI::param($i) || '';
1776             if ($value =~ /^([^'"']+)$/) {
1777                 $ret{$i} = $1;
1778             }
1779         } elsif (exists $opt_d{$i}) {
1780             my $value = CGI::param($i) || '';
1781             if ($value =~ /^\s*(\d+\s+\w+)$/) {
1782                 $ret{$i} = $1;
1783             }
1784         } elsif (exists $opt_t{$i}) { # 1: hh:min optionnal, 2: hh:min required
1785             my $when = CGI::param($i) || '';
1786             if ($when =~ /(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?)/) {
1787                 if ($opt_t{$i} == 1 or defined $2) {
1788                     $ret{$i} = $1;
1789                 }
1790             }
1791         }
1792     }
1793
1794     if ($what{storage_cmd}) {
1795         if (!grep {/^$ret{storage_cmd}$/} ('mount', 'umount', 'release','status')) {
1796             delete $ret{storage_cmd};
1797         }
1798     }
1799
1800     if ($what{slots}) {
1801         foreach my $s (CGI::param('slot')) {
1802             if ($s =~ /^(\d+)$/) {
1803                 push @{$ret{slots}}, $s;
1804             }
1805         }
1806     }
1807
1808     if ($what{since}) {
1809         my $age = $ret{age} || $opt_i{age};
1810         my $since = CGI::param('since') || strftime('%F %T', localtime(time - $age));
1811         if ($since =~ /^(\d{4}-\d{2}-\d{2}( \d{2}:\d{2}:\d{2})?)$/) {
1812             $ret{since} = $1;
1813         }
1814     }
1815
1816     if ($what{lang}) {
1817         my $lang = CGI::param('lang') || 'en';
1818         if ($lang =~ /^(\w\w)$/) {
1819             $ret{lang} = $1;
1820         }
1821     }
1822
1823     if ($what{db_clients}) {
1824         my $filter='';
1825         if ($what{filter}) {
1826             # get security filter only if asked
1827             $filter = $self->get_client_filter();
1828         }
1829
1830         my $query = "
1831 SELECT Client.Name as clientname
1832   FROM Client $filter
1833 ";
1834
1835         my $clients = $self->dbh_selectall_hashref($query, 'clientname');
1836         $ret{db_clients} = [sort {$a->{clientname} cmp $b->{clientname} }
1837                               values %$clients] ;
1838     }
1839
1840     if ($what{db_client_groups}) {
1841         my $filter='';
1842         if ($what{filter}) {
1843             # get security filter only if asked
1844             $filter = $self->get_client_group_filter();
1845         }
1846
1847         my $query = "
1848 SELECT client_group_name AS name
1849   FROM client_group $filter
1850 ";
1851         my $grps = $self->dbh_selectall_hashref($query, 'name');
1852         $ret{db_client_groups} = [sort {$a->{name} cmp $b->{name} }
1853                                   values %$grps] ;
1854     }
1855
1856     if ($what{db_usernames}) {
1857         my $query = "
1858 SELECT username
1859   FROM bweb_user
1860 ";
1861         my $users = $self->dbh_selectall_hashref($query, 'username');
1862         $ret{db_usernames} = [sort {$a->{username} cmp $b->{username} }
1863                                   values %$users] ;
1864     }
1865
1866     if ($what{db_roles}) {
1867         my $query = "
1868 SELECT rolename
1869   FROM bweb_role
1870 ";
1871         my $r = $self->dbh_selectall_hashref($query, 'rolename');
1872         $ret{db_roles} = [sort {$a->{rolename} cmp $b->{rolename} }
1873                                   values %$r] ;
1874     }
1875
1876     if ($what{db_mediatypes}) {
1877         my $query = "
1878 SELECT MediaType as mediatype
1879   FROM MediaType
1880 ";
1881         my $media = $self->dbh_selectall_hashref($query, 'mediatype');
1882         $ret{db_mediatypes} = [sort {$a->{mediatype} cmp $b->{mediatype} }
1883                                   values %$media] ;
1884     }
1885
1886     if ($what{db_locations}) {
1887         my $query = "
1888 SELECT Location as location, Cost as cost
1889   FROM Location
1890 ";
1891         my $loc = $self->dbh_selectall_hashref($query, 'location');
1892         $ret{db_locations} = [ sort { $a->{location}
1893                                       cmp
1894                                       $b->{location}
1895                                   } values %$loc ];
1896     }
1897
1898     if ($what{db_pools}) {
1899         my $query = "SELECT Name as name FROM Pool";
1900
1901         my $all = $self->dbh_selectall_hashref($query, 'name') ;
1902         $ret{db_pools} = [ sort { $a->{name} cmp $b->{name} } values %$all ];
1903     }
1904
1905     if ($what{db_filesets}) {
1906         my $query = "
1907 SELECT FileSet.FileSet AS fileset
1908   FROM FileSet
1909 ";
1910         my $filesets = $self->dbh_selectall_hashref($query, 'fileset');
1911
1912         $ret{db_filesets} = [sort {lc($a->{fileset}) cmp lc($b->{fileset}) }
1913                                values %$filesets] ;
1914     }
1915
1916     if ($what{db_jobnames}) {
1917         my $filter='';
1918         if ($what{filter}) {
1919             $filter = " JOIN Client USING (ClientId) " . $self->get_client_filter();
1920         }
1921         my $query = "
1922 SELECT DISTINCT Job.Name AS jobname
1923   FROM Job $filter
1924 ";
1925         my $jobnames = $self->dbh_selectall_hashref($query, 'jobname');
1926
1927         $ret{db_jobnames} = [sort {lc($a->{jobname}) cmp lc($b->{jobname}) }
1928                                values %$jobnames] ;
1929     }
1930
1931     if ($what{db_devices}) {
1932         my $query = "
1933 SELECT Device.Name AS name
1934   FROM Device
1935 ";
1936         my $devices = $self->dbh_selectall_hashref($query, 'name');
1937
1938         $ret{db_devices} = [sort {lc($a->{name}) cmp lc($b->{name}) }
1939                                values %$devices] ;
1940     }
1941
1942     return \%ret;
1943 }
1944
1945 sub display_graph
1946 {
1947     my ($self) = @_;
1948     $self->can_do('r_view_stat');
1949     my $fields = $self->get_form(qw/age level status clients filesets
1950                                     graph gtype type filter db_clients
1951                                     limit db_filesets width height
1952                                     qclients qfilesets qjobnames db_jobnames/);
1953
1954     my $url = CGI::url(-full => 0,
1955                       -base => 0,
1956                       -query => 1);
1957     $url =~ s/^.+?\?//; # http://path/to/bweb.pl?arg => arg
1958
1959 # this organisation is to keep user choice between 2 click
1960 # TODO : fileset and client selection doesn't work
1961
1962     $self->display({
1963         url => $url,
1964         %$fields,
1965     }, "graph.tpl");
1966
1967     if ($fields->{gtype} eq 'balloon') {
1968         system("./bgraph.pl");
1969     }
1970 }
1971
1972 sub get_selected_media_location
1973 {
1974     my ($self) = @_ ;
1975
1976     my $media = $self->get_form('jmedias');
1977
1978     unless ($media->{jmedias}) {
1979         return undef;
1980     }
1981
1982     my $query = "
1983 SELECT Media.VolumeName AS volumename, Location.Location AS location
1984 FROM Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
1985 WHERE Media.VolumeName IN ($media->{jmedias})
1986 ";
1987
1988     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
1989
1990     # { 'vol1' => { [volumename => 'vol1', location => 'ici'],
1991     #               ..
1992     #             }
1993     # }
1994     return $all;
1995 }
1996
1997 sub move_media
1998 {
1999     my ($self, $in) = @_ ;
2000     $self->can_do('r_media_mgnt');
2001     my $media = $self->get_selected_media_location();
2002
2003     unless ($media) {
2004         return ;
2005     }
2006
2007     my $elt = $self->get_form('db_locations');
2008
2009     $self->display({ ID => $cur_id++,
2010                      enabled => human_enabled($in),
2011                      %$elt,     # db_locations
2012                      media => [
2013             sort { $a->{volumename} cmp $b->{volumename} } values %$media
2014                                ],
2015                      },
2016                    "move_media.tpl");
2017 }
2018
2019 sub help_extern
2020 {
2021     my ($self) = @_ ;
2022     $self->can_do('r_media_mgnt');
2023
2024     my $elt = $self->get_form(qw/db_pools db_mediatypes db_locations/) ;
2025     $self->debug($elt);
2026     $self->display($elt, "help_extern.tpl");
2027 }
2028
2029 sub help_extern_compute
2030 {
2031     my ($self) = @_;
2032     $self->can_do('r_media_mgnt');
2033
2034     my $number = CGI::param('limit') || '' ;
2035     unless ($number =~ /^(\d+)$/) {
2036         return $self->error("Bad arg number : $number ");
2037     }
2038
2039     my ($sql, undef) = $self->get_param('pools',
2040                                         'locations', 'mediatypes');
2041
2042     my $query = "
2043 SELECT Media.VolumeName  AS volumename,
2044        Media.VolStatus   AS volstatus,
2045        Media.LastWritten AS lastwritten,
2046        Media.MediaType   AS mediatype,
2047        Media.VolMounts   AS volmounts,
2048        Pool.Name         AS name,
2049        Media.Recycle     AS recycle,
2050        $self->{sql}->{FROM_UNIXTIME}(
2051           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2052         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2053        ) AS expire
2054 FROM Media
2055  INNER JOIN Pool     ON (Pool.PoolId = Media.PoolId)
2056  LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
2057
2058 WHERE Media.InChanger = 1
2059   AND Media.VolStatus IN ('Disabled', 'Error', 'Full')
2060   $sql
2061 ORDER BY expire DESC, recycle, Media.VolMounts DESC
2062 LIMIT $number
2063 " ;
2064
2065     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2066
2067     $self->display({ Media => [ values %$all ] },
2068                    "help_extern_compute.tpl");
2069 }
2070
2071 sub help_intern
2072 {
2073     my ($self) = @_ ;
2074     $self->can_do('r_media_mgnt');
2075
2076     my $param = $self->get_form(qw/db_locations db_pools db_mediatypes/) ;
2077     $self->display($param, "help_intern.tpl");
2078 }
2079
2080 sub help_intern_compute
2081 {
2082     my ($self) = @_;
2083     $self->can_do('r_media_mgnt');
2084
2085     my $number = CGI::param('limit') || '' ;
2086     unless ($number =~ /^(\d+)$/) {
2087         return $self->error("Bad arg number : $number ");
2088     }
2089
2090     my ($sql, undef) = $self->get_param('pools', 'locations', 'mediatypes');
2091
2092     if (CGI::param('expired')) {
2093         $sql = "
2094 AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2095        + $self->{sql}->{TO_SEC}(Media.VolRetention)
2096     ) < NOW()
2097  " . $sql ;
2098     }
2099
2100     my $query = "
2101 SELECT Media.VolumeName  AS volumename,
2102        Media.VolStatus   AS volstatus,
2103        Media.LastWritten AS lastwritten,
2104        Media.MediaType   AS mediatype,
2105        Media.VolMounts   AS volmounts,
2106        Pool.Name         AS name,
2107        $self->{sql}->{FROM_UNIXTIME}(
2108           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2109         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2110        ) AS expire
2111 FROM Media
2112  INNER JOIN Pool ON (Pool.PoolId = Media.PoolId)
2113  LEFT  JOIN Location ON (Location.LocationId = Media.LocationId)
2114
2115 WHERE Media.InChanger <> 1
2116   AND Media.VolStatus IN ('Purged', 'Full', 'Append')
2117   AND Media.Recycle = 1
2118   $sql
2119 ORDER BY Media.VolUseDuration DESC, Media.VolMounts ASC, expire ASC
2120 LIMIT $number
2121 " ;
2122
2123     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2124
2125     $self->display({ Media => [ values %$all ] },
2126                    "help_intern_compute.tpl");
2127
2128 }
2129
2130 sub display_general
2131 {
2132     my ($self, %arg) = @_ ;
2133
2134     my ($limit, $label) = $self->get_limit(%arg);
2135
2136     my $query = "
2137 SELECT
2138     (SELECT count(Pool.PoolId)   FROM Pool)   AS nb_pool,
2139     (SELECT count(Media.MediaId) FROM Media)  AS nb_media,
2140     (SELECT count(Job.JobId)     FROM Job)    AS nb_job,
2141     (SELECT sum(VolBytes)        FROM Media)  AS nb_bytes,
2142     ($self->{sql}->{DB_SIZE})                 AS db_size,
2143     (SELECT count(Job.JobId)
2144       FROM Job
2145       WHERE Job.JobStatus IN ('E','e','f','A')
2146       $limit
2147     )                                         AS nb_err,
2148     (SELECT count(Client.ClientId) FROM Client) AS nb_client
2149 ";
2150
2151     my $row = $self->dbh_selectrow_hashref($query) ;
2152
2153     $row->{nb_bytes} = human_size($row->{nb_bytes});
2154
2155     $row->{db_size} = human_size($row->{db_size});
2156     $row->{label} = $label;
2157
2158     $self->display($row, "general.tpl");
2159 }
2160
2161 sub get_param
2162 {
2163     my ($self, @what) = @_ ;
2164     my %elt = map { $_ => 1 } @what;
2165     my %ret;
2166
2167     my $limit = '';
2168
2169     if ($elt{clients}) {
2170         my @clients = grep { ! /^\s*$/ } CGI::param('client');
2171         if (@clients) {
2172             $ret{clients} = \@clients;
2173             my $str = $self->dbh_join(@clients);
2174             $limit .= "AND Client.Name IN ($str) ";
2175         }
2176     }
2177
2178     if ($elt{client_groups}) {
2179         my @clients = grep { ! /^\s*$/ } CGI::param('client_group');
2180         if (@clients) {
2181             $ret{client_groups} = \@clients;
2182             my $str = $self->dbh_join(@clients);
2183             $limit .= "AND client_group_name IN ($str) ";
2184         }
2185     }
2186
2187     if ($elt{filesets}) {
2188         my @filesets = grep { ! /^\s*$/ } CGI::param('fileset');
2189         if (@filesets) {
2190             $ret{filesets} = \@filesets;
2191             my $str = $self->dbh_join(@filesets);
2192             $limit .= "AND FileSet.FileSet IN ($str) ";
2193         }
2194     }
2195
2196     if ($elt{mediatypes}) {
2197         my @media = grep { ! /^\s*$/ } CGI::param('mediatype');
2198         if (@media) {
2199             $ret{mediatypes} = \@media;
2200             my $str = $self->dbh_join(@media);
2201             $limit .= "AND Media.MediaType IN ($str) ";
2202         }
2203     }
2204
2205     if ($elt{client}) {
2206         my $client = CGI::param('client');
2207         $ret{client} = $client;
2208         $client = $self->dbh_join($client);
2209         $limit .= "AND Client.Name = $client ";
2210     }
2211
2212     if ($elt{level}) {
2213         my $level = CGI::param('level') || '';
2214         if ($level =~ /^(\w)$/) {
2215             $ret{level} = $1;
2216             $limit .= "AND Job.Level = '$1' ";
2217         }
2218     }
2219
2220     if ($elt{jobid}) {
2221         my $jobid = CGI::param('jobid') || '';
2222
2223         if ($jobid =~ /^(\d+)$/) {
2224             $ret{jobid} = $1;
2225             $limit .= "AND Job.JobId = '$1' ";
2226         }
2227     }
2228
2229     if ($elt{status}) {
2230         my $status = CGI::param('status') || '';
2231         if ($status =~ /^(\w)$/) {
2232             $ret{status} = $1;
2233             if ($1 eq 'f') {
2234                 $limit .= "AND Job.JobStatus IN ('f','E') ";
2235             } elsif ($1 eq 'W') {
2236                 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
2237             } else {
2238                 $limit .= "AND Job.JobStatus = '$1' ";
2239             }
2240         }
2241     }
2242
2243     if ($elt{volstatus}) {
2244         my $status = CGI::param('volstatus') || '';
2245         if ($status =~ /^(\w+)$/) {
2246             $ret{status} = $1;
2247             $limit .= "AND Media.VolStatus = '$1' ";
2248         }
2249     }
2250
2251     if ($elt{locations}) {
2252         my @location = grep { ! /^\s*$/ } CGI::param('location') ;
2253         if (@location) {
2254             $ret{locations} = \@location;
2255             my $str = $self->dbh_join(@location);
2256             $limit .= "AND Location.Location IN ($str) ";
2257         }
2258     }
2259
2260     if ($elt{pools}) {
2261         my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
2262         if (@pool) {
2263             $ret{pools} = \@pool;
2264             my $str = $self->dbh_join(@pool);
2265             $limit .= "AND Pool.Name IN ($str) ";
2266         }
2267     }
2268
2269     if ($elt{location}) {
2270         my $location = CGI::param('location') || '';
2271         if ($location) {
2272             $ret{location} = $location;
2273             $location = $self->dbh_quote($location);
2274             $limit .= "AND Location.Location = $location ";
2275         }
2276     }
2277
2278     if ($elt{pool}) {
2279         my $pool = CGI::param('pool') || '';
2280         if ($pool) {
2281             $ret{pool} = $pool;
2282             $pool = $self->dbh_quote($pool);
2283             $limit .= "AND Pool.Name = $pool ";
2284         }
2285     }
2286
2287     if ($elt{jobtype}) {
2288         my $jobtype = CGI::param('jobtype') || '';
2289         if ($jobtype =~ /^(\w)$/) {
2290             $ret{jobtype} = $1;
2291             $limit .= "AND Job.Type = '$1' ";
2292         }
2293     }
2294
2295     return ($limit, %ret);
2296 }
2297
2298 =head1
2299
2300     get last backup
2301
2302 =cut
2303
2304 sub display_job
2305 {
2306     my ($self, %arg) = @_ ;
2307     return if $self->cant_do('r_view_job');
2308
2309     $arg{order} = ' Job.JobId DESC ';
2310
2311     my ($limit, $label) = $self->get_limit(%arg);
2312     my ($where, undef) = $self->get_param('clients',
2313                                           'client_groups',
2314                                           'level',
2315                                           'filesets',
2316                                           'jobtype',
2317                                           'pools',
2318                                           'jobid',
2319                                           'status');
2320     my $cgq='';
2321     if (CGI::param('client_group')) {
2322         $cgq .= "
2323 JOIN client_group_member USING (ClientId)
2324 JOIN client_group USING (client_group_id)
2325 ";
2326     }
2327     my $filter = $self->get_client_filter();
2328
2329     my $query="
2330 SELECT  Job.JobId       AS jobid,
2331         Client.Name     AS client,
2332         FileSet.FileSet AS fileset,
2333         Job.Name        AS jobname,
2334         Level           AS level,
2335         StartTime       AS starttime,
2336         EndTime         AS endtime,
2337         Pool.Name       AS poolname,
2338         JobFiles        AS jobfiles,
2339         JobBytes        AS jobbytes,
2340         JobStatus       AS jobstatus,
2341      $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2342                                  - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2343                         AS duration,
2344
2345         JobErrors       AS joberrors
2346
2347  FROM Client $filter $cgq,
2348       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
2349           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
2350  WHERE Client.ClientId=Job.ClientId
2351    AND Job.JobStatus NOT IN ('R', 'C')
2352  $where
2353  $limit
2354 ";
2355
2356     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2357
2358     $self->display({ Filter => $label,
2359                      ID => $cur_id++,
2360                      Jobs =>
2361                            [
2362                              sort { $a->{jobid} <=>  $b->{jobid} }
2363                                         values %$all
2364                              ],
2365                    },
2366                    "display_job.tpl");
2367 }
2368
2369 # display job informations
2370 sub display_job_zoom
2371 {
2372     my ($self, $jobid) = @_ ;
2373     $self->can_do('r_view_job');
2374
2375     $jobid = $self->dbh_quote($jobid);
2376
2377     # get security filter
2378     my $filter = $self->get_client_filter();
2379
2380     my $query="
2381 SELECT DISTINCT Job.JobId       AS jobid,
2382                 Client.Name     AS client,
2383                 Job.Name        AS jobname,
2384                 FileSet.FileSet AS fileset,
2385                 Level           AS level,
2386                 Pool.Name       AS poolname,
2387                 StartTime       AS starttime,
2388                 JobFiles        AS jobfiles,
2389                 JobBytes        AS jobbytes,
2390                 JobStatus       AS jobstatus,
2391                 JobErrors       AS joberrors,
2392                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2393                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2394
2395  FROM Client $filter,
2396       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2397           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
2398  WHERE Client.ClientId=Job.ClientId
2399  AND Job.JobId = $jobid
2400 ";
2401
2402     my $row = $self->dbh_selectrow_hashref($query) ;
2403
2404     # display all volumes associate with this job
2405     $query="
2406 SELECT Media.VolumeName as volumename
2407 FROM Job,Media,JobMedia
2408 WHERE Job.JobId = $jobid
2409  AND JobMedia.JobId=Job.JobId
2410  AND JobMedia.MediaId=Media.MediaId
2411 ";
2412
2413     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2414
2415     $row->{volumes} = [ values %$all ] ;
2416     $row->{wiki_url} = $self->{info}->{wiki_url};
2417
2418     $self->display($row, "display_job_zoom.tpl");
2419 }
2420
2421 sub display_job_group
2422 {
2423     my ($self, %arg) = @_;
2424     $self->can_do('r_view_job');
2425
2426     my ($limit, $label) = $self->get_limit(groupby => 'client_group_name',  %arg);
2427
2428     my ($where, undef) = $self->get_param('client_groups',
2429                                           'level',
2430                                           'pools');
2431     my $filter = $self->get_client_group_filter();
2432     my $query =
2433 "
2434 SELECT client_group_name AS client_group_name,
2435        COALESCE(jobok.jobfiles,0)  + COALESCE(joberr.jobfiles,0)  AS jobfiles,
2436        COALESCE(jobok.jobbytes,0)  + COALESCE(joberr.jobbytes,0)  AS jobbytes,
2437        COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2438        COALESCE(jobok.nbjobs,0)  AS nbjobok,
2439        COALESCE(joberr.nbjobs,0) AS nbjoberr,
2440        COALESCE(jobok.duration, '0:0:0') AS duration
2441
2442 FROM client_group $filter LEFT JOIN (
2443     SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2444            SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2445            SUM(JobErrors) AS joberrors,
2446            SUM($self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2447                               - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2448                         AS duration
2449
2450     FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2451              JOIN client_group USING (client_group_id)
2452
2453     WHERE JobStatus = 'T'
2454     $where
2455     $limit
2456 ) AS jobok USING (client_group_name) LEFT JOIN
2457
2458 (
2459     SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2460            SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2461            SUM(JobErrors) AS joberrors
2462     FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2463              JOIN client_group USING (client_group_id)
2464
2465     WHERE JobStatus IN ('f','E', 'A')
2466     $where
2467     $limit
2468 ) AS joberr USING (client_group_name)
2469
2470     ";
2471
2472     my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2473
2474     my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2475
2476     $self->debug($rep);
2477     $self->display($rep, "display_job_group.tpl");
2478 }
2479
2480 sub display_media
2481 {
2482     my ($self, %arg) = @_ ;
2483     $self->can_do('r_view_media');
2484
2485     my ($limit, $label) = $self->get_limit(%arg);
2486     my ($where, %elt) = $self->get_param('pools',
2487                                          'mediatypes',
2488                                          'volstatus',
2489                                          'locations');
2490
2491     my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2492
2493     if ($arg->{jmedias}) {
2494         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2495     }
2496     if ($arg->{qre_media}) {
2497         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2498     }
2499     if ($arg->{expired}) {
2500         $where = "
2501         AND VolStatus = 'Full'
2502         AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2503                + $self->{sql}->{TO_SEC}(Media.VolRetention)
2504             ) < NOW()  " . $where ;
2505     }
2506
2507     my $query="
2508 SELECT Media.VolumeName  AS volumename,
2509        Media.VolBytes    AS volbytes,
2510        Media.VolStatus   AS volstatus,
2511        Media.MediaType   AS mediatype,
2512        Media.InChanger   AS online,
2513        Media.LastWritten AS lastwritten,
2514        Location.Location AS location,
2515        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
2516        Pool.Name         AS poolname,
2517        $self->{sql}->{FROM_UNIXTIME}(
2518           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2519         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2520        ) AS expire
2521 FROM      Pool, Media
2522 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2523 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2524                   Media.MediaType     AS MediaType
2525            FROM Media
2526           WHERE Media.VolStatus = 'Full'
2527           GROUP BY Media.MediaType
2528            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2529
2530 WHERE Media.PoolId=Pool.PoolId
2531 $where
2532 $limit
2533 ";
2534
2535     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2536
2537     $self->display({ ID => $cur_id++,
2538                      Pool => $elt{pool},
2539                      Location => $elt{location},
2540                      Media => [ values %$all ],
2541                    },
2542                    "display_media.tpl");
2543 }
2544
2545 sub display_allmedia
2546 {
2547     my ($self) = @_ ;
2548
2549     my $pool = $self->get_form('db_pools');
2550
2551     foreach my $name (@{ $pool->{db_pools} }) {
2552         CGI::param('pool', $name->{name});
2553         $self->display_media();
2554     }
2555 }
2556
2557 sub display_media_zoom
2558 {
2559     my ($self) = @_ ;
2560
2561     my $media = $self->get_form('jmedias');
2562
2563     unless ($media->{jmedias}) {
2564         return $self->error("Can't get media selection");
2565     }
2566
2567     my $query="
2568 SELECT InChanger     AS online,
2569        Media.Enabled AS enabled,
2570        VolBytes      AS nb_bytes,
2571        VolumeName    AS volumename,
2572        VolStatus     AS volstatus,
2573        VolMounts     AS nb_mounts,
2574        Media.VolUseDuration   AS voluseduration,
2575        Media.MaxVolJobs AS maxvoljobs,
2576        Media.MaxVolFiles AS maxvolfiles,
2577        Media.MaxVolBytes AS maxvolbytes,
2578        VolErrors     AS nb_errors,
2579        Pool.Name     AS poolname,
2580        Location.Location AS location,
2581        Media.Recycle AS recycle,
2582        Media.VolRetention AS volretention,
2583        Media.LastWritten  AS lastwritten,
2584        Media.VolReadTime/1000000  AS volreadtime,
2585        Media.VolWriteTime/1000000 AS volwritetime,
2586        Media.RecycleCount AS recyclecount,
2587        Media.Comment      AS comment,
2588        $self->{sql}->{FROM_UNIXTIME}(
2589           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2590         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2591        ) AS expire
2592  FROM Pool,
2593       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2594  WHERE Pool.PoolId = Media.PoolId
2595  AND VolumeName IN ($media->{jmedias})
2596 ";
2597
2598     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2599
2600     foreach my $media (values %$all) {
2601         my $mq = $self->dbh_quote($media->{volumename});
2602
2603         $query = "
2604 SELECT DISTINCT Job.JobId AS jobid,
2605                 Job.Name  AS name,
2606                 Job.StartTime AS starttime,
2607                 Job.Type  AS type,
2608                 Job.Level AS level,
2609                 Job.JobFiles AS files,
2610                 Job.JobBytes AS bytes,
2611                 Job.jobstatus AS status
2612  FROM Media,JobMedia,Job
2613  WHERE Media.VolumeName=$mq
2614  AND Media.MediaId=JobMedia.MediaId
2615  AND JobMedia.JobId=Job.JobId
2616 ";
2617
2618         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2619
2620         $query = "
2621 SELECT LocationLog.Date    AS date,
2622        Location.Location   AS location,
2623        LocationLog.Comment AS comment
2624  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2625  WHERE Media.MediaId = LocationLog.MediaId
2626    AND Media.VolumeName = $mq
2627 ";
2628
2629         my $logtxt = '';
2630         my $log = $self->dbh_selectall_arrayref($query) ;
2631         if ($log) {
2632             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2633         }
2634
2635         $self->display({ jobs => [ values %$jobs ],
2636                          LocationLog => $logtxt,
2637                          %$media },
2638                        "display_media_zoom.tpl");
2639     }
2640 }
2641
2642 sub location_edit
2643 {
2644     my ($self) = @_ ;
2645     $self->can_do('r_location_mgnt');
2646
2647     my $loc = $self->get_form('qlocation');
2648     unless ($loc->{qlocation}) {
2649         return $self->error("Can't get location");
2650     }
2651
2652     my $query = "
2653 SELECT Location.Location AS location,
2654        Location.Cost   AS cost,
2655        Location.Enabled AS enabled
2656 FROM Location
2657 WHERE Location.Location = $loc->{qlocation}
2658 ";
2659
2660     my $row = $self->dbh_selectrow_hashref($query);
2661     $row->{enabled} = human_enabled($row->{enabled});
2662     $self->display({ ID => $cur_id++,
2663                      %$row }, "location_edit.tpl") ;
2664 }
2665
2666 sub location_save
2667 {
2668     my ($self) = @_ ;
2669     $self->can_do('r_location_mgnt');
2670
2671     my $arg = $self->get_form(qw/qlocation qnewlocation cost enabled/) ;
2672     unless ($arg->{qlocation}) {
2673         return $self->error("Can't get location");
2674     }
2675     unless ($arg->{qnewlocation}) {
2676         return $self->error("Can't get new location name");
2677     }
2678     unless ($arg->{cost}) {
2679         return $self->error("Can't get new cost");
2680     }
2681
2682     my $enabled = from_human_enabled($arg->{enabled});
2683
2684     my $query = "
2685 UPDATE Location SET Cost     = $arg->{cost},
2686                     Location = $arg->{qnewlocation},
2687                     Enabled   = $enabled
2688 WHERE Location.Location = $arg->{qlocation}
2689 ";
2690
2691     $self->dbh_do($query);
2692
2693     $self->location_display();
2694 }
2695
2696 sub location_del
2697 {
2698     my ($self) = @_ ;
2699     $self->can_do('r_location_mgnt');
2700
2701     my $arg = $self->get_form(qw/qlocation/) ;
2702
2703     unless ($arg->{qlocation}) {
2704         return $self->error("Can't get location");
2705     }
2706
2707     my $query = "
2708 SELECT count(Media.MediaId) AS nb
2709   FROM Media INNER JOIN Location USING (LocationID)
2710 WHERE Location = $arg->{qlocation}
2711 ";
2712
2713     my $res = $self->dbh_selectrow_hashref($query);
2714
2715     if ($res->{nb}) {
2716         return $self->error("Sorry, the location must be empty");
2717     }
2718
2719     $query = "
2720 DELETE FROM Location WHERE Location = $arg->{qlocation}
2721 ";
2722
2723     $self->dbh_do($query);
2724
2725     $self->location_display();
2726 }
2727
2728 sub location_add
2729 {
2730     my ($self) = @_ ;
2731     $self->can_do('r_location_mgnt');
2732
2733     my $arg = $self->get_form(qw/qlocation cost/) ;
2734
2735     unless ($arg->{qlocation}) {
2736         $self->display({}, "location_add.tpl");
2737         return 1;
2738     }
2739     unless ($arg->{cost}) {
2740         return $self->error("Can't get new cost");
2741     }
2742
2743     my $enabled = CGI::param('enabled') || '';
2744     $enabled = from_human_enabled($enabled);
2745
2746     my $query = "
2747 INSERT INTO Location (Location, Cost, Enabled)
2748        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2749 ";
2750
2751     $self->dbh_do($query);
2752
2753     $self->location_display();
2754 }
2755
2756 sub location_display
2757 {
2758     my ($self) = @_ ;
2759
2760     my $query = "
2761 SELECT Location.Location AS location,
2762        Location.Cost     AS cost,
2763        Location.Enabled  AS enabled,
2764        (SELECT count(Media.MediaId)
2765          FROM Media
2766         WHERE Media.LocationId = Location.LocationId
2767        ) AS volnum
2768 FROM Location
2769 ";
2770
2771     my $location = $self->dbh_selectall_hashref($query, 'location');
2772
2773     $self->display({ ID => $cur_id++,
2774                      Locations => [ values %$location ] },
2775                    "display_location.tpl");
2776 }
2777
2778 sub update_location
2779 {
2780     my ($self) = @_ ;
2781
2782     my $media = $self->get_selected_media_location();
2783     unless ($media) {
2784         return ;
2785     }
2786
2787     my $arg = $self->get_form('db_locations', 'qnewlocation');
2788
2789     $self->display({ email  => $self->{info}->{email_media},
2790                      %$arg,
2791                      media => [ values %$media ],
2792                    },
2793                    "update_location.tpl");
2794 }
2795
2796 ###########################################################
2797
2798 sub groups_edit
2799 {
2800     my ($self) = @_;
2801     my $grp = $self->get_form(qw/qclient_group db_clients/);
2802
2803     unless ($grp->{qclient_group}) {
2804         $self->can_do('r_group_mgnt');
2805         $self->display({ ID => $cur_id++,
2806                          client_group => "''",
2807                          %$grp,
2808                      }, "groups_edit.tpl");
2809         return;
2810     }
2811
2812     unless ($self->cant_do('r_group_mgnt')) {
2813         $self->can_do('r_view_group');
2814     }
2815
2816     my $query = "
2817 SELECT Name AS name
2818   FROM Client JOIN client_group_member using (clientid)
2819               JOIN client_group using (client_group_id)
2820 WHERE client_group_name = $grp->{qclient_group}
2821 ";
2822
2823     my $row = $self->dbh_selectall_hashref($query, "name");
2824     $self->debug($row);
2825     $self->display({ ID => $cur_id++,
2826                      client_group => $grp->{qclient_group},
2827                      %$grp,
2828                      client_group_member => [ values %$row]},
2829                    "groups_edit.tpl");
2830 }
2831
2832 sub groups_save
2833 {
2834     my ($self) = @_;
2835     $self->can_do('r_group_mgnt');
2836
2837     my $arg = $self->get_form(qw/qclient_group jclients qnewgroup/);
2838
2839     if (!$arg->{qclient_group} and $arg->{qnewgroup}) {
2840         my $query = "
2841 INSERT INTO client_group (client_group_name)
2842 VALUES ($arg->{qnewgroup})
2843 ";
2844         $self->dbh_do($query);
2845         $arg->{qclient_group} = $arg->{qnewgroup};
2846     }
2847
2848     unless ($arg->{qclient_group}) {
2849         return $self->error("Can't get groups");
2850     }
2851
2852     $self->{dbh}->begin_work();
2853
2854     my $query = "
2855 DELETE FROM client_group_member
2856       WHERE client_group_id IN
2857            (SELECT client_group_id
2858               FROM client_group
2859              WHERE client_group_name = $arg->{qclient_group})
2860 ";
2861     $self->dbh_do($query);
2862
2863     if ($arg->{jclients}) {
2864         $query = "
2865     INSERT INTO client_group_member (clientid, client_group_id)
2866        (SELECT  Clientid,
2867                 (SELECT client_group_id
2868                    FROM client_group
2869                   WHERE client_group_name = $arg->{qclient_group})
2870           FROM Client WHERE Name IN ($arg->{jclients})
2871        )
2872 ";
2873         $self->dbh_do($query);
2874     }
2875     if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2876         $query = "
2877 UPDATE client_group
2878    SET client_group_name = $arg->{qnewgroup}
2879  WHERE client_group_name = $arg->{qclient_group}
2880 ";
2881
2882         $self->dbh_do($query);
2883     }
2884
2885     $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2886
2887     $self->display_groups();
2888 }
2889
2890 sub groups_del
2891 {
2892     my ($self) = @_;
2893     $self->can_do('r_group_mgnt');
2894
2895     my $arg = $self->get_form(qw/qclient_group/);
2896
2897     unless ($arg->{qclient_group}) {
2898         return $self->error("Can't get groups");
2899     }
2900
2901     $self->{dbh}->begin_work();
2902
2903     $self->dbh_do("
2904 DELETE FROM client_group_member
2905       WHERE client_group_id IN
2906            (SELECT client_group_id
2907               FROM client_group
2908              WHERE client_group_name = $arg->{qclient_group})");
2909
2910     $self->dbh_do("
2911 DELETE FROM bweb_client_group_acl
2912       WHERE client_group_id IN
2913            (SELECT client_group_id
2914               FROM client_group
2915              WHERE client_group_name = $arg->{qclient_group})");
2916
2917     $self->dbh_do("
2918 DELETE FROM client_group
2919       WHERE client_group_name = $arg->{qclient_group}");
2920
2921     $self->{dbh}->commit();
2922     $self->display_groups();
2923 }
2924
2925 sub display_groups
2926 {
2927     my ($self) = @_;
2928     my $arg;
2929
2930     if ($self->cant_do('r_group_mgnt')) {
2931         $arg = $self->get_form(qw/db_client_groups filter/) ;
2932     } else {
2933         $arg = $self->get_form(qw/db_client_groups/) ;
2934     }
2935
2936     if ($self->{dbh}->errstr) {
2937         return $self->error("Can't use groups with bweb, read INSTALL to enable them");
2938     }
2939
2940     $self->debug($arg);
2941
2942     $self->display({ ID => $cur_id++,
2943                      %$arg},
2944                    "display_groups.tpl");
2945 }
2946
2947 ###########################################################
2948
2949 sub get_roles
2950 {
2951     my ($self) = @_;
2952     if (not $self->{info}->{enable_security}) {
2953         return 1;
2954     }
2955     # admin is a special user that can do everything
2956     if ($self->{loginname} eq 'admin') {
2957         return 1;
2958     }
2959     if (!$self->{loginname}) {
2960         $self->error("Can't get your login name");
2961         $self->display_end();
2962         exit 0;
2963     }
2964     # already fill
2965     if (defined $self->{security}) {
2966         return 1;
2967     }
2968     $self->{security} = {};
2969     my $u = $self->dbh_quote($self->{loginname});
2970
2971     my $query = "
2972  SELECT use_acl, rolename, tpl
2973   FROM bweb_user
2974        JOIN bweb_role_member USING (userid)
2975        JOIN bweb_role USING (roleid)
2976  WHERE username = $u
2977 ";
2978     my $rows = $self->dbh_selectall_arrayref($query);
2979     # do cache with this role
2980     if (!$rows or !scalar(@$rows)) {
2981         $self->error("Can't get $self->{loginname}'s roles");
2982         $self->display_end();
2983         exit 0;
2984     }
2985     foreach my $r (@$rows) {
2986         $self->{security}->{$r->[1]}=1;
2987     }
2988     $self->{security}->{use_acl} = $rows->[0]->[0];
2989     if ($rows->[0]->[2] =~ /^(\w\w)$/) {
2990         $self->{lang} = $1;
2991     }
2992     return 1;
2993 }
2994
2995 sub can_view_client
2996 {
2997     my ($self, $client) = @_;
2998
2999     my $filter = $self->get_client_filter();
3000     if (!$filter) {
3001         return 1;
3002     }
3003     my $cont = $self->dbh_selectrow_hashref("
3004  SELECT 1
3005    FROM Client $filter
3006   WHERE Name = '$client'
3007 ");
3008     return defined $cont;
3009 }
3010
3011 sub cant_do
3012 {
3013     my ($self, $action) = @_;
3014     # is security enabled in configuration ?
3015     if (not $self->{info}->{enable_security}) {
3016         return 0
3017     }
3018     # admin is a special user that can do everything
3019     if ($self->{loginname} eq 'admin') {
3020         return 0;
3021     }
3022     # must be logged
3023     if (!$self->{loginname}) {
3024         $self->{error} = "Can't do $action, your are not logged. " .
3025             "Check security with your administrator";
3026         return 1;
3027     }
3028     if (!$self->get_roles()) {
3029         return 0;
3030     }
3031     if (!$self->{security}->{$action}) {
3032         $self->{error} =
3033             "$self->{loginname} sorry, but this action ($action) " .
3034             "is not permited. " .
3035             "Check security with your administrator";
3036         return 1;
3037     }
3038     return 0;
3039 }
3040
3041 # make like an assert (program die)
3042 sub can_do
3043 {
3044     my ($self, $action) = @_;
3045     if ($self->cant_do($action)) {
3046         $self->error($self->{error});
3047         $self->display_end();
3048         exit 0;
3049     }
3050     return 1;
3051 }
3052
3053 sub use_filter
3054 {
3055     my ($self) = @_;
3056
3057     if (!$self->{info}->{enable_security} or
3058         !$self->{info}->{enable_security_acl})
3059     {
3060         return 0 ;
3061     }
3062
3063     if ($self->get_roles()) {
3064         return $self->{security}->{use_acl};
3065     } else {
3066         return 1;
3067     }
3068 }
3069
3070 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
3071 sub get_client_filter
3072 {
3073     my ($self, $login) = @_;
3074     my $u;
3075     if ($login) {
3076         $u = $self->dbh_quote($login);
3077     } elsif ($self->use_filter()) {
3078         $u = $self->dbh_quote($self->{loginname});
3079     } else {
3080         return '';
3081     }
3082     return "
3083  JOIN (SELECT ClientId FROM client_group_member
3084    JOIN client_group USING (client_group_id)
3085    JOIN bweb_client_group_acl USING (client_group_id)
3086    JOIN bweb_user USING (userid)
3087    WHERE bweb_user.username = $u
3088  ) AS filter USING (ClientId)";
3089 }
3090
3091 #JOIN client_group USING (client_group_id)" . $b->get_client_group_filter()
3092 sub get_client_group_filter
3093 {
3094     my ($self, $login) = @_;
3095     my $u;
3096     if ($login) {
3097         $u = $self->dbh_quote($login);
3098     } elsif ($self->use_filter()) {
3099         $u = $self->dbh_quote($self->{loginname});
3100     } else {
3101         return '';
3102     }
3103     return "
3104  JOIN (SELECT client_group_id
3105          FROM bweb_client_group_acl
3106          JOIN bweb_user USING (userid)
3107    WHERE bweb_user.username = $u
3108  ) AS filter USING (client_group_id)";
3109 }
3110
3111 # role and username have to be quoted before
3112 # role and username can be a quoted list
3113 sub revoke
3114 {
3115     my ($self, $role, $username) = @_;
3116     $self->can_do("r_user_mgnt");
3117
3118     my $nb = $self->dbh_do("
3119  DELETE FROM bweb_role_member
3120        WHERE roleid = (SELECT roleid FROM bweb_role
3121                         WHERE rolename IN ($role))
3122          AND userid = (SELECT userid FROM bweb_user
3123                         WHERE username IN ($username))");
3124     return $nb;
3125 }
3126
3127 # role and username have to be quoted before
3128 # role and username can be a quoted list
3129 sub grant
3130 {
3131     my ($self, $role, $username) = @_;
3132     $self->can_do("r_user_mgnt");
3133
3134     my $nb = $self->dbh_do("
3135    INSERT INTO bweb_role_member (roleid, userid)
3136      SELECT roleid, userid FROM bweb_role, bweb_user
3137       WHERE rolename IN ($role)
3138         AND username IN ($username)
3139      ");
3140     return $nb;
3141 }
3142
3143 # role and username have to be quoted before
3144 # role and username can be a quoted list
3145 sub grant_like
3146 {
3147     my ($self, $copy, $user) = @_;
3148     $self->can_do("r_user_mgnt");
3149
3150     my $nb = $self->dbh_do("
3151   INSERT INTO bweb_role_member (roleid, userid)
3152    SELECT roleid, a.userid
3153      FROM bweb_user AS a, bweb_role_member
3154      JOIN bweb_user USING (userid)
3155     WHERE bweb_user.username = $copy
3156       AND a.username = $user");
3157     return $nb;
3158 }
3159
3160 # username can be a join quoted list of usernames
3161 sub revoke_all
3162 {
3163     my ($self, $username) = @_;
3164     $self->can_do("r_user_mgnt");
3165
3166     $self->dbh_do("
3167    DELETE FROM bweb_role_member
3168          WHERE userid IN (
3169            SELECT userid
3170              FROM bweb_user
3171             WHERE username in ($username))");
3172     $self->dbh_do("
3173 DELETE FROM bweb_client_group_acl
3174  WHERE userid IN (
3175   SELECT userid
3176     FROM bweb_user
3177    WHERE username IN ($username))");
3178
3179 }
3180
3181 sub users_del
3182 {
3183     my ($self) = @_;
3184     $self->can_do("r_user_mgnt");
3185
3186     my $arg = $self->get_form(qw/jusernames/);
3187
3188     unless ($arg->{jusernames}) {
3189         return $self->error("Can't get user");
3190     }
3191
3192     $self->{dbh}->begin_work();
3193     {
3194         $self->revoke_all($arg->{jusernames});
3195         $self->dbh_do("
3196 DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
3197     }
3198     $self->{dbh}->commit();
3199
3200     $self->display_users();
3201 }
3202
3203 sub users_add
3204 {
3205     my ($self) = @_;
3206     $self->can_do("r_user_mgnt");
3207
3208     # we don't quote username directly to check that it is conform
3209     my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate
3210                                  lang qcopy_username jclient_groups/) ;
3211
3212     if (not $arg->{qcreate}) {
3213         $arg = $self->get_form(qw/db_roles db_usernames db_client_groups/);
3214         $self->display($arg, "display_user.tpl");
3215         return 1;
3216     }
3217
3218     my $u = $self->dbh_quote($arg->{username});
3219
3220     $arg->{use_acl}=(CGI::param('use_acl')?'true':'false');
3221
3222     if (!$arg->{qpasswd}) {
3223         $arg->{qpasswd} = "''";
3224     }
3225     if (!$arg->{qcomment}) {
3226         $arg->{qcomment} = "''";
3227     }
3228
3229     # will fail if user already exists
3230     # UPDATE with mysql dbi does not return if update is ok
3231     ($self->dbh_do("
3232   UPDATE bweb_user
3233      SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment},
3234          use_acl=$arg->{use_acl}, tpl='$arg->{lang}'
3235    WHERE username = $u")
3236 #     and (! $self->dbh_is_mysql() )
3237      ) and
3238     $self->dbh_do("
3239   INSERT INTO bweb_user (username, passwd, use_acl, comment, tpl)
3240         VALUES ($u, $arg->{qpasswd}, $arg->{use_acl},
3241                 $arg->{qcomment}, '$arg->{lang}')");
3242
3243     $self->{dbh}->begin_work();
3244     {
3245         $self->revoke_all($u);
3246
3247         if ($arg->{qcopy_username}) {
3248             $self->grant_like($arg->{qcopy_username}, $u);
3249         } else {
3250             $self->grant($arg->{jrolenames}, $u);
3251         }
3252
3253         if ($arg->{jclient_groups}) {
3254             $self->dbh_do("
3255 INSERT INTO bweb_client_group_acl (client_group_id, userid)
3256  SELECT client_group_id, userid
3257    FROM client_group, bweb_user
3258   WHERE client_group_name IN ($arg->{jclient_groups})
3259     AND username = $u
3260 ");
3261         }
3262     }
3263     $self->{dbh}->commit();
3264
3265     $self->display_users();
3266 }
3267
3268 # TODO: we miss a matrix with all user/roles
3269 sub display_users
3270 {
3271     my ($self) = @_;
3272     $self->can_do("r_user_mgnt");
3273
3274     my $arg = $self->get_form(qw/db_usernames/) ;
3275
3276     if ($self->{dbh}->errstr) {
3277         return $self->error("Can't use users with bweb, read INSTALL to enable them");
3278     }
3279
3280     $self->display({ ID => $cur_id++,
3281                      %$arg},
3282                    "display_users.tpl");
3283 }
3284
3285 sub display_user
3286 {
3287     my ($self) = @_;
3288     $self->can_do("r_user_mgnt");
3289
3290     my $arg = $self->get_form('username');
3291     my $user = $self->dbh_quote($arg->{username});
3292
3293     my $userp = $self->dbh_selectrow_hashref("
3294    SELECT username, passwd, comment, use_acl, tpl
3295      FROM bweb_user
3296     WHERE username = $user
3297 ");
3298     if (!$userp) {
3299         return $self->error("Can't find $user in catalog");
3300     }
3301     my $filter = $self->get_client_group_filter($arg->{username});
3302     my $scg = $self->dbh_selectall_hashref("
3303  SELECT client_group_name AS name
3304    FROM client_group $filter
3305 ", 'name');
3306
3307 #  rolename  | userid
3308 #------------+--------
3309 # cancel_job |
3310 # restore    |
3311 # run_job    |      1
3312
3313     my $role = $self->dbh_selectall_hashref("
3314 SELECT rolename, temp.userid
3315      FROM bweb_role
3316      LEFT JOIN (SELECT roleid, userid
3317                   FROM bweb_user JOIN bweb_role_member USING (userid)
3318                  WHERE username = $user) AS temp USING (roleid)
3319 ORDER BY rolename
3320 ", 'rolename');
3321
3322     $arg = $self->get_form(qw/db_usernames db_client_groups/);
3323
3324     $self->display({
3325         db_usernames => $arg->{db_usernames},
3326         username => $userp->{username},
3327         comment => $userp->{comment},
3328         passwd => $userp->{passwd},
3329         lang => $userp->{tpl},
3330         use_acl => $userp->{use_acl},
3331         db_client_groups => $arg->{db_client_groups},
3332         client_group => [ values %$scg ],
3333         db_roles => [ values %$role],
3334     }, "display_user.tpl");
3335 }
3336
3337
3338 ###########################################################
3339
3340 sub get_media_max_size
3341 {
3342     my ($self, $type) = @_;
3343     my $query =
3344 "SELECT avg(VolBytes) AS size
3345   FROM Media
3346  WHERE Media.VolStatus = 'Full'
3347    AND Media.MediaType = '$type'
3348 ";
3349
3350     my $res = $self->selectrow_hashref($query);
3351
3352     if ($res) {
3353         return $res->{size};
3354     } else {
3355         return 0;
3356     }
3357 }
3358
3359 sub update_media
3360 {
3361     my ($self) = @_ ;
3362
3363     my $media = $self->get_form('qmedia');
3364
3365     unless ($media->{qmedia}) {
3366         return $self->error("Can't get media");
3367     }
3368
3369     my $query = "
3370 SELECT Media.Slot         AS slot,
3371        PoolMedia.Name     AS poolname,
3372        Media.VolStatus    AS volstatus,
3373        Media.InChanger    AS inchanger,
3374        Location.Location  AS location,
3375        Media.VolumeName   AS volumename,
3376        Media.MaxVolBytes  AS maxvolbytes,
3377        Media.MaxVolJobs   AS maxvoljobs,
3378        Media.MaxVolFiles  AS maxvolfiles,
3379        Media.VolUseDuration AS voluseduration,
3380        Media.VolRetention AS volretention,
3381        Media.Comment      AS comment,
3382        PoolRecycle.Name   AS poolrecycle,
3383        Media.Enabled      AS enabled
3384
3385 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
3386            LEFT  JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
3387            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
3388
3389 WHERE Media.VolumeName = $media->{qmedia}
3390 ";
3391
3392     my $row = $self->dbh_selectrow_hashref($query);
3393     $row->{volretention} = human_sec($row->{volretention});
3394     $row->{voluseduration} = human_sec($row->{voluseduration});
3395     $row->{enabled} = human_enabled($row->{enabled});
3396
3397     my $elt = $self->get_form(qw/db_pools db_locations/);
3398
3399     $self->display({
3400         %$elt,
3401         %$row,
3402     }, "update_media.tpl");
3403 }
3404
3405 sub save_location
3406 {
3407     my ($self) = @_ ;
3408     $self->can_do('r_media_mgnt');
3409
3410     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
3411
3412     unless ($arg->{jmedias}) {
3413         return $self->error("Can't get selected media");
3414     }
3415
3416     unless ($arg->{qnewlocation}) {
3417         return $self->error("Can't get new location");
3418     }
3419
3420     my $query = "
3421  UPDATE Media
3422      SET LocationId = (SELECT LocationId
3423                        FROM Location
3424                        WHERE Location = $arg->{qnewlocation})
3425      WHERE Media.VolumeName IN ($arg->{jmedias})
3426 ";
3427
3428     my $nb = $self->dbh_do($query);
3429
3430     print "$nb media updated, you may have to update your autochanger.";
3431
3432     $self->display_media();
3433 }
3434
3435 sub location_change
3436 {
3437     my ($self) = @_ ;
3438     $self->can_do('r_media_mgnt');
3439
3440     my $media = $self->get_selected_media_location();
3441     unless ($media) {
3442         return $self->error("Can't get media selection");
3443     }
3444     my $newloc = CGI::param('newlocation');
3445
3446     my $user = CGI::param('user') || 'unknown';
3447     my $comm = CGI::param('comment') || '';
3448     $comm = $self->dbh_quote("$user: $comm");
3449
3450     my $arg = $self->get_form('enabled');
3451     my $en = from_human_enabled($arg->{enabled});
3452     my $b = $self->get_bconsole();
3453
3454     my $query;
3455     foreach my $vol (keys %$media) {
3456         $query = "
3457 INSERT INTO LocationLog (Date,Comment,MediaId,LocationId,NewEnabled,NewVolStatus)
3458  SELECT NOW(), $comm, Media.MediaId, Location.LocationId, $en, VolStatus
3459    FROM Media, Location
3460   WHERE Media.VolumeName = '$vol'
3461     AND Location.Location = '$media->{$vol}->{location}'
3462 ";
3463         $self->dbh_do($query);
3464         $self->debug($query);
3465         $b->send_cmd("update volume=\"$vol\" enabled=$en");
3466     }
3467     $b->close();
3468
3469     my $q = new CGI;
3470     $q->param('action', 'update_location');
3471     my $url = $q->url(-full => 1, -query=>1);
3472
3473     $self->display({ email  => $self->{info}->{email_media},
3474                      url => $url,
3475                      newlocation => $newloc,
3476                      # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3477                      media => [ values %$media ],
3478                    },
3479                    "change_location.tpl");
3480
3481 }
3482
3483 sub display_client_stats
3484 {
3485     my ($self, %arg) = @_ ;
3486     $self->can_do('r_view_stat');
3487
3488     my $client = $self->dbh_quote($arg{clientname});
3489     # get security filter
3490     my $filter = $self->get_client_filter();
3491
3492     my ($limit, $label) = $self->get_limit(%arg);
3493     my $query = "
3494 SELECT
3495     count(Job.JobId)     AS nb_jobs,
3496     sum(Job.JobBytes)    AS nb_bytes,
3497     sum(Job.JobErrors)   AS nb_err,
3498     sum(Job.JobFiles)    AS nb_files,
3499     Client.Name          AS clientname
3500 FROM Job JOIN Client USING (ClientId) $filter
3501 WHERE
3502     Client.Name = $client
3503     $limit
3504 GROUP BY Client.Name
3505 ";
3506
3507     my $row = $self->dbh_selectrow_hashref($query);
3508
3509     $row->{ID} = $cur_id++;
3510     $row->{label} = $label;
3511     $row->{grapharg} = "client";
3512
3513     $self->display($row, "display_client_stats.tpl");
3514 }
3515
3516
3517 sub display_group_stats
3518 {
3519     my ($self, %arg) = @_ ;
3520
3521     my $carg = $self->get_form(qw/qclient_group/);
3522
3523     unless ($carg->{qclient_group}) {
3524         return $self->error("Can't get group");
3525     }
3526
3527     my ($limit, $label) = $self->get_limit(%arg);
3528
3529     my $query = "
3530 SELECT
3531     count(Job.JobId)     AS nb_jobs,
3532     sum(Job.JobBytes)    AS nb_bytes,
3533     sum(Job.JobErrors)   AS nb_err,
3534     sum(Job.JobFiles)    AS nb_files,
3535     client_group.client_group_name  AS clientname
3536 FROM Job JOIN Client USING (ClientId)
3537          JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
3538          JOIN client_group USING (client_group_id)
3539 WHERE
3540     client_group.client_group_name = $carg->{qclient_group}
3541     $limit
3542 GROUP BY client_group.client_group_name
3543 ";
3544
3545     my $row = $self->dbh_selectrow_hashref($query);
3546
3547     $row->{ID} = $cur_id++;
3548     $row->{label} = $label;
3549     $row->{grapharg} = "client_group";
3550
3551     $self->display($row, "display_client_stats.tpl");
3552 }
3553
3554 # [ name, num, value, joberrors, nb_job ] =>
3555 # {  items =>
3556 #      [ { name => 'ALL',
3557 #          events => [ { num => 1, label => '2007-01',
3558 #                        value => 'T', title => 10 },
3559 #                      { num => 2, label => '2007-02',
3560 #                        value => 'R', title => 11 },
3561 #                     ]
3562 #         },
3563 #         { name => 'Other',
3564 #            ...
3565 #       ]
3566 # };
3567 sub make_overview_tab
3568 {
3569     my ($self, $q) = @_;
3570     my $ret = $self->dbh_selectall_arrayref($q);
3571     my @items;
3572     my $events=[];
3573     my $cur_name='';
3574     for my $elt (@$ret) {
3575         if ($cur_name and $cur_name ne $elt->[0]) { # order by name, num
3576             push @items, { name => $cur_name, events => $events};
3577             $events = [];
3578         }
3579         $cur_name = $elt->[0];
3580         push @$events,
3581           { num => $elt->[1], status => $elt->[2],
3582             joberrors => $elt->[3], title => "$elt->[4] jobs"};
3583     }
3584     push @items, { name => $cur_name, events => $events};
3585     return \@items;
3586 }
3587
3588 sub get_time_overview
3589 {
3590     my ($self, $arg) = @_; # want since et age from get_form();
3591     my $type = $arg->{type} || 'day';
3592     if ($type =~ /^(day|week|hour|month)$/) {
3593         $type = uc($1);
3594     } else {
3595         $arg->{type}='day';
3596         $type = 'DAY';
3597     }
3598     my $jobt = $self->{info}->{stat_job_table} || 'Job';
3599     my $stime1 = $self->{sql}->{"STARTTIME_P" . $type}; # get 1,2,3
3600     $stime1 =~ s/Job.StartTime/date/;
3601     my $stime2 = $self->{sql}->{"STARTTIME_" . $type}; # get 2007-01-03, 2007-01-23
3602
3603     my ($limit, $label) = $self->get_limit('since' => $arg->{since},
3604                                            'age' => $arg->{age});
3605     return ($stime1, $stime2, $limit, $label, $jobt);
3606 }
3607
3608 #              lu ma me je ve sa di
3609 #  groupe1     v  v  x  w  v  v  v    overview
3610 #   |-- s1     v  v  v  v  v  v  v    overview_zoom
3611 #   |-- s2     v  v  x  v  v  v  v
3612 #   `-- s3     v  v  v  w  v  v  v
3613 sub display_overview_zoom
3614 {
3615     my ($self) = @_;
3616     $self->can_do('r_view_stat');
3617
3618     my $arg = $self->get_form(qw/jclient_groups age since type level/);
3619
3620     if (!$arg->{jclient_groups}) {
3621         return $self->error("Can't get client_group selection");
3622     }
3623     my ($filter2, undef) = $self->get_param(qw/level jobtype/);
3624     my ($stime1, $stime2, $limit, $label, $jobt) = $self->get_time_overview($arg);
3625
3626     my $filter = $self->get_client_filter();
3627     my $q = "
3628 SELECT name, $stime1 AS num,
3629        JobStatus AS value, joberrors, nb_job
3630 FROM (
3631   SELECT $stime2        AS date,
3632          Client.Name    AS name,
3633          MAX(severity)  AS severity,
3634          COUNT(1)       AS nb_job,
3635          SUM(JobErrors) AS joberrors
3636     FROM $jobt AS Job
3637     JOIN client_group_member USING (ClientId)
3638     JOIN client_group        USING (client_group_id)
3639     JOIN Client              USING (ClientId)  $filter
3640     JOIN Status              USING (JobStatus)
3641    WHERE client_group_name IN ($arg->{jclient_groups})
3642          $limit $filter2
3643
3644    GROUP BY Client.Name, date
3645 ) AS sub JOIN Status USING (severity)
3646  ORDER BY name, date
3647 ";
3648     my $items = $self->make_overview_tab($q);
3649     $self->display({label => $label,
3650                     action => "job;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client=",
3651                     items => $items}, "overview.tpl");
3652 }
3653
3654 sub display_overview
3655 {
3656     my ($self) = @_ ;
3657     $self->can_do('r_view_stat');
3658
3659     my $arg = $self->get_form(qw/jclient_groups age since type level/);
3660     my ($filter2, undef) = $self->get_param(qw/client_groups level jobtype/);
3661     my $filter3 = $self->get_client_group_filter();
3662     my ($stime1, $stime2, $filter1, $label, $jobt) = $self->get_time_overview($arg);
3663
3664     my $q = "
3665 SELECT name, $stime1 AS num,
3666        JobStatus AS value, joberrors, nb_job
3667 FROM (
3668   SELECT $stime2        AS date,
3669          client_group_name AS name,
3670          MAX(severity)  AS severity,
3671          COUNT(1)       AS nb_job,
3672          SUM(JobErrors) AS joberrors
3673     FROM $jobt AS Job
3674     JOIN client_group_member USING (ClientId)
3675     JOIN client_group        USING (client_group_id) $filter3
3676     JOIN Status              USING (JobStatus)
3677    WHERE true $filter1 $filter2
3678    GROUP BY client_group_name, date
3679 ) AS sub JOIN Status USING (severity)
3680  ORDER BY name, date
3681 ";
3682     my $items = $self->make_overview_tab($q);
3683     $self->display({label=>$label,
3684                     action => "overview_zoom;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client_group=",
3685                     items => $items}, "overview.tpl");
3686
3687 }
3688
3689 # poolname can be undef
3690 sub display_pool
3691 {
3692     my ($self, $poolname) = @_ ;
3693     $self->can_do('r_view_media');
3694
3695     my $whereA = '';
3696     my $whereW = '';
3697
3698     my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3699     if ($arg->{jmediatypes}) {
3700         $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3701         $whereA = "AND   MediaType IN ($arg->{jmediatypes}) ";
3702     }
3703
3704 # TODO : afficher les tailles et les dates
3705
3706     my $query = "
3707 SELECT subq.volmax        AS volmax,
3708        subq.volnum        AS volnum,
3709        subq.voltotal      AS voltotal,
3710        Pool.Name          AS name,
3711        Pool.Recycle       AS recycle,
3712        Pool.VolRetention  AS volretention,
3713        Pool.VolUseDuration AS voluseduration,
3714        Pool.MaxVolJobs    AS maxvoljobs,
3715        Pool.MaxVolFiles   AS maxvolfiles,
3716        Pool.MaxVolBytes   AS maxvolbytes,
3717        subq.PoolId        AS PoolId,
3718        subq.MediaType     AS mediatype,
3719        $self->{sql}->{CAT_POOL_TYPE}  AS uniq
3720 FROM
3721   (
3722     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3723            count(Media.MediaId)  AS volnum,
3724            sum(Media.VolBytes)   AS voltotal,
3725            Media.PoolId          AS PoolId,
3726            Media.MediaType       AS MediaType
3727     FROM Media
3728     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3729                       Media.MediaType     AS MediaType
3730                FROM Media
3731               WHERE Media.VolStatus = 'Full'
3732               GROUP BY Media.MediaType
3733                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3734     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3735   ) AS subq
3736 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3737 $whereW
3738 ";
3739
3740     my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3741
3742     $query = "
3743 SELECT Pool.Name AS name,
3744        sum(VolBytes) AS size
3745 FROM   Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3746 WHERE  Media.VolStatus IN ('Recycled', 'Purged')
3747        $whereA
3748 GROUP BY Pool.Name;
3749 ";
3750     my $empty = $self->dbh_selectall_hashref($query, 'name');
3751
3752     foreach my $p (values %$all) {
3753         if ($p->{volmax} > 0) { # mysql returns 0.0000
3754             # we remove Recycled/Purged media from pool usage
3755             if (defined $empty->{$p->{name}}) {
3756                 $p->{voltotal} -= $empty->{$p->{name}}->{size};
3757             }
3758             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
3759         } else {
3760             $p->{poolusage} = 0;
3761         }
3762
3763         $query = "
3764   SELECT VolStatus AS volstatus, count(MediaId) AS nb
3765     FROM Media
3766    WHERE PoolId=$p->{poolid}
3767      AND Media.MediaType = '$p->{mediatype}'
3768          $whereA
3769 GROUP BY VolStatus
3770 ";
3771         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
3772         foreach my $t (values %$content) {
3773             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
3774         }
3775     }
3776
3777     $self->debug($all);
3778     $self->display({ ID => $cur_id++,
3779                      MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
3780                      Pools => [ values %$all ]},
3781                    "display_pool.tpl");
3782 }
3783
3784 sub display_running_job
3785 {
3786     my ($self) = @_;
3787     return if $self->cant_do('r_view_running_job');
3788
3789     my $arg = $self->get_form('client', 'jobid');
3790
3791     if (!$arg->{client} and $arg->{jobid}) {
3792         # get security filter
3793         my $filter = $self->get_client_filter();
3794
3795         my $query = "
3796 SELECT Client.Name AS name
3797 FROM Job INNER JOIN Client USING (ClientId) $filter
3798 WHERE Job.JobId = $arg->{jobid}
3799 ";
3800
3801         my $row = $self->dbh_selectrow_hashref($query);
3802
3803         if ($row) {
3804             $arg->{client} = $row->{name};
3805             CGI::param('client', $arg->{client});
3806         }
3807     }
3808
3809     if ($arg->{client}) {
3810         my $cli = new Bweb::Client(name => $arg->{client});
3811         $cli->display_running_job($self->{info}, $arg->{jobid});
3812         if ($arg->{jobid}) {
3813             $self->get_job_log();
3814         }
3815     } else {
3816         $self->error("Can't get client or jobid");
3817     }
3818 }
3819
3820 sub display_running_jobs
3821 {
3822     my ($self, $display_action) = @_;
3823     return if $self->cant_do('r_view_running_job');
3824
3825     # get security filter
3826     my $filter = $self->get_client_filter();
3827
3828     my $query = "
3829 SELECT Job.JobId AS jobid,
3830        Job.Name  AS jobname,
3831        Job.Level     AS level,
3832        Job.StartTime AS starttime,
3833        Job.JobFiles  AS jobfiles,
3834        Job.JobBytes  AS jobbytes,
3835        Job.JobStatus AS jobstatus,
3836 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
3837                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
3838          AS duration,
3839        Client.Name AS clientname
3840 FROM Job INNER JOIN Client USING (ClientId) $filter
3841 WHERE
3842   JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
3843 ";
3844     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
3845
3846     $self->display({ ID => $cur_id++,
3847                      display_action => $display_action,
3848                      Jobs => [ values %$all ]},
3849                    "running_job.tpl") ;
3850 }
3851
3852 # return the autochanger list to update
3853 sub eject_media
3854 {
3855     my ($self) = @_;
3856     $self->can_do('r_media_mgnt');
3857
3858     my %ret;
3859     my $arg = $self->get_form('jmedias');
3860
3861     unless ($arg->{jmedias}) {
3862         return $self->error("Can't get media selection");
3863     }
3864
3865     my $query = "
3866 SELECT Media.VolumeName  AS volumename,
3867        Storage.Name      AS storage,
3868        Location.Location AS location,
3869        Media.Slot        AS slot
3870 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
3871            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
3872 WHERE Media.VolumeName IN ($arg->{jmedias})
3873   AND Media.InChanger = 1
3874 ";
3875
3876     my $all = $self->dbh_selectall_hashref($query, 'volumename');
3877
3878     foreach my $vol (values %$all) {
3879         my $a = $self->ach_get($vol->{location});
3880         next unless ($a) ;
3881         $ret{$vol->{location}} = 1;
3882
3883         unless ($a->{have_status}) {
3884             $a->status();
3885             $a->{have_status} = 1;
3886         }
3887         # TODO: set enabled
3888         print "eject $vol->{volumename} from $vol->{storage} : ";
3889         if ($a->send_to_io($vol->{slot})) {
3890             print "<img src='/bweb/T.png' alt='ok'><br/>";
3891         } else {
3892             print "<img src='/bweb/E.png' alt='err'><br/>";
3893         }
3894     }
3895     return keys %ret;
3896 }
3897
3898 sub move_email
3899 {
3900     my ($self) = @_;
3901
3902     my ($to, $subject, $content) = (CGI::param('email'),
3903                                     CGI::param('subject'),
3904                                     CGI::param('content'));
3905     $to =~ s/[^\w\d\.\@<>,]//;
3906     $subject =~ s/[^\w\d\.\[\]]/ /;
3907
3908     open(MAIL, "|mail -s '$subject' '$to'") ;
3909     print MAIL $content;
3910     close(MAIL);
3911
3912     print "Mail sent";
3913 }
3914
3915 sub restore
3916 {
3917     my ($self) = @_;
3918
3919     my $arg = $self->get_form('jobid', 'client');
3920
3921     print CGI::header('text/brestore');
3922     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
3923     print "client=$arg->{client}\n" if ($arg->{client});
3924     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
3925     print "\n";
3926 }
3927
3928 # TODO : move this to Bweb::Autochanger ?
3929 # TODO : make this internal to not eject tape ?
3930 use Bconsole;
3931
3932
3933 sub ach_get
3934 {
3935     my ($self, $name) = @_;
3936
3937     unless ($name) {
3938         return $self->error("Can't get your autochanger name ach");
3939     }
3940
3941     unless ($self->{info}->{ach_list}) {
3942         return $self->error("Could not find any autochanger");
3943     }
3944
3945     my $a = $self->{info}->{ach_list}->{$name};
3946
3947     unless ($a) {
3948         $self->error("Can't get your autochanger $name from your ach_list");
3949         return undef;
3950     }
3951
3952     $a->{bweb}  = $self;
3953     $a->{debug} = $self->{debug};
3954
3955     return $a;
3956 }
3957
3958 sub ach_register
3959 {
3960     my ($self, $ach) = @_;
3961     $self->can_do('r_configure');
3962
3963     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
3964
3965     $self->{info}->save();
3966
3967     return 1;
3968 }
3969
3970 sub ach_edit
3971 {
3972     my ($self) = @_;
3973     $self->can_do('r_configure');
3974
3975     my $arg = $self->get_form('ach');
3976     if (!$arg->{ach}
3977         or !$self->{info}->{ach_list}
3978         or !$self->{info}->{ach_list}->{$arg->{ach}})
3979     {
3980         return $self->error("Can't get autochanger name");
3981     }
3982
3983     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
3984
3985     my $i=0;
3986     $ach->{drives} =
3987         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
3988
3989     my $b = $self->get_bconsole();
3990
3991     my @storages = $b->list_storage() ;
3992
3993     $ach->{devices} = [ map { { name => $_ } } @storages ];
3994
3995     $self->display($ach, "ach_add.tpl");
3996     delete $ach->{drives};
3997     delete $ach->{devices};
3998     return 1;
3999 }
4000
4001 sub ach_del
4002 {
4003     my ($self) = @_;
4004     $self->can_do('r_configure');
4005
4006     my $arg = $self->get_form('ach');
4007
4008     if (!$arg->{ach}
4009         or !$self->{info}->{ach_list}
4010         or !$self->{info}->{ach_list}->{$arg->{ach}})
4011     {
4012         return $self->error("Can't get autochanger name");
4013     }
4014
4015     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
4016
4017     $self->{info}->save();
4018     $self->{info}->view();
4019 }
4020
4021 sub ach_add
4022 {
4023     my ($self) = @_;
4024     $self->can_do('r_configure');
4025
4026     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
4027
4028     my $b = $self->get_bconsole();
4029     my @storages = $b->list_storage() ;
4030
4031     unless ($arg->{ach}) {
4032         $arg->{devices} = [ map { { name => $_ } } @storages ];
4033         return $self->display($arg, "ach_add.tpl");
4034     }
4035
4036     my @drives ;
4037     foreach my $drive (CGI::param('drives'))
4038     {
4039         unless (grep(/^$drive$/,@storages)) {
4040             return $self->error("Can't find $drive in storage list");
4041         }
4042
4043         my $index = CGI::param("index_$drive");
4044         unless (defined $index and $index =~ /^(\d+)$/) {
4045             return $self->error("Can't get $drive index");
4046         }
4047
4048         $drives[$index] = $drive;
4049     }
4050
4051     unless (@drives) {
4052         return $self->error("Can't get drives from Autochanger");
4053     }
4054
4055     my $a = new Bweb::Autochanger(name   => $arg->{ach},
4056                                   precmd => $arg->{precmd},
4057                                   drive_name => \@drives,
4058                                   device => $arg->{device},
4059                                   mtxcmd => $arg->{mtxcmd});
4060
4061     $self->ach_register($a) ;
4062
4063     $self->{info}->view();
4064 }
4065
4066 sub delete
4067 {
4068     my ($self) = @_;
4069     $self->can_do('r_delete_job');
4070
4071     my $arg = $self->get_form('jobid');
4072
4073     if ($arg->{jobid}) {
4074         my $b = $self->get_bconsole();
4075         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
4076
4077         $self->display({
4078             content => $ret,
4079             title => "Delete a job ",
4080             name => "delete jobid=$arg->{jobid}",
4081         }, "command.tpl");
4082     }
4083 }
4084
4085 sub do_update_media
4086 {
4087     my ($self) = @_ ;
4088     $self->can_do('r_media_mgnt');
4089
4090     my $arg = $self->get_form(qw/media volstatus inchanger pool
4091                                  slot volretention voluseduration
4092                                  maxvoljobs maxvolfiles maxvolbytes
4093                                  qcomment poolrecycle enabled
4094                               /);
4095
4096     unless ($arg->{media}) {
4097         return $self->error("Can't find media selection");
4098     }
4099
4100     my $update = "update volume=$arg->{media} ";
4101
4102     if ($arg->{volstatus}) {
4103         $update .= " volstatus=$arg->{volstatus} ";
4104     }
4105
4106     if ($arg->{inchanger}) {
4107         $update .= " inchanger=yes " ;
4108         if ($arg->{slot}) {
4109             $update .= " slot=$arg->{slot} ";
4110         }
4111     } else {
4112         $update .= " slot=0 inchanger=no ";
4113     }
4114
4115     if ($arg->{enabled}) {
4116         $update .= " enabled=$arg->{enabled} ";
4117     }
4118
4119     if ($arg->{pool}) {
4120         $update .= " pool=$arg->{pool} " ;
4121     }
4122
4123     if (defined $arg->{volretention}) {
4124         $update .= " volretention=\"$arg->{volretention}\" " ;
4125     }
4126
4127     if (defined $arg->{voluseduration}) {
4128         $update .= " voluse=\"$arg->{voluseduration}\" " ;
4129     }
4130
4131     if (defined $arg->{maxvoljobs}) {
4132         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
4133     }
4134
4135     if (defined $arg->{maxvolfiles}) {
4136         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
4137     }
4138
4139     if (defined $arg->{maxvolbytes}) {
4140         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
4141     }
4142
4143     if (defined $arg->{poolrecycle}) {
4144         $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
4145     }
4146
4147     my $b = $self->get_bconsole();
4148
4149     $self->display({
4150         content => $b->send_cmd($update),
4151         title => "Update a volume ",
4152         name => $update,
4153     }, "command.tpl");
4154
4155
4156     my @q;
4157     my $media = $self->dbh_quote($arg->{media});
4158
4159     my $loc = CGI::param('location') || '';
4160     if ($loc) {
4161         $loc = $self->dbh_quote($loc); # is checked by db
4162         push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
4163     }
4164     if (!$arg->{qcomment}) {
4165         $arg->{qcomment} = "''";
4166     }
4167     push @q, "Comment=$arg->{qcomment}";
4168
4169
4170     my $query = "
4171 UPDATE Media
4172    SET " . join (',', @q) . "
4173  WHERE Media.VolumeName = $media
4174 ";
4175     $self->dbh_do($query);
4176
4177     $self->update_media();
4178 }
4179
4180 sub update_slots
4181 {
4182     my ($self) = @_;
4183     $self->can_do('r_autochanger_mgnt');
4184
4185     my $ach = CGI::param('ach') ;
4186     $ach = $self->ach_get($ach);
4187     unless ($ach) {
4188         return $self->error("Bad autochanger name");
4189     }
4190
4191     print "<pre>";
4192     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
4193     $b->update_slots($ach->{name});
4194     print "</pre>\n"
4195 }
4196
4197 sub get_job_log
4198 {
4199     my ($self) = @_;
4200     $self->can_do('r_view_log');
4201
4202     my $arg = $self->get_form('jobid', 'limit', 'offset');
4203     unless ($arg->{jobid}) {
4204         return $self->error("Can't get jobid");
4205     }
4206
4207     if ($arg->{limit} == 100) {
4208         $arg->{limit} = 1000;
4209     }
4210     # get security filter
4211     my $filter = $self->get_client_filter();
4212
4213     my $query = "
4214 SELECT Job.Name as name, Client.Name as clientname
4215  FROM  Job INNER JOIN Client USING (ClientId) $filter
4216  WHERE JobId = $arg->{jobid}
4217 ";
4218
4219     my $row = $self->dbh_selectrow_hashref($query);
4220
4221     unless ($row) {
4222         return $self->error("Can't find $arg->{jobid} in catalog");
4223     }
4224
4225     # display only Error and Warning messages
4226     $filter = '';
4227     if (CGI::param('error')) {
4228         $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning|ERR=' ";
4229     }
4230
4231     my $logtext;
4232     if (CGI::param('time') || $self->{info}->{display_log_time}) {
4233         $logtext = $self->dbh_strcat('Time', " ' ' ", 'LogText');
4234     } else {
4235         $logtext = 'LogText';
4236     }
4237
4238     $query = "
4239 SELECT count(1) AS nbline, JobId AS jobid,
4240        GROUP_CONCAT($logtext $self->{sql}->{CONCAT_SEP}) AS logtxt
4241   FROM  (
4242     SELECT JobId, Time, LogText
4243     FROM Log
4244    WHERE ( Log.JobId = $arg->{jobid}
4245       OR (Log.JobId = 0
4246           AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
4247           AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
4248        ) ) $filter
4249  ORDER BY LogId
4250  LIMIT $arg->{limit}
4251  OFFSET $arg->{offset}
4252  ) AS temp
4253  GROUP BY JobId
4254
4255 ";
4256
4257     my $log = $self->dbh_selectrow_hashref($query);
4258     unless ($log) {
4259         return $self->error("Can't get log for jobid $arg->{jobid}");
4260     }
4261
4262     $self->display({ lines=> $log->{logtxt},
4263                      nbline => $log->{nbline},
4264                      jobid => $arg->{jobid},
4265                      name  => $row->{name},
4266                      client => $row->{clientname},
4267                      offset => $arg->{offset},
4268                      limit  => $arg->{limit},
4269                  }, 'display_log.tpl');
4270 }
4271
4272 sub add_media
4273 {
4274     my ($self) = @_ ;
4275     $self->can_do('r_media_mgnt');
4276     my $arg = $self->get_form('storage', 'pool', 'nb', 'media', 'offset');
4277     my $b = $self->get_bconsole();
4278
4279     if (!$arg->{storage} || !$arg->{pool} || not defined $arg->{nb} || !$arg->{media} || !$arg->{offset}) {
4280         CGI::param(offset => 0);
4281         $arg = $self->get_form('db_pools');
4282         $arg->{storage} = [ map { { name => $_ } }$b->list_storage()];
4283         $self->display($arg, 'add_media.tpl');
4284         return 1;
4285     }
4286
4287     my $cmd;
4288     if ($arg->{nb} > 0) {
4289         $arg->{offset} = $arg->{offset}?$arg->{offset}:1;
4290         $cmd = "add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n$arg->{nb}\n$arg->{media}\n$arg->{offset}\n";
4291     } else {
4292         $cmd = "add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n0\n$arg->{media}\n";
4293     }
4294     $b->connect();
4295     $b->send($cmd);
4296     $b->expect_it('*');
4297
4298     CGI::param('media', '');
4299     CGI::param('re_media', $arg->{media});
4300     $self->display_media();
4301 }
4302
4303 sub label_barcodes
4304 {
4305     my ($self) = @_ ;
4306     $self->can_do('r_autochanger_mgnt');
4307
4308     my $arg = $self->get_form('ach', 'slots', 'drive');
4309
4310     unless ($arg->{ach}) {
4311         return $self->error("Can't find autochanger name");
4312     }
4313
4314     my $a = $self->ach_get($arg->{ach});
4315     unless ($a) {
4316         return $self->error("Can't find autochanger name in configuration");
4317     }
4318
4319     my $storage = $a->get_drive_name($arg->{drive});
4320     unless ($storage) {
4321         return $self->error("Can't get your drive name");
4322     }
4323
4324     my $slots = '';
4325     my $slots_sql = '';
4326     my $t = 300 ;
4327     if ($arg->{slots}) {
4328         $slots = join(",", @{ $arg->{slots} });
4329         $slots_sql = " AND Slot IN ($slots) ";
4330         $t += 60*scalar( @{ $arg->{slots} }) ;
4331     }
4332
4333     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
4334     print "<h1>This command can take long time, be patient...</h1>";
4335     print "<pre>" ;
4336     $b->label_barcodes(storage => $storage,
4337                        drive => $arg->{drive},
4338                        pool  => 'Scratch',
4339                        slots => $slots) ;
4340     $b->close();
4341     print "</pre>";
4342
4343     $self->dbh_do("
4344   UPDATE Media
4345        SET LocationId =   (SELECT LocationId
4346                              FROM Location
4347                             WHERE Location = '$arg->{ach}')
4348
4349      WHERE (LocationId = 0 OR LocationId IS NULL)
4350        $slots_sql
4351 ");
4352
4353 }
4354
4355 sub purge
4356 {
4357     my ($self) = @_;
4358     $self->can_do('r_purge');
4359
4360     my @volume = CGI::param('media');
4361
4362     unless (@volume) {
4363         return $self->error("Can't get media selection");
4364     }
4365
4366     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4367
4368     foreach my $v (@volume) {
4369         $self->display({
4370             content => $b->purge_volume($v),
4371             title => "Purge media",
4372             name => "purge volume=$v",
4373         }, "command.tpl");
4374     }
4375     $b->close();
4376 }
4377
4378 sub prune
4379 {
4380     my ($self) = @_;
4381     $self->can_do('r_prune');
4382
4383     my @volume = CGI::param('media');
4384     unless (@volume) {
4385         return $self->error("Can't get media selection");
4386     }
4387
4388     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4389
4390     foreach my $v (@volume) {
4391         $self->display({
4392             content => $b->prune_volume($v),
4393             title => "Prune volume",
4394             name => "prune volume=$v",
4395         }, "command.tpl");
4396     }
4397     $b->close();
4398 }
4399
4400 sub cancel_job
4401 {
4402     my ($self) = @_;
4403     $self->can_do('r_cancel_job');
4404
4405     my $arg = $self->get_form('jobid');
4406     unless ($arg->{jobid}) {
4407         return $self->error("Can't get jobid");
4408     }
4409
4410     my $b = $self->get_bconsole();
4411     $self->display({
4412         content => $b->cancel($arg->{jobid}),
4413         title => "Cancel job",
4414         name => "cancel jobid=$arg->{jobid}",
4415     }, "command.tpl");
4416 }
4417
4418 sub fileset_view
4419 {
4420     # Warning, we display current fileset
4421     my ($self) = @_;
4422
4423     my $arg = $self->get_form('fileset');
4424
4425     if ($arg->{fileset}) {
4426         my $b = $self->get_bconsole();
4427         my $ret = $b->get_fileset($arg->{fileset});
4428         $self->display({ fileset => $arg->{fileset},
4429                          %$ret,
4430                      }, "fileset_view.tpl");
4431     } else {
4432         $self->error("Can't get fileset name");
4433     }
4434 }
4435
4436 sub director_show_sched
4437 {
4438     my ($self) = @_ ;
4439     $self->can_do('r_view_job');
4440     my $arg = $self->get_form('days');
4441
4442     my $b = $self->get_bconsole();
4443     my $ret = $b->director_get_sched( $arg->{days} );
4444
4445     $self->display({
4446         id => $cur_id++,
4447         list => $ret,
4448     }, "scheduled_job.tpl");
4449 }
4450
4451 sub enable_disable_job
4452 {
4453     my ($self, $what) = @_ ;
4454     $self->can_do('r_run_job');
4455
4456     my $name = CGI::param('job') || '';
4457     unless ($name =~ /^[\w\d\.\-\s]+$/) {
4458         return $self->error("Can't find job name");
4459     }
4460
4461     my $b = $self->get_bconsole();
4462
4463     my $cmd;
4464     if ($what) {
4465         $cmd = "enable";
4466     } else {
4467         $cmd = "disable";
4468     }
4469
4470     $self->display({
4471         content => $b->send_cmd("$cmd job=\"$name\""),
4472         title => "$cmd $name",
4473         name => "$cmd job=\"$name\"",
4474     }, "command.tpl");
4475 }
4476
4477 sub get_bconsole
4478 {
4479     my ($self) = @_;
4480     return new Bconsole(pref => $self->{info});
4481 }
4482
4483 sub cmd_storage
4484 {
4485     my ($self) = @_;
4486     $self->can_do('r_storage_mgnt');
4487     my $arg = $self->get_form(qw/storage storage_cmd drive/);
4488     my $b = $self->get_bconsole();
4489
4490     if ($arg->{storage} and $arg->{storage_cmd}) {
4491         my $cmd = "$arg->{storage_cmd} storage=\"$arg->{storage}\" drive=$arg->{drive}";
4492         my $ret = $b->send_cmd($cmd);
4493
4494         $self->display({
4495             content => $ret,
4496             title => "Storage ",
4497             name => $cmd,
4498         }, "command.tpl");
4499     } else {
4500         my $storages= [ map { { name => $_ } } $b->list_storage()];
4501         $self->display({ storage => $storages}, "cmd_storage.tpl");
4502     }
4503 }
4504
4505 sub run_job_select
4506 {
4507     my ($self) = @_;
4508     $self->can_do('r_run_job');
4509
4510     my $b = $self->get_bconsole();
4511
4512     my $joblist = [ map { { name => $_ } } $b->list_job() ];
4513
4514     $self->display({ Jobs => $joblist }, "run_job.tpl");
4515 }
4516
4517 sub run_parse_job
4518 {
4519     my ($self, $ouput) = @_;
4520
4521     my %arg;
4522     foreach my $l (split(/\r\n/, $ouput)) {
4523         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4524             $arg{$1} = $2;
4525             $l = $3
4526                 if ($3) ;
4527         }
4528
4529         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4530             %arg = (%arg, @l);
4531         }
4532     }
4533
4534     my %lowcase ;
4535     foreach my $k (keys %arg) {
4536         $lowcase{lc($k)} = $arg{$k} ;
4537     }
4538
4539     return \%lowcase;
4540 }
4541
4542 sub run_job_mod
4543 {
4544     my ($self) = @_;
4545     $self->can_do('r_run_job');
4546
4547     my $b = $self->get_bconsole();
4548
4549     my $job = CGI::param('job') || '';
4550
4551     # we take informations from director, and we overwrite with user wish
4552     my $info = $b->send_cmd("show job=\"$job\"");
4553     my $attr = $self->run_parse_job($info);
4554
4555     my $arg = $self->get_form(qw/pool level client fileset storage media/);
4556
4557     if (!$arg->{pool} and $arg->{media}) {
4558         my $r = $self->dbh_selectrow_hashref("
4559 SELECT Pool.Name AS name
4560   FROM Media JOIN Pool USING (PoolId)
4561  WHERE Media.VolumeName = '$arg->{media}'
4562    AND Pool.Name != 'Scratch'
4563 ");
4564         if ($r) {
4565             $arg->{pool} = $r->{name};
4566         }
4567     }
4568
4569     my %job_opt = (%$attr, %$arg);
4570
4571     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
4572
4573     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
4574     my $clients = [ map { { name => $_ } }$b->list_client()];
4575     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
4576     my $storages= [ map { { name => $_ } }$b->list_storage()];
4577
4578     $self->display({
4579         jobs     => $jobs,
4580         pools    => $pools,
4581         clients  => $clients,
4582         filesets => $filesets,
4583         storages => $storages,
4584         %job_opt,
4585     }, "run_job_mod.tpl");
4586 }
4587
4588 sub run_job
4589 {
4590     my ($self) = @_;
4591     $self->can_do('r_run_job');
4592
4593     my $b = $self->get_bconsole();
4594
4595     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
4596
4597     $self->display({
4598         jobs     => $jobs,
4599     }, "run_job.tpl");
4600 }
4601
4602 sub run_job_now
4603 {
4604     my ($self) = @_;
4605     $self->can_do('r_run_job');
4606
4607     my $b = $self->get_bconsole();
4608
4609     # TODO: check input (don't use pool, level)
4610
4611     my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
4612     my $job = CGI::param('job') || '';
4613     my $storage = CGI::param('storage') || '';
4614
4615     my $jobid = $b->run(job => $job,
4616                         client => $arg->{client},
4617                         priority => $arg->{priority},
4618                         level => $arg->{level},
4619                         storage => $storage,
4620                         pool => $arg->{pool},
4621                         fileset => $arg->{fileset},
4622                         when => $arg->{when},
4623                         );
4624
4625     print $b->{error};
4626
4627     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>";
4628 }
4629
4630 sub display_next_job
4631 {
4632     my ($self) = @_;
4633
4634     my $arg = $self->get_form(qw/job begin end/);
4635     if (!$arg->{job}) {
4636         return $self->error("Can't get job name");
4637     }
4638
4639     my $b = $self->get_bconsole();
4640
4641     my $job = $b->send_cmd("show job=\"$arg->{job}\"");
4642     my $attr = $self->run_parse_job($job);
4643
4644     if (!$attr->{schedule}) {
4645         return $self->error("Can't get $arg->{job} schedule");
4646     }
4647     my $jpool=$attr->{pool} || '';
4648
4649     my $sched = new Bweb::Sched(bconsole => $b, name => $attr->{schedule},
4650                                 begin => $arg->{begin}, end => $arg->{end});
4651
4652     my $ss = $sched->get_scheds($attr->{schedule});
4653     my @ret;
4654
4655     foreach my $s (@$ss) {
4656         my $level = $sched->get_level($s);
4657         my $pool  = $sched->get_pool($s) || $jpool;
4658         my $evt = $sched->get_event($s);
4659         push @ret, map { "$_ : $pool ($level)\n" } @$evt;
4660     }
4661
4662     print "<b>$arg->{job}:</b><pre>", sort @ret, "</pre><br>";
4663 }
4664
4665 # check jobs against their schedule
4666 sub check_job
4667 {
4668     my ($self, $sched, $schedname, $job, $job_pool, $client) = @_;
4669     return undef if (!$self->can_view_client($client));
4670
4671     my $sch = $sched->get_scheds($schedname);
4672     return undef if (!$sch);
4673
4674     my $end = $sched->{end}; # this backup must have start before the next one
4675     my @ret;
4676     foreach my $s (@$sch) {
4677         my $pool = $sched->get_pool($s) || $job_pool;
4678         my $level = $sched->get_level($s);
4679         my ($l) = ($level =~ m/^(.)/); # we keep the first letter
4680         my $evts = $sched->get_event($s);
4681
4682         foreach my $evt (reverse @$evts) {
4683             my $all = $self->dbh_selectrow_hashref("
4684  SELECT 1
4685    FROM Job JOIN Pool USING (PoolId) JOIN Client USING (ClientId)
4686   WHERE Job.StartTime >= '$evt'
4687     AND Job.StartTime <  '$end'
4688     AND Job.Type = 'B'
4689     AND Job.Name = '$job'
4690     AND Job.JobStatus = 'T'
4691     AND Job.Level = '$l'
4692 " . ($pool?" AND Pool.Name = '$pool' ":'') . "
4693     AND Client.Name = '$client'
4694  LIMIT 1
4695 ");
4696             if ($all) {
4697 #               print "ok $job ";
4698             } else {
4699                 push @{$self->{tmp}}, {date => $evt, level => $level,
4700                                        type => 'Backup', name => $job,
4701                                        pool => $pool, volume => $pool};
4702             }
4703             $end = $evt;
4704         }
4705     }
4706 }
4707
4708 sub display_missing_job
4709 {
4710     my ($self) = @_;
4711     my $arg = $self->get_form(qw/begin end/);
4712
4713     if (!$arg->{begin}) { # TODO: change this
4714         $arg->{begin} = strftime('%F %T', localtime(time - 24*60*60 ));
4715     }
4716     if (!$arg->{end}) {
4717         $arg->{end} = strftime('%F %T', localtime(time));
4718     }
4719     $self->{tmp} = [];          # check_job use this for result
4720
4721     my $bconsole = $self->get_bconsole();
4722
4723     my $sched = new Bweb::Sched(bconsole => $bconsole,
4724                                 begin => $arg->{begin},
4725                                 end => $arg->{end});
4726
4727     my $job = $bconsole->send_cmd("show job");
4728     my ($jname, $jsched, $jclient, $jpool);
4729     foreach my $j (split(/\r?\n/, $job)) {
4730         if ($j =~ /Job: name=([\w\d\-]+?) JobType=/i) {
4731             if ($jname and $jsched) {
4732                 $self->check_job($sched, $jsched, $jname, $jpool, $jclient);
4733             }
4734             $jname = $1;
4735             $jclient = $jpool = $jsched = undef;
4736         } elsif ($j =~ /Client: name=(.+?) address=/i) {
4737             $jclient = $1;
4738         } elsif ($j =~ /Pool: name=([\w\d\-]+) PoolType=/i) {
4739             $jpool = $1;
4740         } elsif ($j =~ /Schedule: name=([\w\d\-]+)/i) {
4741             $jsched = $1;
4742         }
4743     }
4744     $self->display({
4745         id => $cur_id++,
4746         title => "Missing Job (since $arg->{begin} to $arg->{end})",
4747         list => $self->{tmp},
4748     }, "scheduled_job.tpl");
4749
4750     delete $self->{tmp};
4751 }
4752
4753 1;