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     }
2754     return 1;
2755 }
2756
2757 sub use_filter
2758 {
2759     my ($self) = @_;
2760
2761     if (!$self->{info}->{enable_security} or
2762         !$self->{info}->{enable_security_acl})
2763     {
2764         return 0 ;
2765     }
2766
2767     if ($self->get_roles()) {
2768         return $self->{security}->{use_acl};
2769     } else {
2770         return 0;
2771     }
2772 }
2773
2774 # JOIN Client USING (ClientId) " . $b->get_client_filter() . "
2775 sub get_client_filter
2776 {
2777     my ($self, $login) = @_;
2778     my $u;
2779     if ($login) {
2780         $u = $self->dbh_quote($login);
2781     } elsif ($self->use_filter()) {
2782         $u = $self->dbh_quote($self->{loginname});
2783     } else {
2784         return '';
2785     }
2786     return "
2787  JOIN (SELECT ClientId FROM client_group_member
2788    JOIN client_group USING (client_group_id)
2789    JOIN bweb_client_group_acl USING (client_group_id)
2790    JOIN bweb_user USING (userid)
2791    WHERE bweb_user.username = $u
2792  ) AS filter USING (ClientId)";
2793 }
2794
2795 #JOIN client_group USING (client_group_id)" . $b->get_client_group_filter()
2796 sub get_client_group_filter
2797 {
2798     my ($self, $login) = @_;
2799     my $u;
2800     if ($login) {
2801         $u = $self->dbh_quote($login);
2802     } elsif ($self->use_filter()) {
2803         $u = $self->dbh_quote($self->{loginname});
2804     } else {
2805         return '';
2806     }
2807     return "
2808  JOIN (SELECT client_group_id
2809          FROM bweb_client_group_acl
2810          JOIN bweb_user USING (userid)
2811    WHERE bweb_user.username = $u
2812  ) AS filter USING (client_group_id)";
2813 }
2814
2815 # role and username have to be quoted before
2816 # role and username can be a quoted list
2817 sub revoke
2818 {
2819     my ($self, $role, $username) = @_;
2820     $self->can_do("r_user_mgnt");
2821
2822     my $nb = $self->dbh_do("
2823  DELETE FROM bweb_role_member
2824        WHERE roleid = (SELECT roleid FROM bweb_role
2825                         WHERE rolename IN ($role))
2826          AND userid = (SELECT userid FROM bweb_user
2827                         WHERE username IN ($username))");
2828     return $nb;
2829 }
2830
2831 # role and username have to be quoted before
2832 # role and username can be a quoted list
2833 sub grant
2834 {
2835     my ($self, $role, $username) = @_;
2836     $self->can_do("r_user_mgnt");
2837
2838     my $nb = $self->dbh_do("
2839    INSERT INTO bweb_role_member (roleid, userid)
2840      SELECT roleid, userid FROM bweb_role, bweb_user
2841       WHERE rolename IN ($role)
2842         AND username IN ($username)
2843      ");
2844     return $nb;
2845 }
2846
2847 # role and username have to be quoted before
2848 # role and username can be a quoted list
2849 sub grant_like
2850 {
2851     my ($self, $copy, $user) = @_;
2852     $self->can_do("r_user_mgnt");
2853
2854     my $nb = $self->dbh_do("
2855   INSERT INTO bweb_role_member (roleid, userid)
2856    SELECT roleid, a.userid
2857      FROM bweb_user AS a, bweb_role_member
2858      JOIN bweb_user USING (userid)
2859     WHERE bweb_user.username = $copy
2860       AND a.username = $user");
2861     return $nb;
2862 }
2863
2864 # username can be a join quoted list of usernames
2865 sub revoke_all
2866 {
2867     my ($self, $username) = @_;
2868     $self->can_do("r_user_mgnt");
2869
2870     $self->dbh_do("
2871    DELETE FROM bweb_role_member
2872          WHERE userid IN (
2873            SELECT userid
2874              FROM bweb_user
2875             WHERE username in ($username))");
2876     $self->dbh_do("
2877 DELETE FROM bweb_client_group_acl
2878  WHERE userid IN (
2879   SELECT userid
2880     FROM bweb_user
2881    WHERE username IN ($username))");
2882
2883 }
2884
2885 sub users_del
2886 {
2887     my ($self) = @_;
2888     $self->can_do("r_user_mgnt");
2889
2890     my $arg = $self->get_form(qw/jusernames/);
2891
2892     unless ($arg->{jusernames}) {
2893         return $self->error("Can't get user");
2894     }
2895
2896     $self->{dbh}->begin_work();
2897     {
2898         $self->revoke_all($arg->{jusernames});
2899         $self->dbh_do("
2900 DELETE FROM bweb_user WHERE username IN ($arg->{jusernames})");
2901     }
2902     $self->{dbh}->commit();
2903
2904     $self->display_users();
2905 }
2906
2907 sub users_add
2908 {
2909     my ($self) = @_;
2910     $self->can_do("r_user_mgnt");
2911
2912     # we don't quote username directly to check that it is conform
2913     my $arg = $self->get_form(qw/username qpasswd qcomment jrolenames qcreate qcopy_username jclient_groups/) ;
2914
2915     if (not $arg->{qcreate}) {
2916         $arg = $self->get_form(qw/db_roles db_usernames db_client_groups/);
2917         $self->display($arg, "display_user.tpl");
2918         return 1;
2919     }
2920
2921     my $u = $self->dbh_quote($arg->{username});
2922
2923     $arg->{use_acl}=(CGI::param('use_acl')?'true':'false');
2924
2925     if (!$arg->{qpasswd}) {
2926         $arg->{qpasswd} = "''";
2927     }
2928     if (!$arg->{qcomment}) {
2929         $arg->{qcomment} = "''";
2930     }
2931
2932     # will fail if user already exists
2933     # UPDATE with mysql dbi does not return if update is ok
2934     ($self->dbh_do("
2935   UPDATE bweb_user
2936      SET passwd=$arg->{qpasswd}, comment=$arg->{qcomment},
2937          use_acl=$arg->{use_acl}
2938    WHERE username = $u")
2939 #     and (! $self->dbh_is_mysql() )
2940      ) and
2941     $self->dbh_do("
2942   INSERT INTO bweb_user (username, passwd, use_acl, comment)
2943         VALUES ($u, $arg->{qpasswd}, $arg->{use_acl}, $arg->{qcomment})");
2944
2945     $self->{dbh}->begin_work();
2946     {
2947         $self->revoke_all($u);
2948
2949         if ($arg->{qcopy_username}) {
2950             $self->grant_like($arg->{qcopy_username}, $u);
2951         } else {
2952             $self->grant($arg->{jrolenames}, $u);
2953         }
2954
2955         if ($arg->{jclient_groups}) {
2956             $self->dbh_do("
2957 INSERT INTO bweb_client_group_acl (client_group_id, userid)
2958  SELECT client_group_id, userid
2959    FROM client_group, bweb_user
2960   WHERE client_group_name IN ($arg->{jclient_groups})
2961     AND username = $u
2962 ");
2963         }
2964     }
2965     $self->{dbh}->commit();
2966
2967     $self->display_users();
2968 }
2969
2970 # TODO: we miss a matrix with all user/roles
2971 sub display_users
2972 {
2973     my ($self) = @_;
2974     $self->can_do("r_user_mgnt");
2975
2976     my $arg = $self->get_form(qw/db_usernames/) ;
2977
2978     if ($self->{dbh}->errstr) {
2979         return $self->error("Can't use users with bweb, read INSTALL to enable them");
2980     }
2981
2982     $self->display({ ID => $cur_id++,
2983                      %$arg},
2984                    "display_users.tpl");
2985 }
2986
2987 sub display_user
2988 {
2989     my ($self) = @_;
2990     $self->can_do("r_user_mgnt");
2991
2992     my $arg = $self->get_form('username');
2993     my $user = $self->dbh_quote($arg->{username});
2994
2995     my $userp = $self->dbh_selectrow_hashref("
2996    SELECT username, passwd, comment, use_acl
2997      FROM bweb_user
2998     WHERE username = $user
2999 ");
3000     if (!$userp) {
3001         return $self->error("Can't find $user in catalog");
3002     }
3003     my $filter = $self->get_client_group_filter($arg->{username});
3004     my $scg = $self->dbh_selectall_hashref("
3005  SELECT client_group_name AS name
3006    FROM client_group $filter
3007 ", 'name');
3008
3009 #  rolename  | userid
3010 #------------+--------
3011 # cancel_job |
3012 # restore    |
3013 # run_job    |      1
3014
3015     my $role = $self->dbh_selectall_hashref("
3016 SELECT rolename, temp.userid
3017      FROM bweb_role
3018      LEFT JOIN (SELECT roleid, userid
3019                   FROM bweb_user JOIN bweb_role_member USING (userid)
3020                  WHERE username = $user) AS temp USING (roleid)
3021 ORDER BY rolename
3022 ", 'rolename');
3023
3024     $arg = $self->get_form(qw/db_usernames db_client_groups/);
3025
3026     $self->display({
3027         db_usernames => $arg->{db_usernames},
3028         username => $userp->{username},
3029         comment => $userp->{comment},
3030         passwd => $userp->{passwd},
3031         use_acl => $userp->{use_acl},
3032         db_client_groups => $arg->{db_client_groups},
3033         client_group => [ values %$scg ],
3034         db_roles => [ values %$role],
3035     }, "display_user.tpl");
3036 }
3037
3038
3039 ###########################################################
3040
3041 sub get_media_max_size
3042 {
3043     my ($self, $type) = @_;
3044     my $query =
3045 "SELECT avg(VolBytes) AS size
3046   FROM Media
3047  WHERE Media.VolStatus = 'Full'
3048    AND Media.MediaType = '$type'
3049 ";
3050
3051     my $res = $self->selectrow_hashref($query);
3052
3053     if ($res) {
3054         return $res->{size};
3055     } else {
3056         return 0;
3057     }
3058 }
3059
3060 sub update_media
3061 {
3062     my ($self) = @_ ;
3063
3064     my $media = $self->get_form('qmedia');
3065
3066     unless ($media->{qmedia}) {
3067         return $self->error("Can't get media");
3068     }
3069
3070     my $query = "
3071 SELECT Media.Slot         AS slot,
3072        PoolMedia.Name     AS poolname,
3073        Media.VolStatus    AS volstatus,
3074        Media.InChanger    AS inchanger,
3075        Location.Location  AS location,
3076        Media.VolumeName   AS volumename,
3077        Media.MaxVolBytes  AS maxvolbytes,
3078        Media.MaxVolJobs   AS maxvoljobs,
3079        Media.MaxVolFiles  AS maxvolfiles,
3080        Media.VolUseDuration AS voluseduration,
3081        Media.VolRetention AS volretention,
3082        Media.Comment      AS comment,
3083        PoolRecycle.Name   AS poolrecycle,
3084        Media.Enabled      AS enabled
3085
3086 FROM Media INNER JOIN Pool AS PoolMedia ON (Media.PoolId = PoolMedia.PoolId)
3087            LEFT  JOIN Pool AS PoolRecycle ON (Media.RecyclePoolId = PoolRecycle.PoolId)
3088            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
3089
3090 WHERE Media.VolumeName = $media->{qmedia}
3091 ";
3092
3093     my $row = $self->dbh_selectrow_hashref($query);
3094     $row->{volretention} = human_sec($row->{volretention});
3095     $row->{voluseduration} = human_sec($row->{voluseduration});
3096     $row->{enabled} = human_enabled($row->{enabled});
3097
3098     my $elt = $self->get_form(qw/db_pools db_locations/);
3099
3100     $self->display({
3101         %$elt,
3102         %$row,
3103     }, "update_media.tpl");
3104 }
3105
3106 sub save_location
3107 {
3108     my ($self) = @_ ;
3109     $self->can_do('r_media_mgnt');
3110
3111     my $arg = $self->get_form('jmedias', 'qnewlocation') ;
3112
3113     unless ($arg->{jmedias}) {
3114         return $self->error("Can't get selected media");
3115     }
3116
3117     unless ($arg->{qnewlocation}) {
3118         return $self->error("Can't get new location");
3119     }
3120
3121     my $query = "
3122  UPDATE Media
3123      SET LocationId = (SELECT LocationId
3124                        FROM Location
3125                        WHERE Location = $arg->{qnewlocation})
3126      WHERE Media.VolumeName IN ($arg->{jmedias})
3127 ";
3128
3129     my $nb = $self->dbh_do($query);
3130
3131     print "$nb media updated, you may have to update your autochanger.";
3132
3133     $self->display_media();
3134 }
3135
3136 sub location_change
3137 {
3138     my ($self) = @_ ;
3139     $self->can_do('r_media_mgnt');
3140
3141     my $media = $self->get_selected_media_location();
3142     unless ($media) {
3143         return $self->error("Can't get media selection");
3144     }
3145     my $newloc = CGI::param('newlocation');
3146
3147     my $user = CGI::param('user') || 'unknown';
3148     my $comm = CGI::param('comment') || '';
3149     $comm = $self->dbh_quote("$user: $comm");
3150
3151     my $arg = $self->get_form('enabled');
3152     my $en = human_enabled($arg->{enabled});
3153     my $b = $self->get_bconsole();
3154
3155     my $query;
3156     foreach my $vol (keys %$media) {
3157         $query = "
3158 INSERT LocationLog (Date, Comment, MediaId, LocationId, NewVolStatus)
3159  VALUES(
3160        NOW(), $comm, (SELECT MediaId FROM Media WHERE VolumeName = '$vol'),
3161        (SELECT LocationId FROM Location WHERE Location = '$media->{$vol}->{location}'),
3162        (SELECT VolStatus FROM Media WHERE VolumeName = '$vol')
3163       )
3164 ";
3165         $self->dbh_do($query);
3166         $self->debug($query);
3167         $b->send_cmd("update volume=\"$vol\" enabled=$en");
3168     }
3169     $b->close();
3170
3171     my $q = new CGI;
3172     $q->param('action', 'update_location');
3173     my $url = $q->url(-full => 1, -query=>1);
3174
3175     $self->display({ email  => $self->{info}->{email_media},
3176                      url => $url,
3177                      newlocation => $newloc,
3178                      # [ { volumename => 'vol1' }, { volumename => 'vol2'},..]
3179                      media => [ values %$media ],
3180                    },
3181                    "change_location.tpl");
3182
3183 }
3184
3185 sub display_client_stats
3186 {
3187     my ($self, %arg) = @_ ;
3188     $self->can_do('r_view_stat');
3189
3190     my $client = $self->dbh_quote($arg{clientname});
3191     # get security filter
3192     my $filter = $self->get_client_filter();
3193
3194     my ($limit, $label) = $self->get_limit(%arg);
3195     my $query = "
3196 SELECT
3197     count(Job.JobId)     AS nb_jobs,
3198     sum(Job.JobBytes)    AS nb_bytes,
3199     sum(Job.JobErrors)   AS nb_err,
3200     sum(Job.JobFiles)    AS nb_files,
3201     Client.Name          AS clientname
3202 FROM Job JOIN Client USING (ClientId) $filter
3203 WHERE
3204     Client.Name = $client
3205     $limit
3206 GROUP BY Client.Name
3207 ";
3208
3209     my $row = $self->dbh_selectrow_hashref($query);
3210
3211     $row->{ID} = $cur_id++;
3212     $row->{label} = $label;
3213     $row->{grapharg} = "client";
3214
3215     $self->display($row, "display_client_stats.tpl");
3216 }
3217
3218
3219 sub display_group_stats
3220 {
3221     my ($self, %arg) = @_ ;
3222
3223     my $carg = $self->get_form(qw/qclient_group/);
3224
3225     unless ($carg->{qclient_group}) {
3226         return $self->error("Can't get group");
3227     }
3228
3229     my ($limit, $label) = $self->get_limit(%arg);
3230
3231     my $query = "
3232 SELECT
3233     count(Job.JobId)     AS nb_jobs,
3234     sum(Job.JobBytes)    AS nb_bytes,
3235     sum(Job.JobErrors)   AS nb_err,
3236     sum(Job.JobFiles)    AS nb_files,
3237     client_group.client_group_name  AS clientname
3238 FROM Job JOIN Client USING (ClientId)
3239          JOIN client_group_member ON (Client.ClientId = client_group_member.clientid)
3240          JOIN client_group USING (client_group_id)
3241 WHERE
3242     client_group.client_group_name = $carg->{qclient_group}
3243     $limit
3244 GROUP BY client_group.client_group_name
3245 ";
3246
3247     my $row = $self->dbh_selectrow_hashref($query);
3248
3249     $row->{ID} = $cur_id++;
3250     $row->{label} = $label;
3251     $row->{grapharg} = "client_group";
3252
3253     $self->display($row, "display_client_stats.tpl");
3254 }
3255
3256 # poolname can be undef
3257 sub display_pool
3258 {
3259     my ($self, $poolname) = @_ ;
3260     my $whereA = '';
3261     my $whereW = '';
3262
3263     my $arg = $self->get_form('jmediatypes', 'qmediatypes');
3264     if ($arg->{jmediatypes}) {
3265         $whereW = "WHERE MediaType IN ($arg->{jmediatypes}) ";
3266         $whereA = "AND   MediaType IN ($arg->{jmediatypes}) ";
3267     }
3268
3269 # TODO : afficher les tailles et les dates
3270
3271     my $query = "
3272 SELECT subq.volmax        AS volmax,
3273        subq.volnum        AS volnum,
3274        subq.voltotal      AS voltotal,
3275        Pool.Name          AS name,
3276        Pool.Recycle       AS recycle,
3277        Pool.VolRetention  AS volretention,
3278        Pool.VolUseDuration AS voluseduration,
3279        Pool.MaxVolJobs    AS maxvoljobs,
3280        Pool.MaxVolFiles   AS maxvolfiles,
3281        Pool.MaxVolBytes   AS maxvolbytes,
3282        subq.PoolId        AS PoolId,
3283        subq.MediaType     AS mediatype,
3284        $self->{sql}->{CAT_POOL_TYPE}  AS uniq
3285 FROM
3286   (
3287     SELECT COALESCE(media_avg_size.volavg,0) * count(Media.MediaId) AS volmax,
3288            count(Media.MediaId)  AS volnum,
3289            sum(Media.VolBytes)   AS voltotal,
3290            Media.PoolId          AS PoolId,
3291            Media.MediaType       AS MediaType
3292     FROM Media
3293     LEFT JOIN (SELECT avg(Media.VolBytes) AS volavg,
3294                       Media.MediaType     AS MediaType
3295                FROM Media
3296               WHERE Media.VolStatus = 'Full'
3297               GROUP BY Media.MediaType
3298                ) AS media_avg_size ON (Media.MediaType = media_avg_size.MediaType)
3299     GROUP BY Media.MediaType, Media.PoolId, media_avg_size.volavg
3300   ) AS subq
3301 LEFT JOIN Pool ON (Pool.PoolId = subq.PoolId)
3302 $whereW
3303 ";
3304
3305     my $all = $self->dbh_selectall_hashref($query, 'uniq') ;
3306
3307     $query = "
3308 SELECT Pool.Name AS name,
3309        sum(VolBytes) AS size
3310 FROM   Media JOIN Pool ON (Media.PoolId = Pool.PoolId)
3311 WHERE  Media.VolStatus IN ('Recycled', 'Purged')
3312        $whereA
3313 GROUP BY Pool.Name;
3314 ";
3315     my $empty = $self->dbh_selectall_hashref($query, 'name');
3316
3317     foreach my $p (values %$all) {
3318         if ($p->{volmax} > 0) { # mysql returns 0.0000
3319             # we remove Recycled/Purged media from pool usage
3320             if (defined $empty->{$p->{name}}) {
3321                 $p->{voltotal} -= $empty->{$p->{name}}->{size};
3322             }
3323             $p->{poolusage} = sprintf('%.2f', $p->{voltotal} * 100/ $p->{volmax}) ;
3324         } else {
3325             $p->{poolusage} = 0;
3326         }
3327
3328         $query = "
3329   SELECT VolStatus AS volstatus, count(MediaId) AS nb
3330     FROM Media
3331    WHERE PoolId=$p->{poolid}
3332      AND Media.MediaType = '$p->{mediatype}'
3333          $whereA
3334 GROUP BY VolStatus
3335 ";
3336         my $content = $self->dbh_selectall_hashref($query, 'volstatus');
3337         foreach my $t (values %$content) {
3338             $p->{"nb_" . $t->{volstatus}} = $t->{nb} ;
3339         }
3340     }
3341
3342     $self->debug($all);
3343     $self->display({ ID => $cur_id++,
3344                      MediaType => $arg->{qmediatypes}, # [ { name => type1 } , { name => type2 } ]
3345                      Pools => [ values %$all ]},
3346                    "display_pool.tpl");
3347 }
3348
3349 sub display_running_job
3350 {
3351     my ($self) = @_;
3352     return if $self->cant_do('r_view_running_job');
3353
3354     my $arg = $self->get_form('client', 'jobid');
3355
3356     if (!$arg->{client} and $arg->{jobid}) {
3357         # get security filter
3358         my $filter = $self->get_client_filter();
3359
3360         my $query = "
3361 SELECT Client.Name AS name
3362 FROM Job INNER JOIN Client USING (ClientId) $filter
3363 WHERE Job.JobId = $arg->{jobid}
3364 ";
3365
3366         my $row = $self->dbh_selectrow_hashref($query);
3367
3368         if ($row) {
3369             $arg->{client} = $row->{name};
3370             CGI::param('client', $arg->{client});
3371         }
3372     }
3373
3374     if ($arg->{client}) {
3375         my $cli = new Bweb::Client(name => $arg->{client});
3376         $cli->display_running_job($self->{info}, $arg->{jobid});
3377         if ($arg->{jobid}) {
3378             $self->get_job_log();
3379         }
3380     } else {
3381         $self->error("Can't get client or jobid");
3382     }
3383 }
3384
3385 sub display_running_jobs
3386 {
3387     my ($self, $display_action) = @_;
3388     return if $self->cant_do('r_view_running_job');
3389
3390     # get security filter
3391     my $filter = $self->get_client_filter();
3392
3393     my $query = "
3394 SELECT Job.JobId AS jobid,
3395        Job.Name  AS jobname,
3396        Job.Level     AS level,
3397        Job.StartTime AS starttime,
3398        Job.JobFiles  AS jobfiles,
3399        Job.JobBytes  AS jobbytes,
3400        Job.JobStatus AS jobstatus,
3401 $self->{sql}->{SEC_TO_TIME}(  $self->{sql}->{UNIX_TIMESTAMP}(NOW())
3402                             - $self->{sql}->{UNIX_TIMESTAMP}(StartTime))
3403          AS duration,
3404        Client.Name AS clientname
3405 FROM Job INNER JOIN Client USING (ClientId) $filter
3406 WHERE
3407   JobStatus IN ('C','R','B','e','D','F','S','m','M','s','j','c','d','t','p')
3408 ";
3409     my $all = $self->dbh_selectall_hashref($query, 'jobid') ;
3410
3411     $self->display({ ID => $cur_id++,
3412                      display_action => $display_action,
3413                      Jobs => [ values %$all ]},
3414                    "running_job.tpl") ;
3415 }
3416
3417 # return the autochanger list to update
3418 sub eject_media
3419 {
3420     my ($self) = @_;
3421     $self->can_do('r_media_mgnt');
3422
3423     my %ret;
3424     my $arg = $self->get_form('jmedias');
3425
3426     unless ($arg->{jmedias}) {
3427         return $self->error("Can't get media selection");
3428     }
3429
3430     my $query = "
3431 SELECT Media.VolumeName  AS volumename,
3432        Storage.Name      AS storage,
3433        Location.Location AS location,
3434        Media.Slot        AS slot
3435 FROM Media INNER JOIN Storage  ON (Media.StorageId  = Storage.StorageId)
3436            LEFT  JOIN Location ON (Media.LocationId = Location.LocationId)
3437 WHERE Media.VolumeName IN ($arg->{jmedias})
3438   AND Media.InChanger = 1
3439 ";
3440
3441     my $all = $self->dbh_selectall_hashref($query, 'volumename');
3442
3443     foreach my $vol (values %$all) {
3444         my $a = $self->ach_get($vol->{location});
3445         next unless ($a) ;
3446         $ret{$vol->{location}} = 1;
3447
3448         unless ($a->{have_status}) {
3449             $a->status();
3450             $a->{have_status} = 1;
3451         }
3452         # TODO: set enabled
3453         print "eject $vol->{volumename} from $vol->{storage} : ";
3454         if ($a->send_to_io($vol->{slot})) {
3455             print "<img src='/bweb/T.png' alt='ok'><br/>";
3456         } else {
3457             print "<img src='/bweb/E.png' alt='err'><br/>";
3458         }
3459     }
3460     return keys %ret;
3461 }
3462
3463 sub move_email
3464 {
3465     my ($self) = @_;
3466
3467     my ($to, $subject, $content) = (CGI::param('email'),
3468                                     CGI::param('subject'),
3469                                     CGI::param('content'));
3470     $to =~ s/[^\w\d\.\@<>,]//;
3471     $subject =~ s/[^\w\d\.\[\]]/ /;
3472
3473     open(MAIL, "|mail -s '$subject' '$to'") ;
3474     print MAIL $content;
3475     close(MAIL);
3476
3477     print "Mail sent";
3478 }
3479
3480 sub restore
3481 {
3482     my ($self) = @_;
3483
3484     my $arg = $self->get_form('jobid', 'client');
3485
3486     print CGI::header('text/brestore');
3487     print "jobid=$arg->{jobid}\n" if ($arg->{jobid});
3488     print "client=$arg->{client}\n" if ($arg->{client});
3489     print "\n\nYou have to assign this mime type with /usr/bin/brestore.pl\n";
3490     print "\n";
3491 }
3492
3493 # TODO : move this to Bweb::Autochanger ?
3494 # TODO : make this internal to not eject tape ?
3495 use Bconsole;
3496
3497
3498 sub ach_get
3499 {
3500     my ($self, $name) = @_;
3501
3502     unless ($name) {
3503         return $self->error("Can't get your autochanger name ach");
3504     }
3505
3506     unless ($self->{info}->{ach_list}) {
3507         return $self->error("Could not find any autochanger");
3508     }
3509
3510     my $a = $self->{info}->{ach_list}->{$name};
3511
3512     unless ($a) {
3513         $self->error("Can't get your autochanger $name from your ach_list");
3514         return undef;
3515     }
3516
3517     $a->{bweb}  = $self;
3518     $a->{debug} = $self->{debug};
3519
3520     return $a;
3521 }
3522
3523 sub ach_register
3524 {
3525     my ($self, $ach) = @_;
3526     $self->can_do('r_configure');
3527
3528     $self->{info}->{ach_list}->{$ach->{name}} = $ach;
3529
3530     $self->{info}->save();
3531
3532     return 1;
3533 }
3534
3535 sub ach_edit
3536 {
3537     my ($self) = @_;
3538     $self->can_do('r_configure');
3539
3540     my $arg = $self->get_form('ach');
3541     if (!$arg->{ach}
3542         or !$self->{info}->{ach_list}
3543         or !$self->{info}->{ach_list}->{$arg->{ach}})
3544     {
3545         return $self->error("Can't get autochanger name");
3546     }
3547
3548     my $ach = $self->{info}->{ach_list}->{$arg->{ach}};
3549
3550     my $i=0;
3551     $ach->{drives} =
3552         [ map { { name => $_, index => $i++ } } @{$ach->{drive_name}} ] ;
3553
3554     my $b = $self->get_bconsole();
3555
3556     my @storages = $b->list_storage() ;
3557
3558     $ach->{devices} = [ map { { name => $_ } } @storages ];
3559
3560     $self->display($ach, "ach_add.tpl");
3561     delete $ach->{drives};
3562     delete $ach->{devices};
3563     return 1;
3564 }
3565
3566 sub ach_del
3567 {
3568     my ($self) = @_;
3569     $self->can_do('r_configure');
3570
3571     my $arg = $self->get_form('ach');
3572
3573     if (!$arg->{ach}
3574         or !$self->{info}->{ach_list}
3575         or !$self->{info}->{ach_list}->{$arg->{ach}})
3576     {
3577         return $self->error("Can't get autochanger name");
3578     }
3579
3580     delete $self->{info}->{ach_list}->{$arg->{ach}} ;
3581
3582     $self->{info}->save();
3583     $self->{info}->view();
3584 }
3585
3586 sub ach_add
3587 {
3588     my ($self) = @_;
3589     $self->can_do('r_configure');
3590
3591     my $arg = $self->get_form('ach', 'mtxcmd', 'device', 'precmd');
3592
3593     my $b = $self->get_bconsole();
3594     my @storages = $b->list_storage() ;
3595
3596     unless ($arg->{ach}) {
3597         $arg->{devices} = [ map { { name => $_ } } @storages ];
3598         return $self->display($arg, "ach_add.tpl");
3599     }
3600
3601     my @drives ;
3602     foreach my $drive (CGI::param('drives'))
3603     {
3604         unless (grep(/^$drive$/,@storages)) {
3605             return $self->error("Can't find $drive in storage list");
3606         }
3607
3608         my $index = CGI::param("index_$drive");
3609         unless (defined $index and $index =~ /^(\d+)$/) {
3610             return $self->error("Can't get $drive index");
3611         }
3612
3613         $drives[$index] = $drive;
3614     }
3615
3616     unless (@drives) {
3617         return $self->error("Can't get drives from Autochanger");
3618     }
3619
3620     my $a = new Bweb::Autochanger(name   => $arg->{ach},
3621                                   precmd => $arg->{precmd},
3622                                   drive_name => \@drives,
3623                                   device => $arg->{device},
3624                                   mtxcmd => $arg->{mtxcmd});
3625
3626     $self->ach_register($a) ;
3627
3628     $self->{info}->view();
3629 }
3630
3631 sub delete
3632 {
3633     my ($self) = @_;
3634     $self->can_do('r_delete_job');
3635
3636     my $arg = $self->get_form('jobid');
3637
3638     if ($arg->{jobid}) {
3639         my $b = $self->get_bconsole();
3640         my $ret = $b->send_cmd("delete jobid=\"$arg->{jobid}\"");
3641
3642         $self->display({
3643             content => $ret,
3644             title => "Delete a job ",
3645             name => "delete jobid=$arg->{jobid}",
3646         }, "command.tpl");
3647     }
3648 }
3649
3650 sub do_update_media
3651 {
3652     my ($self) = @_ ;
3653     $self->can_do('r_media_mgnt');
3654
3655     my $arg = $self->get_form(qw/media volstatus inchanger pool
3656                                  slot volretention voluseduration
3657                                  maxvoljobs maxvolfiles maxvolbytes
3658                                  qcomment poolrecycle enabled
3659                               /);
3660
3661     unless ($arg->{media}) {
3662         return $self->error("Can't find media selection");
3663     }
3664
3665     my $update = "update volume=$arg->{media} ";
3666
3667     if ($arg->{volstatus}) {
3668         $update .= " volstatus=$arg->{volstatus} ";
3669     }
3670
3671     if ($arg->{inchanger}) {
3672         $update .= " inchanger=yes " ;
3673         if ($arg->{slot}) {
3674             $update .= " slot=$arg->{slot} ";
3675         }
3676     } else {
3677         $update .= " slot=0 inchanger=no ";
3678     }
3679
3680     if ($arg->{enabled}) {
3681         $update .= " enabled=$arg->{enabled} ";
3682     }
3683
3684     if ($arg->{pool}) {
3685         $update .= " pool=$arg->{pool} " ;
3686     }
3687
3688     if (defined $arg->{volretention}) {
3689         $update .= " volretention=\"$arg->{volretention}\" " ;
3690     }
3691
3692     if (defined $arg->{voluseduration}) {
3693         $update .= " voluse=\"$arg->{voluseduration}\" " ;
3694     }
3695
3696     if (defined $arg->{maxvoljobs}) {
3697         $update .= " maxvoljobs=$arg->{maxvoljobs} " ;
3698     }
3699
3700     if (defined $arg->{maxvolfiles}) {
3701         $update .= " maxvolfiles=$arg->{maxvolfiles} " ;
3702     }
3703
3704     if (defined $arg->{maxvolbytes}) {
3705         $update .= " maxvolbytes=$arg->{maxvolbytes} " ;
3706     }
3707
3708     if (defined $arg->{poolrecycle}) {
3709         $update .= " recyclepool=\"$arg->{poolrecycle}\" " ;
3710     }
3711
3712     my $b = $self->get_bconsole();
3713
3714     $self->display({
3715         content => $b->send_cmd($update),
3716         title => "Update a volume ",
3717         name => $update,
3718     }, "command.tpl");
3719
3720
3721     my @q;
3722     my $media = $self->dbh_quote($arg->{media});
3723
3724     my $loc = CGI::param('location') || '';
3725     if ($loc) {
3726         $loc = $self->dbh_quote($loc); # is checked by db
3727         push @q, "LocationId=(SELECT LocationId FROM Location WHERE Location=$loc)";
3728     }
3729     if (!$arg->{qcomment}) {
3730         $arg->{qcomment} = "''";
3731     }
3732     push @q, "Comment=$arg->{qcomment}";
3733
3734
3735     my $query = "
3736 UPDATE Media
3737    SET " . join (',', @q) . "
3738  WHERE Media.VolumeName = $media
3739 ";
3740     $self->dbh_do($query);
3741
3742     $self->update_media();
3743 }
3744
3745 sub update_slots
3746 {
3747     my ($self) = @_;
3748     $self->can_do('r_autochanger_mgnt');
3749
3750     my $ach = CGI::param('ach') ;
3751     $ach = $self->ach_get($ach);
3752     unless ($ach) {
3753         return $self->error("Bad autochanger name");
3754     }
3755
3756     print "<pre>";
3757     my $b = new Bconsole(pref => $self->{info},timeout => 60,log_stdout => 1);
3758     $b->update_slots($ach->{name});
3759     print "</pre>\n"
3760 }
3761
3762 sub get_job_log
3763 {
3764     my ($self) = @_;
3765     $self->can_do('r_view_log');
3766
3767     my $arg = $self->get_form('jobid', 'limit', 'offset');
3768     unless ($arg->{jobid}) {
3769         return $self->error("Can't get jobid");
3770     }
3771
3772     if ($arg->{limit} == 100) {
3773         $arg->{limit} = 1000;
3774     }
3775     # get security filter
3776     my $filter = $self->get_client_filter();
3777
3778     my $query = "
3779 SELECT Job.Name as name, Client.Name as clientname
3780  FROM  Job INNER JOIN Client USING (ClientId) $filter
3781  WHERE JobId = $arg->{jobid}
3782 ";
3783
3784     my $row = $self->dbh_selectrow_hashref($query);
3785
3786     unless ($row) {
3787         return $self->error("Can't find $arg->{jobid} in catalog");
3788     }
3789
3790     # display only Error and Warning messages
3791     $filter = '';
3792     if (CGI::param('error')) {
3793         $filter = " AND LogText $self->{sql}->{MATCH} 'Error|Warning' ";
3794     }
3795
3796     my $logtext;
3797     if (CGI::param('time') || $self->{info}->{display_log_time}) {
3798         $logtext = $self->dbh_strcat('Time', " ' ' ", 'LogText');
3799     } else {
3800         $logtext = 'LogText';
3801     }
3802
3803     $query = "
3804 SELECT count(1) AS nbline, JobId AS jobid,
3805        GROUP_CONCAT($logtext $self->{sql}->{CONCAT_SEP}) AS logtxt
3806   FROM  (
3807     SELECT JobId, Time, LogText
3808     FROM Log
3809    WHERE ( Log.JobId = $arg->{jobid}
3810       OR (Log.JobId = 0
3811           AND Time >= (SELECT StartTime FROM Job WHERE JobId=$arg->{jobid})
3812           AND Time <= (SELECT COALESCE(EndTime,NOW()) FROM Job WHERE JobId=$arg->{jobid})
3813        ) ) $filter
3814  ORDER BY LogId
3815  LIMIT $arg->{limit}
3816  OFFSET $arg->{offset}
3817  ) AS temp
3818  GROUP BY JobId
3819
3820 ";
3821
3822     my $log = $self->dbh_selectrow_hashref($query);
3823     unless ($log) {
3824         return $self->error("Can't get log for jobid $arg->{jobid}");
3825     }
3826
3827     $self->display({ lines=> $log->{logtxt},
3828                      nbline => $log->{nbline},
3829                      jobid => $arg->{jobid},
3830                      name  => $row->{name},
3831                      client => $row->{clientname},
3832                      offset => $arg->{offset},
3833                      limit  => $arg->{limit},
3834                  }, 'display_log.tpl');
3835 }
3836
3837 sub label_barcodes
3838 {
3839     my ($self) = @_ ;
3840     $self->can_do('r_autochanger_mgnt');
3841
3842     my $arg = $self->get_form('ach', 'slots', 'drive');
3843
3844     unless ($arg->{ach}) {
3845         return $self->error("Can't find autochanger name");
3846     }
3847
3848     my $a = $self->ach_get($arg->{ach});
3849     unless ($a) {
3850         return $self->error("Can't find autochanger name in configuration");
3851     }
3852
3853     my $storage = $a->get_drive_name($arg->{drive});
3854     unless ($storage) {
3855         return $self->error("Can't get your drive name");
3856     }
3857
3858     my $slots = '';
3859     my $slots_sql = '';
3860     my $t = 300 ;
3861     if ($arg->{slots}) {
3862         $slots = join(",", @{ $arg->{slots} });
3863         $slots_sql = " AND Slot IN ($slots) ";
3864         $t += 60*scalar( @{ $arg->{slots} }) ;
3865     }
3866
3867     my $b = new Bconsole(pref => $self->{info}, timeout => $t,log_stdout => 1);
3868     print "<h1>This command can take long time, be patient...</h1>";
3869     print "<pre>" ;
3870     $b->label_barcodes(storage => $storage,
3871                        drive => $arg->{drive},
3872                        pool  => 'Scratch',
3873                        slots => $slots) ;
3874     $b->close();
3875     print "</pre>";
3876
3877     $self->dbh_do("
3878   UPDATE Media
3879        SET LocationId =   (SELECT LocationId
3880                              FROM Location
3881                             WHERE Location = '$arg->{ach}')
3882
3883      WHERE (LocationId = 0 OR LocationId IS NULL)
3884        $slots_sql
3885 ");
3886
3887 }
3888
3889 sub purge
3890 {
3891     my ($self) = @_;
3892     $self->can_do('r_purge');
3893
3894     my @volume = CGI::param('media');
3895
3896     unless (@volume) {
3897         return $self->error("Can't get media selection");
3898     }
3899
3900     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3901
3902     foreach my $v (@volume) {
3903         $self->display({
3904             content => $b->purge_volume($v),
3905             title => "Purge media",
3906             name => "purge volume=$v",
3907         }, "command.tpl");
3908     }
3909     $b->close();
3910 }
3911
3912 sub prune
3913 {
3914     my ($self) = @_;
3915     $self->can_do('r_prune');
3916
3917     my @volume = CGI::param('media');
3918     unless (@volume) {
3919         return $self->error("Can't get media selection");
3920     }
3921
3922     my $b = new Bconsole(pref => $self->{info}, timeout => 60);
3923
3924     foreach my $v (@volume) {
3925         $self->display({
3926             content => $b->prune_volume($v),
3927             title => "Prune volume",
3928             name => "prune volume=$v",
3929         }, "command.tpl");
3930     }
3931     $b->close();
3932 }
3933
3934 sub cancel_job
3935 {
3936     my ($self) = @_;
3937     $self->can_do('r_cancel_job');
3938
3939     my $arg = $self->get_form('jobid');
3940     unless ($arg->{jobid}) {
3941         return $self->error("Can't get jobid");
3942     }
3943
3944     my $b = $self->get_bconsole();
3945     $self->display({
3946         content => $b->cancel($arg->{jobid}),
3947         title => "Cancel job",
3948         name => "cancel jobid=$arg->{jobid}",
3949     }, "command.tpl");
3950 }
3951
3952 sub fileset_view
3953 {
3954     # Warning, we display current fileset
3955     my ($self) = @_;
3956
3957     my $arg = $self->get_form('fileset');
3958
3959     if ($arg->{fileset}) {
3960         my $b = $self->get_bconsole();
3961         my $ret = $b->get_fileset($arg->{fileset});
3962         $self->display({ fileset => $arg->{fileset},
3963                          %$ret,
3964                      }, "fileset_view.tpl");
3965     } else {
3966         $self->error("Can't get fileset name");
3967     }
3968 }
3969
3970 sub director_show_sched
3971 {
3972     my ($self) = @_ ;
3973
3974     my $arg = $self->get_form('days');
3975
3976     my $b = $self->get_bconsole();
3977     my $ret = $b->director_get_sched( $arg->{days} );
3978
3979     $self->display({
3980         id => $cur_id++,
3981         list => $ret,
3982     }, "scheduled_job.tpl");
3983 }
3984
3985 sub enable_disable_job
3986 {
3987     my ($self, $what) = @_ ;
3988     $self->can_do('r_run_job');
3989
3990     my $name = CGI::param('job') || '';
3991     unless ($name =~ /^[\w\d\.\-\s]+$/) {
3992         return $self->error("Can't find job name");
3993     }
3994
3995     my $b = $self->get_bconsole();
3996
3997     my $cmd;
3998     if ($what) {
3999         $cmd = "enable";
4000     } else {
4001         $cmd = "disable";
4002     }
4003
4004     $self->display({
4005         content => $b->send_cmd("$cmd job=\"$name\""),
4006         title => "$cmd $name",
4007         name => "$cmd job=\"$name\"",
4008     }, "command.tpl");
4009 }
4010
4011 sub get_bconsole
4012 {
4013     my ($self) = @_;
4014     return new Bconsole(pref => $self->{info});
4015 }
4016
4017 sub run_job_select
4018 {
4019     my ($self) = @_;
4020     $self->can_do('r_run_job');
4021
4022     my $b = $self->get_bconsole();
4023
4024     my $joblist = [ map { { name => $_ } } $b->list_job() ];
4025
4026     $self->display({ Jobs => $joblist }, "run_job.tpl");
4027 }
4028
4029 sub run_parse_job
4030 {
4031     my ($self, $ouput) = @_;
4032
4033     my %arg;
4034     foreach my $l (split(/\r\n/, $ouput)) {
4035         if ($l =~ /(\w+): name=([\w\d\.\s-]+?)(\s+\w+=.+)?$/) {
4036             $arg{$1} = $2;
4037             $l = $3
4038                 if ($3) ;
4039         }
4040
4041         if (my @l = $l =~ /(\w+)=([\w\d*]+)/g) {
4042             %arg = (%arg, @l);
4043         }
4044     }
4045
4046     my %lowcase ;
4047     foreach my $k (keys %arg) {
4048         $lowcase{lc($k)} = $arg{$k} ;
4049     }
4050
4051     return \%lowcase;
4052 }
4053
4054 sub run_job_mod
4055 {
4056     my ($self) = @_;
4057     $self->can_do('r_run_job');
4058
4059     my $b = $self->get_bconsole();
4060
4061     my $job = CGI::param('job') || '';
4062
4063     # we take informations from director, and we overwrite with user wish
4064     my $info = $b->send_cmd("show job=\"$job\"");
4065     my $attr = $self->run_parse_job($info);
4066
4067     my $arg = $self->get_form('pool', 'level', 'client', 'fileset', 'storage');
4068     my %job_opt = (%$attr, %$arg);
4069
4070     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
4071
4072     my $pools  = [ map { { name => $_ } } $b->list_pool() ];
4073     my $clients = [ map { { name => $_ } }$b->list_client()];
4074     my $filesets= [ map { { name => $_ } }$b->list_fileset() ];
4075     my $storages= [ map { { name => $_ } }$b->list_storage()];
4076
4077     $self->display({
4078         jobs     => $jobs,
4079         pools    => $pools,
4080         clients  => $clients,
4081         filesets => $filesets,
4082         storages => $storages,
4083         %job_opt,
4084     }, "run_job_mod.tpl");
4085 }
4086
4087 sub run_job
4088 {
4089     my ($self) = @_;
4090     $self->can_do('r_run_job');
4091
4092     my $b = $self->get_bconsole();
4093
4094     my $jobs   = [ map {{ name => $_ }} $b->list_job() ];
4095
4096     $self->display({
4097         jobs     => $jobs,
4098     }, "run_job.tpl");
4099 }
4100
4101 sub run_job_now
4102 {
4103     my ($self) = @_;
4104     $self->can_do('r_run_job');
4105
4106     my $b = $self->get_bconsole();
4107
4108     # TODO: check input (don't use pool, level)
4109
4110     my $arg = $self->get_form('pool', 'level', 'client', 'priority', 'when', 'fileset');
4111     my $job = CGI::param('job') || '';
4112     my $storage = CGI::param('storage') || '';
4113
4114     my $jobid = $b->run(job => $job,
4115                         client => $arg->{client},
4116                         priority => $arg->{priority},
4117                         level => $arg->{level},
4118                         storage => $storage,
4119                         pool => $arg->{pool},
4120                         fileset => $arg->{fileset},
4121                         when => $arg->{when},
4122                         );
4123
4124     print $jobid, $b->{error};
4125
4126     print "<br>You can follow job execution <a href='?action=dsp_cur_job;client=$arg->{client};jobid=$jobid'> here </a>";
4127 }
4128
4129 1;