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