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