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