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

   1 ################################################################
   2 use strict;
   3
   4 =head1 LICENSE
   5
   6    Bacula(R) - The Network Backup Solution
   7
   8    Copyright (C) 2000-2017 Kern Sibbald
   9
  10    The original author of Bacula is Kern Sibbald, with contributions
  11    from many others, a complete list can be found in the file AUTHORS.
  12
  13    You may use this file and others of this release according to the
  14    license defined in the LICENSE file, which includes the Affero General
  15    Public License, v3.0 ("AGPLv3") and some additional permissions and
  16    terms pursuant to its AGPLv3 Section 7.
  17
  18    This notice must be preserved when any source code is
  19    conveyed and/or propagated.
  20
  21    Bacula(R) is a registered trademark of Kern Sibbald.
  22
  23 =cut
  24
  25 package scripts::functions;
  26 use File::Basename qw/basename/;
  27 # Export all functions needed to be used by a simple
  28 # perl -Mscripts::functions -e '' script
  29 use Exporter;
  30 our @ISA = qw(Exporter);
  31
  32 our @EXPORT = qw(update_some_files create_many_files check_multiple_copies
  33                   update_client $HOST $BASEPORT add_to_backup_list
  34                   run_bconsole run_bacula start_test end_test create_bconcmds
  35                   create_many_dirs cleanup start_bacula
  36                   get_dirname check_jobmedia_content
  37                   stop_bacula get_resource set_maximum_concurrent_jobs get_time
  38                   add_attribute check_prune_list check_min_volume_size
  39                   init_delta update_delta check_max_backup_size comment_out
  40                   create_many_files_size check_jobmedia  $plugins debug p
  41                   check_max_volume_size $estat $bstat $rstat $zstat $cwd $bin
  42                   $scripts $conf $rscripts $tmp $working $dstat extract_resource
  43                   $db_name $db_user $db_password $src $tmpsrc $out $CLIENT docmd
  44                   set_global_maximum_concurrent_jobs check_volumes update_some_files_rep
  45                   remote_init remote_config remote_stop remote_diff remote_check
  46                   get_field_size get_field_ratio create_binfile get_bytes get_mbytes
  47                   check_parts);
  48
  49
  50 use File::Copy qw/copy/;
  51
  52 our ($cwd, $bin, $scripts, $conf, $rscripts, $tmp, $working, $estat, $dstat,
  53      $plugins, $bstat, $zstat, $rstat, $debug, $out, $TestName, $FORCE_ALIGNED,
  54      $PREBUILT, $FORCE_CLOUD,
  55      $REMOTE_CLIENT, $REMOTE_ADDR, $REMOTE_FILE, $REMOTE_PORT, $REMOTE_PASSWORD,
  56      $REMOTE_STORE_ADDR, $REGRESS_DEBUG, $REMOTE_USER, $start_time, $end_time,
  57      $db_name, $db_user, $db_password, $src, $tmpsrc, $HOST, $BASEPORT, $CLIENT);
  58
  59 END {
  60     if ($estat || $rstat || $zstat || $bstat || $dstat) {
  61         exit 1;
  62     }
  63 }
  64
  65 BEGIN {
  66     # start by loading the ./config file
  67     my ($envar, $enval);
  68     if (! -f "./config") {
  69         die "Could not find ./config file\n";
  70     }
  71     # load the ./config file in a subshell doesn't allow to use "env" to display all variable
  72     open(IN, ". ./config; set |") or die "Could not run shell: $!\n";
  73     while ( my $l = <IN> ) {
  74         chomp ($l);
  75         if ($l =~ /^([\w\d]+)='?([^']+)'?/) {
  76             next if ($1 eq 'SHELLOPTS'); # is in read-only
  77             ($envar,$enval) = ($1, $2);
  78             $ENV{$envar} = $enval;
  79         }
  80     }
  81     close(IN);
  82     $cwd = `pwd`;
  83     chomp($cwd);
  84
  85     # set internal variable name and update environment variable
  86     $ENV{db_name}     = $db_name     = $ENV{db_name}     || 'regress';
  87     $ENV{db_user}     = $db_user     = $ENV{db_user}     || 'regress';
  88     $ENV{db_password} = $db_password = $ENV{db_password} || '';
  89
  90     $ENV{bin}      = $bin      =  $ENV{bin}      || "$cwd/bin";
  91     $ENV{tmp}      = $tmp      =  $ENV{tmp}      || "$cwd/tmp";
  92     $ENV{src}      = $src      =  $ENV{src}      || "$cwd/src";
  93     $ENV{conf}     = $conf     =  $ENV{conf}     || $bin;
  94     $ENV{scripts}  = $scripts  =  $ENV{scripts}  || $bin;
  95     $ENV{plugins}  = $plugins  =  $ENV{plugins}  || "$bin/plugins";
  96     $ENV{tmpsrc}   = $tmpsrc   =  $ENV{tmpsrc}   || "$cwd/tmp/build";
  97     $ENV{working}  = $working  =  $ENV{working}  || "$cwd/working";
  98     $ENV{rscripts} = $rscripts =  $ENV{rscripts} || "$cwd/scripts";
  99     $ENV{HOST}     = $HOST     =  $ENV{HOST}     || "localhost";
 100     $ENV{BASEPORT} = $BASEPORT =  $ENV{BASEPORT} || "8101";
 101     $ENV{REGRESS_DEBUG} = $debug         = $ENV{REGRESS_DEBUG} || 0;
 102     $ENV{REMOTE_CLIENT} = $REMOTE_CLIENT = $ENV{REMOTE_CLIENT} || 'remote-fd';
 103     $ENV{REMOTE_ADDR}   = $REMOTE_ADDR   = $ENV{REMOTE_ADDR}   || undef;
 104     $ENV{REMOTE_FILE}   = $REMOTE_FILE   = $ENV{REMOTE_FILE}   || "/tmp";
 105     $ENV{REMOTE_PORT}   = $REMOTE_PORT   = $ENV{REMOTE_PORT}   || 9102;
 106     $ENV{REMOTE_PASSWORD} = $REMOTE_PASSWORD = $ENV{REMOTE_PASSWORD} || "xxx";
 107     $ENV{REMOTE_STORE_ADDR}=$REMOTE_STORE_ADDR=$ENV{REMOTE_STORE_ADDR} || undef;
 108     $ENV{REMOTE_USER}   = $REMOTE_USER   = $ENV{REMOTE_USER}   || undef;
 109     $ENV{FORCE_ALIGNED} = $FORCE_ALIGNED = $ENV{FORCE_ALIGNED} || 'no';
 110     $ENV{FORCE_CLOUD}   = $FORCE_CLOUD = $ENV{FORCE_CLOUD} || 'no';
 111     $ENV{PREBUILT}      = $PREBUILT = $ENV{PREBUILT} || 'no';
 112     $ENV{CLIENT}        = $CLIENT        = $ENV{CLIENT}        || "$HOST-fd";
 113     $ENV{LANG} = 'C';
 114     $out = ($debug) ? '@tee' : '@out';
 115
 116     $TestName = basename($0);
 117
 118     $dstat = $estat = $rstat = $bstat = $zstat = 0;
 119 }
 120
 121 # execute bconsole session
 122 sub run_bconsole
 123 {
 124     my $script = shift || "$tmp/bconcmds";
 125     return docmd("cat $script | $bin/bconsole -c $conf/bconsole.conf");
 126 }
 127
 128 # create a file-list for many tests using
 129 # <$cwd/tmp/file-list as fileset
 130 sub add_to_backup_list
 131 {
 132     open(FP, ">$tmp/file-list") or die "ERROR: Unable to open $tmp/file-list $@";
 133     foreach my $l (@_) {
 134         if ($l =~ /\n$/) {
 135             print FP $l;
 136         } else {
 137             print FP $l, "\n";
 138         }
 139     }
 140     close(FP);
 141 }
 142
 143 sub cleanup
 144 {
 145     system("$rscripts/cleanup");
 146     return $? == 0;
 147 }
 148
 149 sub start_test
 150 {
 151     if ($FORCE_ALIGNED eq "yes") {
 152         if ($PREBUILT ne "yes") {
 153            system("make -C $cwd/build/src/plugins/sd install-aligned-plugin > /dev/null");
 154         }
 155         add_attribute("$conf/bacula-sd.conf", "Device Type", "Aligned", "Device");
 156         add_attribute("$conf/bacula-sd.conf", "Plugin Directory", "$plugins", "Storage");
 157     }
 158     if ($FORCE_CLOUD eq "yes") {
 159         add_attribute("$conf/bacula-sd.conf", "Device Type", "Cloud", "Device");
 160     }
 161
 162     $start_time = time();
 163     my $d = strftime('%R:%S', localtime($start_time));
 164     print "\n\n === Starting $TestName at $d ===\n";
 165 }
 166
 167 sub end_test
 168 {
 169     $end_time = time();
 170     my $t = strftime('%R:%S', localtime($end_time));
 171     my $d = strftime('%H:%M:%S', gmtime($end_time - $start_time));
 172
 173     if ( -f "$tmp/err.log") {
 174         system("cat $tmp/err.log");
 175     }
 176
 177     if ($estat != 0 || $zstat != 0 || $dstat != 0 || $bstat != 0 ) {
 178         print "
 179        !!!!! $TestName failed!!! $t $d !!!!!
 180          Status: estat=$estat zombie=$zstat backup=$bstat restore=$rstat diff=$dstat\n";
 181
 182         if ($bstat != 0 || $rstat != 0) {
 183             print "     !!! Bad termination status       !!!\n";
 184         } else {
 185             print "     !!! Restored files differ        !!!\n";
 186         }
 187         print "     Status: backup=$bstat restore=$rstat diff=$dstat\n";
 188         print "     Test owner of $ENV{SITE_NAME} is $ENV{EMAIL}\n";
 189     } else {
 190         print "\n\n    === Ending $TestName at $t ($d) ===\n\n";
 191     }
 192 }
 193
 194 # create a console command file, can handle a list
 195 sub create_bconcmds
 196 {
 197     open(FP, ">$tmp/bconcmds");
 198     map { print FP "$_\n"; } @_;
 199     close(FP);
 200 }
 201
 202 # run a command
 203 sub docmd
 204 {
 205     my $cmd = shift;
 206     system("sh -c '$cmd " . (($debug)?"":" >/dev/null") . "'");
 207     return $? == 0;
 208 }
 209
 210 sub start_bacula
 211 {
 212     my $ret;
 213     $ret = docmd("$bin/bacula start");
 214
 215     # cleanup bweb stuff
 216     create_bconcmds('@out /dev/null',
 217                     'sql',
 218                     'truncate client_group;',
 219                     'truncate client_group_member;',
 220                     'update Media set LocationId=0;',
 221                     'truncate location;',
 222                     '');
 223     run_bconsole();
 224     return $ret;
 225 }
 226
 227 sub stop_bacula
 228 {
 229     return docmd("$bin/bacula stop");
 230 }
 231
 232 sub get_dirname
 233 {
 234     my $ret = `$bin/bdirjson -c $conf/bacula-dir.conf -l Name -r Director`;
 235     if ($ret =~ /"Name": "(.+?)"/) {
 236         print "$1\n";
 237     }
 238 }
 239
 240 sub get_resource
 241 {
 242     my ($file, $type, $name) = @_;
 243     my $ret;
 244     open(FP, $file) or die "Can't open $file";
 245     my $content = join("", <FP>);
 246
 247     if ($content =~ m/(^$type \{[^}]+?Name\s*=\s*"?$name"?[^}]+?^\})/ms) {
 248         $ret = $1;
 249     }
 250
 251     close(FP);
 252     return $ret;
 253 }
 254
 255 sub extract_resource
 256 {
 257     my $ret = get_resource(@_);
 258     if ($ret) {
 259         print $ret, "\n";
 260     }
 261 }
 262
 263 sub get_field_size
 264 {
 265     my ($file, $field) = @_;
 266     my $size=0;
 267
 268     my $pattern=$field."\\s*([\\d,]+)";
 269     open(FP, $file) or die "ERROR: Can't open $file";
 270
 271     while (<FP>) {
 272         if (/$pattern/) {
 273             $size=$1;
 274         }
 275     }
 276
 277     close(FP);
 278
 279     $size =~ s/,//g;
 280
 281     print $size."\n";
 282 }
 283
 284 sub get_field_ratio
 285 {
 286     my ($file, $field) = @_;
 287     my $ret=0;
 288     my $ratio=0;
 289
 290     my $pattern=$field."\\s*[\\d.]+%\\s+([\\d]+)\.[\\d]*:1"; # stop at the '.'
 291     my $pattern2=$field."\\s*None";
 292     open(FP, $file) or die "ERROR: Can't open $file";
 293
 294     while (<FP>) {
 295         if (/$pattern/) {
 296             $ratio=$1;
 297         }
 298         if (/$pattern2/) {
 299             $ratio="None";
 300         }
 301     }
 302
 303     close(FP);
 304
 305     $ratio =~ s/,//g;
 306
 307     print $ratio."\n";
 308 }
 309
 310
 311
 312 sub check_max_backup_size
 313 {
 314     my ($file, $size) = @_;
 315     my $ret=0;
 316     my $s=0;
 317
 318     open(FP, $file) or die "ERROR: Can't open $file";
 319
 320     while (<FP>) {
 321
 322         if (/FD Bytes Written: +([\d,]+)/) {
 323             $s=$1;
 324         }
 325     }
 326
 327     close(FP);
 328
 329     $size =~ s/,//g;
 330
 331     if ($s > $size) {
 332         print "ERROR: backup too big ($s > $size)\n";
 333         $ret++;
 334     } else {
 335         print "OK\n";
 336     }
 337     return $ret;
 338 }
 339
 340 sub check_min_volume_size
 341 {
 342     my ($size, @vol) = @_;
 343     my $ret=0;
 344
 345     foreach my $v (@vol) {
 346         if (! -f "$tmp/$v") {
 347             print "ERR: $tmp/$v not accessible\n";
 348             $ret++;
 349             next;
 350         }
 351         if (-s "$tmp/$v" < $size) {
 352             print "ERR: $tmp/$v too small\n";
 353             $ret++;
 354         }
 355     }
 356     $estat+=$ret;
 357     return $ret;
 358 }
 359
 360 # check_volumes("tmp/log1.out", "tmp/log2.out", ...)
 361 sub check_volumes
 362 {
 363     my @files = @_;
 364     my %done;
 365     unlink("$tmp/check_volumes.out");
 366     unlink("$tmp/check_volumes_data.out");
 367
 368     foreach my $f (@files) {
 369         open(FP, $f) or next;
 370         while (my $f = <FP>)
 371         {
 372             if ($f =~ /Wrote label to prelabeled Volume "(.+?)" on (?:dedup data|file) device "(.+?)" \((.+?)\)/) {
 373                 if (!$done{$1}) {
 374                     $done{$1} = 1;
 375                     if (-f "$3/$1") {
 376                         system("$bin/bls -c $conf/bacula-sd.conf -j -E -V \"$1\" \"$2\" &>> $tmp/check_volumes.out");
 377                         if ($? != 0) {
 378                             debug("Found problems for $1, traces are in $tmp/check_volumes.out");
 379                             $estat = 1;
 380                         }
 381                         system("$bin/bextract -t -c $conf/bacula-sd.conf -V \"$1\" \"$2\" /tmp &>> $tmp/check_volumes_data.out");
 382                         if ($? != 0) {
 383                             debug("Found problems for $1, traces are in $tmp/check_volumes_data.out");
 384                             $estat = 1;
 385                         }
 386                     }
 387                 }
 388             }
 389         }
 390         close(FP);
 391     }
 392     return $estat;
 393 }
 394
 395 # Here we want to list all cloud parts and check what we have in the catalog
 396 sub check_parts
 397 {
 398     my $tempfile = "$tmp/check_parts.$$";
 399     open(FP, "|$bin/bconsole -c $conf/bconsole.conf >$tempfile");
 400     print FP "\@echo File generated by scripts::function::check_part()\n";
 401     print FP "sql\n";
 402     print FP "SELECT 'Name', VolumeName, Storage.Name FROM Media JOIN Storage USING (StorageId) WHERE VolType = 14;\n";
 403     close(FP);
 404
 405     unlink("$tmp/check_parts.out");
 406     open(CMD, ">$tmp/bconsole.cmd");
 407     print CMD "\@output $tmp/check_parts.out\n";
 408     open(FP, $tempfile);
 409     while (my $l = <FP>) {
 410         $l =~ s/,//g;           # Default bacula output is putting , every 1000
 411         $l =~ s/\|/!/g;         # | is a special char in regexp
 412         if ($l =~ /!\s*Name\s*!\s*([\w\d-]+)\s*!\s*([\w\d-]+)\s*/) {
 413             print CMD "cloud list volume=$1 storage=$2\n";
 414         }
 415     }
 416     close(FP);
 417     close(CMD);
 418     run_bconsole("$tmp/bconsole.cmd");
 419     open(OUT, "$tmp/check_parts.out");
 420     while (my $l = <OUT>) {
 421         if ($l =~ /Error/) {
 422             print $l;
 423             $estat=1;
 424         }
 425     }
 426     close(OUT);
 427 }
 428
 429 # This test is supposed to detect JobMedia corruption for all jobs
 430 # stored in the catalog.
 431 sub check_jobmedia
 432 {
 433     use bigint;
 434
 435     my %jobids;
 436     my $ret=0;
 437     my %jobs;
 438     #  SELECT JobId, Min(FirstIndex) AS A FROM JobMedia GROUP BY JobId HAVING Min(FirstIndex) > 1;
 439     open(FP, "|$bin/bconsole -c $conf/bconsole.conf >$tmp/check_jobmedia.$$");
 440     print FP "\@echo File generated by scripts::function::check_jobmedia()\n";
 441     print FP "sql\n";
 442     print FP "SELECT 'ERROR with FirstIndex not starting at 1 (JobId|FirstIndex)', JobId, Min(FirstIndex) AS A FROM JobMedia GROUP BY JobId HAVING Min(FirstIndex) > 1;\n";
 443     print FP "SELECT 'ERROR with LastIndex != JobFiles (JobId|LastIndex|JobFiles)', JobId, Max(LastIndex), JobFiles FROM Job JOIN JobMedia USING (JobId) WHERE JobStatus = 'T' AND Type = 'B' GROUP BY JobId,JobFiles HAVING Max(LastIndex) != JobFiles;\n";
 444     print FP "SELECT 'Index', JobId, FirstIndex, LastIndex, JobMediaId FROM JobMedia ORDER BY JobId, JobMediaId;\n";
 445     print FP "SELECT 'Block', JobId, MediaId, StartFile, EndFile, StartBlock, EndBlock, JobMediaId FROM JobMedia ORDER BY JobId, JobMediaId;\n";
 446     print FP "SELECT 'ERROR StartAddress > EndAddress (JobMediaId)', JobMediaId  from JobMedia where ((CAST(StartFile AS bigint)<<32) + StartBlock) > ((CAST (EndFile AS bigint) <<32) + EndBlock);\n";
 447     close(FP);
 448
 449     my $tempfile = "$tmp/check_jobmedia.$$";
 450     open(FP, $tempfile);
 451     while (my $l = <FP>) {
 452         $l =~ s/,//g;           # Default bacula output is putting , every 1000
 453         $l =~ s/\|/!/g;         # | is a special char in regexp
 454
 455         if ($l =~ /ERROR with LastIndex [\D]+(\d+)/) {
 456             print $l;
 457             print "HINT: Some FileIndex are not covered by a JobMedia. It usually means that you ",
 458                     "can't restore jobs impacted (jobid $1)\n\n";
 459             $jobids{$1}=1;
 460             $ret++;
 461
 462         } elsif ($l =~ / ERROR /) {
 463             print $l;
 464             $ret++;
 465                      #              JobId     FirstIndex   LastIndex
 466                      #   Index  !     1     !         1 !      2277 !
 467         } elsif ($l =~ /Index\s*!\s*(\d+)\s*!\s*(\d+)\s*!\s*(\d+)\s*!/) {
 468             my ($jobid, $first, $last) = ($1, $2, $3);
 469
 470             next if ($first == 0 && $last == 0);
 471
 472             if ($jobs{$jobid} && !($jobs{$jobid} == $first || $jobs{$jobid} == ($first - 1))) {
 473                 print "ERROR: found a gap in JobMedia, the FirstIndex is not equal to the previous LastIndex for jobid $jobid FirstIndex $first LastIndex $last PreviousLast $jobs{$jobid}\n";
 474                 $ret++;
 475             }
 476             $jobs{$jobid} = $last;
 477
 478                       #              JobId    MediaId     StartFile    EndFile   StartBlock  EndBlock     JobMediaId
 479                       # Block   !     2     !         3 !   1       !    1     !    129223 ! 999807168 !          4 !
 480         } elsif ($l =~ /Block\s*!\s*(\d+)\s*!\s*(\d+)\s*!\s*(\d+)\s*!\s*(\d+)\s*!\s*(\d+)\s*!\s*(\d+)\s*!/) {
 481             my ($jobid, $mediaid, $firstfile, $lastfile, $firstblk, $lastblk) = ($1, $2, $3, $4, $5, $6);
 482
 483             my $first = ($firstfile << 32) + $firstblk;
 484             my $last = ($lastfile << 32) + $lastblk;
 485
 486             if ($jobs{"$jobid:$mediaid"} && $jobs{"$jobid:$mediaid"} > $first) {
 487                 print "ERROR: in JobMedia, previous Block is before the current Block for jobid=$jobid mediaid=$mediaid (";
 488                 print $jobs{"$jobid:$mediaid"},  " > $first)\n";
 489                 $ret++;
 490             }
 491             if ($last < $first) {
 492                 print "ERROR: in JobMedia, the EndAddress is lower than the FirstAddress for JobId=$jobid MediaId=$mediaid ($last < $first)\n";
 493                 $ret++;
 494             }
 495             $jobs{"$jobid:$mediaid"} = $last;
 496         }
 497     }
 498     close(FP);
 499     if ($ret) {
 500         print "ERROR: Found errors while checking JobMedia records, look the file $tempfile\n";
 501         if (scalar(%jobids)) {
 502             print "       The JobId list to check is dumped to $tmp/bad-jobid.out\n";
 503             open(FP, ">$tmp/bad-jobid.out");
 504             print FP join("\n", keys %jobids), "\n";
 505             close(FP);
 506         }
 507     }
 508     exit $ret;
 509 }
 510
 511 # check if a volume is too big
 512 # check_max_backup_size(10000, "vol1", "vol3");
 513 sub check_max_volume_size
 514 {
 515     my ($size, @vol) = @_;
 516     my $ret=0;
 517
 518     foreach my $v (@vol) {
 519         if (! -f "$tmp/$v") {
 520             print "ERR: $tmp/$v not accessible\n";
 521             $ret++;
 522             next;
 523         }
 524         if (-s "$tmp/$v" > $size) {
 525             print "ERR: $tmp/$v too big\n";
 526             $ret++;
 527         }
 528     }
 529     $estat+=$ret;
 530     return $ret;
 531 }
 532
 533 # update client definition for the current test
 534 # it permits to test remote client
 535 sub update_client
 536 {
 537     my ($new_passwd, $new_address, $new_port) = @_;
 538     my $in_client=0;
 539
 540     open(FP, "$conf/bacula-dir.conf") or die "can't open source $!";
 541     open(NEW, ">$tmp/bacula-dir.conf.$$") or die "can't open dest $!";
 542     while (my $l = <FP>) {
 543         if (!$in_client && $l =~ /^Client \{/) {
 544             $in_client=1;
 545         }
 546
 547         if ($in_client && $l =~ /Address/i) {
 548             $l = "Address = $new_address\n";
 549         }
 550
 551         if ($in_client && $l =~ /FDPort/i) {
 552             $l = "FDPort = $new_port\n";
 553         }
 554
 555         if ($in_client && $l =~ /Password/i) {
 556             $l = "Password = \"$new_passwd\"\n";
 557         }
 558
 559         if ($in_client && $l =~ /^\}/) {
 560             $in_client=0;
 561         }
 562         print NEW $l;
 563     }
 564     close(FP);
 565     close(NEW);
 566     my $ret = copy("$tmp/bacula-dir.conf.$$", "$conf/bacula-dir.conf");
 567     unlink("$tmp/bacula-dir.conf.$$");
 568     return $ret;
 569 }
 570
 571 # if you want to run this function more than 100 times, please, update this number
 572 my $last_update = 100;
 573
 574 # open a directory and update all files
 575 sub update_some_files_rep
 576 {
 577     my ($dest, $nbupdate)=@_;
 578     my $t=rand();
 579     my $f;
 580     my $nb=0;
 581     my $nbdel=0;
 582     my $total=0;
 583
 584     if ($nbupdate) {
 585         $last_update = $nbupdate;
 586         unlink("$tmp/last_update");
 587
 588     } elsif (-f "$tmp/last_update") {
 589         $last_update = `cat $tmp/last_update`;
 590         chomp($last_update);
 591         $last_update--;
 592         if ($last_update == 0) {
 593             $last_update = 100;
 594         }
 595     }
 596     my $base = chr($last_update % 26 + 65); # We use a base directory A-Z
 597
 598     system("sh -c 'echo $last_update > $tmp/last_update'");
 599     print "Update files in $dest\n";
 600     opendir(DIR, "$dest/$base") || die "$!";
 601     map {
 602         $f = "$dest/$base/$_";
 603         if (($total++ % $last_update) == 0) {
 604             if (-f $f) {
 605                 # We delete some of them, and we replace them later
 606                 if ((($nb + $nbdel) % 11) == 0) {
 607                     unlink($f);
 608                     $nbdel++;
 609
 610                     open(FP, ">$dest/$base/$last_update-$nbdel.txt") or die "$f $!";
 611                     seek(FP, $last_update * 4000, 0);
 612                     print FP "$t update $f\n";
 613                     close(FP);
 614
 615                 } else {
 616                     open(FP, ">>$f") or die "$f $!";
 617                     print FP "$t update $f\n";
 618                     close(FP);
 619                     $nb++;
 620                 }
 621             }
 622         }
 623     } sort readdir(DIR);
 624     closedir DIR;
 625     print "$nb files updated, $nbdel deleted/created\n";
 626 }
 627
 628 # open a directory and update all files
 629 sub update_some_files
 630 {
 631     my ($dest)=@_;
 632     my $t=rand();
 633     my $f;
 634     my $nb=0;
 635     print "Update files in $dest\n";
 636     opendir(DIR, $dest) || die "$!";
 637     map {
 638         $f = "$dest/$_";
 639         if (-f $f) {
 640             open(FP, ">$f") or die "$f $!";
 641             print FP "$t update $f\n";
 642             close(FP);
 643             $nb++;
 644         }
 645     } readdir(DIR);
 646     closedir DIR;
 647     print "$nb files updated\n";
 648 }
 649
 650 # create big number of files in a given directory
 651 # Inputs: dest  destination directory
 652 #         nb    number of file to create
 653 # Example:
 654 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
 655 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000, 32000)'
 656 sub create_many_files
 657 {
 658     my ($dest, $nb, $sparse_size) = @_;
 659     my $base;
 660     my $dir=$dest;
 661     $nb = $nb / 2;              # We create 2 files per loop
 662     $nb = $nb || 750000;
 663     $sparse_size = $sparse_size | 0;
 664     mkdir $dest;
 665     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 666
 667     # already done
 668     if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
 669         debug("Files already created\n");
 670         return;
 671     }
 672
 673     # auto flush stdout for dots
 674     $| = 1;
 675     print "Create ", $nb * 2, " files into $dest\n";
 676     for(my $i=0; $i < 26; $i++) {
 677         $base = chr($i + 65);
 678         mkdir("$dest/$base") if (! -d "$dest/$base");
 679     }
 680     for(my $i=0; $i<=$nb; $i++) {
 681         $base = chr($i % 26 + 65);
 682         open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
 683         print FP "$i\n";
 684         if ($sparse_size) {
 685             seek(FP, ($sparse_size + $i)/2, 1);
 686         }
 687         print FP "$i\n";
 688         if ($sparse_size) {
 689             seek(FP, ($sparse_size + $i)/2, 1);
 690         }
 691         print FP "$i\n";
 692         close(FP);
 693
 694         open(FP, ">>$dir/b${base}a${i}csq$base") or die "$dir $!";
 695         print FP "$base $i\n";
 696         close(FP);
 697
 698         if (!($i % 100)) {
 699             $dir = "$dest/$base/$base$i$base";
 700             mkdir $dir;
 701         }
 702         print "." if (!($i % 10000));
 703     }
 704     print "\n";
 705 }
 706
 707 # BEEF
 708 # create big number of files in a given directory
 709 # Inputs: dest  destination directory
 710 #         nb    number of file to create
 711 # Example:
 712 # perl -Mscripts::functions -e 'create_many_files_size("$cwd/files", 100000)'
 713 sub create_many_files_size
 714 {
 715     my ($dest, $nb) = @_;
 716     my $base;
 717     my $dir=$dest;
 718     $nb = $nb || 750000;
 719     mkdir $dest;
 720     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 721
 722     # already done
 723     if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
 724         debug("Files already created\n");
 725         return;
 726     }
 727
 728     # auto flush stdout for dots
 729     $| = 1;
 730     print "Create $nb files into $dest\n";
 731     for(my $i=0; $i < 26; $i++) {
 732         $base = chr($i + 65);
 733         mkdir("$dest/$base") if (! -d "$dest/$base");
 734     }
 735     for(my $i=0; $i<=$nb; $i++) {
 736         $base = chr($i % 26 + 65);
 737         open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
 738         print FP "$base" x $i;
 739         close(FP);
 740
 741         print "." if (!($i % 10000));
 742     }
 743     print "\n";
 744 }
 745
 746 # create big number of dirs in a given directory
 747 # Inputs: dest  destination directory
 748 #         nb    number of dirs to create
 749 # Example:
 750 # perl -Mscripts::functions -e 'create_many_dirs("$cwd/files", 100000)'
 751 sub create_many_dirs
 752 {
 753     my ($dest, $nb) = @_;
 754     my ($base, $base2);
 755     my $dir=$dest;
 756     $nb = $nb || 750000;
 757     mkdir $dest;
 758     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 759     $base2 = chr(($nb+10) % 26 + 65);
 760     # already done
 761     if (-d "$dest/$base/$base2/$base/a${base}a${nb}aaa${base}") {
 762         debug("Files already created\n");
 763         return;
 764     }
 765
 766     # auto flush stdout for dots
 767     $| = 1;
 768     print "Create $nb dirs into $dest\n";
 769     for(my $i=0; $i < 26; $i++) {
 770         $base = chr($i + 65);
 771         $base2 = chr(($i+10) % 26 + 65);
 772         mkdir("$dest/$base");
 773         mkdir("$dest/$base/$base2");
 774         mkdir("$dest/$base/$base2/$base$base2");
 775         mkdir("$dest/$base/$base2/$base$base2/$base$base2");
 776         mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base");
 777     }
 778     for(my $i=0; $i<=$nb; $i++) {
 779         $base = chr($i % 26 + 65);
 780         $base2 = chr(($i+10) % 26 + 65);
 781         mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base/a${base}a${i}aaa$base");
 782         print "." if (!($i % 10000));
 783     }
 784     print "\n";
 785 }
 786
 787 sub check_encoding
 788 {
 789     if (grep {/Wanted SQL_ASCII, got UTF8/}
 790         `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
 791     {
 792         print "Found database encoding problem, please modify the ",
 793               "database encoding (SQL_ASCII)\n";
 794         exit 1;
 795     }
 796 }
 797
 798 sub set_global_maximum_concurrent_jobs
 799 {
 800     my ($nb) = @_;
 801     add_attribute("$conf/bacula-dir.conf", "MaximumConcurrentJobs", $nb, "Job");
 802     add_attribute("$conf/bacula-dir.conf", "MaximumConcurrentJobs", $nb, "Client");
 803     add_attribute("$conf/bacula-dir.conf", "MaximumConcurrentJobs", $nb, "Director");
 804     add_attribute("$conf/bacula-dir.conf", "MaximumConcurrentJobs", $nb, "Storage");
 805     add_attribute("$conf/bacula-sd.conf", "MaximumConcurrentJobs", $nb, "Storage");
 806     add_attribute("$conf/bacula-sd.conf", "MaximumConcurrentJobs", $nb, "Device");
 807     add_attribute("$conf/bacula-fd.conf", "MaximumConcurrentJobs", $nb, "FileDaemon");
 808 }
 809
 810 # You can change the maximum concurrent jobs for any config file
 811 # If specified, you can change only one Resource or one type of
 812 # resource at the time (optional)
 813 #  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100);
 814 #  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Director');
 815 #  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Device', 'Drive-0');
 816 sub set_maximum_concurrent_jobs
 817 {
 818     my ($file, $nb, $obj, $name) = @_;
 819
 820     die "Can't get new maximumconcurrentjobs"
 821         unless ($nb);
 822
 823     add_attribute($file, "Maximum Concurrent Jobs", $nb, $obj, $name);
 824 }
 825
 826 # You can comment out a directive
 827 #  comment_out('$conf/bacula-dir.conf', 'FDTimeout', 'Job', 'test');
 828 #  comment_out('$conf/bacula-dir.conf', 'FDTimeout');
 829 sub comment_out
 830 {
 831     my ($file, $attr, $obj, $name) = @_;
 832     my ($cur_obj, $cur_name, $done);
 833
 834     open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
 835     open(SRC, $file) or die "Can't open $file";
 836     while (my $l = <SRC>)
 837     {
 838         if ($l =~ /^#/) {
 839             print FP $l;
 840             next;
 841         }
 842
 843         if ($l =~ /^(\w+) \{/) {
 844             $cur_obj = $1;
 845             $done=0;
 846         }
 847
 848         if ($l =~ /^\s*\Q$attr\E/i) {
 849             if (!$obj || $cur_obj eq $obj) {
 850                 if (!$name || $cur_name eq $name) {
 851                     $l =~ s/^/##/;
 852                     $done=1
 853                 }
 854             }
 855         }
 856
 857         if ($l =~ /^\s*Name\s*=\s*"?([\w\d\.-]+)"?/i) {
 858             $cur_name = $1;
 859         }
 860         print FP $l;
 861     }
 862     close(SRC);
 863     close(FP);
 864     copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
 865 }
 866
 867 # You can add option to a resource
 868 #  add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Director');
 869 #  add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Storage', 'FileStorage');
 870 sub add_attribute
 871 {
 872     my ($file, $attr, $value, $obj, $name) = @_;
 873     my ($cur_obj, $cur_name, $done);
 874
 875     my $is_options = $obj && $obj eq 'Options';
 876     if ($value =~ /\s/ && $value !~ m:[/"]:) { # exclude speed from the escape
 877         $value = "\"$value\"";
 878     }
 879     open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
 880     open(SRC, $file) or die "Can't open $file";
 881     while (my $l = <SRC>)
 882     {
 883         if ($l =~ /^#/) {
 884             print FP $l;
 885             next;
 886         }
 887
 888         if ($l =~ /^(\w+) \{/  || ($is_options && $l =~ /\s+(Options)\s*\{/)) {
 889             $cur_obj = $1;
 890             $done=0;
 891         }
 892
 893         if ($l =~ /^\s*\Q$attr\E/i) {
 894             if (!$obj || $cur_obj eq $obj) {
 895                 if (!$name || $cur_name eq $name) {
 896                     $l =~ s/\Q$attr\E\s*=\s*.+/$attr = $value/ig;
 897                     $done=1
 898                 }
 899             }
 900         }
 901
 902         if ($l =~ /^\s*Name\s*=\s*"?([\w\d\.-]+)"?/i) {
 903             $cur_name = $1;
 904         }
 905
 906         my $add_missing = 0;
 907         if ($is_options) {
 908             if ($l =~ /\}/) {
 909                 $add_missing = 1;
 910             }
 911         } elsif ($l =~ /^\}/) {
 912             $add_missing = 1;
 913         }
 914
 915         if ($add_missing) {
 916             if (!$done) {
 917                 if ($cur_obj && $cur_obj eq $obj) {
 918                     if (!$name || $cur_name eq $name) {
 919                         $l =~ s/\}/\n  $attr = $value\n\}/;
 920                     }
 921                 }
 922             }
 923             $cur_name = $cur_obj = undef;
 924         }
 925         print FP $l;
 926     }
 927     close(SRC);
 928     close(FP);
 929     copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
 930 }
 931
 932 # This test the list jobs output to check differences
 933 # Input: read file argument
 934 #        check if all jobids in argument are present in the first
 935 #        'list jobs' and not present in the second
 936 # Output: exit(1) if something goes wrong and print error
 937 sub check_prune_list
 938 {
 939     my $f = shift;
 940     my %to_check = map { $_ => 1} @_;
 941     my %seen;
 942     my $in_list_jobs=0;
 943     my $nb_list_job=0;
 944     my $nb = scalar(@_);
 945     open(FP, $f) or die "Can't open $f $!";
 946     while (my $l = <FP>)          # read all files to check
 947     {
 948         if ($l =~ /list jobs/) {
 949             $in_list_jobs=1;
 950             $nb_list_job++;
 951
 952             if ($nb_list_job == 2) {
 953                 foreach my $jobid (keys %to_check) {
 954                     if (!$seen{$jobid}) {
 955                         print "ERROR: in $f, can't find JobId=$jobid in first 'list jobs'\n";
 956                         exit 1;
 957                     }
 958                 }
 959             }
 960             next;
 961         }
 962         if ($nb_list_job == 0) {
 963             next;
 964         }
 965         if ($l =~ /Pruned (\d+) Job for client/) {
 966             if ($1 != $nb) {
 967                 print "ERROR: in $f, Prune command returns $1 jobs, want $nb\n";
 968                 exit 1;
 969             }
 970         }
 971
 972         if ($l =~ /No Jobs found to prune/) {
 973            if ($nb != 0) {
 974                 print "ERROR: in $f, Prune command returns 0 job, want $nb\n";
 975                 exit 1;
 976             }
 977         }
 978
 979         # list jobs ouput:
 980         # | 1 | NightlySave | 2010-06-16 22:43:05 | B | F | 27 | 4173577 | T |
 981         if ($l =~ /^\|\s+(\d+)/) {
 982             if ($nb_list_job == 1) {
 983                 $seen{$1}=1;
 984             } else {
 985                 delete $seen{$1};
 986             }
 987         }
 988     }
 989     close(FP);
 990     foreach my $jobid (keys %to_check) {
 991         if (!$seen{$jobid}) {
 992             print "******** listing of $f *********\n";
 993             system("cat $f");
 994             print "******** end listing of $f *********\n";
 995             print "ERROR: in $f, JobId=$jobid should not be, but is still present in the 2nd 'list jobs'\n";
 996             exit 1;
 997         }
 998     }
 999     if ($nb_list_job != 2) {
1000         print "ERROR: in $f, not enough 'list jobs'\n";
1001         exit 1;
1002     }
1003     exit 0;
1004 }
1005
1006 # This test ensure that 'list copies' displays only each copy one time
1007 #
1008 # Input: read stream from stdin or with file list argument
1009 #        check the number of copies with the ARGV[1]
1010 # Output: exit(1) if something goes wrong and print error
1011 sub check_multiple_copies
1012 {
1013     my ($nb_to_found) = @_;
1014
1015     my $in_list_copies=0;       # are we or not in a list copies block
1016     my $nb_found=0;             # count the number of copies found
1017     my $ret = 0;
1018     my %seen;
1019
1020     while (my $l = <>)          # read all files to check
1021     {
1022         if ($l =~ /list copies/) {
1023             $in_list_copies=1;
1024             %seen = ();
1025             next;
1026         }
1027
1028         # not in a list copies anymore
1029         if ($in_list_copies && $l =~ /^ /) {
1030             $in_list_copies=0;
1031             next;
1032         }
1033
1034         # list copies ouput:
1035         # |     3 | Backup.2009-09-28 |  9 | DiskChangerMedia |
1036         if ($in_list_copies && $l =~ /^\|\s+\d+/) {
1037             my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
1038             if (exists $seen{$jobid}) {
1039                 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
1040                 $ret = 1;
1041             } else {
1042                 $seen{$jobid}=$copyid;
1043                 $nb_found++;
1044             }
1045         }
1046     }
1047
1048     # test the number of copies against the given arg
1049     if ($nb_to_found && ($nb_to_found != $nb_found)) {
1050         print "ERROR: Found wrong number of copies ",
1051               "($nb_to_found != $nb_found)\n";
1052         exit 1;
1053     }
1054
1055     exit $ret;
1056 }
1057
1058 use POSIX qw/strftime/;
1059 sub get_time
1060 {
1061     my ($sec) = @_;
1062     print strftime('%F %T', localtime(time+$sec)), "\n";
1063 }
1064
1065 sub debug
1066 {
1067     if ($debug) {
1068         print join("\n", @_), "\n";
1069     }
1070 }
1071
1072 sub p
1073 {
1074     debug("\n################################################################",
1075           @_,
1076           "################################################################\n");
1077 }
1078
1079 # check if binaries are OK
1080 sub remote_check
1081 {
1082     my $ret = 0;
1083     my $path = "/opt/bacula/bin";
1084     print "INFO: check binaries\n";
1085     foreach my $b (qw/bacula-fd bacula-dir bconsole bdirjson bsdjson
1086                       bfdjson bbconsjson bacula-sd/)
1087     {
1088         if (-x "$path/$b") {
1089             my $out = `$path/$b -? 2>&1`;
1090             if ($out !~ /Version:/g) {
1091                 print "ERROR: with $b -?\n";
1092                 system("$path/$b -?");
1093                 $ret++;
1094             }
1095         }
1096     }
1097     foreach my $b (qw/bacula-sd/)
1098     {
1099         if (-r "$path/$b") {
1100             my $libs = `ldd $path/$b`;
1101             if ($libs !~ /tokyocabinet/g) {
1102                 print "ERROR: unable to find tokyocabinet for $b\n";
1103                 print $libs;
1104                 $ret++;
1105             }
1106         }
1107     }
1108
1109     return $ret;
1110 }
1111
1112 sub remote_config
1113 {
1114     open(FP, ">$REMOTE_FILE/bacula-fd.conf") or
1115         die "ERROR: Can't open $REMOTE_FILE/bacula-fd.conf $!";
1116
1117     my $plugins = '/opt/bacula/bin';
1118     if (-d '/opt/bacula/plugins') {
1119         $plugins = '/opt/bacula/plugins';
1120     }
1121
1122     print FP "
1123 Director {
1124   Name = $HOST-dir
1125   Password = \"$REMOTE_PASSWORD\"
1126 }
1127 FileDaemon {
1128   Name = remote-fd
1129   FDport = $REMOTE_PORT
1130   WorkingDirectory = $REMOTE_FILE/working
1131   Pid Directory = $REMOTE_FILE/working
1132   Plugin Directory = $plugins
1133   Maximum Concurrent Jobs = 20
1134 }
1135 Messages {
1136   Name = Standard
1137   director = $HOST-dir = all, !skipped, !restored
1138 }
1139 ";
1140     close(FP);
1141     system("mkdir -p '$REMOTE_FILE/working' '$REMOTE_FILE/save'");
1142     system("rm -rf '$REMOTE_FILE/restore'");
1143     my $pid = fork();
1144     if (!$pid) {
1145         close(STDIN);  open(STDIN, "/dev/null");
1146         close(STDOUT); open(STDOUT, ">/dev/null");
1147         close(STDERR); open(STDERR, ">/dev/null");
1148         exec("/opt/bacula/bin/bacula-fd -c $REMOTE_FILE/bacula-fd.conf");
1149         exit 1;
1150     }
1151     sleep(2);
1152     $pid = `cat $REMOTE_FILE/working/bacula-fd.$REMOTE_PORT.pid`;
1153     chomp($pid);
1154
1155     # create files and tweak rights
1156     create_many_files("$REMOTE_FILE/save", 5000);
1157     chdir("$REMOTE_FILE/save");
1158     my $d = 'A';
1159     my $r = 0700;
1160     for my $g ( split(' ', $( )) {
1161         chmod $r++, $d;
1162         chown $<, $g, $d++;
1163     }
1164
1165     # create a sparse file of 2MB
1166     init_delta("$REMOTE_FILE/save", 2000000);
1167
1168     # create a simple script to execute
1169     open(FP, ">test.sh") or die "Can't open test.sh $!";
1170     print FP "#!/bin/sh\n";
1171     print FP "echo this is a script";
1172     close(FP);
1173     chmod 0755, "test.sh";
1174
1175     # create a hardlink
1176     link("test.sh", "link-test.sh");
1177
1178     # create long filename
1179     mkdir("b" x 255) or print "can't create long dir $!\n";
1180     copy("test.sh", ("b" x 255) . '/' . ("a" x 255)) or print "can't create long dir $!\n";
1181
1182     # play with some symlinks
1183     symlink("test.sh", "sym-test.sh");
1184     symlink("$REMOTE_FILE/save/test.sh", "sym-abs-test.sh");
1185
1186     if ($pid) {
1187         system("ps $pid");
1188         $estat = ($? != 0);
1189     } else {
1190         $estat = 1;
1191     }
1192 }
1193
1194 sub remote_diff
1195 {
1196     debug("Doing diff between save and restore");
1197     system("ssh $REMOTE_USER$REMOTE_ADDR " .
1198      "$REMOTE_FILE/scripts/diff.pl -s $REMOTE_FILE/save -d $REMOTE_FILE/restore/$REMOTE_FILE/save");
1199     $dstat = ($? != 0);
1200 }
1201
1202 sub remote_stop
1203 {
1204     debug("Kill remote bacula-fd $REMOTE_ADDR");
1205     system("ssh $REMOTE_USER$REMOTE_ADDR " .
1206              "'test -f $REMOTE_FILE/working/bacula-fd.$REMOTE_PORT.pid && " .
1207               "kill `cat $REMOTE_FILE/working/bacula-fd.$REMOTE_PORT.pid`'");
1208 }
1209
1210 sub remote_init
1211 {
1212     system("ssh $REMOTE_USER$REMOTE_ADDR mkdir -p '$REMOTE_FILE/scripts/'");
1213     system("scp -q scripts/functions.pm scripts/diff.pl $REMOTE_USER$REMOTE_ADDR:$REMOTE_FILE/scripts/");
1214     system("scp -q config $REMOTE_USER$REMOTE_ADDR:$REMOTE_FILE/");
1215     debug("INFO: Configuring remote client");
1216     system("ssh $REMOTE_USER$REMOTE_ADDR 'cd $REMOTE_FILE && perl -Mscripts::functions -e remote_config'");
1217     system("ssh $REMOTE_USER$REMOTE_ADDR 'cd $REMOTE_FILE && perl -Mscripts::functions -e remote_check'");
1218 }
1219
1220 sub get_mbytes
1221 {
1222     my ($source, $cmd, $binonly) = @_;
1223     my $buf;
1224     if (!open(FP1, $cmd)) {
1225         print "ERR\nCan't open $cmd $@\n";
1226         exit 1;
1227     }
1228     if (!open(FP, $source)) {
1229         print "ERR\nCan't open $source $@\n";
1230         exit 1;
1231     }
1232     while (my $l = <FP1>) {
1233         if ($l =~ /^(\d+):(\d+)/) {
1234             if (!$binonly) {
1235                 print "New chunk is $1:$2\n";
1236             }
1237             seek(FP, $1, 0);
1238             sysread(FP, $buf, $2);
1239             print $buf;
1240             if (!$binonly) {
1241                 print "\n";
1242             }
1243         }
1244     }
1245     close(FP);
1246     close(FP1);
1247 }
1248
1249 sub get_bytes
1250 {
1251     my ($file, $offset, $len) = @_;
1252     my $buf;
1253     if (!open(FP, $file)) {
1254         print "ERR\nCan't open $file $@\n";
1255         exit 1;
1256     }
1257     seek(FP, $offset, 0);
1258     sysread(FP, $buf, $len);
1259     print $buf, "\n";
1260     close(FP);
1261 }
1262
1263 sub create_binfile
1264 {
1265     my ($file, $nb) = @_;
1266     $nb |= 10;
1267
1268     if (!open(FP, ">$file")) {
1269         print "ERR\nCan't create txt $file $@\n";
1270         exit 1;
1271     }
1272     for (my $i = 0; $i < $nb ; $i++) {
1273         foreach my $c ('a'..'z') {
1274             my $l = ($c x 1024);
1275             print FP $l;
1276         }
1277     }
1278     close(FP);
1279 }
1280
1281 my $c = "a";
1282
1283 sub init_delta
1284 {
1285     my ($source, $sparse_size) = @_;
1286
1287     $sparse_size = $sparse_size || 100000000;
1288
1289     # Create $source if needed
1290     system("mkdir -p '$source'");
1291
1292     if (!chdir($source)) {
1293         print "ERR\nCan't access to $source $!\n";
1294         exit 1;
1295     }
1296
1297     open(FP, ">text.txt") or return "ERR\nCan't create txt file $@\n";
1298     my $l = ($c x 80) . "\n";
1299     print FP $l x 40000;
1300     close(FP);
1301
1302     open(FP, ">prev");
1303     print FP $c, "\n";
1304     close(FP);
1305
1306     open(FP, ">sparse.dat") or return "ERR\nCan't create sparse $@\n";
1307     seek(FP, $sparse_size, 0);
1308     print FP $l;
1309     close(FP);
1310 }
1311
1312 sub update_delta
1313 {
1314     my ($source) = shift;
1315
1316     if (!chdir($source)) {
1317         return "ERR\nCan't access to $source $!\n";
1318     }
1319
1320     $c = `cat prev`;
1321     chomp($c);
1322
1323     open(FP, "+<sparse.dat") or return "ERR\nCan't update the sparse file $@\n";
1324     seek(FP, int(rand(-s "sparse.dat")), 0);
1325     print FP $c x 400;
1326     seek(FP, 0, 2);
1327     print FP $c x 4000;
1328     close(FP);
1329
1330
1331     open(FP, ">>text.txt") or return "ERR\nCan't update txt file $@\n";
1332     $c++;
1333     my $l = ($c x 80) . "\n";
1334     print FP $l x 40000;
1335     close(FP);
1336
1337     open(FP, ">prev");
1338     print FP $c, "\n";
1339     close(FP);
1340
1341     return "OK\n";
1342 }
1343
1344 sub check_jobmedia_content
1345 {
1346     use bigint;
1347     my ($jobmedia, $bls) = @_;
1348     my @lst;
1349     my $jm;
1350
1351     open(FP, $jobmedia);
1352
1353 #  jobmediaid: 110
1354 #       jobid: 10
1355 #     mediaid: 2
1356 #  volumename: Vol-0002
1357 #  firstindex: 1
1358 #   lastindex: 1
1359 #   startfile: 0
1360 #     endfile: 0
1361 #  startblock: 903,387
1362 #    endblock: 5,096,666
1363
1364     while (my $line = <FP>) {
1365         if ($line =~ /(\w+): (.+)/) {
1366             my ($k, $t) = (lc($1), $2);
1367             $t =~ s/,//g;
1368             $jm->{$k} = $t;
1369
1370             if ($k eq 'endblock') {
1371                 $jm->{startaddress} = ($jm->{startfile} << 32) + $jm->{startblock};
1372                 $jm->{endaddress} = ($jm->{endfile} << 32) + $jm->{endblock};
1373                 push @lst, $jm;
1374                 $jm = {};
1375             }
1376         }
1377     }
1378     close(FP);
1379
1380     open(FP, $bls);
1381     #File:blk=0:11160794 blk_num=0 blen=64512 First rec FI=SOS_LABEL SessId=10 SessTim=1424160078 Strm=10 rlen=152
1382     my $volume;
1383     while (my $line = <FP>) {
1384         chomp($line);
1385         if ($line =~ /Ready to read from volume "(.+?)"/) {
1386             $volume = $1;
1387         }
1388         if ($line =~ /File:blk=(\d+):(\d+) blk_num=\d+ blen=(\d+)/) {
1389             my $found = 0;
1390             my ($address, $len) = (($1<<32) + $2, $3);
1391             foreach $jm (@lst) {
1392                 if ($volume eq $jm->{volumename} && $address >= $jm->{startaddress} && $address <= $jm->{endaddress})
1393                 {
1394                     $found = 1;
1395                     last;
1396                 }
1397             }
1398             if (!$found) {
1399                 print "ERROR: Address=$address len=$len volume=$volume not in BSR!!\n";
1400                 print "$line\nJobMedia:\n";
1401                 foreach $jm (@lst) {
1402                     if ($volume eq $jm->{volumename})
1403                     {
1404                         print "JobMediaId=$jm->{jobmediaid}\tStartAddress=$jm->{startaddress}\tEndAddress=$jm->{endaddress}\n";
1405                     }
1406                 }
1407             }
1408         }
1409     }
1410
1411     close(FP);
1412 }
1413
1414 1;