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) 2000-2009 Free Software Foundation Europe e.V.
   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    This program is Free Software; you can redistribute it and/or
  14    modify it under the terms of version two of the GNU General Public
  15    License as published by the Free Software Foundation plus additions
  16    that are listed in the file LICENSE.
  17
  18    This program is distributed in the hope that it will be useful, but
  19    WITHOUT ANY WARRANTY; without even the implied warranty of
  20    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  21    General Public License for more details.
  22
  23    You should have received a copy of the GNU General Public License
  24    along with this program; if not, write to the Free Software
  25    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26    02110-1301, USA.
  27
  28    Bacula® is a registered trademark of Kern Sibbald.
  29    The licensor of Bacula is the Free Software Foundation Europe
  30    (FSFE), Fiduciary Program, Sumatrastrasse 25, 8006 Zurich,
  31    Switzerland, email:ftf@fsfeurope.org.
  32
  33 =cut
  34
  35 package scripts::functions;
  36 # Export all functions needed to be used by a simple
  37 # perl -Mscripts::functions -e '' script
  38 use Exporter;
  39 our @ISA = qw(Exporter);
  40
  41 our @EXPORT = qw(update_some_files create_many_files check_multiple_copies
  42                   update_client $HOST $BASEPORT add_to_backup_list
  43                   check_volume_size create_many_dirs cleanup start_bacula
  44                   stop_bacula get_resource set_maximum_concurrent_jobs get_time
  45                   add_attribute check_prune_list check_min_volume_size
  46                   check_max_volume_size $estat $bstat $rstat $zstat $cwd $bin
  47                   $scripts $conf $rscripts $tmp $working extract_resource
  48                   $db_name $db_user $db_password $src $tmpsrc);
  49
  50
  51 use File::Copy qw/copy/;
  52
  53 our ($cwd, $bin, $scripts, $conf, $rscripts, $tmp, $working, $estat, $bstat, $zstat, $rstat,
  54      $db_name, $db_user, $db_password, $src, $tmpsrc, $HOST, $BASEPORT);
  55
  56 END {
  57     if ($estat || $rstat || $zstat || $bstat) {
  58         exit 1;
  59     }
  60 }
  61
  62 BEGIN {
  63     # start by loading the ./config file
  64     my ($envar, $enval);
  65     if (! -f "./config") {
  66         die "Could not find ./config file\n";
  67     }
  68     # load the ./config file in a subshell doesn't allow to use "env" to display all variable
  69     open(IN, ". ./config; env |") or die "Could not run shell: $!\n";
  70     while ( my $l = <IN> ) {
  71         chomp ($l);
  72         ($envar,$enval) = split (/=/,$l,2);
  73         $ENV{$envar} = $enval;
  74     }
  75     close(IN);
  76     $cwd = `pwd`;
  77     chomp($cwd);
  78
  79     # set internal variable name and update environment variable
  80     $ENV{db_name} = $db_name = $ENV{db_name} || 'regress';
  81     $ENV{db_user} = $db_user = $ENV{db_user} || 'regress';
  82     $ENV{db_password} = $db_password = $ENV{db_password} || '';
  83
  84     $ENV{bin}      = $bin      =  $ENV{bin}      || "$cwd/bin";
  85     $ENV{tmp}      = $tmp      =  $ENV{tmp}      || "$cwd/tmp";
  86     $ENV{src}      = $src      =  $ENV{src}      || "$cwd/src";
  87     $ENV{conf}     = $conf     =  $ENV{conf}     || $bin;
  88     $ENV{scripts}  = $scripts  =  $ENV{scripts}  || $bin;
  89     $ENV{tmpsrc}   = $tmpsrc   =  $ENV{tmpsrc}   || "$cwd/tmp/build";
  90     $ENV{working}  = $working  =  $ENV{working}  || "$cwd/working";
  91     $ENV{rscripts} = $rscripts =  $ENV{rscripts} || "$cwd/scripts";
  92     $ENV{HOST}     = $HOST     =  $ENV{HOST}     || "localhost";
  93     $ENV{BASEPORT} = $BASEPORT =  $ENV{BASEPORT} || "8101";
  94
  95     $estat = $rstat = $bstat = $zstat = 0;
  96 }
  97
  98 sub cleanup
  99 {
 100     system("$rscripts/cleanup");
 101     return $? == 0;
 102 }
 103
 104 sub start_bacula
 105 {
 106     my $ret;
 107     $ENV{LANG}='C';
 108     system("$bin/bacula start");
 109     $ret = $? == 0;
 110     open(FP, ">$tmp/bcmd");
 111     print FP "sql\ntruncate client_group;\ntruncate client_group_member;\nupdate Media set LocationId=0;\ntruncate location;\n\n";
 112     close(FP);
 113     system("cat $tmp/bcmd | $bin/bconsole >/dev/null");
 114     return $ret;
 115 }
 116
 117 sub stop_bacula
 118 {
 119     $ENV{LANG}='C';
 120     system("$bin/bacula stop");
 121     return $? == 0;
 122 }
 123
 124 sub get_resource
 125 {
 126     my ($file, $type, $name) = @_;
 127     my $ret;
 128     open(FP, $file) or die "Can't open $file";
 129     my $content = join("", <FP>);
 130
 131     if ($content =~ m/(^$type {[^}]+?Name\s*=\s*"?$name"?[^}]+?^})/ms) {
 132         $ret = $1;
 133     }
 134
 135     close(FP);
 136     return $ret;
 137 }
 138
 139 sub extract_resource
 140 {
 141     my $ret = get_resource(@_);
 142     if ($ret) {
 143         print $ret, "\n";
 144     }
 145 }
 146
 147 sub check_min_volume_size
 148 {
 149     my ($size, @vol) = @_;
 150     my $ret=0;
 151
 152     foreach my $v (@vol) {
 153         if (! -f "$tmp/$v") {
 154             print "ERR: $tmp/$v not accessible\n";
 155             $ret++;
 156             next;
 157         }
 158         if (-s "$tmp/$v" < $size) {
 159             print "ERR: $tmp/$v too small\n";
 160             $ret++;
 161         }
 162     }
 163     $estat+=$ret;
 164     return $ret;
 165 }
 166
 167 sub check_max_volume_size
 168 {
 169     my ($size, @vol) = @_;
 170     my $ret=0;
 171
 172     foreach my $v (@vol) {
 173         if (! -f "$tmp/$v") {
 174             print "ERR: $tmp/$v not accessible\n";
 175             $ret++;
 176             next;
 177         }
 178         if (-s "$tmp/$v" > $size) {
 179             print "ERR: $tmp/$v too big\n";
 180             $ret++;
 181         }
 182     }
 183     $estat+=$ret;
 184     return $ret;
 185 }
 186
 187 sub add_to_backup_list
 188 {
 189     open(FP, ">>$tmp/file-list") or die "Can't open $tmp/file-list for update $!";
 190     print FP join("\n", @_);
 191     close(FP);
 192 }
 193
 194 # update client definition for the current test
 195 # it permits to test remote client
 196 sub update_client
 197 {
 198     my ($new_passwd, $new_address, $new_port) = @_;
 199     my $in_client=0;
 200
 201     open(FP, "$conf/bacula-dir.conf") or die "can't open source $!";
 202     open(NEW, ">$tmp/bacula-dir.conf.$$") or die "can't open dest $!";
 203     while (my $l = <FP>) {
 204         if (!$in_client && $l =~ /^Client {/) {
 205             $in_client=1;
 206         }
 207
 208         if ($in_client && $l =~ /Address/i) {
 209             $l = "Address = $new_address\n";
 210         }
 211
 212         if ($in_client && $l =~ /FDPort/i) {
 213             $l = "FDPort = $new_port\n";
 214         }
 215
 216         if ($in_client && $l =~ /Password/i) {
 217             $l = "Password = \"$new_passwd\"\n";
 218         }
 219
 220         if ($in_client && $l =~ /^}/) {
 221             $in_client=0;
 222         }
 223         print NEW $l;
 224     }
 225     close(FP);
 226     close(NEW);
 227     my $ret = copy("$tmp/bacula-dir.conf.$$", "$conf/bacula-dir.conf");
 228     unlink("$tmp/bacula-dir.conf.$$");
 229     return $ret;
 230 }
 231
 232 # open a directory and update all files
 233 sub update_some_files
 234 {
 235     my ($dest)=@_;
 236     my $t=rand();
 237     my $f;
 238     my $nb=0;
 239     print "Update files in $dest\n";
 240     opendir(DIR, $dest) || die "$!";
 241     map {
 242         $f = "$dest/$_";
 243         if (-f $f) {
 244             open(FP, ">$f") or die "$f $!";
 245             print FP "$t update $f\n";
 246             close(FP);
 247             $nb++;
 248         }
 249     } readdir(DIR);
 250     closedir DIR;
 251     print "$nb files updated\n";
 252 }
 253
 254 # create big number of files in a given directory
 255 # Inputs: dest  destination directory
 256 #         nb    number of file to create
 257 # Example:
 258 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
 259 sub create_many_files
 260 {
 261     my ($dest, $nb) = @_;
 262     my $base;
 263     my $dir=$dest;
 264     $nb = $nb || 750000;
 265     mkdir $dest;
 266     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 267
 268     # already done
 269     if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
 270         print "Files already created\n";
 271         return;
 272     }
 273
 274     # auto flush stdout for dots
 275     $| = 1;
 276     print "Create $nb files into $dest\n";
 277     for(my $i=0; $i < 26; $i++) {
 278         $base = chr($i + 65);
 279         mkdir("$dest/$base") if (! -d "$dest/$base");
 280     }
 281     for(my $i=0; $i<=$nb; $i++) {
 282         $base = chr($i % 26 + 65);
 283         open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
 284         print FP "$i\n";
 285         close(FP);
 286
 287         open(FP, ">$dir/b${base}a${i}csq$base") or die "$dir $!";
 288         print FP "$base $i\n";
 289         close(FP);
 290
 291         if (!($i % 100)) {
 292             $dir = "$dest/$base/$base$i$base";
 293             mkdir $dir;
 294         }
 295         print "." if (!($i % 10000));
 296     }
 297     print "\n";
 298 }
 299
 300 # create big number of dirs in a given directory
 301 # Inputs: dest  destination directory
 302 #         nb    number of dirs to create
 303 # Example:
 304 # perl -Mscripts::functions -e 'create_many_dirs("$cwd/files", 100000)'
 305 sub create_many_dirs
 306 {
 307     my ($dest, $nb) = @_;
 308     my ($base, $base2);
 309     my $dir=$dest;
 310     $nb = $nb || 750000;
 311     mkdir $dest;
 312     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 313     $base2 = chr(($nb+10) % 26 + 65);
 314     # already done
 315     if (-d "$dest/$base/$base2/$base/a${base}a${nb}aaa${base}") {
 316         print "Files already created\n";
 317         return;
 318     }
 319
 320     # auto flush stdout for dots
 321     $| = 1;
 322     print "Create $nb dirs into $dest\n";
 323     for(my $i=0; $i < 26; $i++) {
 324         $base = chr($i + 65);
 325         $base2 = chr(($i+10) % 26 + 65);
 326         mkdir("$dest/$base");
 327         mkdir("$dest/$base/$base2");
 328         mkdir("$dest/$base/$base2/$base$base2");
 329         mkdir("$dest/$base/$base2/$base$base2/$base$base2");
 330         mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base");
 331     }
 332     for(my $i=0; $i<=$nb; $i++) {
 333         $base = chr($i % 26 + 65);
 334         $base2 = chr(($i+10) % 26 + 65);
 335         mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base/a${base}a${i}aaa$base");
 336         print "." if (!($i % 10000));
 337     }
 338     print "\n";
 339 }
 340
 341 sub check_encoding
 342 {
 343     if (grep {/Wanted SQL_ASCII, got UTF8/}
 344         `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
 345     {
 346         print "Found database encoding problem, please modify the ",
 347               "database encoding (SQL_ASCII)\n";
 348         exit 1;
 349     }
 350 }
 351
 352 # You can change the maximum concurrent jobs for any config file
 353 # If specified, you can change only one Resource or one type of
 354 # resource at the time (optional)
 355 #  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100);
 356 #  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Director');
 357 #  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Device', 'Drive-0');
 358 sub set_maximum_concurrent_jobs
 359 {
 360     my ($file, $nb, $obj, $name) = @_;
 361
 362     die "Can't get new maximumconcurrentjobs"
 363         unless ($nb);
 364
 365     add_attribute($file, "Maximum Concurrent Jobs", $nb, $obj, $name);
 366 }
 367
 368
 369 # You can add option to a resource
 370 #  add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Director');
 371 #  add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Storage', 'FileStorage');
 372 sub add_attribute
 373 {
 374     my ($file, $attr, $value, $obj, $name) = @_;
 375     my ($cur_obj, $cur_name, $done);
 376
 377     open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
 378     open(SRC, $file) or die "Can't open $file";
 379     while (my $l = <SRC>)
 380     {
 381         if ($l =~ /^#/) {
 382             print FP $l;
 383             next;
 384         }
 385
 386         if ($l =~ /^(\w+) {/) {
 387             $cur_obj = $1;
 388             $done=0;
 389         }
 390
 391         if ($l =~ /\Q$attr\E/i) {
 392             if (!$obj || $cur_obj eq $obj) {
 393                 if (!$name || $cur_name eq $name) {
 394                     $l =~ s/\Q$attr\E\s*=\s*.+/$attr = $value/ig;
 395                     $done=1
 396                 }
 397             }
 398         }
 399
 400         if ($l =~ /Name\s*=\s*"?([\w\d\.-]+)"?/i) {
 401             $cur_name = $1;
 402         }
 403
 404         if ($l =~ /^}/) {
 405             if (!$done) {
 406                 if ($cur_obj eq $obj) {
 407                     if (!$name || $cur_name eq $name) {
 408                         $l = "  $attr = $value\n$l";
 409                     }
 410                 }
 411             }
 412             $cur_name = $cur_obj = undef;
 413         }
 414         print FP $l;
 415     }
 416     close(SRC);
 417     close(FP);
 418     copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
 419 }
 420
 421 # This test the list jobs output to check differences
 422 # Input: read file argument
 423 #        check if all jobids in argument are present in the first
 424 #        'list jobs' and not present in the second
 425 # Output: exit(1) if something goes wrong and print error
 426 sub check_prune_list
 427 {
 428     my $f = shift;
 429     my %to_check = map { $_ => 1} @_;
 430     my %seen;
 431     my $in_list_jobs=0;
 432     my $nb_list_job=0;
 433     my $nb = scalar(@_);
 434     open(FP, $f) or die "Can't open $f $!";
 435     while (my $l = <FP>)          # read all files to check
 436     {
 437         if ($l =~ /list jobs/) {
 438             $in_list_jobs=1;
 439             $nb_list_job++;
 440
 441             if ($nb_list_job == 2) {
 442                 foreach my $jobid (keys %to_check) {
 443                     if (!$seen{$jobid}) {
 444                         print "ERROR: in $f, can't find $jobid in first 'list jobs'\n";
 445                         exit 1;
 446                     }
 447                 }
 448             }
 449             next;
 450         }
 451         if ($nb_list_job == 0) {
 452             next;
 453         }
 454         if ($l =~ /Pruned (\d+) Job for client/) {
 455             if ($1 != $nb) {
 456                 print "ERROR: in $f, Prune command returns $1 jobs, want $nb\n";
 457                 exit 1;
 458             }
 459         }
 460
 461         if ($l =~ /No Jobs found to prune/) {
 462            if ($nb != 0) {
 463                 print "ERROR: in $f, Prune command returns 0 job, want $nb\n";
 464                 exit 1;
 465             }
 466         }
 467
 468         # list jobs ouput:
 469         # | 1 | NightlySave | 2010-06-16 22:43:05 | B | F | 27 | 4173577 | T |
 470         if ($l =~ /^\|\s+(\d+)/) {
 471             if ($nb_list_job == 1) {
 472                 $seen{$1}=1;
 473             } else {
 474                 delete $seen{$1};
 475             }
 476         }
 477     }
 478     close(FP);
 479     foreach my $jobid (keys %to_check) {
 480         if (!$seen{$jobid}) {
 481             print "ERROR: in $f, $jobid in still present in the 2nd 'list jobs'\n";
 482             exit 1;
 483         }
 484     }
 485     if ($nb_list_job != 2) {
 486         print "ERROR: in $f, not enough 'list jobs'\n";
 487         exit 1;
 488     }
 489     exit 0;
 490 }
 491
 492 # This test ensure that 'list copies' displays only each copy one time
 493 #
 494 # Input: read stream from stdin or with file list argument
 495 #        check the number of copies with the ARGV[1]
 496 # Output: exit(1) if something goes wrong and print error
 497 sub check_multiple_copies
 498 {
 499     my ($nb_to_found) = @_;
 500
 501     my $in_list_copies=0;       # are we or not in a list copies block
 502     my $nb_found=0;             # count the number of copies found
 503     my $ret = 0;
 504     my %seen;
 505
 506     while (my $l = <>)          # read all files to check
 507     {
 508         if ($l =~ /list copies/) {
 509             $in_list_copies=1;
 510             %seen = ();
 511             next;
 512         }
 513
 514         # not in a list copies anymore
 515         if ($in_list_copies && $l =~ /^ /) {
 516             $in_list_copies=0;
 517             next;
 518         }
 519
 520         # list copies ouput:
 521         # |     3 | Backup.2009-09-28 |  9 | DiskChangerMedia |
 522         if ($in_list_copies && $l =~ /^\|\s+\d+/) {
 523             my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
 524             if (exists $seen{$jobid}) {
 525                 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
 526                 $ret = 1;
 527             } else {
 528                 $seen{$jobid}=$copyid;
 529                 $nb_found++;
 530             }
 531         }
 532     }
 533
 534     # test the number of copies against the given arg
 535     if ($nb_to_found && ($nb_to_found != $nb_found)) {
 536         print "ERROR: Found wrong number of copies ",
 537               "($nb_to_found != $nb_found)\n";
 538         exit 1;
 539     }
 540
 541     exit $ret;
 542 }
 543
 544 use POSIX qw/strftime/;
 545 sub get_time
 546 {
 547     my ($sec) = @_;
 548     print strftime('%F %T', localtime(time+$sec)), "\n";
 549 }
 550
 551 1;