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

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