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