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 our @EXPORT =  qw(update_some_files create_many_files check_multiple_copies
  41                   update_client $HOST $BASEPORT add_to_backup_list check_volume_size
  42                   create_many_dirs cleanup start_bacula stop_bacula get_resource
  43                   set_maximum_concurrent_jobs get_time add_attribute
  44                   check_min_volume_size check_max_volume_size $estat $bstat $rstat $zstat
  45                   $cwd $bin $scripts $conf $rscripts $tmp $working extract_resource
  46                   $db_name $db_user $db_password $src $tmpsrc);
  47
  48
  49 use File::Copy qw/copy/;
  50
  51 our ($cwd, $bin, $scripts, $conf, $rscripts, $tmp, $working, $estat, $bstat, $zstat, $rstat,
  52      $db_name, $db_user, $db_password, $src, $tmpsrc, $HOST, $BASEPORT);
  53
  54 END {
  55     if ($estat || $rstat || $zstat || $bstat) {
  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; env |") or die "Could not run shell: $!\n";
  68     while ( my $l = <IN> ) {
  69         chomp ($l);
  70         ($envar,$enval) = split (/=/,$l,2);
  71         $ENV{$envar} = $enval;
  72     }
  73     close(IN);
  74     $cwd = `pwd`;
  75     chomp($cwd);
  76
  77     # set internal variable name and update environment variable
  78     $ENV{db_name} = $db_name = $ENV{db_name} || 'regress';
  79     $ENV{db_user} = $db_user = $ENV{db_user} || 'regress';
  80     $ENV{db_password} = $db_password = $ENV{db_password} || '';
  81
  82     $ENV{bin}      = $bin      =  $ENV{bin}      || "$cwd/bin";
  83     $ENV{tmp}      = $tmp      =  $ENV{tmp}      || "$cwd/tmp";
  84     $ENV{src}      = $src      =  $ENV{src}      || "$cwd/src";
  85     $ENV{conf}     = $conf     =  $ENV{conf}     || $bin;
  86     $ENV{scripts}  = $scripts  =  $ENV{scripts}  || $bin;
  87     $ENV{tmpsrc}   = $tmpsrc   =  $ENV{tmpsrc}   || "$cwd/tmp/build";
  88     $ENV{working}  = $working  =  $ENV{working}  || "$cwd/working";
  89     $ENV{rscripts} = $rscripts =  $ENV{rscripts} || "$cwd/scripts";
  90     $ENV{HOST}     = $HOST     =  $ENV{HOST}     || "localhost";
  91     $ENV{BASEPORT} = $BASEPORT =  $ENV{BASEPORT} || "8101";
  92
  93     $estat = $rstat = $bstat = $zstat = 0;
  94 }
  95
  96 sub cleanup
  97 {
  98     system("$rscripts/cleanup");
  99     return $? == 0;
 100 }
 101
 102 sub start_bacula
 103 {
 104     my $ret;
 105     $ENV{LANG}='C';
 106     system("$bin/bacula start");
 107     $ret = $? == 0;
 108     open(FP, ">$tmp/bcmd");
 109     print FP "sql\ntruncate client_group;\ntruncate client_group_member;\nupdate Media set LocationId=0;\ntruncate location;\n\n";
 110     close(FP);
 111     system("cat $tmp/bcmd | $bin/bconsole >/dev/null");
 112     return $ret;
 113 }
 114
 115 sub stop_bacula
 116 {
 117     $ENV{LANG}='C';
 118     system("$bin/bacula stop");
 119     return $? == 0;
 120 }
 121
 122 sub get_resource
 123 {
 124     my ($file, $type, $name) = @_;
 125     my $ret;
 126     open(FP, $file) or die "Can't open $file";
 127     my $content = join("", <FP>);
 128
 129     if ($content =~ m/(^$type {[^}]+?Name\s*=\s*"?$name"?[^}]+?^})/ms) {
 130         $ret = $1;
 131     }
 132
 133     close(FP);
 134     return $ret;
 135 }
 136
 137 sub extract_resource
 138 {
 139     my $ret = get_resource(@_);
 140     if ($ret) {
 141         print $ret, "\n";
 142     }
 143 }
 144
 145 sub check_min_volume_size
 146 {
 147     my ($size, @vol) = @_;
 148     my $ret=0;
 149
 150     foreach my $v (@vol) {
 151         if (! -f "$tmp/$v") {
 152             print "ERR: $tmp/$v not accessible\n";
 153             $ret++;
 154             next;
 155         }
 156         if (-s "$tmp/$v" < $size) {
 157             print "ERR: $tmp/$v too small\n";
 158             $ret++;
 159         }
 160     }
 161     $estat+=$ret;
 162     return $ret;
 163 }
 164
 165 sub check_max_volume_size
 166 {
 167     my ($size, @vol) = @_;
 168     my $ret=0;
 169
 170     foreach my $v (@vol) {
 171         if (! -f "$tmp/$v") {
 172             print "ERR: $tmp/$v not accessible\n";
 173             $ret++;
 174             next;
 175         }
 176         if (-s "$tmp/$v" > $size) {
 177             print "ERR: $tmp/$v too big\n";
 178             $ret++;
 179         }
 180     }
 181     $estat+=$ret;
 182     return $ret;
 183 }
 184
 185 sub add_to_backup_list
 186 {
 187     open(FP, ">>$tmp/file-list") or die "Can't open $tmp/file-list for update $!";
 188     print FP join("\n", @_);
 189     close(FP);
 190 }
 191
 192 # update client definition for the current test
 193 # it permits to test remote client
 194 sub update_client
 195 {
 196     my ($new_passwd, $new_address, $new_port) = @_;
 197     my $in_client=0;
 198
 199     open(FP, "$conf/bacula-dir.conf") or die "can't open source $!";
 200     open(NEW, ">$tmp/bacula-dir.conf.$$") or die "can't open dest $!";
 201     while (my $l = <FP>) {
 202         if (!$in_client && $l =~ /^Client {/) {
 203             $in_client=1;
 204         }
 205
 206         if ($in_client && $l =~ /Address/i) {
 207             $l = "Address = $new_address\n";
 208         }
 209
 210         if ($in_client && $l =~ /FDPort/i) {
 211             $l = "FDPort = $new_port\n";
 212         }
 213
 214         if ($in_client && $l =~ /Password/i) {
 215             $l = "Password = \"$new_passwd\"\n";
 216         }
 217
 218         if ($in_client && $l =~ /^}/) {
 219             $in_client=0;
 220         }
 221         print NEW $l;
 222     }
 223     close(FP);
 224     close(NEW);
 225     my $ret = copy("$tmp/bacula-dir.conf.$$", "$conf/bacula-dir.conf");
 226     unlink("$tmp/bacula-dir.conf.$$");
 227     return $ret;
 228 }
 229
 230 # open a directory and update all files
 231 sub update_some_files
 232 {
 233     my ($dest)=@_;
 234     my $t=rand();
 235     my $f;
 236     my $nb=0;
 237     print "Update files in $dest\n";
 238     opendir(DIR, $dest) || die "$!";
 239     map {
 240         $f = "$dest/$_";
 241         if (-f $f) {
 242             open(FP, ">$f") or die "$f $!";
 243             print FP "$t update $f\n";
 244             close(FP);
 245             $nb++;
 246         }
 247     } readdir(DIR);
 248     closedir DIR;
 249     print "$nb files updated\n";
 250 }
 251
 252 # create big number of files in a given directory
 253 # Inputs: dest  destination directory
 254 #         nb    number of file to create
 255 # Example:
 256 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
 257 sub create_many_files
 258 {
 259     my ($dest, $nb) = @_;
 260     my $base;
 261     my $dir=$dest;
 262     $nb = $nb || 750000;
 263     mkdir $dest;
 264     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 265
 266     # already done
 267     if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
 268         print "Files already created\n";
 269         return;
 270     }
 271
 272     # auto flush stdout for dots
 273     $| = 1;
 274     print "Create $nb files into $dest\n";
 275     for(my $i=0; $i < 26; $i++) {
 276         $base = chr($i + 65);
 277         mkdir("$dest/$base") if (! -d "$dest/$base");
 278     }
 279     for(my $i=0; $i<=$nb; $i++) {
 280         $base = chr($i % 26 + 65);
 281         open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
 282         print FP "$i\n";
 283         close(FP);
 284
 285         open(FP, ">$dir/b${base}a${i}csq$base") or die "$dir $!";
 286         print FP "$base $i\n";
 287         close(FP);
 288
 289         if (!($i % 100)) {
 290             $dir = "$dest/$base/$base$i$base";
 291             mkdir $dir;
 292         }
 293         print "." if (!($i % 10000));
 294     }
 295     print "\n";
 296 }
 297
 298 # create big number of dirs in a given directory
 299 # Inputs: dest  destination directory
 300 #         nb    number of dirs to create
 301 # Example:
 302 # perl -Mscripts::functions -e 'create_many_dirs("$cwd/files", 100000)'
 303 sub create_many_dirs
 304 {
 305     my ($dest, $nb) = @_;
 306     my ($base, $base2);
 307     my $dir=$dest;
 308     $nb = $nb || 750000;
 309     mkdir $dest;
 310     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 311     $base2 = chr(($nb+10) % 26 + 65);
 312     # already done
 313     if (-d "$dest/$base/$base2/$base/a${base}a${nb}aaa${base}") {
 314         print "Files already created\n";
 315         return;
 316     }
 317
 318     # auto flush stdout for dots
 319     $| = 1;
 320     print "Create $nb dirs into $dest\n";
 321     for(my $i=0; $i < 26; $i++) {
 322         $base = chr($i + 65);
 323         $base2 = chr(($i+10) % 26 + 65);
 324         mkdir("$dest/$base");
 325         mkdir("$dest/$base/$base2");
 326         mkdir("$dest/$base/$base2/$base$base2");
 327         mkdir("$dest/$base/$base2/$base$base2/$base$base2");
 328         mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base");
 329     }
 330     for(my $i=0; $i<=$nb; $i++) {
 331         $base = chr($i % 26 + 65);
 332         $base2 = chr(($i+10) % 26 + 65);
 333         mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base/a${base}a${i}aaa$base");
 334         print "." if (!($i % 10000));
 335     }
 336     print "\n";
 337 }
 338
 339 sub check_encoding
 340 {
 341     if (grep {/Wanted SQL_ASCII, got UTF8/}
 342         `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
 343     {
 344         print "Found database encoding problem, please modify the ",
 345               "database encoding (SQL_ASCII)\n";
 346         exit 1;
 347     }
 348 }
 349
 350 # You can change the maximum concurrent jobs for any config file
 351 # If specified, you can change only one Resource or one type of
 352 # resource at the time (optional)
 353 #  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100);
 354 #  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Director');
 355 #  set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Device', 'Drive-0');
 356 sub set_maximum_concurrent_jobs
 357 {
 358     my ($file, $nb, $obj, $name) = @_;
 359
 360     die "Can't get new maximumconcurrentjobs"
 361         unless ($nb);
 362
 363     add_attribute($file, "Maximum Concurrent Jobs", $nb, $obj, $name);
 364 }
 365
 366
 367 # You can add option to a resource
 368 #  add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Director');
 369 #  add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Storage', 'FileStorage');
 370 sub add_attribute
 371 {
 372     my ($file, $attr, $value, $obj, $name) = @_;
 373     my ($cur_obj, $cur_name, $done);
 374
 375     open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
 376     open(SRC, $file) or die "Can't open $file";
 377     while (my $l = <SRC>)
 378     {
 379         if ($l =~ /^#/) {
 380             print FP $l;
 381             next;
 382         }
 383
 384         if ($l =~ /^(\w+) {/) {
 385             $cur_obj = $1;
 386             $done=0;
 387         }
 388
 389         if ($l =~ /\Q$attr\E/i) {
 390             if (!$obj || $cur_obj eq $obj) {
 391                 if (!$name || $cur_name eq $name) {
 392                     $l =~ s/\Q$attr\E\s*=\s*.+/$attr = $value/ig;
 393                     $done=1
 394                 }
 395             }
 396         }
 397
 398         if ($l =~ /Name\s*=\s*"?([\w\d\.-]+)"?/i) {
 399             $cur_name = $1;
 400         }
 401
 402         if ($l =~ /^}/) {
 403             if (!$done) {
 404                 if ($cur_obj eq $obj) {
 405                     if (!$name || $cur_name eq $name) {
 406                         $l = "  $attr = $value\n$l";
 407                     }
 408                 }
 409             }
 410             $cur_name = $cur_obj = undef;
 411         }
 412         print FP $l;
 413     }
 414     close(SRC);
 415     close(FP);
 416     copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
 417 }
 418
 419 # This test ensure that 'list copies' displays only each copy one time
 420 #
 421 # Input: read stream from stdin or with file list argument
 422 #        check the number of copies with the ARGV[1]
 423 # Output: exit(1) if something goes wrong and print error
 424 sub check_multiple_copies
 425 {
 426     my ($nb_to_found) = @_;
 427
 428     my $in_list_copies=0;       # are we or not in a list copies block
 429     my $nb_found=0;             # count the number of copies found
 430     my $ret = 0;
 431     my %seen;
 432
 433     while (my $l = <>)          # read all files to check
 434     {
 435         if ($l =~ /list copies/) {
 436             $in_list_copies=1;
 437             %seen = ();
 438             next;
 439         }
 440
 441         # not in a list copies anymore
 442         if ($in_list_copies && $l =~ /^ /) {
 443             $in_list_copies=0;
 444             next;
 445         }
 446
 447         # list copies ouput:
 448         # |     3 | Backup.2009-09-28 |  9 | DiskChangerMedia |
 449         if ($in_list_copies && $l =~ /^\|\s+\d+/) {
 450             my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
 451             if (exists $seen{$jobid}) {
 452                 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
 453                 $ret = 1;
 454             } else {
 455                 $seen{$jobid}=$copyid;
 456                 $nb_found++;
 457             }
 458         }
 459     }
 460
 461     # test the number of copies against the given arg
 462     if ($nb_to_found && ($nb_to_found != $nb_found)) {
 463         print "ERROR: Found wrong number of copies ",
 464               "($nb_to_found != $nb_found)\n";
 465         exit 1;
 466     }
 467
 468     exit $ret;
 469 }
 470
 471 use POSIX qw/strftime/;
 472 sub get_time
 473 {
 474     my ($sec) = @_;
 475     print strftime('%F %T', localtime(time+$sec)), "\n";
 476 }
 477
 478 1;