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 get_resource
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");
105 system("$bin/bacula start");
107 open(FP, ">$tmp/bcmd");
108 print FP "sql\ntruncate client_group;\ntruncate client_group_member;\nupdate Media set LocationId=0;\ntruncate location;\n\n";
110 system("cat $tmp/bcmd | $bin/bconsole >/dev/null");
117 system("$bin/bacula stop");
123 my ($file, $type, $name) = @_;
125 open(FP, $file) or die "Can't open $file";
126 my $content = join("", <FP>);
128 if ($content =~ m/(^$type {[^}]+?Name\s*=\s*"?$name"?[^}]+?^})/ms) {
138 my $ret = get_resource(@_);
144 sub check_min_volume_size
146 my ($size, @vol) = @_;
149 foreach my $v (@vol) {
150 if (! -f "$tmp/$v") {
151 print "ERR: $tmp/$v not accessible\n";
155 if (-s "$tmp/$v" < $size) {
156 print "ERR: $tmp/$v too small\n";
164 sub check_max_volume_size
166 my ($size, @vol) = @_;
169 foreach my $v (@vol) {
170 if (! -f "$tmp/$v") {
171 print "ERR: $tmp/$v not accessible\n";
175 if (-s "$tmp/$v" > $size) {
176 print "ERR: $tmp/$v too big\n";
184 sub add_to_backup_list
186 open(FP, ">>$tmp/file-list") or die "Can't open $tmp/file-list for update $!";
187 print FP join("\n", @_);
191 # update client definition for the current test
192 # it permits to test remote client
195 my ($new_passwd, $new_address, $new_port) = @_;
198 open(FP, "$conf/bacula-dir.conf") or die "can't open source $!";
199 open(NEW, ">$tmp/bacula-dir.conf.$$") or die "can't open dest $!";
200 while (my $l = <FP>) {
201 if (!$in_client && $l =~ /^Client {/) {
205 if ($in_client && $l =~ /Address/i) {
206 $l = "Address = $new_address\n";
209 if ($in_client && $l =~ /FDPort/i) {
210 $l = "FDPort = $new_port\n";
213 if ($in_client && $l =~ /Password/i) {
214 $l = "Password = \"$new_passwd\"\n";
217 if ($in_client && $l =~ /^}/) {
224 my $ret = copy("$tmp/bacula-dir.conf.$$", "$conf/bacula-dir.conf");
225 unlink("$tmp/bacula-dir.conf.$$");
229 # open a directory and update all files
230 sub update_some_files
236 print "Update files in $dest\n";
237 opendir(DIR, $dest) || die "$!";
241 open(FP, ">$f") or die "$f $!";
242 print FP "$t update $f\n";
248 print "$nb files updated\n";
251 # create big number of files in a given directory
252 # Inputs: dest destination directory
253 # nb number of file to create
255 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
256 sub create_many_files
258 my ($dest, $nb) = @_;
263 $base = chr($nb % 26 + 65); # We use a base directory A-Z
266 if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
267 print "Files already created\n";
271 # auto flush stdout for dots
273 print "Create $nb files into $dest\n";
274 for(my $i=0; $i < 26; $i++) {
275 $base = chr($i + 65);
276 mkdir("$dest/$base") if (! -d "$dest/$base");
278 for(my $i=0; $i<=$nb; $i++) {
279 $base = chr($i % 26 + 65);
280 open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
284 open(FP, ">$dir/b${base}a${i}csq$base") or die "$dir $!";
285 print FP "$base $i\n";
289 $dir = "$dest/$base/$base$i$base";
292 print "." if (!($i % 10000));
297 # create big number of dirs in a given directory
298 # Inputs: dest destination directory
299 # nb number of dirs to create
301 # perl -Mscripts::functions -e 'create_many_dirs("$cwd/files", 100000)'
304 my ($dest, $nb) = @_;
309 $base = chr($nb % 26 + 65); # We use a base directory A-Z
310 $base2 = chr(($nb+10) % 26 + 65);
312 if (-d "$dest/$base/$base2/$base/a${base}a${nb}aaa${base}") {
313 print "Files already created\n";
317 # auto flush stdout for dots
319 print "Create $nb dirs into $dest\n";
320 for(my $i=0; $i < 26; $i++) {
321 $base = chr($i + 65);
322 $base2 = chr(($i+10) % 26 + 65);
323 mkdir("$dest/$base");
324 mkdir("$dest/$base/$base2");
325 mkdir("$dest/$base/$base2/$base$base2");
326 mkdir("$dest/$base/$base2/$base$base2/$base$base2");
327 mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base");
329 for(my $i=0; $i<=$nb; $i++) {
330 $base = chr($i % 26 + 65);
331 $base2 = chr(($i+10) % 26 + 65);
332 mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base/a${base}a${i}aaa$base");
333 print "." if (!($i % 10000));
340 if (grep {/Wanted SQL_ASCII, got UTF8/}
341 `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
343 print "Found database encoding problem, please modify the ",
344 "database encoding (SQL_ASCII)\n";
349 # This test ensure that 'list copies' displays only each copy one time
351 # Input: read stream from stdin or with file list argument
352 # check the number of copies with the ARGV[1]
353 # Output: exit(1) if something goes wrong and print error
354 sub check_multiple_copies
356 my ($nb_to_found) = @_;
358 my $in_list_copies=0; # are we or not in a list copies block
359 my $nb_found=0; # count the number of copies found
363 while (my $l = <>) # read all files to check
365 if ($l =~ /list copies/) {
371 # not in a list copies anymore
372 if ($in_list_copies && $l =~ /^ /) {
378 # | 3 | Backup.2009-09-28 | 9 | DiskChangerMedia |
379 if ($in_list_copies && $l =~ /^\|\s+\d+/) {
380 my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
381 if (exists $seen{$jobid}) {
382 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
385 $seen{$jobid}=$copyid;
391 # test the number of copies against the given arg
392 if ($nb_to_found && ($nb_to_found != $nb_found)) {
393 print "ERROR: Found wrong number of copies ",
394 "($nb_to_found != $nb_found)\n";