1 ################################################################
6 Bacula® - The Network Backup Solution
8 Copyright (C) 2000-2009 Free Software Foundation Europe e.V.
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.
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.
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.
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
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.
35 package scripts::functions;
36 # Export all functions needed to be used by a simple
37 # perl -Mscripts::functions -e '' script
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);
48 use File::Copy qw/copy/;
50 our ($cwd, $bin, $scripts, $conf, $rscripts, $tmp, $working, $estat, $bstat, $zstat, $rstat,
51 $db_name, $db_user, $db_password, $src, $tmpsrc, $HOST, $BASEPORT);
54 if ($estat || $rstat || $zstat || $bstat) {
60 # start by loading the ./config file
62 if (! -f "./config") {
63 die "Could not find ./config file\n";
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> ) {
69 ($envar,$enval) = split (/=/,$l,2);
70 $ENV{$envar} = $enval;
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} || '';
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";
92 $estat = $rstat = $bstat = $zstat = 0;
97 system("$rscripts/cleanup");
104 system("$bin/bacula start");
111 system("$bin/bacula stop");
117 my ($file, $type, $name) = @_;
119 open(FP, $file) or die "Can't open $file";
120 my $content = join("", <FP>);
122 if ($content =~ m/(^$type {[^}]+?Name\s*=\s*"?$name"?[^}]+?^})/ms) {
129 sub check_min_volume_size
131 my ($size, @vol) = @_;
134 foreach my $v (@vol) {
135 if (! -f "$tmp/$v") {
136 print "ERR: $tmp/$v not accessible\n";
140 if (-s "$tmp/$v" < $size) {
141 print "ERR: $tmp/$v too small\n";
149 sub check_max_volume_size
151 my ($size, @vol) = @_;
154 foreach my $v (@vol) {
155 if (! -f "$tmp/$v") {
156 print "ERR: $tmp/$v not accessible\n";
160 if (-s "$tmp/$v" > $size) {
161 print "ERR: $tmp/$v too big\n";
169 sub add_to_backup_list
171 open(FP, ">>$tmp/file-list") or die "Can't open $tmp/file-list for update $!";
172 print FP join("\n", @_);
176 # update client definition for the current test
177 # it permits to test remote client
180 my ($new_passwd, $new_address, $new_port) = @_;
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 {/) {
190 if ($in_client && $l =~ /Address/i) {
191 $l = "Address = $new_address\n";
194 if ($in_client && $l =~ /FDPort/i) {
195 $l = "FDPort = $new_port\n";
198 if ($in_client && $l =~ /Password/i) {
199 $l = "Password = \"$new_passwd\"\n";
202 if ($in_client && $l =~ /^}/) {
209 my $ret = copy("$tmp/bacula-dir.conf.$$", "$conf/bacula-dir.conf");
210 unlink("$tmp/bacula-dir.conf.$$");
214 # open a directory and update all files
215 sub update_some_files
221 print "Update files in $dest\n";
222 opendir(DIR, $dest) || die "$!";
226 open(FP, ">$f") or die "$f $!";
227 print FP "$t update $f\n";
233 print "$nb files updated\n";
236 # create big number of files in a given directory
237 # Inputs: dest destination directory
238 # nb number of file to create
240 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
241 sub create_many_files
243 my ($dest, $nb) = @_;
248 $base = chr($nb % 26 + 65); # We use a base directory A-Z
251 if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
252 print "Files already created\n";
256 # auto flush stdout for dots
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");
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 $!";
269 open(FP, ">$dir/b${base}a${i}csq$base") or die "$dir $!";
270 print FP "$base $i\n";
274 $dir = "$dest/$base/$base$i$base";
277 print "." if (!($i % 10000));
282 # create big number of dirs in a given directory
283 # Inputs: dest destination directory
284 # nb number of dirs to create
286 # perl -Mscripts::functions -e 'create_many_dirs("$cwd/files", 100000)'
289 my ($dest, $nb) = @_;
294 $base = chr($nb % 26 + 65); # We use a base directory A-Z
295 $base2 = chr(($nb+10) % 26 + 65);
297 if (-d "$dest/$base/$base2/$base/a${base}a${nb}aaa${base}") {
298 print "Files already created\n";
302 # auto flush stdout for dots
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");
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));
325 if (grep {/Wanted SQL_ASCII, got UTF8/}
326 `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
328 print "Found database encoding problem, please modify the ",
329 "database encoding (SQL_ASCII)\n";
334 # This test ensure that 'list copies' displays only each copy one time
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
341 my ($nb_to_found) = @_;
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
348 while (my $l = <>) # read all files to check
350 if ($l =~ /list copies/) {
356 # not in a list copies anymore
357 if ($in_list_copies && $l =~ /^ /) {
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";
370 $seen{$jobid}=$copyid;
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";