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