git.sur5r.net Git - bacula/bacula/blob - regress/scripts/functions.pm

   1 ################################################################
   2 use strict;
   3
   4 =head1 LICENSE
   5
   6    Bacula® - The Network Backup Solution
   7
   8    Copyright (C) 2008-2014 Bacula Systems SA
   9
  10    The main author of Bacula is Kern Sibbald, with contributions from
  11    many others, a complete list can be found in the file AUTHORS.
  12
  13    Licensees holding a valid Bacula Systems SA license may use this file
  14    and others of this release in accordance with the proprietary license
  15    agreement provided in the LICENSE file.  Redistribution of any part of
  16    this release is not permitted.
  17
  18    Bacula® is a registered trademark of Kern Sibbald.
  19
  20 =cut
  21
  22 package scripts::functions;
  23 use File::Basename qw/basename/;
  24 # Export all functions needed to be used by a simple
  25 # perl -Mscripts::functions -e '' script
  26 use Exporter;
  27 our @ISA = qw(Exporter);
  28
  29 our @EXPORT = qw(update_some_files create_many_files check_multiple_copies
  30                   update_client $HOST $BASEPORT add_to_backup_list
  31                   run_bconsole run_bacula start_test end_test create_bconcmds
  32                   create_many_dirs cleanup start_bacula
  33                   get_dirname
  34                   stop_bacula get_resource set_maximum_concurrent_jobs get_time
  35                   add_attribute check_prune_list check_min_volume_size
  36                   init_delta update_delta check_max_backup_size comment_out
  37                   create_many_files_size $plugins debug p
  38                   check_max_volume_size $estat $bstat $rstat $zstat $cwd $bin
  39                   $scripts $conf $rscripts $tmp $working $dstat extract_resource
  40                   $db_name $db_user $db_password $src $tmpsrc $out $CLIENT docmd
  41                   set_global_maximum_concurrent_jobs check_volumes update_some_files_rep
  42                   remote_init remote_config remote_stop remote_diff remote_check
  43                   get_field_size get_field_ratio create_binfile );
  44
  45
  46 use File::Copy qw/copy/;
  47
  48 our ($cwd, $bin, $scripts, $conf, $rscripts, $tmp, $working, $estat, $dstat,
  49      $plugins, $bstat, $zstat, $rstat, $debug, $out, $TestName,
  50      $REMOTE_CLIENT, $REMOTE_ADDR, $REMOTE_FILE, $REMOTE_PORT, $REMOTE_PASSWORD,
  51      $REMOTE_STORE_ADDR, $REGRESS_DEBUG, $REMOTE_USER, $start_time, $end_time,
  52      $db_name, $db_user, $db_password, $src, $tmpsrc, $HOST, $BASEPORT, $CLIENT);
  53
  54 END {
  55     if ($estat || $rstat || $zstat || $bstat || $dstat) {
  56         exit 1;
  57     }
  58 }
  59
  60 BEGIN {
  61     # start by loading the ./config file
  62     my ($envar, $enval);
  63     if (! -f "./config") {
  64         die "Could not find ./config file\n";
  65     }
  66     # load the ./config file in a subshell doesn't allow to use "env" to display all variable
  67     open(IN, ". ./config; set |") or die "Could not run shell: $!\n";
  68     while ( my $l = <IN> ) {
  69         chomp ($l);
  70         if ($l =~ /^([\w\d]+)='?([^']+)'?/) {
  71             next if ($1 eq 'SHELLOPTS'); # is in read-only
  72             ($envar,$enval) = ($1, $2);
  73             $ENV{$envar} = $enval;
  74         }
  75     }
  76     close(IN);
  77     $cwd = `pwd`;
  78     chomp($cwd);
  79
  80     # set internal variable name and update environment variable
  81     $ENV{db_name}     = $db_name     = $ENV{db_name}     || 'regress';
  82     $ENV{db_user}     = $db_user     = $ENV{db_user}     || 'regress';
  83     $ENV{db_password} = $db_password = $ENV{db_password} || '';
  84
  85     $ENV{bin}      = $bin      =  $ENV{bin}      || "$cwd/bin";
  86     $ENV{tmp}      = $tmp      =  $ENV{tmp}      || "$cwd/tmp";
  87     $ENV{src}      = $src      =  $ENV{src}      || "$cwd/src";
  88     $ENV{conf}     = $conf     =  $ENV{conf}     || $bin;
  89     $ENV{scripts}  = $scripts  =  $ENV{scripts}  || $bin;
  90     $ENV{plugins}  = $plugins  =  $ENV{plugins}  || "$bin/plugins";
  91     $ENV{tmpsrc}   = $tmpsrc   =  $ENV{tmpsrc}   || "$cwd/tmp/build";
  92     $ENV{working}  = $working  =  $ENV{working}  || "$cwd/working";
  93     $ENV{rscripts} = $rscripts =  $ENV{rscripts} || "$cwd/scripts";
  94     $ENV{HOST}     = $HOST     =  $ENV{HOST}     || "localhost";
  95     $ENV{BASEPORT} = $BASEPORT =  $ENV{BASEPORT} || "8101";
  96     $ENV{REGRESS_DEBUG} = $debug         = $ENV{REGRESS_DEBUG} || 0;
  97     $ENV{REMOTE_CLIENT} = $REMOTE_CLIENT = $ENV{REMOTE_CLIENT} || 'remote-fd';
  98     $ENV{REMOTE_ADDR}   = $REMOTE_ADDR   = $ENV{REMOTE_ADDR}   || undef;
  99     $ENV{REMOTE_FILE}   = $REMOTE_FILE   = $ENV{REMOTE_FILE}   || "/tmp";
 100     $ENV{REMOTE_PORT}   = $REMOTE_PORT   = $ENV{REMOTE_PORT}   || 9102;
 101     $ENV{REMOTE_PASSWORD} = $REMOTE_PASSWORD = $ENV{REMOTE_PASSWORD} || "xxx";
 102     $ENV{REMOTE_STORE_ADDR}=$REMOTE_STORE_ADDR=$ENV{REMOTE_STORE_ADDR} || undef;
 103     $ENV{REMOTE_USER}   = $REMOTE_USER   = $ENV{REMOTE_USER}   || undef;
 104     $ENV{CLIENT}        = $CLIENT        = $ENV{CLIENT}        || "$HOST-fd";
 105     $ENV{LANG} = 'C';
 106     $out = ($debug) ? '@tee' : '@out';
 107
 108     $TestName = basename($0);
 109
 110     $dstat = $estat = $rstat = $bstat = $zstat = 0;
 111 }
 112
 113 # execute bconsole session
 114 sub run_bconsole
 115 {
 116     my $script = shift || "$tmp/bconcmds";
 117     return docmd("cat $script | $bin/bconsole -c $conf/bconsole.conf");
 118 }
 119
 120 # create a file-list for many tests using
 121 # <$cwd/tmp/file-list as fileset
 122 sub add_to_backup_list
 123 {
 124     open(FP, ">$tmp/file-list") or die "ERROR: Unable to open $tmp/file-list $@";
 125     foreach my $l (@_) {
 126         if ($l =~ /\n$/) {
 127             print FP $l;
 128         } else {
 129             print FP $l, "\n";
 130         }
 131     }
 132     close(FP);
 133 }
 134
 135 sub cleanup
 136 {
 137     system("$rscripts/cleanup");
 138     return $? == 0;
 139 }
 140
 141 sub start_test
 142 {
 143     $start_time = time();
 144     my $d = strftime('%R:%S', localtime($start_time));
 145     print "\n\n === Starting $TestName at $d ===\n";
 146 }
 147
 148 sub end_test
 149 {
 150     $end_time = time();
 151     my $t = strftime('%R:%S', localtime($end_time));
 152     my $d = strftime('%H:%M:%S', gmtime($end_time - $start_time));
 153
 154     if ( -f "$tmp/err.log") {
 155         system("cat $tmp/err.log");
 156     }
 157
 158     if ($estat != 0 || $zstat != 0 || $dstat != 0 || $bstat != 0 ) {
 159         print "
 160        !!!!! $TestName failed!!! $t $d !!!!!
 161          Status: estat=$estat zombie=$zstat backup=$bstat restore=$rstat diff=$dstat\n";
 162
 163         if ($bstat != 0 || $rstat != 0) {
 164             print "     !!! Bad termination status       !!!\n";
 165         } else {
 166             print "     !!! Restored files differ        !!!\n";
 167         }
 168         print "     Status: backup=$bstat restore=$rstat diff=$dstat\n";
 169         print "     Test owner of $ENV{SITE_NAME} is $ENV{EMAIL}\n";
 170     } else {
 171         print "\n\n    === Ending $TestName at $t ($d) ===\n\n";
 172     }
 173 }
 174
 175 # create a console command file, can handle a list
 176 sub create_bconcmds
 177 {
 178     open(FP, ">$tmp/bconcmds");
 179     map { print FP "$_\n"; } @_;
 180     close(FP);
 181 }
 182
 183 # run a command
 184 sub docmd
 185 {
 186     my $cmd = shift;
 187     system("sh -c '$cmd " . (($debug)?"":" >/dev/null") . "'");
 188     return $? == 0;
 189 }
 190
 191 sub start_bacula
 192 {
 193     my $ret;
 194     $ret = docmd("$bin/bacula start");
 195
 196     # cleanup bweb stuff
 197     create_bconcmds('@out /dev/null',
 198                     'sql',
 199                     'truncate client_group;',
 200                     'truncate client_group_member;',
 201                     'update Media set LocationId=0;',
 202                     'truncate location;',
 203                     '');
 204     run_bconsole();
 205     return $ret;
 206 }
 207
 208 sub stop_bacula
 209 {
 210     return docmd("$bin/bacula stop");
 211 }
 212
 213 sub get_dirname
 214 {
 215     my $ret = `$bin/bdirjson -c $conf/bacula-dir.conf -l Name -r Director`;
 216     if ($ret =~ /"Name": "(.+?)"/) {
 217         print "$1\n";
 218     }
 219 }
 220
 221 sub get_resource
 222 {
 223     my ($file, $type, $name) = @_;
 224     my $ret;
 225     open(FP, $file) or die "Can't open $file";
 226     my $content = join("", <FP>);
 227
 228     if ($content =~ m/(^$type \{[^}]+?Name\s*=\s*"?$name"?[^}]+?^\})/ms) {
 229         $ret = $1;
 230     }
 231
 232     close(FP);
 233     return $ret;
 234 }
 235
 236 sub extract_resource
 237 {
 238     my $ret = get_resource(@_);
 239     if ($ret) {
 240         print $ret, "\n";
 241     }
 242 }
 243
 244 sub get_field_size
 245 {
 246     my ($file, $field) = @_;
 247     my $size=0;
 248
 249     my $pattern=$field."\\s*([\\d,]+)";
 250     open(FP, $file) or die "ERROR: Can't open $file";
 251
 252     while (<FP>) {
 253         if (/$pattern/) {
 254             $size=$1;
 255         }
 256     }
 257
 258     close(FP);
 259
 260     $size =~ s/,//g;
 261
 262     print $size."\n";
 263 }
 264
 265 sub get_field_ratio
 266 {
 267     my ($file, $field) = @_;
 268     my $ret=0;
 269     my $ratio=0;
 270
 271     my $pattern=$field."\\s*[\\d.]+%\\s+([\\d]+)\.[\\d]*:1"; # stop at the '.'
 272     my $pattern2=$field."\\s*None";
 273     open(FP, $file) or die "ERROR: Can't open $file";
 274
 275     while (<FP>) {
 276         if (/$pattern/) {
 277             $ratio=$1;
 278         }
 279         if (/$pattern2/) {
 280             $ratio="None";
 281         }
 282     }
 283
 284     close(FP);
 285
 286     $ratio =~ s/,//g;
 287
 288     print $ratio."\n";
 289 }
 290
 291
 292
 293 sub check_max_backup_size
 294 {
 295     my ($file, $size) = @_;
 296     my $ret=0;
 297     my $s=0;
 298
 299     open(FP, $file) or die "ERROR: Can't open $file";
 300
 301     while (<FP>) {
 302
 303         if (/FD Bytes Written: +([\d,]+)/) {
 304             $s=$1;
 305         }
 306     }
 307
 308     close(FP);
 309
 310     $size =~ s/,//g;
 311
 312     if ($s > $size) {
 313         print "ERROR: backup too big ($s > $size)\n";
 314         $ret++;
 315     } else {
 316         print "OK\n";
 317     }
 318     return $ret;
 319 }
 320
 321 sub check_min_volume_size
 322 {
 323     my ($size, @vol) = @_;
 324     my $ret=0;
 325
 326     foreach my $v (@vol) {
 327         if (! -f "$tmp/$v") {
 328             print "ERR: $tmp/$v not accessible\n";
 329             $ret++;
 330             next;
 331         }
 332         if (-s "$tmp/$v" < $size) {
 333             print "ERR: $tmp/$v too small\n";
 334             $ret++;
 335         }
 336     }
 337     $estat+=$ret;
 338     return $ret;
 339 }
 340
 341 # check_volumes("tmp/log1.out", "tmp/log2.out", ...)
 342 sub check_volumes
 343 {
 344     my @files = @_;
 345     my %done;
 346     unlink("$tmp/check_volumes.out");
 347
 348     foreach my $f (@files) {
 349         open(FP, $f) or next;
 350         while (my $f = <FP>)
 351         {
 352             if ($f =~ /Wrote label to prelabeled Volume "(.+?)" on file device "(.+?)" \((.+?)\)/) {
 353                 if (!$done{$1}) {
 354                     $done{$1} = 1;
 355                     if (-f "$3/$1") {
 356                         system("$bin/bls -c $conf/bacula-sd.conf -j -E -V \"$1\" \"$2\" &>> $tmp/check_volumes.out");
 357                         if ($? != 0) {
 358                             debug("Found problems for $1, traces are in $tmp/check_volumes.out");
 359                             $estat = 1;
 360                         }
 361                     }
 362                 }
 363             }
 364         }
 365         close(FP);
 366     }
 367     return $estat;
 368 }
 369
 370 # check if a volume is too big
 371 # check_max_backup_size(10000, "vol1", "vol3");
 372 sub check_max_volume_size
 373 {
 374     my ($size, @vol) = @_;
 375     my $ret=0;
 376
 377     foreach my $v (@vol) {
 378         if (! -f "$tmp/$v") {
 379             print "ERR: $tmp/$v not accessible\n";
 380             $ret++;
 381             next;
 382         }
 383         if (-s "$tmp/$v" > $size) {
 384             print "ERR: $tmp/$v too big\n";
 385             $ret++;
 386         }
 387     }
 388     $estat+=$ret;
 389     return $ret;
 390 }
 391
 392 # update client definition for the current test
 393 # it permits to test remote client
 394 sub update_client
 395 {
 396     my ($new_passwd, $new_address, $new_port) = @_;
 397     my $in_client=0;
 398
 399     open(FP, "$conf/bacula-dir.conf") or die "can't open source $!";
 400     open(NEW, ">$tmp/bacula-dir.conf.$$") or die "can't open dest $!";
 401     while (my $l = <FP>) {
 402         if (!$in_client && $l =~ /^Client \{/) {
 403             $in_client=1;
 404         }
 405
 406         if ($in_client && $l =~ /Address/i) {
 407             $l = "Address = $new_address\n";
 408         }
 409
 410         if ($in_client && $l =~ /FDPort/i) {
 411             $l = "FDPort = $new_port\n";
 412         }
 413
 414         if ($in_client && $l =~ /Password/i) {
 415             $l = "Password = \"$new_passwd\"\n";
 416         }
 417
 418         if ($in_client && $l =~ /^\}/) {
 419             $in_client=0;
 420         }
 421         print NEW $l;
 422     }
 423     close(FP);
 424     close(NEW);
 425     my $ret = copy("$tmp/bacula-dir.conf.$$", "$conf/bacula-dir.conf");
 426     unlink("$tmp/bacula-dir.conf.$$");
 427     return $ret;
 428 }
 429
 430 # if you want to run this function more than 100 times, please, update this number
 431 my $last_update = 100;
 432
 433 # open a directory and update all files
 434 sub update_some_files_rep
 435 {
 436     my ($dest, $nbupdate)=@_;
 437     my $t=rand();
 438     my $f;
 439     my $nb=0;
 440     my $nbdel=0;
 441     my $total=0;
 442
 443     if ($nbupdate) {
 444         $last_update = $nbupdate;
 445         unlink("$tmp/last_update");
 446
 447     } elsif (-f "$tmp/last_update") {
 448         $last_update = `cat $tmp/last_update`;
 449         chomp($last_update);
 450         $last_update--;
 451         if ($last_update == 0) {
 452             $last_update = 100;
 453         }
 454     }
 455     my $base = chr($last_update % 26 + 65); # We use a base directory A-Z
 456
 457     system("sh -c 'echo $last_update > $tmp/last_update'");
 458     print "Update files in $dest\n";
 459     opendir(DIR, "$dest/$base") || die "$!";
 460     map {
 461         $f = "$dest/$base/$_";
 462         if (($total++ % $last_update) == 0) {
 463             if (-f $f) {
 464                 # We delete some of them, and we replace them later
 465                 if ((($nb + $nbdel) % 11) == 0) {
 466                     unlink($f);
 467                     $nbdel++;
 468
 469                     open(FP, ">$dest/$base/$last_update-$nbdel.txt") or die "$f $!";
 470                     seek(FP, $last_update * 4000, 0);
 471                     print FP "$t update $f\n";
 472                     close(FP);
 473
 474                 } else {
 475                     open(FP, ">>$f") or die "$f $!";
 476                     print FP "$t update $f\n";
 477                     close(FP);
 478                     $nb++;
 479                 }
 480             }
 481         }
 482     } sort readdir(DIR);
 483     closedir DIR;
 484     print "$nb files updated, $nbdel deleted/created\n";
 485 }
 486
 487 # open a directory and update all files
 488 sub update_some_files
 489 {
 490     my ($dest)=@_;
 491     my $t=rand();
 492     my $f;
 493     my $nb=0;
 494     print "Update files in $dest\n";
 495     opendir(DIR, $dest) || die "$!";
 496     map {
 497         $f = "$dest/$_";
 498         if (-f $f) {
 499             open(FP, ">$f") or die "$f $!";
 500             print FP "$t update $f\n";
 501             close(FP);
 502             $nb++;
 503         }
 504     } readdir(DIR);
 505     closedir DIR;
 506     print "$nb files updated\n";
 507 }
 508
 509 # create big number of files in a given directory
 510 # Inputs: dest  destination directory
 511 #         nb    number of file to create
 512 # Example:
 513 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
 514 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000, 32000)'
 515 sub create_many_files
 516 {
 517     my ($dest, $nb, $sparse_size) = @_;
 518     my $base;
 519     my $dir=$dest;
 520     $nb = $nb / 2;              # We create 2 files per loop
 521     $nb = $nb || 750000;
 522     $sparse_size = $sparse_size | 0;
 523     mkdir $dest;
 524     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 525
 526     # already done
 527     if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
 528         debug("Files already created\n");
 529         return;
 530     }
 531
 532     # auto flush stdout for dots
 533     $| = 1;
 534     print "Create ", $nb * 2, " files into $dest\n";
 535     for(my $i=0; $i < 26; $i++) {
 536         $base = chr($i + 65);
 537         mkdir("$dest/$base") if (! -d "$dest/$base");
 538     }
 539     for(my $i=0; $i<=$nb; $i++) {
 540         $base = chr($i % 26 + 65);
 541         open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
 542         if ($sparse_size) {
 543             seek(FP, $sparse_size + $i, 0);
 544         }
 545         print FP "$i\n";
 546         close(FP);
 547
 548         open(FP, ">>$dir/b${base}a${i}csq$base") or die "$dir $!";
 549         print FP "$base $i\n";
 550         close(FP);
 551
 552         if (!($i % 100)) {
 553             $dir = "$dest/$base/$base$i$base";
 554             mkdir $dir;
 555         }
 556         print "." if (!($i % 10000));
 557     }
 558     print "\n";
 559 }
 560
 561 # BEEF
 562 # create big number of files in a given directory
 563 # Inputs: dest  destination directory
 564 #         nb    number of file to create
 565 # Example:
 566 # perl -Mscripts::functions -e 'create_many_files_size("$cwd/files", 100000)'
 567 sub create_many_files_size
 568 {
 569     my ($dest, $nb) = @_;
 570     my $base;
 571     my $dir=$dest;
 572     $nb = $nb || 750000;
 573     mkdir $dest;
 574     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 575
 576     # already done
 577     if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
 578         debug("Files already created\n");
 579         return;
 580     }
 581
 582     # auto flush stdout for dots
 583     $| = 1;
 584     print "Create $nb files into $dest\n";
 585     for(my $i=0; $i < 26; $i++) {
 586         $base = chr($i + 65);
 587         mkdir("$dest/$base") if (! -d "$dest/$base");
 588     }
 589     for(my $i=0; $i<=$nb; $i++) {
 590         $base = chr($i % 26 + 65);
 591         open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
 592         print FP "$base" x $i;
 593         close(FP);
 594
 595         print "." if (!($i % 10000));
 596     }
 597     print "\n";
 598 }
 599
 600 # create big number of dirs in a given directory
 601 # Inputs: dest  destination directory
 602 #         nb    number of dirs to create
 603 # Example:
 604 # perl -Mscripts::functions -e 'create_many_dirs("$cwd/files", 100000)'
 605 sub create_many_dirs
 606 {
 607     my ($dest, $nb) = @_;
 608     my ($base, $base2);
 609     my $dir=$dest;
 610     $nb = $nb || 750000;
 611     mkdir $dest;
 612     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 613     $base2 = chr(($nb+10) % 26 + 65);
 614     # already done
 615     if (-d "$dest/$base/$base2/$base/a${base}a${nb}aaa${base}") {
 616         debug("Files already created\n");
 617         return;
 618     }
 619
 620     # auto flush stdout for dots
 621     $| = 1;
 622     print "Create $nb dirs into $dest\n";
 623     for(my $i=0; $i < 26; $i++) {
 624         $base = chr($i + 65);
 625         $base2 = chr(($i+10) % 26 + 65);
 626         mkdir("$dest/$base");
 627         mkdir("$dest/$base/$base2");
 628         mkdir("$dest/$base/$base2/$base$base2");
 629         mkdir("$dest/$base/$base2/$base$base2/$base$base2");
 630         mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base");
 631     }
 632     for(my $i=0; $i<=$nb; $i++) {
 633         $base = chr($i % 26 + 65);
 634         $base2 = chr(($i+10) % 26 + 65);
 635         mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base/a${base}a${i}aaa$base");
 636         print "." if (!($i % 10000));
 637     }
 638     print "\n";
 639 }
 640
 641 sub check_encoding
 642 {
 643     if (grep {/Wanted SQL_ASCII, got UTF8/}
 644         `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
 645     {
 646         print "Found database encoding problem, please modify the ",
 647               "database encoding (SQL_ASCII)\n";
 648         exit 1;
 649     }
 650 }
 651
 652 sub set_global_maximum_concurrent_jobs
 653 {
 654     my ($nb) = @_;
 655     add_attribute("$conf/bacula-dir.conf", "MaximumConcurrentJobs", $nb, "Job");
 656     add_attribute("$conf/bacula-dir.conf", "MaximumConcurrentJobs", $nb, "Client");
 657     add_attribute("$conf/bacula-dir.conf", "MaximumConcurrentJobs", $nb, "Director");
 658     add_attribute("$conf/bacula-dir.conf", "MaximumConcurrentJobs", $nb, "Storage");
 659     add_attribute("$conf/bacula-sd.conf", "MaximumConcurrentJobs", $nb, "Storage");
 660     add_attribute("$conf/bacula-sd.conf", "MaximumConcurrentJobs", $nb, "Device");
 661     add_attribute("$conf/bacula-fd.conf", "MaximumConcurrentJobs", $nb, "FileDaemon");
 662 }
 663
 664 # You can change the maximum concurrent jobs for any config file
 665 # If specified, you can change only one Resource or one type of
 666 # resource at the time (optional)
 667 #  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100);
 668 #  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Director');
 669 #  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Device', 'Drive-0');
 670 sub set_maximum_concurrent_jobs
 671 {
 672     my ($file, $nb, $obj, $name) = @_;
 673
 674     die "Can't get new maximumconcurrentjobs"
 675         unless ($nb);
 676
 677     add_attribute($file, "Maximum Concurrent Jobs", $nb, $obj, $name);
 678 }
 679
 680 # You can comment out a directive
 681 #  comment_out('$conf/bacula-dir.conf', 'FDTimeout', 'Job', 'test');
 682 #  comment_out('$conf/bacula-dir.conf', 'FDTimeout');
 683 sub comment_out
 684 {
 685     my ($file, $attr, $obj, $name) = @_;
 686     my ($cur_obj, $cur_name, $done);
 687
 688     open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
 689     open(SRC, $file) or die "Can't open $file";
 690     while (my $l = <SRC>)
 691     {
 692         if ($l =~ /^#/) {
 693             print FP $l;
 694             next;
 695         }
 696
 697         if ($l =~ /^(\w+) \{/) {
 698             $cur_obj = $1;
 699             $done=0;
 700         }
 701
 702         if ($l =~ /^\s*\Q$attr\E/i) {
 703             if (!$obj || $cur_obj eq $obj) {
 704                 if (!$name || $cur_name eq $name) {
 705                     $l =~ s/^/##/;
 706                     $done=1
 707                 }
 708             }
 709         }
 710
 711         if ($l =~ /^\s*Name\s*=\s*"?([\w\d\.-]+)"?/i) {
 712             $cur_name = $1;
 713         }
 714         print FP $l;
 715     }
 716     close(SRC);
 717     close(FP);
 718     copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
 719 }
 720
 721 # You can add option to a resource
 722 #  add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Director');
 723 #  add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Storage', 'FileStorage');
 724 sub add_attribute
 725 {
 726     my ($file, $attr, $value, $obj, $name) = @_;
 727     my ($cur_obj, $cur_name, $done);
 728
 729     my $is_options = $obj && $obj eq 'Options';
 730     open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
 731     open(SRC, $file) or die "Can't open $file";
 732     while (my $l = <SRC>)
 733     {
 734         if ($l =~ /^#/) {
 735             print FP $l;
 736             next;
 737         }
 738
 739         if ($l =~ /^(\w+) \{/  || ($is_options && $l =~ /\s+(Options)\s*\{/)) {
 740             $cur_obj = $1;
 741             $done=0;
 742         }
 743
 744         if ($l =~ /^\s*\Q$attr\E/i) {
 745             if (!$obj || $cur_obj eq $obj) {
 746                 if (!$name || $cur_name eq $name) {
 747                     $l =~ s/\Q$attr\E\s*=\s*.+/$attr = $value/ig;
 748                     $done=1
 749                 }
 750             }
 751         }
 752
 753         if ($l =~ /^\s*Name\s*=\s*"?([\w\d\.-]+)"?/i) {
 754             $cur_name = $1;
 755         }
 756
 757         my $add_missing = 0;
 758         if ($is_options) {
 759             if ($l =~ /\}/) {
 760                 $add_missing = 1;
 761             }
 762         } elsif ($l =~ /^\}/) {
 763             $add_missing = 1;
 764         }
 765
 766         if ($add_missing) {
 767             if (!$done) {
 768                 if ($cur_obj && $cur_obj eq $obj) {
 769                     if (!$name || $cur_name eq $name) {
 770                         $l =~ s/\}/\n  $attr = $value\n\}/;
 771                     }
 772                 }
 773             }
 774             $cur_name = $cur_obj = undef;
 775         }
 776         print FP $l;
 777     }
 778     close(SRC);
 779     close(FP);
 780     copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
 781 }
 782
 783 # This test the list jobs output to check differences
 784 # Input: read file argument
 785 #        check if all jobids in argument are present in the first
 786 #        'list jobs' and not present in the second
 787 # Output: exit(1) if something goes wrong and print error
 788 sub check_prune_list
 789 {
 790     my $f = shift;
 791     my %to_check = map { $_ => 1} @_;
 792     my %seen;
 793     my $in_list_jobs=0;
 794     my $nb_list_job=0;
 795     my $nb = scalar(@_);
 796     open(FP, $f) or die "Can't open $f $!";
 797     while (my $l = <FP>)          # read all files to check
 798     {
 799         if ($l =~ /list jobs/) {
 800             $in_list_jobs=1;
 801             $nb_list_job++;
 802
 803             if ($nb_list_job == 2) {
 804                 foreach my $jobid (keys %to_check) {
 805                     if (!$seen{$jobid}) {
 806                         print "ERROR: in $f, can't find JobId=$jobid in first 'list jobs'\n";
 807                         exit 1;
 808                     }
 809                 }
 810             }
 811             next;
 812         }
 813         if ($nb_list_job == 0) {
 814             next;
 815         }
 816         if ($l =~ /Pruned (\d+) Job for client/) {
 817             if ($1 != $nb) {
 818                 print "ERROR: in $f, Prune command returns $1 jobs, want $nb\n";
 819                 exit 1;
 820             }
 821         }
 822
 823         if ($l =~ /No Jobs found to prune/) {
 824            if ($nb != 0) {
 825                 print "ERROR: in $f, Prune command returns 0 job, want $nb\n";
 826                 exit 1;
 827             }
 828         }
 829
 830         # list jobs ouput:
 831         # | 1 | NightlySave | 2010-06-16 22:43:05 | B | F | 27 | 4173577 | T |
 832         if ($l =~ /^\|\s+(\d+)/) {
 833             if ($nb_list_job == 1) {
 834                 $seen{$1}=1;
 835             } else {
 836                 delete $seen{$1};
 837             }
 838         }
 839     }
 840     close(FP);
 841     foreach my $jobid (keys %to_check) {
 842         if (!$seen{$jobid}) {
 843             print "******** listing of $f *********\n";
 844             system("cat $f");
 845             print "******** end listing of $f *********\n";
 846             print "ERROR: in $f, JobId=$jobid should not be, but is still present in the 2nd 'list jobs'\n";
 847             exit 1;
 848         }
 849     }
 850     if ($nb_list_job != 2) {
 851         print "ERROR: in $f, not enough 'list jobs'\n";
 852         exit 1;
 853     }
 854     exit 0;
 855 }
 856
 857 # This test ensure that 'list copies' displays only each copy one time
 858 #
 859 # Input: read stream from stdin or with file list argument
 860 #        check the number of copies with the ARGV[1]
 861 # Output: exit(1) if something goes wrong and print error
 862 sub check_multiple_copies
 863 {
 864     my ($nb_to_found) = @_;
 865
 866     my $in_list_copies=0;       # are we or not in a list copies block
 867     my $nb_found=0;             # count the number of copies found
 868     my $ret = 0;
 869     my %seen;
 870
 871     while (my $l = <>)          # read all files to check
 872     {
 873         if ($l =~ /list copies/) {
 874             $in_list_copies=1;
 875             %seen = ();
 876             next;
 877         }
 878
 879         # not in a list copies anymore
 880         if ($in_list_copies && $l =~ /^ /) {
 881             $in_list_copies=0;
 882             next;
 883         }
 884
 885         # list copies ouput:
 886         # |     3 | Backup.2009-09-28 |  9 | DiskChangerMedia |
 887         if ($in_list_copies && $l =~ /^\|\s+\d+/) {
 888             my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
 889             if (exists $seen{$jobid}) {
 890                 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
 891                 $ret = 1;
 892             } else {
 893                 $seen{$jobid}=$copyid;
 894                 $nb_found++;
 895             }
 896         }
 897     }
 898
 899     # test the number of copies against the given arg
 900     if ($nb_to_found && ($nb_to_found != $nb_found)) {
 901         print "ERROR: Found wrong number of copies ",
 902               "($nb_to_found != $nb_found)\n";
 903         exit 1;
 904     }
 905
 906     exit $ret;
 907 }
 908
 909 use POSIX qw/strftime/;
 910 sub get_time
 911 {
 912     my ($sec) = @_;
 913     print strftime('%F %T', localtime(time+$sec)), "\n";
 914 }
 915
 916 sub debug
 917 {
 918     if ($debug) {
 919         print join("\n", @_), "\n";
 920     }
 921 }
 922
 923 sub p
 924 {
 925     debug("\n################################################################",
 926           @_,
 927           "################################################################\n");
 928 }
 929
 930 # check if binaries are OK
 931 sub remote_check
 932 {
 933     my $ret = 0;
 934     my $path = "/opt/bacula/bin";
 935     print "INFO: check binaries\n";
 936     foreach my $b (qw/bacula-fd bacula-dir bconsole bdirjson bsdjson
 937                       bfdjson bbconsjson bacula-sd/)
 938     {
 939         if (-x "$path/$b") {
 940             my $out = `$path/$b -? 2>&1`;
 941             if ($out !~ /Version:/g) {
 942                 print "ERROR: with $b -?\n";
 943                 system("$path/$b -?");
 944                 $ret++;
 945             }
 946         }
 947     }
 948     foreach my $b (qw/bacula-sd/)
 949     {
 950         if (-r "$path/$b") {
 951             my $libs = `ldd $path/$b`;
 952             if ($libs !~ /tokyocabinet/g) {
 953                 print "ERROR: unable to find tokyocabinet for $b\n";
 954                 print $libs;
 955                 $ret++;
 956             }
 957         }
 958     }
 959
 960     return $ret;
 961 }
 962
 963 sub remote_config
 964 {
 965     open(FP, ">$REMOTE_FILE/bacula-fd.conf") or
 966         die "ERROR: Can't open $REMOTE_FILE/bacula-fd.conf $!";
 967
 968     my $plugins = '/opt/bacula/bin';
 969     if (-d '/opt/bacula/plugins') {
 970         $plugins = '/opt/bacula/plugins';
 971     }
 972
 973     print FP "
 974 Director {
 975   Name = $HOST-dir
 976   Password = \"$REMOTE_PASSWORD\"
 977 }
 978 FileDaemon {
 979   Name = remote-fd
 980   FDport = $REMOTE_PORT
 981   WorkingDirectory = $REMOTE_FILE/working
 982   Pid Directory = $REMOTE_FILE/working
 983   Plugin Directory = $plugins
 984   Maximum Concurrent Jobs = 20
 985 }
 986 Messages {
 987   Name = Standard
 988   director = $HOST-dir = all, !skipped, !restored
 989 }
 990 ";
 991     close(FP);
 992     system("mkdir -p '$REMOTE_FILE/working' '$REMOTE_FILE/save'");
 993     system("rm -rf '$REMOTE_FILE/restore'");
 994     my $pid = fork();
 995     if (!$pid) {
 996         close(STDIN);  open(STDIN, "/dev/null");
 997         close(STDOUT); open(STDOUT, ">/dev/null");
 998         close(STDERR); open(STDERR, ">/dev/null");
 999         exec("/opt/bacula/bin/bacula-fd -c $REMOTE_FILE/bacula-fd.conf");
1000         exit 1;
1001     }
1002     sleep(2);
1003     $pid = `cat $REMOTE_FILE/working/bacula-fd.$REMOTE_PORT.pid`;
1004     chomp($pid);
1005
1006     # create files and tweak rights
1007     create_many_files("$REMOTE_FILE/save", 5000);
1008     chdir("$REMOTE_FILE/save");
1009     my $d = 'A';
1010     my $r = 0700;
1011     for my $g ( split(' ', $( )) {
1012         chmod $r++, $d;
1013         chown $<, $g, $d++;
1014     }
1015
1016     # create a sparse file of 2MB
1017     init_delta("$REMOTE_FILE/save", 2000000);
1018
1019     # create a simple script to execute
1020     open(FP, ">test.sh") or die "Can't open test.sh $!";
1021     print FP "#!/bin/sh\n";
1022     print FP "echo this is a script";
1023     close(FP);
1024     chmod 0755, "test.sh";
1025
1026     # create a hardlink
1027     link("test.sh", "link-test.sh");
1028
1029     # create long filename
1030     mkdir("b" x 255) or print "can't create long dir $!\n";
1031     copy("test.sh", ("b" x 255) . '/' . ("a" x 255)) or print "can't create long dir $!\n";
1032
1033     # play with some symlinks
1034     symlink("test.sh", "sym-test.sh");
1035     symlink("$REMOTE_FILE/save/test.sh", "sym-abs-test.sh");
1036
1037     if ($pid) {
1038         system("ps $pid");
1039         $estat = ($? != 0);
1040     } else {
1041         $estat = 1;
1042     }
1043 }
1044
1045 sub remote_diff
1046 {
1047     debug("Doing diff between save and restore");
1048     system("ssh $REMOTE_USER$REMOTE_ADDR " .
1049      "$REMOTE_FILE/scripts/diff.pl -s $REMOTE_FILE/save -d $REMOTE_FILE/restore/$REMOTE_FILE/save");
1050     $dstat = ($? != 0);
1051 }
1052
1053 sub remote_stop
1054 {
1055     debug("Kill remote bacula-fd $REMOTE_ADDR");
1056     system("ssh $REMOTE_USER$REMOTE_ADDR " .
1057              "'test -f $REMOTE_FILE/working/bacula-fd.$REMOTE_PORT.pid && " .
1058               "kill `cat $REMOTE_FILE/working/bacula-fd.$REMOTE_PORT.pid`'");
1059 }
1060
1061 sub remote_init
1062 {
1063     system("ssh $REMOTE_USER$REMOTE_ADDR mkdir -p '$REMOTE_FILE/scripts/'");
1064     system("scp -q scripts/functions.pm scripts/diff.pl $REMOTE_USER$REMOTE_ADDR:$REMOTE_FILE/scripts/");
1065     system("scp -q config $REMOTE_USER$REMOTE_ADDR:$REMOTE_FILE/");
1066     debug("INFO: Configuring remote client");
1067     system("ssh $REMOTE_USER$REMOTE_ADDR 'cd $REMOTE_FILE && perl -Mscripts::functions -e remote_config'");
1068     system("ssh $REMOTE_USER$REMOTE_ADDR 'cd $REMOTE_FILE && perl -Mscripts::functions -e remote_check'");
1069 }
1070
1071 sub create_binfile
1072 {
1073     my ($file, $nb) = @_;
1074     $nb |= 10;
1075
1076     if (!open(FP, ">$file")) {
1077         print "ERR\nCan't create txt $file $@\n";
1078         exit 1;
1079     }
1080     for (my $i = 0; $i < $nb ; $i++) {
1081         foreach my $c ('a'..'z') {
1082             my $l = ($c x 1024);
1083             print FP $l;
1084         }
1085     }
1086     close(FP);
1087 }
1088
1089 my $c = "a";
1090
1091 sub init_delta
1092 {
1093     my ($source, $sparse_size) = @_;
1094
1095     $sparse_size = $sparse_size || 100000000;
1096
1097     # Create $source if needed
1098     system("mkdir -p '$source'");
1099
1100     if (!chdir($source)) {
1101         print "ERR\nCan't access to $source $!\n";
1102         exit 1;
1103     }
1104
1105     open(FP, ">text.txt") or return "ERR\nCan't create txt file $@\n";
1106     my $l = ($c x 80) . "\n";
1107     print FP $l x 40000;
1108     close(FP);
1109
1110     open(FP, ">prev");
1111     print FP $c, "\n";
1112     close(FP);
1113
1114     open(FP, ">sparse.dat") or return "ERR\nCan't create sparse $@\n";
1115     seek(FP, $sparse_size, 0);
1116     print FP $l;
1117     close(FP);
1118 }
1119
1120 sub update_delta
1121 {
1122     my ($source) = shift;
1123
1124     if (!chdir($source)) {
1125         return "ERR\nCan't access to $source $!\n";
1126     }
1127
1128     $c = `cat prev`;
1129     chomp($c);
1130
1131     open(FP, "+<sparse.dat") or return "ERR\nCan't update the sparse file $@\n";
1132     seek(FP, int(rand(-s "sparse.dat")), 0);
1133     print FP $c x 400;
1134     seek(FP, 0, 2);
1135     print FP $c x 4000;
1136     close(FP);
1137
1138
1139     open(FP, ">>text.txt") or return "ERR\nCan't update txt file $@\n";
1140     $c++;
1141     my $l = ($c x 80) . "\n";
1142     print FP $l x 40000;
1143     close(FP);
1144
1145     open(FP, ">prev");
1146     print FP $c, "\n";
1147     close(FP);
1148
1149     return "OK\n";
1150 }
1151
1152 1;