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 Examined'};
 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         if ($client) {
2256             $ret{client} = $client;
2257             $client = $self->dbh_quote($client);
2258             $limit .= "AND Client.Name = $client ";
2259         }
2260     }
2261
2262     if ($elt{level}) {
2263         my $level = CGI::param('level') || '';
2264         if ($level =~ /^(\w)$/) {
2265             $ret{level} = $1;
2266             $limit .= "AND Job.Level = '$1' ";
2267         }
2268     }
2269
2270     if ($elt{jobid}) {
2271         my $jobid = CGI::param('jobid') || '';
2272
2273         if ($jobid =~ /^(\d+)$/) {
2274             $ret{jobid} = $1;
2275             $limit .= "AND Job.JobId = '$1' ";
2276         }
2277     }
2278
2279     if ($elt{status}) {
2280         my $status = CGI::param('status') || '';
2281         if ($status =~ /^(\w)$/) {
2282             $ret{status} = $1;
2283             if ($1 eq 'f') {
2284                 $limit .= "AND Job.JobStatus IN ('f','E') ";
2285             } elsif ($1 eq 'W') {
2286                 $limit .= "AND Job.JobStatus = 'T' AND Job.JobErrors > 0 ";
2287             } else {
2288                 $limit .= "AND Job.JobStatus = '$1' ";
2289             }
2290         }
2291     }
2292
2293     if ($elt{volstatus}) {
2294         my $status = CGI::param('volstatus') || '';
2295         if ($status =~ /^(\w+)$/) {
2296             $ret{status} = $1;
2297             $limit .= "AND Media.VolStatus = '$1' ";
2298         }
2299     }
2300
2301     if ($elt{locations}) {
2302         my @location = grep { ! /^\s*$/ } CGI::param('location') ;
2303         if (@location) {
2304             $ret{locations} = \@location;
2305             my $str = $self->dbh_join(@location);
2306             $limit .= "AND Location.Location IN ($str) ";
2307         }
2308     }
2309
2310     if ($elt{pools}) {
2311         my @pool = grep { ! /^\s*$/ } CGI::param('pool') ;
2312         if (@pool) {
2313             $ret{pools} = \@pool;
2314             my $str = $self->dbh_join(@pool);
2315             $limit .= "AND Pool.Name IN ($str) ";
2316         }
2317     }
2318
2319     if ($elt{location}) {
2320         my $location = CGI::param('location') || '';
2321         if ($location) {
2322             $ret{location} = $location;
2323             $location = $self->dbh_quote($location);
2324             $limit .= "AND Location.Location = $location ";
2325         }
2326     }
2327
2328     if ($elt{pool}) {
2329         my $pool = CGI::param('pool') || '';
2330         if ($pool) {
2331             $ret{pool} = $pool;
2332             $pool = $self->dbh_quote($pool);
2333             $limit .= "AND Pool.Name = $pool ";
2334         }
2335     }
2336
2337     if ($elt{jobtype}) {
2338         my $jobtype = CGI::param('jobtype') || '';
2339         if ($jobtype =~ /^(\w)$/) {
2340             $ret{jobtype} = $1;
2341             $limit .= "AND Job.Type = '$1' ";
2342         }
2343     }
2344
2345     return ($limit, %ret);
2346 }
2347
2348 =head1
2349
2350     get last backup
2351
2352 =cut
2353
2354 sub display_job
2355 {
2356     my ($self, %arg) = @_ ;
2357     return if $self->cant_do('r_view_job');
2358
2359     $arg{order} = ' Job.JobId DESC ';
2360
2361     my ($limit, $label) = $self->get_limit(%arg);
2362     my ($where, undef) = $self->get_param('clients',
2363                                           'client_groups',
2364                                           'level',
2365                                           'filesets',
2366                                           'jobtype',
2367                                           'pools',
2368                                           'jobid',
2369                                           'status');
2370     my $cgq='';
2371     if (CGI::param('client_group')) {
2372         $cgq .= "
2373 JOIN client_group_member USING (ClientId)
2374 JOIN client_group USING (client_group_id)
2375 ";
2376     }
2377     my $filter = $self->get_client_filter();
2378
2379     my $query="
2380 SELECT  Job.JobId       AS jobid,
2381         Client.Name     AS client,
2382         FileSet.FileSet AS fileset,
2383         Job.Name        AS jobname,
2384         Level           AS level,
2385         StartTime       AS starttime,
2386         EndTime         AS endtime,
2387         Pool.Name       AS poolname,
2388         JobFiles        AS jobfiles,
2389         JobBytes        AS jobbytes,
2390         JobStatus       AS jobstatus,
2391      $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2392                                  - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
2393                         AS duration,
2394
2395         JobErrors       AS joberrors
2396
2397  FROM Client $filter $cgq,
2398       Job LEFT JOIN Pool     ON (Job.PoolId    = Pool.PoolId)
2399           LEFT JOIN FileSet  ON (Job.FileSetId = FileSet.FileSetId)
2400  WHERE Client.ClientId=Job.ClientId
2401    AND Job.JobStatus NOT IN ('R', 'C')
2402  $where
2403  $limit
2404 ";
2405
2406     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
2407
2408     $self->display({ Filter => $label,
2409                      ID => $cur_id++,
2410                      Jobs =>
2411                            [
2412                              sort { $a->{jobid} <=>  $b->{jobid} }
2413                                         values %$all
2414                              ],
2415                    },
2416                    "display_job.tpl");
2417 }
2418
2419 # display job informations
2420 sub display_job_zoom
2421 {
2422     my ($self, $jobid) = @_ ;
2423     $self->can_do('r_view_job');
2424
2425     $jobid = $self->dbh_quote($jobid);
2426
2427     # get security filter
2428     my $filter = $self->get_client_filter();
2429
2430     my $query="
2431 SELECT DISTINCT Job.JobId       AS jobid,
2432                 Client.Name     AS client,
2433                 Job.Name        AS jobname,
2434                 FileSet.FileSet AS fileset,
2435                 Level           AS level,
2436                 Pool.Name       AS poolname,
2437                 StartTime       AS starttime,
2438                 JobFiles        AS jobfiles,
2439                 JobBytes        AS jobbytes,
2440                 JobStatus       AS jobstatus,
2441                 JobErrors       AS joberrors,
2442                 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2443                                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)) AS duration
2444
2445  FROM Client $filter,
2446       Job LEFT JOIN FileSet ON (Job.FileSetId = FileSet.FileSetId)
2447           LEFT JOIN Pool    ON (Job.PoolId    = Pool.PoolId)
2448  WHERE Client.ClientId=Job.ClientId
2449  AND Job.JobId = $jobid
2450 ";
2451
2452     my $row = $self->dbh_selectrow_hashref($query) ;
2453
2454     # display all volumes associate with this job
2455     $query="
2456 SELECT Media.VolumeName as volumename
2457 FROM Job,Media,JobMedia
2458 WHERE Job.JobId = $jobid
2459  AND JobMedia.JobId=Job.JobId
2460  AND JobMedia.MediaId=Media.MediaId
2461 ";
2462
2463     my $all = $self->dbh_selectall_hashref($query, 'volumename');
2464
2465     $row->{volumes} = [ values %$all ] ;
2466     $row->{wiki_url} = $self->{info}->{wiki_url};
2467
2468     $self->display($row, "display_job_zoom.tpl");
2469 }
2470
2471 sub display_job_group
2472 {
2473     my ($self, %arg) = @_;
2474     $self->can_do('r_view_job');
2475
2476     my ($limit, $label) = $self->get_limit(groupby => 'client_group_name',  %arg);
2477
2478     my ($where, undef) = $self->get_param('client_groups',
2479                                           'level',
2480                                           'pools');
2481     my $filter = $self->get_client_group_filter();
2482     my $query =
2483 "
2484 SELECT client_group_name AS client_group_name,
2485        COALESCE(jobok.jobfiles,0)  + COALESCE(joberr.jobfiles,0)  AS jobfiles,
2486        COALESCE(jobok.jobbytes,0)  + COALESCE(joberr.jobbytes,0)  AS jobbytes,
2487        COALESCE(jobok.joberrors,0) + COALESCE(joberr.joberrors,0) AS joberrors,
2488        COALESCE(jobok.nbjobs,0)  AS nbjobok,
2489        COALESCE(joberr.nbjobs,0) AS nbjoberr,
2490        COALESCE(jobok.duration, '0:0:0') AS duration
2491
2492 FROM client_group $filter LEFT JOIN (
2493     SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2494            SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2495            SUM(JobErrors) AS joberrors,
2496            SUM($self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(EndTime)
2497                               - $self->{sql}->{UNIX_TIMESTAMP}(StartTime)))
2498                         AS duration
2499
2500     FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2501              JOIN client_group USING (client_group_id)
2502
2503     WHERE JobStatus = 'T'
2504     $where
2505     $limit
2506 ) AS jobok USING (client_group_name) LEFT JOIN
2507
2508 (
2509     SELECT client_group_name AS client_group_name, COUNT(1) AS nbjobs,
2510            SUM(JobFiles) AS jobfiles, SUM(JobBytes) AS jobbytes,
2511            SUM(JobErrors) AS joberrors
2512     FROM Job JOIN client_group_member ON (Job.ClientId = client_group_member.ClientId)
2513              JOIN client_group USING (client_group_id)
2514
2515     WHERE JobStatus IN ('f','E', 'A')
2516     $where
2517     $limit
2518 ) AS joberr USING (client_group_name)
2519
2520     ";
2521
2522     my $all = $self->dbh_selectall_hashref($query, 'client_group_name');
2523
2524     my $rep = { groups => [ values %$all ], age => $arg{age}, filter => $label };
2525
2526     $self->debug($rep);
2527     $self->display($rep, "display_job_group.tpl");
2528 }
2529
2530 sub display_media
2531 {
2532     my ($self, %arg) = @_ ;
2533     $self->can_do('r_view_media');
2534
2535     my ($limit, $label) = $self->get_limit(%arg);
2536     my ($where, %elt) = $self->get_param('pools',
2537                                          'mediatypes',
2538                                          'volstatus',
2539                                          'locations');
2540
2541     my $arg = $self->get_form('jmedias', 'qre_media', 'expired');
2542
2543     if ($arg->{jmedias}) {
2544         $where = "AND Media.VolumeName IN ($arg->{jmedias}) $where";
2545     }
2546     if ($arg->{qre_media}) {
2547         $where = "AND Media.VolumeName $self->{sql}->{MATCH} $arg->{qre_media} $where";
2548     }
2549     if ($arg->{expired}) {
2550         $where = "
2551         AND VolStatus = 'Full'
2552         AND (    $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2553                + $self->{sql}->{TO_SEC}(Media.VolRetention)
2554             ) < NOW()  " . $where ;
2555     }
2556
2557     my $query="
2558 SELECT Media.VolumeName  AS volumename,
2559        Media.VolBytes    AS volbytes,
2560        Media.VolStatus   AS volstatus,
2561        Media.MediaType   AS mediatype,
2562        Media.InChanger   AS online,
2563        Media.LastWritten AS lastwritten,
2564        Location.Location AS location,
2565        (volbytes*100/COALESCE(media_avg_size.size,-1))  AS volusage,
2566        Pool.Name         AS poolname,
2567        $self->{sql}->{FROM_UNIXTIME}(
2568           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2569         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2570        ) AS expire
2571 FROM      Pool, Media
2572 LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2573 LEFT JOIN (SELECT avg(Media.VolBytes) AS size,
2574                   Media.MediaType     AS MediaType
2575            FROM Media
2576           WHERE Media.VolStatus = 'Full'
2577           GROUP BY Media.MediaType
2578            ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
2579
2580 WHERE Media.PoolId=Pool.PoolId
2581 $where
2582 $limit
2583 ";
2584
2585     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2586
2587     $self->display({ ID => $cur_id++,
2588                      Pool => $elt{pool},
2589                      Location => $elt{location},
2590                      Media => [ values %$all ],
2591                    },
2592                    "display_media.tpl");
2593 }
2594
2595 sub display_allmedia
2596 {
2597     my ($self) = @_ ;
2598
2599     my $pool = $self->get_form('db_pools');
2600
2601     foreach my $name (@{ $pool->{db_pools} }) {
2602         CGI::param('pool', $name->{name});
2603         $self->display_media();
2604     }
2605 }
2606
2607 sub display_media_zoom
2608 {
2609     my ($self) = @_ ;
2610
2611     my $media = $self->get_form('jmedias');
2612
2613     unless ($media->{jmedias}) {
2614         return $self->error("Can't get media selection");
2615     }
2616
2617     my $query="
2618 SELECT InChanger     AS online,
2619        Media.Enabled AS enabled,
2620        VolBytes      AS nb_bytes,
2621        VolumeName    AS volumename,
2622        VolStatus     AS volstatus,
2623        VolMounts     AS nb_mounts,
2624        Media.VolUseDuration   AS voluseduration,
2625        Media.MaxVolJobs AS maxvoljobs,
2626        Media.MaxVolFiles AS maxvolfiles,
2627        Media.MaxVolBytes AS maxvolbytes,
2628        VolErrors     AS nb_errors,
2629        Pool.Name     AS poolname,
2630        Location.Location AS location,
2631        Media.Recycle AS recycle,
2632        Media.VolRetention AS volretention,
2633        Media.LastWritten  AS lastwritten,
2634        Media.VolReadTime/1000000  AS volreadtime,
2635        Media.VolWriteTime/1000000 AS volwritetime,
2636        Media.RecycleCount AS recyclecount,
2637        Media.Comment      AS comment,
2638        $self->{sql}->{FROM_UNIXTIME}(
2639           $self->{sql}->{UNIX_TIMESTAMP}(Media.LastWritten)
2640         + $self->{sql}->{TO_SEC}(Media.VolRetention)
2641        ) AS expire
2642  FROM Pool,
2643       Media LEFT JOIN Location ON (Media.LocationId = Location.LocationId)
2644  WHERE Pool.PoolId = Media.PoolId
2645  AND VolumeName IN ($media->{jmedias})
2646 ";
2647
2648     my $all = $self->dbh_selectall_hashref($query, 'volumename') ;
2649
2650     foreach my $media (values %$all) {
2651         my $mq = $self->dbh_quote($media->{volumename});
2652
2653         $query = "
2654 SELECT DISTINCT Job.JobId AS jobid,
2655                 Job.Name  AS name,
2656                 Job.StartTime AS starttime,
2657                 Job.Type  AS type,
2658                 Job.Level AS level,
2659                 Job.JobFiles AS files,
2660                 Job.JobBytes AS bytes,
2661                 Job.jobstatus AS status
2662  FROM Media,JobMedia,Job
2663  WHERE Media.VolumeName=$mq
2664  AND Media.MediaId=JobMedia.MediaId
2665  AND JobMedia.JobId=Job.JobId
2666 ";
2667
2668         my $jobs = $self->dbh_selectall_hashref($query, 'jobid') ;
2669
2670         $query = "
2671 SELECT LocationLog.Date    AS date,
2672        Location.Location   AS location,
2673        LocationLog.Comment AS comment
2674  FROM Media,LocationLog INNER JOIN Location ON (LocationLog.LocationId = Location.LocationId)
2675  WHERE Media.MediaId = LocationLog.MediaId
2676    AND Media.VolumeName = $mq
2677 ";
2678
2679         my $logtxt = '';
2680         my $log = $self->dbh_selectall_arrayref($query) ;
2681         if ($log) {
2682             $logtxt = join("\n", map { ($_->[0] . ' ' . $_->[1] . ' ' . $_->[2])} @$log ) ;
2683         }
2684
2685         $self->display({ jobs => [ values %$jobs ],
2686                          LocationLog => $logtxt,
2687                          %$media },
2688                        "display_media_zoom.tpl");
2689     }
2690 }
2691
2692 sub location_edit
2693 {
2694     my ($self) = @_ ;
2695     $self->can_do('r_location_mgnt');
2696
2697     my $loc = $self->get_form('qlocation');
2698     unless ($loc->{qlocation}) {
2699         return $self->error("Can't get location");
2700     }
2701
2702     my $query = "
2703 SELECT Location.Location AS location,
2704        Location.Cost   AS cost,
2705        Location.Enabled AS enabled
2706 FROM Location
2707 WHERE Location.Location = $loc->{qlocation}
2708 ";
2709
2710     my $row = $self->dbh_selectrow_hashref($query);
2711     $row->{enabled} = human_enabled($row->{enabled});
2712     $self->display({ ID => $cur_id++,
2713                      %$row }, "location_edit.tpl") ;
2714 }
2715
2716 sub location_save
2717 {
2718     my ($self) = @_ ;
2719     $self->can_do('r_location_mgnt');
2720
2721     my $arg = $self->get_form(qw/qlocation qnewlocation cost enabled/) ;
2722     unless ($arg->{qlocation}) {
2723         return $self->error("Can't get location");
2724     }
2725     unless ($arg->{qnewlocation}) {
2726         return $self->error("Can't get new location name");
2727     }
2728     unless ($arg->{cost}) {
2729         return $self->error("Can't get new cost");
2730     }
2731
2732     my $enabled = from_human_enabled($arg->{enabled});
2733
2734     my $query = "
2735 UPDATE Location SET Cost     = $arg->{cost},
2736                     Location = $arg->{qnewlocation},
2737                     Enabled   = $enabled
2738 WHERE Location.Location = $arg->{qlocation}
2739 ";
2740
2741     $self->dbh_do($query);
2742
2743     $self->location_display();
2744 }
2745
2746 sub location_del
2747 {
2748     my ($self) = @_ ;
2749     $self->can_do('r_location_mgnt');
2750
2751     my $arg = $self->get_form(qw/qlocation/) ;
2752
2753     unless ($arg->{qlocation}) {
2754         return $self->error("Can't get location");
2755     }
2756
2757     my $query = "
2758 SELECT count(Media.MediaId) AS nb
2759   FROM Media INNER JOIN Location USING (LocationID)
2760 WHERE Location = $arg->{qlocation}
2761 ";
2762
2763     my $res = $self->dbh_selectrow_hashref($query);
2764
2765     if ($res->{nb}) {
2766         return $self->error("Sorry, the location must be empty");
2767     }
2768
2769     $query = "
2770 DELETE FROM Location WHERE Location = $arg->{qlocation}
2771 ";
2772
2773     $self->dbh_do($query);
2774
2775     $self->location_display();
2776 }
2777
2778 sub location_add
2779 {
2780     my ($self) = @_ ;
2781     $self->can_do('r_location_mgnt');
2782
2783     my $arg = $self->get_form(qw/qlocation cost/) ;
2784
2785     unless ($arg->{qlocation}) {
2786         $self->display({}, "location_add.tpl");
2787         return 1;
2788     }
2789     unless ($arg->{cost}) {
2790         return $self->error("Can't get new cost");
2791     }
2792
2793     my $enabled = CGI::param('enabled') || '';
2794     $enabled = from_human_enabled($enabled);
2795
2796     my $query = "
2797 INSERT INTO Location (Location, Cost, Enabled)
2798        VALUES ($arg->{qlocation}, $arg->{cost}, $enabled)
2799 ";
2800
2801     $self->dbh_do($query);
2802
2803     $self->location_display();
2804 }
2805
2806 sub location_display
2807 {
2808     my ($self) = @_ ;
2809
2810     my $query = "
2811 SELECT Location.Location AS location,
2812        Location.Cost     AS cost,
2813        Location.Enabled  AS enabled,
2814        (SELECT count(Media.MediaId)
2815          FROM Media
2816         WHERE Media.LocationId = Location.LocationId
2817        ) AS volnum
2818 FROM Location
2819 ";
2820
2821     my $location = $self->dbh_selectall_hashref($query, 'location');
2822
2823     $self->display({ ID => $cur_id++,
2824                      Locations => [ values %$location ] },
2825                    "display_location.tpl");
2826 }
2827
2828 sub update_location
2829 {
2830     my ($self) = @_ ;
2831
2832     my $media = $self->get_selected_media_location();
2833     unless ($media) {
2834         return ;
2835     }
2836
2837     my $arg = $self->get_form('db_locations', 'qnewlocation');
2838
2839     $self->display({ email  => $self->{info}->{email_media},
2840                      %$arg,
2841                      media => [ values %$media ],
2842                    },
2843                    "update_location.tpl");
2844 }
2845
2846 ###########################################################
2847
2848 sub client_save
2849 {
2850     my ($self) = @_;
2851     my $arg = $self->get_form(qw/jclient_groups qclient/);
2852
2853     unless ($arg->{qclient}) {
2854         return $self->error("Can't get client name");
2855     }
2856
2857     $self->can_do('r_group_mgnt');
2858
2859     my $f1 = $self->get_client_filter();
2860     my $f2 = $self->get_client_group_filter();
2861
2862     $self->{dbh}->begin_work();
2863
2864     my $query = "
2865 DELETE FROM client_group_member
2866       WHERE ClientId IN
2867            (SELECT ClientId
2868               FROM Client $f1
2869              WHERE Client.Name = $arg->{qclient})
2870 ";
2871     $self->dbh_do($query);
2872
2873     if ($arg->{jclient_groups}) {
2874         $query = "
2875  INSERT INTO client_group_member (client_group_id, ClientId)
2876     (SELECT client_group_id, (SELECT ClientId
2877                 FROM Client $f1
2878                WHERE Name = $arg->{qclient})
2879        FROM client_group $f2 WHERE client_group_name IN ($arg->{jclient_groups})
2880     )
2881 ";
2882         $self->dbh_do($query);
2883     }
2884
2885     $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2886
2887     $self->display_clients();
2888 }
2889
2890 sub groups_edit
2891 {
2892     my ($self) = @_;
2893     my $grp = $self->get_form(qw/qclient_group db_clients/);
2894
2895     unless ($grp->{qclient_group}) {
2896         $self->can_do('r_group_mgnt');
2897         $self->display({ ID => $cur_id++,
2898                          client_group => "''",
2899                          %$grp,
2900                      }, "groups_edit.tpl");
2901         return;
2902     }
2903
2904     unless ($self->cant_do('r_group_mgnt')) {
2905         $self->can_do('r_view_group');
2906     }
2907
2908     my $query = "
2909 SELECT Name AS name
2910   FROM Client JOIN client_group_member using (ClientId)
2911               JOIN client_group using (client_group_id)
2912 WHERE client_group_name = $grp->{qclient_group}
2913 ";
2914
2915     my $row = $self->dbh_selectall_hashref($query, "name");
2916     $self->debug($row);
2917     $self->display({ ID => $cur_id++,
2918                      client_group => $grp->{qclient_group},
2919                      %$grp,
2920                      client_group_member => [ values %$row]},
2921                    "groups_edit.tpl");
2922 }
2923
2924 sub groups_save
2925 {
2926     my ($self) = @_;
2927     $self->can_do('r_group_mgnt');
2928
2929     my $arg = $self->get_form(qw/qclient_group jclients qnewgroup qcomment/);
2930
2931     if (!$arg->{qclient_group} and $arg->{qnewgroup}) {
2932         my $query = "
2933 INSERT INTO client_group (client_group_name, comment)
2934 VALUES ($arg->{qnewgroup}, $arg->{qcomment})
2935 ";
2936         $self->dbh_do($query);
2937         $arg->{qclient_group} = $arg->{qnewgroup};
2938     }
2939
2940     unless ($arg->{qclient_group}) {
2941         return $self->error("Can't get groups");
2942     }
2943
2944     $self->{dbh}->begin_work();
2945
2946     my $query = "
2947 DELETE FROM client_group_member
2948       WHERE client_group_id IN
2949            (SELECT client_group_id
2950               FROM client_group
2951              WHERE client_group_name = $arg->{qclient_group})
2952 ";
2953     $self->dbh_do($query);
2954
2955     if ($arg->{jclients}) {
2956         $query = "
2957     INSERT INTO client_group_member (ClientId, client_group_id)
2958        (SELECT  ClientId,
2959                 (SELECT client_group_id
2960                    FROM client_group
2961                   WHERE client_group_name = $arg->{qclient_group})
2962           FROM Client WHERE Name IN ($arg->{jclients})
2963        )
2964 ";
2965         $self->dbh_do($query);
2966     }
2967     if ($arg->{qclient_group} ne $arg->{qnewgroup}) {
2968         $query = "
2969 UPDATE client_group
2970    SET client_group_name = $arg->{qnewgroup}, comment = $arg->{qcomment}
2971  WHERE client_group_name = $arg->{qclient_group}
2972 ";
2973
2974         $self->dbh_do($query);
2975     }
2976
2977     $self->{dbh}->commit() or $self->error($self->{dbh}->errstr);
2978
2979     $self->display_groups();
2980 }
2981
2982 sub groups_del
2983 {
2984     my ($self) = @_;
2985     $self->can_do('r_group_mgnt');
2986
2987     my $arg = $self->get_form(qw/qclient_group/);
2988
2989     unless ($arg->{qclient_group}) {
2990         return $self->error("Can't get groups");
2991     }
2992
2993     $self->{dbh}->begin_work();
2994
2995     $self->dbh_do("
2996 DELETE FROM client_group_member
2997       WHERE client_group_id IN
2998            (SELECT client_group_id
2999               FROM client_group
3000              WHERE client_group_name = $arg->{qclient_group})");
3001
3002     $self->dbh_do("
3003 DELETE FROM bweb_client_group_acl
3004       WHERE client_group_id IN
3005            (SELECT client_group_id
3006               FROM client_group
3007              WHERE client_group_name = $arg->{qclient_group})");
3008
3009     $self->dbh_do("
3010 DELETE FROM client_group
3011       WHERE client_group_name = $arg->{qclient_group}");
3012
3013     $self->{dbh}->commit();
3014     $self->display_groups();
3015 }
3016
3017 sub display_groups
3018 {
3019     my ($self) = @_;
3020     my $arg;
3021
3022     if ($self->cant_do('r_group_mgnt')) {
3023         $arg = $self->get_form(qw/db_client_groups filter/) ;
3024     } else {
3025         $arg = $self->get_form(qw/db_client_groups/) ;
3026     }
3027
3028     if ($self->{dbh}->errstr) {
3029         return $self->error("Can't use groups with bweb, read INSTALL to enable them");
3030     }
3031
3032     $self->debug($arg);
3033
3034     $self->display({ ID => $cur_id++,
3035                      %$arg},
3036                    "display_groups.tpl");
3037 }
3038
3039 ###########################################################
3040
3041 sub get_roles
3042 {
3043     my ($self) = @_;
3044     if (not $self->{info}->{enable_security}) {
3045         return 1;
3046     }
3047     # admin is a special user that can do everything
3048     if ($self->{loginname} eq 'admin') {
3049         return 1;
3050     }
3051     if (!$self->{loginname}) {
3052         $self->error("Can't get your login name");
3053         $self->display_end();
3054         exit 0;
3055     }
3056     # already fill
3057     if (defined $self->{security}) {
3058         return 1;
3059     }
3060     $self->{security} = {};
3061     my $u = $self->dbh_quote($self->{loginname});
3062
3063     my $query = "
3064  SELECT use_acl, rolename, tpl
3065   FROM bweb_user
3066        JOIN bweb_role_member USING (userid)
3067        JOIN bweb_role USING (roleid)
3068  WHERE username = $u
3069 ";
3070     my $rows = $self->dbh_selectall_arrayref($query);
3071     # do cache with this role
3072     if (!$rows or !scalar(@$rows)) {
3073         $self->error("Can't get $self->{loginname}'s roles");
3074         $self->display_end();
3075         exit 0;
3076     }
3077     foreach my $r (@$rows) {
3078         $self->{security}->{$r->[1]}=1;
3079     }
3080     $self->{security}->{use_acl} = $rows->[0]->[0];
3081     if ($rows->[0]->[2] =~ /^(\w\w)$/) {
3082         $self->{lang} = $1;
3083     }
3084     return 1;
3085 }
3086
3087 sub can_view_client
3088 {
3089     my ($self, $client) = @_;
3090
3091     my $filter = $self->get_client_filter();
3092     if (!$filter) {
3093         return 1;
3094     }
3095     my $cont = $self->dbh_selectrow_hashref("
3096  SELECT 1
3097    FROM Client $filter
3098   WHERE Name = '$client'
3099 ");
3100     return defined $cont;
3101 }
3102
3103 sub cant_do
3104 {
3105     my ($self, $action) = @_;
3106     # is security enabled in configuration ?
3107     if (not $self->{info}->{enable_security}) {
3108         return 0
3109     }
3110     # admin is a special user that can do everything
3111     if ($self->{loginname} eq 'admin') {
3112         return 0;
3113     }
3114     # must be logged
3115     if (!$self->{loginname}) {
3116         $self->{error} = "Can't do $action, your are not logged. " .
3117             "Check security with your administrator";
3118         return 1;
3119     }
3120     if (!$self->get_roles()) {
3121         return 0;
3122     }
3123     if (!$self->{security}->{$action}) {
3124         $self->{error} =
3125             "$self->{loginname} sorry, but this action ($action) " .
3126             "is not permited. " .
3127             "Check security with your administrator";
3128         return 1;
3129     }
3130     return 0;
3131 }
3132
3133 # make like an assert (program die)
3134 sub can_do
3135 {
3136     my ($self, $action) = @_;
3137     if ($self->cant_do($action)) {
3138         $self->error($self->{error});
3139         $self->display_end();
3140         exit 0;
3141     }
3142     return 1;
3143 }
3144
3145 sub use_filter
3146 {
3147     my ($self) = @_;
3148
3149     if (!$self->{info}->{enable_security} or
3150         !$self->{info}->{enable_security_acl})
3151     {
3152         return 0 ;
3153     }
3154
3155     if ($self->get_roles()) {
3156         return $self->{security}->{use_acl};
3157     } else {
3158         return 1;
3159     }
3160 }
3161
3162 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
3163 sub get_client_filter
3164 {
3165     my ($self, $login) = @_;
3166     my $u;
3167     if ($login) {
3168         $u = $self->dbh_quote($login);
3169     } elsif ($self->use_filter()) {
3170         $u = $self->dbh_quote($self->{loginname});
3171     } else {
3172         return '';
3173     }
3174     return "
3175  JOIN (SELECT ClientId FROM client_group_member
3176    JOIN client_group USING (client_group_id)
3177    JOIN bweb_client_group_acl USING (client_group_id)
3178    JOIN bweb_user USING (userid)
3179    WHERE bweb_user.username = $u
3180  ) AS filter USING (ClientId)";
3181 }
3182
3183 #JOIN client_group USING (client_group_id)" . $b->get_client_group_filter()
3184 sub get_client_group_filter
3185 {
3186     my ($self, $login) = @_;
3187     my $u;
3188     if ($login) {
3189         $u = $self->dbh_quote($login);
3190     } elsif ($self->use_filter()) {
3191         $u = $self->dbh_quote($self->{loginname});
3192     } else {
3193         return '';
3194     }
3195     return "
3196  JOIN (SELECT client_group_id
3197          FROM bweb_client_group_acl
3198          JOIN bweb_user USING (userid)
3199    WHERE bweb_user.username = $u
3200  ) AS filter USING (client_group_id)";
3201 }
3202
3203 # role and username have to be quoted before
3204 # role and username can be a quoted list
3205 sub revoke
3206 {
3207     my ($self, $role, $username) = @_;
3208     $self->can_do("r_user_mgnt");
3209
3210     my $nb = $self->dbh_do("
3211  DELETE FROM bweb_role_member
3212        WHERE roleid = (SELECT roleid FROM bweb_role
3213                         WHERE rolename IN ($role))
3214          AND userid = (SELECT userid FROM bweb_user
3215                         WHERE username IN ($username))");
3216     return $nb;
3217 }
3218
3219 # role and username have to be quoted before
3220 # role and username can be a quoted list
3221 sub grant
3222 {
3223     my ($self, $role, $username) = @_;
3224     $self->can_do("r_user_mgnt");
3225
3226     my $nb = $self->dbh_do("
3227    INSERT INTO bweb_role_member (roleid, userid)
3228      SELECT roleid, userid FROM bweb_role, bweb_user
3229       WHERE rolename IN ($role)
3230         AND username IN ($username)
3231      ");
3232     return $nb;
3233 }
3234
3235 # role and username have to be quoted before
3236 # role and username can be a quoted list
3237 sub grant_like
3238 {
3239     my ($self, $copy, $user) = @_;
3240     $self->can_do("r_user_mgnt");
3241
3242     my $nb = $self->dbh_do("
3243   INSERT INTO bweb_role_member (roleid, userid)
3244    SELECT roleid, a.userid
3245      FROM bweb_user AS a, bweb_role_member
3246      JOIN bweb_user USING (userid)
3247     WHERE bweb_user.username = $copy
3248       AND a.username = $user");
3249     return $nb;
3250 }
3251
3252 # username can be a join quoted list of usernames
3253 sub revoke_all
3254 {
3255     my ($self, $username) = @_;
3256     $self->can_do("r_user_mgnt");
3257
3258     $self->dbh_do("
3259    DELETE FROM bweb_role_member
3260          WHERE userid IN (
3261            SELECT userid
3262              FROM bweb_user
3263             WHERE username in ($username))");
3264     $self->dbh_do("
3265 DELETE FROM bweb_client_group_acl
3266  WHERE userid IN (
3267   SELECT userid
3268     FROM bweb_user
3269    WHERE username IN ($username))");
3270
3271 }
3272
3273 sub users_del
3274 {
3275     my ($self) = @_;
3276     $self->can_do("r_user_mgnt");
3277
3278     my $arg = $self->get_form(qw/jusernames/);
3279
3280     unless ($arg->{jusernames}) {
3281         return $self->error("Can't get user");
3282     }
3283
3284     $self->{dbh}->begin_work();
3285     {
3286         $self->revoke_all($arg->{jusernames});
3287         $self->dbh_do("
3288 DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
3289     }
3290     $self->{dbh}->commit();
3291
3292     $self->display_users();
3293 }
3294
3295 sub users_add
3296 {
3297     my ($self) = @_;
3298     $self->can_do("r_user_mgnt");
3299
3300     # we don't quote username directly to check that it is conform
3301     my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate
3302                                  lang qcopy_username jclient_groups/) ;
3303
3304     if (not $arg->{qcreate}) {
3305         $arg = $self->get_form(qw/db_roles db_usernames db_client_groups/);
3306         $self->display($arg, "display_user.tpl");
3307         return 1;
3308     }
3309
3310     my $u = $self->dbh_quote($arg->{username});
3311
3312     $arg->{use_acl}=(CGI::param('use_acl')?'true':'false');
3313
3314     if (!$arg->{qpasswd}) {
3315         $arg->{qpasswd} = "''";
3316     }
3317     if (!$arg->{qcomment}) {
3318         $arg->{qcomment} = "''";
3319     }
3320
3321     # will fail if user already exists
3322     # UPDATE with mysql dbi does not return if update is ok
3323     ($self->dbh_do("
3324   UPDATE bweb_user
3325      SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment},
3326          use_acl=$arg->{use_acl}, tpl='$arg->{lang}'
3327    WHERE username = $u")
3328 #     and (! $self->dbh_is_mysql() )
3329      ) and
3330     $self->dbh_do("
3331   INSERT INTO bweb_user (username, passwd, use_acl, comment, tpl)
3332         VALUES ($u, $arg->{qpasswd}, $arg->{use_acl},
3333                 $arg->{qcomment}, '$arg->{lang}')");
3334
3335     $self->{dbh}->begin_work();
3336     {
3337         $self->revoke_all($u);
3338
3339         if ($arg->{qcopy_username}) {
3340             $self->grant_like($arg->{qcopy_username}, $u);
3341         } else {
3342             $self->grant($arg->{jrolenames}, $u);
3343         }
3344
3345         if ($arg->{jclient_groups}) {
3346             $self->dbh_do("
3347 INSERT INTO bweb_client_group_acl (client_group_id, userid)
3348  SELECT client_group_id, userid
3349    FROM client_group, bweb_user
3350   WHERE client_group_name IN ($arg->{jclient_groups})
3351     AND username = $u
3352 ");
3353         }
3354     }
3355     $self->{dbh}->commit();
3356
3357     $self->display_users();
3358 }
3359
3360 # TODO: we miss a matrix with all user/roles
3361 sub display_users
3362 {
3363     my ($self) = @_;
3364     $self->can_do("r_user_mgnt");
3365
3366     my $arg = $self->get_form(qw/db_usernames/) ;
3367
3368     if ($self->{dbh}->errstr) {
3369         return $self->error("Can't use users with bweb, read INSTALL to enable them");
3370     }
3371
3372     $self->display({ ID => $cur_id++,
3373                      %$arg},
3374                    "display_users.tpl");
3375 }
3376
3377 sub display_user
3378 {
3379     my ($self) = @_;
3380     $self->can_do("r_user_mgnt");
3381
3382     my $arg = $self->get_form('username');
3383     my $user = $self->dbh_quote($arg->{username});
3384
3385     my $userp = $self->dbh_selectrow_hashref("
3386    SELECT username, passwd, comment, use_acl, tpl
3387      FROM bweb_user
3388     WHERE username = $user
3389 ");
3390     if (!$userp) {
3391         return $self->error("Can't find $user in catalog");
3392     }
3393     my $filter = $self->get_client_group_filter($arg->{username});
3394     my $scg = $self->dbh_selectall_hashref("
3395  SELECT client_group_name AS name
3396    FROM client_group $filter
3397 ", 'name');
3398
3399 #  rolename  | userid
3400 #------------+--------
3401 # cancel_job |      0
3402 # restore    |      0
3403 # run_job    |      1
3404
3405     my $role = $self->dbh_selectall_hashref("
3406 SELECT rolename, max(here) AS userid FROM (
3407         SELECT rolename, 1 AS here
3408           FROM bweb_user
3409           JOIN bweb_role_member USING (userid)
3410           JOIN bweb_role USING (roleid)
3411           WHERE username = $user
3412        UNION ALL
3413        SELECT rolename, 0
3414          FROM bweb_role
3415 ) AS temp
3416 GROUP by rolename", 'rolename');
3417
3418     $arg = $self->get_form(qw/db_usernames db_client_groups/);
3419
3420     $self->display({
3421         db_usernames => $arg->{db_usernames},
3422         username => $userp->{username},
3423         comment => $userp->{comment},
3424         passwd => $userp->{passwd},
3425         lang => $userp->{tpl},
3426         use_acl => $userp->{use_acl},
3427         db_client_groups => $arg->{db_client_groups},
3428         client_group => [ values %$scg ],
3429         db_roles => [ values %$role],
3430     }, "display_user.tpl");
3431 }
3432
3433
3434 ###########################################################
3435
3436 sub get_media_max_size
3437 {
3438     my ($self, $type) = @_;
3439     my $query =
3440 "SELECT avg(VolBytes) AS size
3441   FROM Media
3442  WHERE Media.VolStatus = 'Full'
3443    AND Media.MediaType = '$type'
3444 ";
3445
3446     my $res = $self->selectrow_hashref($query);
3447
3448     if ($res) {
3449         return $res->{size};
3450     } else {
3451         return 0;
3452     }
3453 }
3454
3455 sub update_media
3456 {
3457     my ($self) = @_ ;
3458
3459     my $media = $self->get_form('qmedia');
3460
3461     unless ($media->{qmedia}) {
3462         return $self->error("Can't get media");
3463     }
3464
3465     my $query = "
3466 SELECT Media.Slot         AS slot,
3467        PoolMedia.Name     AS poolname,
3468        Media.VolStatus    AS volstatus,
3469        Media.InChanger    AS inchanger,
3470        Location.Location  AS location,
3471        Media.VolumeName   AS volumename,
3472        Media.MaxVolBytes  AS maxvolbytes,
3473        Media.MaxVolJobs   AS maxvoljobs,
3474        Media.MaxVolFiles  AS maxvolfiles,
3475        Media.VolUseDuration AS voluseduration,
3476        Media.VolRetention AS volretention,
3477        Media.Comment      AS comment,
3478        PoolRecycle.Name   AS poolrecycle,
3479        Media.Enabled      AS enabled
3480
3481 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
3482            LEFT  JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
3483            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
3484
3485 WHERE Media.VolumeName = $media->{qmedia}
3486 ";
3487
3488     my $row = $self->dbh_selectrow_hashref($query);
3489     $row->{volretention} = human_sec($row->{volretention});
3490     $row->{voluseduration} = human_sec($row->{voluseduration});
3491     $row->{enabled} = human_enabled($row->{enabled});
3492
3493     my $elt = $self->get_form(qw/db_pools db_locations/);
3494
3495     $self->display({
3496         %$elt,
3497         %$row,
3498     }, "update_media.tpl");
3499 }
3500
3501 sub save_location
3502 {
3503     my ($self) = @_ ;
3504     $self->can_do('r_media_mgnt');
3505
3506     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
3507
3508     unless ($arg->{jmedias}) {
3509         return $self->error("Can't get selected media");
3510     }
3511
3512     unless ($arg->{qnewlocation}) {
3513         return $self->error("Can't get new location");
3514     }
3515
3516     my $query = "
3517  UPDATE Media
3518      SET LocationId = (SELECT LocationId
3519                        FROM Location
3520                        WHERE Location = $arg->{qnewlocation})
3521      WHERE Media.VolumeName IN ($arg->{jmedias})
3522 ";
3523
3524     my $nb = $self->dbh_do($query);
3525
3526     print "$nb media updated, you may have to update your autochanger.";
3527
3528     $self->display_media();
3529 }
3530
3531 sub location_change
3532 {
3533     my ($self) = @_ ;
3534     $self->can_do('r_media_mgnt');
3535
3536     my $media = $self->get_selected_media_location();
3537     unless ($media) {
3538         return $self->error("Can't get media selection");
3539     }
3540     my $newloc = CGI::param('newlocation');
3541
3542     my $user = CGI::param('user') || 'unknown';
3543     my $comm = CGI::param('comment') || '';
3544     $comm = $self->dbh_quote("$user: $comm");
3545
3546     my $arg = $self->get_form('enabled');
3547     my $en = from_human_enabled($arg->{enabled});
3548     my $b = $self->get_bconsole();
3549
3550     my $query;
3551     foreach my $vol (keys %$media) {
3552         $query = "
3553 INSERT INTO LocationLog (Date,Comment,MediaId,LocationId,NewEnabled,NewVolStatus)
3554  SELECT NOW(), $comm, Media.MediaId, Location.LocationId, $en, VolStatus
3555    FROM Media, Location
3556   WHERE Media.VolumeName = '$vol'
3557     AND Location.Location = '$media->{$vol}->{location}'
3558 ";
3559         $self->dbh_do($query);
3560         $self->debug($query);
3561         $b->send_cmd("update volume=\"$vol\" enabled=$en");
3562     }
3563     $b->close();
3564
3565     my $q = new CGI;
3566     $q->param('action', 'update_location');
3567     my $url = $q->url(-full => 1, -query=>1);
3568
3569     $self->display({ email  => $self->{info}->{email_media},
3570                      url => $url,
3571                      newlocation => $newloc,
3572                      # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3573                      media => [ values %$media ],
3574                    },
3575                    "change_location.tpl");
3576
3577 }
3578
3579 sub display_client_stats
3580 {
3581     my ($self, %arg) = @_ ;
3582     $self->can_do('r_view_stat');
3583
3584     my $client = $self->dbh_quote($arg{clientname});
3585     # get security filter
3586     my $filter = $self->get_client_filter();
3587
3588     my ($limit, $label) = $self->get_limit(%arg);
3589     my $query = "
3590 SELECT
3591     count(Job.JobId)     AS nb_jobs,
3592     sum(Job.JobBytes)    AS nb_bytes,
3593     sum(Job.JobErrors)   AS nb_err,
3594     sum(Job.JobFiles)    AS nb_files,
3595     Client.Name          AS clientname
3596 FROM Job JOIN Client USING (ClientId) $filter
3597 WHERE
3598     Client.Name = $client
3599     $limit
3600 GROUP BY Client.Name
3601 ";
3602
3603     my $row = $self->dbh_selectrow_hashref($query);
3604
3605     $row->{ID} = $cur_id++;
3606     $row->{label} = $label;
3607     $row->{grapharg} = "client";
3608
3609     $self->display($row, "display_client_stats.tpl");
3610 }
3611
3612
3613 sub _display_group_stats
3614 {
3615     my ($self, %arg) = @_ ;
3616
3617     my $carg = $self->get_form(qw/qclient_group/);
3618
3619     unless ($carg->{qclient_group}) {
3620         return $self->error("Can't get group");
3621     }
3622
3623     my ($limit, $label) = $self->get_limit(%arg);
3624
3625     my $query = "
3626 SELECT
3627     count(Job.JobId)     AS nb_jobs,
3628     sum(Job.JobBytes)    AS nb_bytes,
3629     sum(Job.JobErrors)   AS nb_err,
3630     sum(Job.JobFiles)    AS nb_files,
3631     client_group.client_group_name  AS clientname
3632 FROM Job JOIN Client USING (ClientId)
3633          JOIN client_group_member ON (Client.ClientId = client_group_member.ClientId)
3634          JOIN client_group USING (client_group_id)
3635 WHERE
3636     client_group.client_group_name = $carg->{qclient_group}
3637     $limit
3638 GROUP BY client_group.client_group_name
3639 ";
3640
3641     my $row = $self->dbh_selectrow_hashref($query);
3642
3643     $row->{ID} = $cur_id++;
3644     $row->{label} = $label;
3645     $row->{grapharg} = "client_group";
3646
3647     $self->display($row, "display_client_stats.tpl");
3648 }
3649
3650 # [ name, num, value, joberrors, nb_job ] =>
3651 # {  items =>
3652 #      [ { name => 'ALL',
3653 #          events => [ { num => 1, label => '2007-01',
3654 #                        value => 'T', title => 10 },
3655 #                      { num => 2, label => '2007-02',
3656 #                        value => 'R', title => 11 },
3657 #                     ]
3658 #         },
3659 #         { name => 'Other',
3660 #            ...
3661 #       ]
3662 # };
3663 sub make_overview_tab
3664 {
3665     my ($self, $q) = @_;
3666     my $ret = $self->dbh_selectall_arrayref($q);
3667     my @items;
3668     my $events=[];
3669     my $cur_name='';
3670     for my $elt (@$ret) {
3671         if ($cur_name and $cur_name ne $elt->[0]) { # order by name, num
3672             push @items, { name => $cur_name, events => $events};
3673             $events = [];
3674         }
3675         $cur_name = $elt->[0];
3676         push @$events,
3677           { num => $elt->[1], status => $elt->[2],
3678             joberrors => $elt->[3], title => "$elt->[4] jobs"};
3679     }
3680     push @items, { name => $cur_name, events => $events};
3681     return \@items;
3682 }
3683
3684 sub get_time_overview
3685 {
3686     my ($self, $arg) = @_; # want since et age from get_form();
3687     my $type = $arg->{type} || 'day';
3688     if ($type =~ /^(day|week|hour|month)$/) {
3689         $type = uc($1);
3690     } else {
3691         $arg->{type}='day';
3692         $type = 'DAY';
3693     }
3694     my $jobt = $self->{info}->{stat_job_table} || 'Job';
3695     my $stime1 = $self->{sql}->{"STARTTIME_P" . $type}; # get 1,2,3
3696     $stime1 =~ s/Job.StartTime/date/;
3697     my $stime2 = $self->{sql}->{"STARTTIME_" . $type}; # get 2007-01-03, 2007-01-23
3698
3699     my ($limit, $label) = $self->get_limit('since' => $arg->{since},
3700                                            'age' => $arg->{age});
3701     return ($stime1, $stime2, $limit, $label, $jobt);
3702 }
3703
3704 #              lu ma me je ve sa di
3705 #  groupe1     v  v  x  w  v  v  v    overview
3706 #   |-- s1     v  v  v  v  v  v  v    overview_zoom
3707 #   |-- s2     v  v  x  v  v  v  v
3708 #   `-- s3     v  v  v  w  v  v  v
3709 sub display_overview_zoom
3710 {
3711     my ($self) = @_;
3712     $self->can_do('r_view_stat');
3713
3714     my $arg = $self->get_form(qw/jclient_groups age since type level/);
3715
3716     if (!$arg->{jclient_groups}) {
3717         return $self->error("Can't get client_group selection");
3718     }
3719     my ($filter2, undef) = $self->get_param(qw/level jobtype/);
3720     my ($stime1, $stime2, $limit, $label, $jobt) = $self->get_time_overview($arg);
3721
3722     my $filter = $self->get_client_filter();
3723     my $q = "
3724 SELECT name, $stime1 AS num,
3725        JobStatus AS value, joberrors, nb_job
3726 FROM (
3727   SELECT $stime2        AS date,
3728          Client.Name    AS name,
3729          MAX(severity)  AS severity,
3730          COUNT(1)       AS nb_job,
3731          SUM(JobErrors) AS joberrors
3732     FROM $jobt AS Job
3733     JOIN client_group_member USING (ClientId)
3734     JOIN client_group        USING (client_group_id)
3735     JOIN Client              USING (ClientId)  $filter
3736     JOIN Status              USING (JobStatus)
3737    WHERE client_group_name IN ($arg->{jclient_groups})
3738          $limit $filter2
3739
3740    GROUP BY Client.Name, date
3741 ) AS sub JOIN Status USING (severity)
3742  ORDER BY name, date
3743 ";
3744     my $items = $self->make_overview_tab($q);
3745     $self->display({label => $label,
3746                     action => "job;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client=",
3747                     items => $items}, "overview.tpl");
3748 }
3749
3750 sub display_overview
3751 {
3752     my ($self) = @_ ;
3753     $self->can_do('r_view_stat');
3754
3755     my $arg = $self->get_form(qw/jclient_groups age since type level/);
3756     my ($filter2, undef) = $self->get_param(qw/client_groups level jobtype/);
3757     my $filter3 = $self->get_client_group_filter();
3758     my ($stime1, $stime2, $filter1, $label, $jobt) = $self->get_time_overview($arg);
3759
3760     my $q = "
3761 SELECT name, $stime1 AS num,
3762        JobStatus AS value, joberrors, nb_job
3763 FROM (
3764   SELECT $stime2        AS date,
3765          client_group_name AS name,
3766          MAX(severity)  AS severity,
3767          COUNT(1)       AS nb_job,
3768          SUM(JobErrors) AS joberrors
3769     FROM $jobt AS Job
3770     JOIN client_group_member USING (ClientId)
3771     JOIN client_group        USING (client_group_id) $filter3
3772     JOIN Status              USING (JobStatus)
3773    WHERE true $filter1 $filter2
3774    GROUP BY client_group_name, date
3775 ) AS sub JOIN Status USING (severity)
3776  ORDER BY name, date
3777 ";
3778     my $items = $self->make_overview_tab($q);
3779     $self->display({label=>$label,
3780                     action => "overview_zoom;since=$arg->{since};level=$arg->{level};type=$arg->{type};age=$arg->{age};client_group=",
3781                     items => $items}, "overview.tpl");
3782
3783 }
3784
3785 # poolname can be undef
3786 sub display_pool
3787 {
3788     my ($self, $poolname) = @_ ;
3789     $self->can_do('r_view_media');
3790
3791     my $whereA = '';
3792     my $whereW = '';
3793
3794     my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3795     if ($arg->{jmediatypes}) {
3796         $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3797         $whereA = "AND   MediaType IN ($arg->{jmediatypes}) ";
3798     }
3799
3800 # TODO : afficher les tailles et les dates
3801
3802     my $query = "
3803 SELECT subq.volmax        AS volmax,
3804        subq.volnum        AS volnum,
3805        subq.voltotal      AS voltotal,
3806        Pool.Name          AS name,
3807        Pool.Recycle       AS recycle,
3808        Pool.VolRetention  AS volretention,
3809        Pool.VolUseDuration AS voluseduration,
3810        Pool.MaxVolJobs    AS maxvoljobs,
3811        Pool.MaxVolFiles   AS maxvolfiles,
3812        Pool.MaxVolBytes   AS maxvolbytes,
3813        subq.PoolId        AS PoolId,
3814        subq.MediaType     AS mediatype,
3815        $self->{sql}->{CAT_POOL_TYPE}  AS uniq
3816 FROM
3817   (
3818     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3819            count(Media.MediaId)  AS volnum,
3820            sum(Media.VolBytes)   AS voltotal,
3821            Media.PoolId          AS PoolId,
3822            Media.MediaType       AS MediaType
3823     FROM Media
3824     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3825                       Media.MediaType     AS MediaType
3826                FROM Media
3827               WHERE Media.VolStatus = 'Full'
3828               GROUP BY Media.MediaType
3829                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3830     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3831   ) AS subq
3832 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3833 $whereW
3834 ";
3835
3836     my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3837
3838     $query = "
3839 SELECT Pool.Name AS name,
3840        sum(VolBytes) AS size
3841 FROM   Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3842 WHERE  Media.VolStatus IN ('Recycled', 'Purged')
3843        $whereA
3844 GROUP BY Pool.Name;
3845 ";
3846     my $empty = $self->dbh_selectall_hashref($query, 'name');
3847
3848     foreach my $p (values %$all) {
3849         if ($p->{volmax} > 0) { # mysql returns 0.0000
3850             # we remove Recycled/Purged media from pool usage
3851             if (defined $empty->{$p->{name}}) {
3852                 $p->{voltotal} -= $empty->{$p->{name}}->{size};
3853             }
3854             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
3855         } else {
3856             $p->{poolusage} = 0;
3857         }
3858
3859         $query = "
3860   SELECT VolStatus AS volstatus, count(MediaId) AS nb
3861     FROM Media
3862    WHERE PoolId=$p->{poolid}
3863      AND Media.MediaType = '$p->{mediatype}'
3864          $whereA
3865 GROUP BY VolStatus
3866 ";
3867         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
3868         foreach my $t (values %$content) {
3869             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
3870         }
3871     }
3872
3873     $self->debug($all);
3874     $self->display({ ID => $cur_id++,
3875                      MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
3876                      Pools => [ values %$all ]},
3877                    "display_pool.tpl");
3878 }
3879
3880 # With this function, we get an estimation of next jobfiles/jobbytes count
3881 sub get_estimate_query
3882 {
3883     my ($self, $mode, $job, $level) = @_;
3884     # get security filter
3885     my $filter = $self->get_client_filter();
3886
3887     my $query;
3888
3889     if ($self->dbh_is_mysql()) { # mysql doesn't have statistics functions
3890         $query = "
3891 SELECT jobname AS jobname,
3892        0.1 AS corr_jobbytes, AVG(jobbytes) AS jobbytes,
3893        COUNT(1) AS nb_jobbytes ";
3894     } else {
3895         # postgresql have functions that permit to handle lineal regression
3896         # in y=ax + b
3897         # REGR_SLOPE(Y,X) = get x
3898         # REGR_INTERCEPT(Y,X) = get b
3899         # and we need y when x=now()
3900         # CORR gives the correlation
3901         # (TODO: display progress bar only if CORR > 0.8)
3902         my $now = scalar(time);
3903         $query = "
3904 SELECT temp.jobname AS jobname,
3905        CORR(jobbytes,jobtdate) AS corr_jobbytes,
3906        ($now*REGR_SLOPE(jobbytes,jobtdate)
3907          + REGR_INTERCEPT(jobbytes,jobtdate)) AS jobbytes,
3908        COUNT(1) AS nb_jobbytes ";
3909     }
3910     # if it's a differential, we need to compare since the last full
3911     #
3912     #   F D D D F D D D      F I I I I D I I I
3913     # | #     # #     #    | #         #
3914     # | #   # # #   # #    | #         #
3915     # | # # # # # # # #    | # # # # # # # # #
3916     # +-----------------   +-------------------
3917     my $filter2='';
3918     if ($level eq 'D') {
3919         $filter2 = "
3920 AND Job.StartTime > (
3921  SELECT StartTime
3922    FROM Job
3923   WHERE Job.Name = '$job'
3924     AND Job.Level = 'F'
3925     AND Job.JobStatus = 'T'
3926 ORDER BY Job.StartTime DESC LIMIT 1
3927 ) ";
3928     }
3929
3930     $query .=
3931 "
3932 FROM (
3933    SELECT Job.Name AS jobname,
3934           JobBytes AS jobbytes,
3935           JobTDate AS jobtdate
3936    FROM Job INNER JOIN Client USING (ClientId) $filter
3937    WHERE Job.Name = '$job'
3938      AND Job.Level = '$level'
3939      AND Job.JobStatus = 'T'
3940      $filter2
3941    ORDER BY StartTime DESC
3942    LIMIT 4
3943 ) AS temp GROUP BY temp.jobname
3944 ";
3945
3946     if ($mode eq 'jobfiles') {
3947         $query =~ s/jobbytes/jobfiles/g;
3948         $query =~ s/JobBytes/JobFiles/g;
3949     }
3950     return $query;
3951 }
3952
3953 sub display_running_job
3954 {
3955     my ($self) = @_;
3956     return if $self->cant_do('r_view_running_job');
3957
3958     my $arg = $self->get_form('jobid');
3959
3960     return $self->error("Can't get jobid") unless ($arg->{jobid});
3961
3962     # get security filter
3963     my $filter = $self->get_client_filter();
3964
3965     my $query = "
3966 SELECT Client.Name AS name, Job.Name AS jobname,
3967        Job.Level AS level, Type AS type
3968 FROM Job INNER JOIN Client USING (ClientId) $filter
3969 WHERE Job.JobId = $arg->{jobid}
3970 ";
3971
3972     my $row = $self->dbh_selectrow_hashref($query);
3973
3974     if ($row) {
3975         $arg->{client} = $row->{name};
3976     } else {
3977         return $self->error("Can't get client");
3978     }
3979
3980     if ($row->{type} eq 'B') {
3981         # for jobfiles, we use only last Full backup. status client= returns
3982         # all files that have been checked
3983         my $query1 = $self->get_estimate_query('jobfiles', $row->{jobname}, 'F');
3984         my $query2 = $self->get_estimate_query('jobbytes',
3985                                                $row->{jobname}, $row->{level});
3986
3987         # LEFT JOIN because we always have a previous Full
3988         $query = "
3989 SELECT  corr_jobbytes, jobbytes, corr_jobfiles, jobfiles
3990   FROM ($query1) AS A LEFT JOIN ($query2) AS B USING (jobname)
3991 ";
3992         $row = $self->dbh_selectrow_hashref($query);
3993
3994         if (!$row) {
3995             $row->{jobbytes} = $row->{jobfiles} = 0;
3996         }
3997     }
3998     my $cli = new Bweb::Client(name => $arg->{client});
3999     $cli->display_running_job($self, $arg->{jobid}, $row);
4000     if ($arg->{jobid}) {
4001         $self->get_job_log();
4002     }
4003 }
4004
4005 sub display_running_jobs
4006 {
4007     my ($self, $display_action) = @_;
4008     return if $self->cant_do('r_view_running_job');
4009
4010     # get security filter
4011     my $filter = $self->get_client_filter();
4012
4013     my $query = "
4014 SELECT Job.JobId AS jobid,
4015        Job.Name  AS jobname,
4016        Job.Level     AS level,
4017        Job.StartTime AS starttime,
4018        Job.JobFiles  AS jobfiles,
4019        Job.JobBytes  AS jobbytes,
4020        Job.JobStatus AS jobstatus,
4021 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
4022                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
4023          AS duration,
4024        Client.Name AS clientname
4025 FROM Job INNER JOIN Client USING (ClientId) $filter
4026 WHERE
4027   JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
4028 ";
4029     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
4030
4031     $self->display({ ID => $cur_id++,
4032                      display_action => $display_action,
4033                      Jobs => [ values %$all ]},
4034                    "running_job.tpl") ;
4035 }
4036
4037 sub display_group_stats
4038 {
4039     my ($self) = @_;
4040     my $arg = $self->get_form('age', 'since');
4041     return if $self->cant_do('r_view_stat');
4042
4043     my $filter = $self->get_client_group_filter();
4044
4045     my ($limit, $label) = $self->get_limit(%$arg);
4046     my ($where, undef) = $self->get_param('client_groups', 'level');
4047
4048     my $query = "
4049 SELECT client_group_name AS name, nb_byte, nb_file, nb_job, nb_resto
4050   FROM (
4051
4052     SELECT sum(JobBytes) AS nb_byte,
4053            sum(JobFiles) AS nb_file,
4054            count(1) AS nb_job, client_group_name
4055       FROM job_old JOIN client_group_member USING (ClientId)
4056       JOIN client_group USING (client_group_id) $filter
4057      WHERE JobStatus = 'T' AND Type IN ('M', 'B', 'g')
4058            $where $limit
4059     GROUP BY client_group_name ORDER BY client_group_name
4060
4061   ) AS T1 LEFT JOIN (
4062
4063     SELECT count(1) AS nb_resto, client_group_name
4064       FROM job_old JOIN client_group_member USING (ClientId)
4065       JOIN client_group USING (client_group_id)
4066      WHERE JobStatus = 'T' AND Type = 'R'
4067            $where $limit
4068     GROUP BY client_group_name ORDER BY client_group_name
4069
4070   ) AS T2 USING (client_group_name)
4071 ";
4072     $self->debug($query);
4073     my $all = $self->dbh_selectall_hashref($query, 'name') ;
4074     $self->debug($all);
4075
4076     $self->display({ ID => $cur_id++,
4077                      label => $label,
4078                      Stats => [ values %$all ]},
4079                    "display_stats.tpl") ;
4080 }
4081
4082 # return the autochanger list to update
4083 sub eject_media
4084 {
4085     my ($self) = @_;
4086     $self->can_do('r_media_mgnt');
4087
4088     my %ret;
4089     my $arg = $self->get_form('jmedias');
4090
4091     unless ($arg->{jmedias}) {
4092         return $self->error("Can't get media selection");
4093     }
4094
4095     my $query = "
4096 SELECT Media.VolumeName  AS volumename,
4097        Storage.Name      AS storage,
4098        Location.Location AS location,
4099        Media.Slot        AS slot
4100 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
4101            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
4102 WHERE Media.VolumeName IN ($arg->{jmedias})
4103   AND Media.InChanger = 1
4104 ";
4105
4106     my $all = $self->dbh_selectall_hashref($query, 'volumename');
4107
4108     foreach my $vol (values %$all) {
4109         my $a = $self->ach_get($vol->{location});
4110         next unless ($a) ;
4111         $ret{$vol->{location}} = 1;
4112
4113         unless ($a->{have_status}) {
4114             $a->status();
4115             $a->{have_status} = 1;
4116         }
4117         # TODO: set enabled
4118         print "eject $vol->{volumename} from $vol->{storage} : ";
4119         if ($a->send_to_io($vol->{slot})) {
4120             print "<img src='/bweb/T.png' alt='ok'><br/>";
4121         } else {
4122             print "<img src='/bweb/E.png' alt='err'><br/>";
4123         }
4124     }
4125     return keys %ret;
4126 }
4127
4128 sub move_email
4129 {
4130     my ($self) = @_;
4131
4132     my ($to, $subject, $content) = (CGI::param('email'),
4133                                     CGI::param('subject'),
4134                                     CGI::param('content'));
4135     $to =~ s/[^\w\d\.\@<>,]//;
4136     $subject =~ s/[^\w\d\.\[\]]/ /;
4137
4138     open(MAIL, "|mail -s '$subject' '$to'") ;
4139     print MAIL $content;
4140     close(MAIL);
4141
4142     print "Mail sent";
4143 }
4144
4145 sub restore
4146 {
4147     my ($self) = @_;
4148
4149     my $arg = $self->get_form('jobid', 'client');
4150
4151     print CGI::header('text/brestore');
4152     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
4153     print "client=$arg->{client}\n" if ($arg->{client});
4154     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
4155     print "\n";
4156 }
4157
4158 # TODO : move this to Bweb::Autochanger ?
4159 # TODO : make this internal to not eject tape ?
4160 use Bconsole;
4161
4162
4163 sub ach_get
4164 {
4165     my ($self, $name) = @_;
4166
4167     unless ($name) {
4168         return $self->error("Can't get your autochanger name ach");
4169     }
4170
4171     unless ($self->{info}->{ach_list}) {
4172         return $self->error("Could not find any autochanger");
4173     }
4174
4175     my $a = $self->{info}->{ach_list}->{$name};
4176
4177     unless ($a) {
4178         $self->error("Can't get your autochanger $name from your ach_list");
4179         return undef;
4180     }
4181
4182     $a->{bweb}  = $self;
4183     $a->{debug} = $self->{debug};
4184
4185     return $a;
4186 }
4187
4188 sub ach_register
4189 {
4190     my ($self, $ach) = @_;
4191     $self->can_do('r_configure');
4192
4193     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
4194
4195     $self->{info}->save();
4196
4197     return 1;
4198 }
4199
4200 sub ach_edit
4201 {
4202     my ($self) = @_;
4203     $self->can_do('r_configure');
4204
4205     my $arg = $self->get_form('ach');
4206     if (!$arg->{ach}
4207         or !$self->{info}->{ach_list}
4208         or !$self->{info}->{ach_list}->{$arg->{ach}})
4209     {
4210         return $self->error("Can't get autochanger name");
4211     }
4212
4213     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
4214
4215     my $i=0;
4216     $ach->{drives} =
4217         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
4218
4219     my $b = $self->get_bconsole();
4220
4221     my @storages = $b->list_storage() ;
4222
4223     $ach->{devices} = [ map { { name => $_ } } @storages ];
4224
4225     $self->display($ach, "ach_add.tpl");
4226     delete $ach->{drives};
4227     delete $ach->{devices};
4228     return 1;
4229 }
4230
4231 sub ach_del
4232 {
4233     my ($self) = @_;
4234     $self->can_do('r_configure');
4235
4236     my $arg = $self->get_form('ach');
4237
4238     if (!$arg->{ach}
4239         or !$self->{info}->{ach_list}
4240         or !$self->{info}->{ach_list}->{$arg->{ach}})
4241     {
4242         return $self->error("Can't get autochanger name");
4243     }
4244
4245     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
4246
4247     $self->{info}->save();
4248     $self->{info}->view();
4249 }
4250
4251 sub ach_add
4252 {
4253     my ($self) = @_;
4254     $self->can_do('r_configure');
4255
4256     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
4257
4258     my $b = $self->get_bconsole();
4259     my @storages = $b->list_storage() ;
4260
4261     unless ($arg->{ach}) {
4262         $arg->{devices} = [ map { { name => $_ } } @storages ];
4263         return $self->display($arg, "ach_add.tpl");
4264     }
4265
4266     my @drives ;
4267     foreach my $drive (CGI::param('drives'))
4268     {
4269         unless (grep(/^$drive$/,@storages)) {
4270             return $self->error("Can't find $drive in storage list");
4271         }
4272
4273         my $index = CGI::param("index_$drive");
4274         unless (defined $index and $index =~ /^(\d+)$/) {
4275             return $self->error("Can't get $drive index");
4276         }
4277
4278         $drives[$index] = $drive;
4279     }
4280
4281     unless (@drives) {
4282         return $self->error("Can't get drives from Autochanger");
4283     }
4284
4285     my $a = new Bweb::Autochanger(name   => $arg->{ach},
4286                                   precmd => $arg->{precmd},
4287                                   drive_name => \@drives,
4288                                   device => $arg->{device},
4289                                   mtxcmd => $arg->{mtxcmd});
4290
4291     $self->ach_register($a) ;
4292
4293     $self->{info}->view();
4294 }
4295
4296 sub delete
4297 {
4298     my ($self) = @_;
4299     $self->can_do('r_delete_job');
4300
4301     my $arg = $self->get_form('jobid');
4302
4303     if ($arg->{jobid}) {
4304         my $b = $self->get_bconsole();
4305         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
4306
4307         $self->display({
4308             content => $ret,
4309             title => "Delete a job ",
4310             name => "delete jobid=$arg->{jobid}",
4311         }, "command.tpl");
4312     }
4313 }
4314
4315 sub do_update_media
4316 {
4317     my ($self) = @_ ;
4318     $self->can_do('r_media_mgnt');
4319
4320     my $arg = $self->get_form(qw/media volstatus inchanger pool
4321                                  slot volretention voluseduration
4322                                  maxvoljobs maxvolfiles maxvolbytes
4323                                  qcomment poolrecycle enabled
4324                               /);
4325
4326     unless ($arg->{media}) {
4327         return $self->error("Can't find media selection");
4328     }
4329
4330     my $update = "update volume=$arg->{media} ";
4331
4332     if ($arg->{volstatus}) {
4333         $update .= " volstatus=$arg->{volstatus} ";
4334     }
4335
4336     if ($arg->{inchanger}) {
4337         $update .= " inchanger=yes " ;
4338         if ($arg->{slot}) {
4339             $update .= " slot=$arg->{slot} ";
4340         }
4341     } else {
4342         $update .= " slot=0 inchanger=no ";
4343     }
4344
4345     if ($arg->{enabled}) {
4346         $update .= " enabled=$arg->{enabled} ";
4347     }
4348
4349     if ($arg->{pool}) {
4350         $update .= " pool=$arg->{pool} " ;
4351     }
4352
4353     if (defined $arg->{volretention}) {
4354         $update .= " volretention=\"$arg->{volretention}\" " ;
4355     }
4356
4357     if (defined $arg->{voluseduration}) {
4358         $update .= " voluse=\"$arg->{voluseduration}\" " ;
4359     }
4360
4361     if (defined $arg->{maxvoljobs}) {
4362         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
4363     }
4364
4365     if (defined $arg->{maxvolfiles}) {
4366         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
4367     }
4368
4369     if (defined $arg->{maxvolbytes}) {
4370         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
4371     }
4372
4373     if (defined $arg->{poolrecycle}) {
4374         $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
4375     }
4376
4377     my $b = $self->get_bconsole();
4378
4379     $self->display({
4380         content => $b->send_cmd($update),
4381         title => "Update a volume ",
4382         name => $update,
4383     }, "command.tpl");
4384
4385
4386     my @q;
4387     my $media = $self->dbh_quote($arg->{media});
4388
4389     my $loc = CGI::param('location') || '';
4390     if ($loc) {
4391         $loc = $self->dbh_quote($loc); # is checked by db
4392         push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
4393     }
4394     if (!$arg->{qcomment}) {
4395         $arg->{qcomment} = "''";
4396     }
4397     push @q, "Comment=$arg->{qcomment}";
4398
4399
4400     my $query = "
4401 UPDATE Media
4402    SET " . join (',', @q) . "
4403  WHERE Media.VolumeName = $media
4404 ";
4405     $self->dbh_do($query);
4406
4407     $self->update_media();
4408 }
4409
4410 sub update_slots
4411 {
4412     my ($self) = @_;
4413     $self->can_do('r_autochanger_mgnt');
4414
4415     my $ach = CGI::param('ach') ;
4416     $ach = $self->ach_get($ach);
4417     unless ($ach) {
4418         return $self->error("Bad autochanger name");
4419     }
4420
4421     print "<pre>";
4422     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
4423     $b->update_slots($ach->{name});
4424     print "</pre>\n"
4425 }
4426
4427 sub get_job_log
4428 {
4429     my ($self) = @_;
4430     $self->can_do('r_view_log');
4431
4432     my $arg = $self->get_form('jobid', 'limit', 'offset');
4433     unless ($arg->{jobid}) {
4434         return $self->error("Can't get jobid");
4435     }
4436
4437     if ($arg->{limit} == 100) {
4438         $arg->{limit} = 1000;
4439     }
4440     # get security filter
4441     my $filter = $self->get_client_filter();
4442
4443     my $query = "
4444 SELECT Job.Name as name, Client.Name as clientname
4445  FROM  Job INNER JOIN Client USING (ClientId) $filter
4446  WHERE JobId = $arg->{jobid}
4447 ";
4448
4449     my $row = $self->dbh_selectrow_hashref($query);
4450
4451     unless ($row) {
4452         return $self->error("Can't find $arg->{jobid} in catalog");
4453     }
4454
4455     # display only Error and Warning messages
4456     $filter = '';
4457     if (CGI::param('error')) {
4458         $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning|ERR=' ";
4459     }
4460
4461     my $logtext;
4462     if (CGI::param('time') || $self->{info}->{display_log_time}) {
4463         $logtext = $self->dbh_strcat('Time', " ' ' ", 'LogText');
4464     } else {
4465         $logtext = 'LogText';
4466     }
4467
4468     $query = "
4469 SELECT count(1) AS nbline, JobId AS jobid,
4470        GROUP_CONCAT($logtext $self->{sql}->{CONCAT_SEP}) AS logtxt
4471   FROM  (
4472     SELECT JobId, Time, LogText
4473     FROM Log
4474    WHERE ( Log.JobId = $arg->{jobid}
4475       OR (Log.JobId = 0
4476           AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
4477           AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
4478        ) ) $filter
4479  ORDER BY LogId
4480  LIMIT $arg->{limit}
4481  OFFSET $arg->{offset}
4482  ) AS temp
4483  GROUP BY JobId
4484
4485 ";
4486
4487     my $log = $self->dbh_selectrow_hashref($query);
4488     unless ($log) {
4489         return $self->error("Can't get log for jobid $arg->{jobid}");
4490     }
4491
4492     $self->display({ lines=> $log->{logtxt},
4493                      nbline => $log->{nbline},
4494                      jobid => $arg->{jobid},
4495                      name  => $row->{name},
4496                      client => $row->{clientname},
4497                      offset => $arg->{offset},
4498                      limit  => $arg->{limit},
4499                  }, 'display_log.tpl');
4500 }
4501
4502 sub add_media
4503 {
4504     my ($self) = @_ ;
4505     $self->can_do('r_media_mgnt');
4506     my $arg = $self->get_form('storage', 'pool', 'nb', 'media', 'offset');
4507     my $b = $self->get_bconsole();
4508
4509     if (!$arg->{storage} || !$arg->{pool} || not defined $arg->{nb} || !$arg->{media} || !$arg->{offset}) {
4510         CGI::param(offset => 0);
4511         $arg = $self->get_form('db_pools');
4512         $arg->{storage} = [ map { { name => $_ } }$b->list_storage()];
4513         $self->display($arg, 'add_media.tpl');
4514         return 1;
4515     }
4516
4517     my $cmd;
4518     if ($arg->{nb} > 0) {
4519         $arg->{offset} = $arg->{offset}?$arg->{offset}:1;
4520         $cmd = "add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n$arg->{nb}\n$arg->{media}\n$arg->{offset}\n";
4521     } else {
4522         $cmd = "add pool=\"$arg->{pool}\" storage=\"$arg->{storage}\"\n0\n$arg->{media}\n";
4523     }
4524     $b->connect();
4525     $b->send($cmd);
4526     $b->expect_it('*');
4527
4528     CGI::param('media', '');
4529     CGI::param('re_media', $arg->{media});
4530     $self->display_media();
4531 }
4532
4533 sub label_barcodes
4534 {
4535     my ($self) = @_ ;
4536     $self->can_do('r_autochanger_mgnt');
4537
4538     my $arg = $self->get_form('ach', 'slots', 'drive');
4539
4540     unless ($arg->{ach}) {
4541         return $self->error("Can't find autochanger name");
4542     }
4543
4544     my $a = $self->ach_get($arg->{ach});
4545     unless ($a) {
4546         return $self->error("Can't find autochanger name in configuration");
4547     }
4548
4549     my $storage = $a->get_drive_name($arg->{drive});
4550     unless ($storage) {
4551         return $self->error("Can't get your drive name");
4552     }
4553
4554     my $slots = '';
4555     my $slots_sql = '';
4556     my $t = 300 ;
4557     if ($arg->{slots}) {
4558         $slots = join(",", @{ $arg->{slots} });
4559         $slots_sql = " AND Slot IN ($slots) ";
4560         $t += 60*scalar( @{ $arg->{slots} }) ;
4561     }
4562
4563     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
4564     print "<h1>This command can take long time, be patient...</h1>";
4565     print "<pre>" ;
4566     $b->label_barcodes(storage => $storage,
4567                        drive => $arg->{drive},
4568                        pool  => 'Scratch',
4569                        slots => $slots) ;
4570     $b->close();
4571     print "</pre>";
4572
4573     $self->dbh_do("
4574   UPDATE Media
4575        SET LocationId =   (SELECT LocationId
4576                              FROM Location
4577                             WHERE Location = '$arg->{ach}')
4578
4579      WHERE (LocationId = 0 OR LocationId IS NULL)
4580        $slots_sql
4581 ");
4582
4583 }
4584
4585 sub purge
4586 {
4587     my ($self) = @_;
4588     $self->can_do('r_purge');
4589
4590     my @volume = CGI::param('media');
4591
4592     unless (@volume) {
4593         return $self->error("Can't get media selection");
4594     }
4595
4596     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4597
4598     foreach my $v (@volume) {
4599         $self->display({
4600             content => $b->purge_volume($v),
4601             title => "Purge media",
4602             name => "purge volume=$v",
4603         }, "command.tpl");
4604     }
4605     $b->close();
4606 }
4607
4608 sub prune
4609 {
4610     my ($self) = @_;
4611     $self->can_do('r_prune');
4612
4613     my @volume = CGI::param('media');
4614     unless (@volume) {
4615         return $self->error("Can't get media selection");
4616     }
4617
4618     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
4619
4620     foreach my $v (@volume) {
4621         $self->display({
4622             content => $b->prune_volume($v),
4623             title => "Prune volume",
4624             name => "prune volume=$v",
4625         }, "command.tpl");
4626     }
4627     $b->close();
4628 }
4629
4630 sub cancel_job
4631 {
4632     my ($self) = @_;
4633     $self->can_do('r_cancel_job');
4634
4635     my $arg = $self->get_form('jobid');
4636     unless ($arg->{jobid}) {
4637         return $self->error("Can't get jobid");
4638     }
4639
4640     my $b = $self->get_bconsole();
4641     $self->display({
4642         content => $b->cancel($arg->{jobid}),
4643         title => "Cancel job",
4644         name => "cancel jobid=$arg->{jobid}",
4645     }, "command.tpl");
4646 }
4647
4648 sub fileset_view
4649 {
4650     # Warning, we display current fileset
4651     my ($self) = @_;
4652
4653     my $arg = $self->get_form('fileset');
4654
4655     if ($arg->{fileset}) {
4656         my $b = $self->get_bconsole();
4657         my $ret = $b->get_fileset($arg->{fileset});
4658         $self->display({ fileset => $arg->{fileset},
4659                          %$ret,
4660                      }, "fileset_view.tpl");
4661     } else {
4662         $self->error("Can't get fileset name");
4663     }
4664 }
4665
4666 sub director_show_sched
4667 {
4668     my ($self) = @_ ;
4669     $self->can_do('r_view_job');
4670     my $arg = $self->get_form('days');
4671
4672     my $b = $self->get_bconsole();
4673     my $ret = $b->director_get_sched( $arg->{days} );
4674
4675     $self->display({
4676         id => $cur_id++,
4677         list => $ret,
4678     }, "scheduled_job.tpl");
4679 }
4680
4681 sub enable_disable_job
4682 {
4683     my ($self, $what) = @_ ;
4684     $self->can_do('r_run_job');
4685
4686     my $name = CGI::param('job') || '';
4687     unless ($name =~ /^[\w\d\.\-\s]+$/) {
4688         return $self->error("Can't find job name");
4689     }
4690
4691     my $b = $self->get_bconsole();
4692
4693     my $cmd;
4694     if ($what) {
4695         $cmd = "enable";
4696     } else {
4697         $cmd = "disable";
4698     }
4699
4700     $self->display({
4701         content => $b->send_cmd("$cmd job=\"$name\""),
4702         title => "$cmd $name",
4703         name => "$cmd job=\"$name\"",
4704     }, "command.tpl");
4705 }
4706
4707 sub get_bconsole
4708 {
4709     my ($self) = @_;
4710     return new Bconsole(pref => $self->{info});
4711 }
4712
4713 sub cmd_storage
4714 {
4715     my ($self) = @_;
4716     $self->can_do('r_storage_mgnt');
4717     my $arg = $self->get_form(qw/storage storage_cmd drive/);
4718     my $b = $self->get_bconsole();
4719
4720     if ($arg->{storage} and $arg->{storage_cmd}) {
4721         my $cmd = "$arg->{storage_cmd} storage=\"$arg->{storage}\" drive=$arg->{drive}";
4722         my $ret = $b->send_cmd($cmd);
4723
4724         $self->display({
4725             content => $ret,
4726             title => "Storage ",
4727             name => $cmd,
4728         }, "command.tpl");
4729     } else {
4730         my $storages= [ map { { name => $_ } } $b->list_storage()];
4731         $self->display({ storage => $storages}, "cmd_storage.tpl");
4732     }
4733 }
4734
4735 sub run_job_select
4736 {
4737     my ($self) = @_;
4738     $self->can_do('r_run_job');
4739
4740     my $b = $self->get_bconsole();
4741
4742     my $joblist = [ map { { name => $_ } } $b->list_job() ];
4743
4744     $self->display({ Jobs => $joblist }, "run_job.tpl");
4745 }
4746
4747 sub run_parse_job
4748 {
4749     my ($self, $ouput) = @_;
4750
4751     my %arg;
4752     foreach my $l (split(/\r\n/, $ouput)) {
4753         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4754             $arg{$1} = $2;
4755             $l = $3
4756                 if ($3) ;
4757         }
4758
4759         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4760             %arg = (%arg, @l);
4761         }
4762     }
4763
4764     my %lowcase ;
4765     foreach my $k (keys %arg) {
4766         $lowcase{lc($k)} = $arg{$k} ;
4767     }
4768
4769     return \%lowcase;
4770 }
4771
4772 sub run_job_mod
4773 {
4774     my ($self) = @_;
4775     $self->can_do('r_run_job');
4776
4777     my $b = $self->get_bconsole();
4778
4779     my $job = CGI::param('job') || '';
4780
4781     # we take informations from director, and we overwrite with user wish
4782     my $info = $b->send_cmd("show job=\"$job\"");
4783     my $attr = $self->run_parse_job($info);
4784
4785     my $arg = $self->get_form(qw/pool level client fileset storage media/);
4786
4787     if (!$arg->{pool} and $arg->{media}) {
4788         my $r = $self->dbh_selectrow_hashref("
4789 SELECT Pool.Name AS name
4790   FROM Media JOIN Pool USING (PoolId)
4791  WHERE Media.VolumeName = '$arg->{media}'
4792    AND Pool.Name != 'Scratch'
4793 ");
4794         if ($r) {
4795             $arg->{pool} = $r->{name};
4796         }
4797     }
4798
4799     my %job_opt = (%$attr, %$arg);
4800
4801     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
4802
4803     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
4804     my $clients = [ map { { name => $_ } }$b->list_client()];
4805     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
4806     my $storages= [ map { { name => $_ } }$b->list_storage()];
4807
4808     $self->display({
4809         jobs     => $jobs,
4810         pools    => $pools,
4811         clients  => $clients,
4812         filesets => $filesets,
4813         storages => $storages,
4814         %job_opt,
4815     }, "run_job_mod.tpl");
4816 }
4817
4818 sub run_job
4819 {
4820     my ($self) = @_;
4821     $self->can_do('r_run_job');
4822
4823     my $b = $self->get_bconsole();
4824
4825     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
4826
4827     $self->display({
4828         jobs     => $jobs,
4829     }, "run_job.tpl");
4830 }
4831
4832 sub run_job_now
4833 {
4834     my ($self) = @_;
4835     $self->can_do('r_run_job');
4836
4837     my $b = $self->get_bconsole();
4838
4839     # TODO: check input (don't use pool, level)
4840
4841     my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
4842     my $job = CGI::param('job') || '';
4843     my $storage = CGI::param('storage') || '';
4844
4845     my $jobid = $b->run(job => $job,
4846                         client => $arg->{client},
4847                         priority => $arg->{priority},
4848                         level => $arg->{level},
4849                         storage => $storage,
4850                         pool => $arg->{pool},
4851                         fileset => $arg->{fileset},
4852                         when => $arg->{when},
4853                         );
4854
4855     print $b->{error};
4856
4857     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>";
4858 }
4859
4860 sub display_next_job
4861 {
4862     my ($self) = @_;
4863
4864     my $arg = $self->get_form(qw/job begin end/);
4865     if (!$arg->{job}) {
4866         return $self->error("Can't get job name");
4867     }
4868
4869     my $b = $self->get_bconsole();
4870
4871     my $job = $b->send_cmd("show job=\"$arg->{job}\"");
4872     my $attr = $self->run_parse_job($job);
4873
4874     if (!$attr->{schedule}) {
4875         return $self->error("Can't get $arg->{job} schedule");
4876     }
4877     my $jpool=$attr->{pool} || '';
4878
4879     my $sched = new Bweb::Sched(bconsole => $b, name => $attr->{schedule},
4880                                 begin => $arg->{begin}, end => $arg->{end});
4881
4882     my $ss = $sched->get_scheds($attr->{schedule});
4883     my @ret;
4884
4885     foreach my $s (@$ss) {
4886         my $level = $sched->get_level($s);
4887         my $pool  = $sched->get_pool($s) || $jpool;
4888         my $evt = $sched->get_event($s);
4889         push @ret, map { "$_ : $pool ($level)\n" } @$evt;
4890     }
4891
4892     print "<b>$arg->{job}:</b><pre>", sort @ret, "</pre><br>";
4893 }
4894
4895 # check jobs against their schedule
4896 sub check_job
4897 {
4898     my ($self, $sched, $schedname, $job, $job_pool, $client, $type) = @_;
4899     return undef if (!$self->can_view_client($client));
4900
4901     my $sch = $sched->get_scheds($schedname);
4902     return undef if (!$sch);
4903
4904     my $end = $sched->{end}; # this backup must have start before the next one
4905     my @ret;
4906     foreach my $s (@$sch) {
4907         my $pool;
4908         if ($type eq 'B') {     # we take the pool only for backup job
4909             $pool = $sched->get_pool($s) || $job_pool;
4910         }
4911         my $level = $sched->get_level($s);
4912         my ($l) = ($level =~ m/^(.)/); # we keep the first letter
4913         my $evts = $sched->get_event($s);
4914
4915         foreach my $evt (reverse @$evts) {
4916             my $all = $self->dbh_selectrow_hashref("
4917  SELECT 1
4918    FROM Job JOIN Client USING (ClientId) LEFT JOIN Pool USING (PoolId)
4919   WHERE Job.StartTime >= '$evt'
4920     AND Job.StartTime <  '$end'
4921     AND Job.Name = '$job'
4922     AND Job.Type = '$type'
4923     AND Job.JobStatus = 'T'
4924     AND Job.Level = '$l'
4925 " . ($pool?" AND Pool.Name = '$pool' ":'') . "
4926     AND Client.Name = '$client'
4927  LIMIT 1
4928 ");
4929             if ($all) {
4930 #               print "ok $job ";
4931             } else {
4932                 push @{$self->{tmp}}, {date => $evt, level => $level,
4933                                        type => 'Backup', name => $job,
4934                                        pool => $pool, volume => $pool};
4935             }
4936             $end = $evt;
4937         }
4938     }
4939 }
4940
4941 sub display_missing_job
4942 {
4943     my ($self) = @_;
4944     my $arg = $self->get_form(qw/begin end/);
4945
4946     if (!$arg->{begin}) { # TODO: change this
4947         $arg->{begin} = strftime('%F %T', localtime(time - 24*60*60 ));
4948     }
4949     if (!$arg->{end}) {
4950         $arg->{end} = strftime('%F %T', localtime(time));
4951     }
4952     $self->{tmp} = [];          # check_job use this for result
4953
4954     my $bconsole = $self->get_bconsole();
4955
4956     my $sched = new Bweb::Sched(bconsole => $bconsole,
4957                                 begin => $arg->{begin},
4958                                 end => $arg->{end});
4959
4960     my $job = $bconsole->send_cmd("show job");
4961     my ($jname, $jsched, $jclient, $jpool, $jtype);
4962     foreach my $j (split(/\r?\n/, $job)) {
4963         if ($j =~ /Job: name=([\w\d\-]+?) JobType=(\d+)/i) {
4964             if ($jname and $jsched) {
4965                 $self->check_job($sched, $jsched, $jname,
4966                                  $jpool, $jclient, $jtype);
4967             }
4968             $jname = $1;
4969             $jtype = chr($2);
4970             $jclient = $jpool = $jsched = undef;
4971         } elsif ($j =~ /Client: name=(.+?) address=/i) {
4972             $jclient = $1;
4973         } elsif ($j =~ /Pool: name=([\w\d\-]+) PoolType=/i) {
4974             $jpool = $1;
4975         } elsif ($j =~ /Schedule: name=([\w\d\-]+)/i) {
4976             $jsched = $1;
4977         }
4978     }
4979     $self->display({
4980         id => $cur_id++,
4981         title => "Missing Job (since $arg->{begin} to $arg->{end})",
4982         list => $self->{tmp},
4983     }, "scheduled_job.tpl");
4984
4985     delete $self->{tmp};
4986 }
4987
4988 1;