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