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