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