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
  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 extract_resource
 122 {
 123     my ($file, $type, $name) = @_;
 124
 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         print $1, "\n";
 130     }
 131
 132     close(FP);
 133 }
 134
 135 sub check_min_volume_size
 136 {
 137     my ($size, @vol) = @_;
 138     my $ret=0;
 139
 140     foreach my $v (@vol) {
 141         if (! -f "$tmp/$v") {
 142             print "ERR: $tmp/$v not accessible\n";
 143             $ret++;
 144             next;
 145         }
 146         if (-s "$tmp/$v" < $size) {
 147             print "ERR: $tmp/$v too small\n";
 148             $ret++;
 149         }
 150     }
 151     $estat+=$ret;
 152     return $ret;
 153 }
 154
 155 sub check_max_volume_size
 156 {
 157     my ($size, @vol) = @_;
 158     my $ret=0;
 159
 160     foreach my $v (@vol) {
 161         if (! -f "$tmp/$v") {
 162             print "ERR: $tmp/$v not accessible\n";
 163             $ret++;
 164             next;
 165         }
 166         if (-s "$tmp/$v" > $size) {
 167             print "ERR: $tmp/$v too big\n";
 168             $ret++;
 169         }
 170     }
 171     $estat+=$ret;
 172     return $ret;
 173 }
 174
 175 sub add_to_backup_list
 176 {
 177     open(FP, ">>$tmp/file-list") or die "Can't open $tmp/file-list for update $!";
 178     print FP join("\n", @_);
 179     close(FP);
 180 }
 181
 182 # update client definition for the current test
 183 # it permits to test remote client
 184 sub update_client
 185 {
 186     my ($new_passwd, $new_address, $new_port) = @_;
 187     my $in_client=0;
 188
 189     open(FP, "$conf/bacula-dir.conf") or die "can't open source $!";
 190     open(NEW, ">$tmp/bacula-dir.conf.$$") or die "can't open dest $!";
 191     while (my $l = <FP>) {
 192         if (!$in_client && $l =~ /^Client {/) {
 193             $in_client=1;
 194         }
 195
 196         if ($in_client && $l =~ /Address/i) {
 197             $l = "Address = $new_address\n";
 198         }
 199
 200         if ($in_client && $l =~ /FDPort/i) {
 201             $l = "FDPort = $new_port\n";
 202         }
 203
 204         if ($in_client && $l =~ /Password/i) {
 205             $l = "Password = \"$new_passwd\"\n";
 206         }
 207
 208         if ($in_client && $l =~ /^}/) {
 209             $in_client=0;
 210         }
 211         print NEW $l;
 212     }
 213     close(FP);
 214     close(NEW);
 215     my $ret = copy("$tmp/bacula-dir.conf.$$", "$conf/bacula-dir.conf");
 216     unlink("$tmp/bacula-dir.conf.$$");
 217     return $ret;
 218 }
 219
 220 # open a directory and update all files
 221 sub update_some_files
 222 {
 223     my ($dest)=@_;
 224     my $t=rand();
 225     my $f;
 226     my $nb=0;
 227     print "Update files in $dest\n";
 228     opendir(DIR, $dest) || die "$!";
 229     map {
 230         $f = "$dest/$_";
 231         if (-f $f) {
 232             open(FP, ">$f") or die "$f $!";
 233             print FP "$t update $f\n";
 234             close(FP);
 235             $nb++;
 236         }
 237     } readdir(DIR);
 238     closedir DIR;
 239     print "$nb files updated\n";
 240 }
 241
 242 # create big number of files in a given directory
 243 # Inputs: dest  destination directory
 244 #         nb    number of file to create
 245 # Example:
 246 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
 247 sub create_many_files
 248 {
 249     my ($dest, $nb) = @_;
 250     my $base;
 251     my $dir=$dest;
 252     $nb = $nb || 750000;
 253     mkdir $dest;
 254     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 255
 256     # already done
 257     if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
 258         print "Files already created\n";
 259         return;
 260     }
 261
 262     # auto flush stdout for dots
 263     $| = 1;
 264     print "Create $nb files into $dest\n";
 265     for(my $i=0; $i < 26; $i++) {
 266         $base = chr($i + 65);
 267         mkdir("$dest/$base") if (! -d "$dest/$base");
 268     }
 269     for(my $i=0; $i<=$nb; $i++) {
 270         $base = chr($i % 26 + 65);
 271         open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
 272         print FP "$i\n";
 273         close(FP);
 274
 275         open(FP, ">$dir/b${base}a${i}csq$base") or die "$dir $!";
 276         print FP "$base $i\n";
 277         close(FP);
 278
 279         if (!($i % 100)) {
 280             $dir = "$dest/$base/$base$i$base";
 281             mkdir $dir;
 282         }
 283         print "." if (!($i % 10000));
 284     }
 285     print "\n";
 286 }
 287
 288 # create big number of dirs in a given directory
 289 # Inputs: dest  destination directory
 290 #         nb    number of dirs to create
 291 # Example:
 292 # perl -Mscripts::functions -e 'create_many_dirs("$cwd/files", 100000)'
 293 sub create_many_dirs
 294 {
 295     my ($dest, $nb) = @_;
 296     my ($base, $base2);
 297     my $dir=$dest;
 298     $nb = $nb || 750000;
 299     mkdir $dest;
 300     $base = chr($nb % 26 + 65); # We use a base directory A-Z
 301     $base2 = chr(($nb+10) % 26 + 65);
 302     # already done
 303     if (-d "$dest/$base/$base2/$base/a${base}a${nb}aaa${base}") {
 304         print "Files already created\n";
 305         return;
 306     }
 307
 308     # auto flush stdout for dots
 309     $| = 1;
 310     print "Create $nb dirs into $dest\n";
 311     for(my $i=0; $i < 26; $i++) {
 312         $base = chr($i + 65);
 313         $base2 = chr(($i+10) % 26 + 65);
 314         mkdir("$dest/$base");
 315         mkdir("$dest/$base/$base2");
 316         mkdir("$dest/$base/$base2/$base$base2");
 317         mkdir("$dest/$base/$base2/$base$base2/$base$base2");
 318         mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base");
 319     }
 320     for(my $i=0; $i<=$nb; $i++) {
 321         $base = chr($i % 26 + 65);
 322         $base2 = chr(($i+10) % 26 + 65);
 323         mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base/a${base}a${i}aaa$base");
 324         print "." if (!($i % 10000));
 325     }
 326     print "\n";
 327 }
 328
 329 sub check_encoding
 330 {
 331     if (grep {/Wanted SQL_ASCII, got UTF8/}
 332         `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
 333     {
 334         print "Found database encoding problem, please modify the ",
 335               "database encoding (SQL_ASCII)\n";
 336         exit 1;
 337     }
 338 }
 339
 340 # This test ensure that 'list copies' displays only each copy one time
 341 #
 342 # Input: read stream from stdin or with file list argument
 343 #        check the number of copies with the ARGV[1]
 344 # Output: exit(1) if something goes wrong and print error
 345 sub check_multiple_copies
 346 {
 347     my ($nb_to_found) = @_;
 348
 349     my $in_list_copies=0;       # are we or not in a list copies block
 350     my $nb_found=0;             # count the number of copies found
 351     my $ret = 0;
 352     my %seen;
 353
 354     while (my $l = <>)          # read all files to check
 355     {
 356         if ($l =~ /list copies/) {
 357             $in_list_copies=1;
 358             %seen = ();
 359             next;
 360         }
 361
 362         # not in a list copies anymore
 363         if ($in_list_copies && $l =~ /^ /) {
 364             $in_list_copies=0;
 365             next;
 366         }
 367
 368         # list copies ouput:
 369         # |     3 | Backup.2009-09-28 |  9 | DiskChangerMedia |
 370         if ($in_list_copies && $l =~ /^\|\s+\d+/) {
 371             my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
 372             if (exists $seen{$jobid}) {
 373                 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
 374                 $ret = 1;
 375             } else {
 376                 $seen{$jobid}=$copyid;
 377                 $nb_found++;
 378             }
 379         }
 380     }
 381
 382     # test the number of copies against the given arg
 383     if ($nb_to_found && ($nb_to_found != $nb_found)) {
 384         print "ERROR: Found wrong number of copies ",
 385               "($nb_to_found != $nb_found)\n";
 386         exit 1;
 387     }
 388
 389     exit $ret;
 390 }
 391
 392 1;