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);
41 our @EXPORT = qw(update_some_files create_many_files check_multiple_copies
42 update_client $HOST $BASEPORT add_to_backup_list
43 check_volume_size create_many_dirs cleanup start_bacula
44 stop_bacula get_resource set_maximum_concurrent_jobs get_time
45 add_attribute check_prune_list check_min_volume_size
46 check_max_volume_size $estat $bstat $rstat $zstat $cwd $bin
47 $scripts $conf $rscripts $tmp $working $dstat extract_resource
48 $db_name $db_user $db_password $src $tmpsrc
49 remote_init remote_config remote_stop remote_diff );
52 use File::Copy qw/copy/;
54 our ($cwd, $bin, $scripts, $conf, $rscripts, $tmp, $working, $estat, $dstat,
55 $bstat, $zstat, $rstat, $debug,
56 $REMOTE_CLIENT, $REMOTE_ADDR, $REMOTE_FILE, $REMOTE_PORT, $REMOTE_PASSWORD,
57 $REMOTE_STORE_ADDR, $REGRESS_DEBUG,
58 $db_name, $db_user, $db_password, $src, $tmpsrc, $HOST, $BASEPORT);
61 if ($estat || $rstat || $zstat || $bstat || $dstat) {
67 # start by loading the ./config file
69 if (! -f "./config") {
70 die "Could not find ./config file\n";
72 # load the ./config file in a subshell doesn't allow to use "env" to display all variable
73 open(IN, ". ./config; set |") or die "Could not run shell: $!\n";
74 while ( my $l = <IN> ) {
76 if ($l =~ /^([\w\d]+)='?([^']+)'?/) {
77 next if ($1 eq 'SHELLOPTS'); # is in read-only
78 ($envar,$enval) = ($1, $2);
79 $ENV{$envar} = $enval;
86 # set internal variable name and update environment variable
87 $ENV{db_name} = $db_name = $ENV{db_name} || 'regress';
88 $ENV{db_user} = $db_user = $ENV{db_user} || 'regress';
89 $ENV{db_password} = $db_password = $ENV{db_password} || '';
91 $ENV{bin} = $bin = $ENV{bin} || "$cwd/bin";
92 $ENV{tmp} = $tmp = $ENV{tmp} || "$cwd/tmp";
93 $ENV{src} = $src = $ENV{src} || "$cwd/src";
94 $ENV{conf} = $conf = $ENV{conf} || $bin;
95 $ENV{scripts} = $scripts = $ENV{scripts} || $bin;
96 $ENV{tmpsrc} = $tmpsrc = $ENV{tmpsrc} || "$cwd/tmp/build";
97 $ENV{working} = $working = $ENV{working} || "$cwd/working";
98 $ENV{rscripts} = $rscripts = $ENV{rscripts} || "$cwd/scripts";
99 $ENV{HOST} = $HOST = $ENV{HOST} || "localhost";
100 $ENV{BASEPORT} = $BASEPORT = $ENV{BASEPORT} || "8101";
101 $ENV{REGRESS_DEBUG} = $debug = $ENV{REGRESS_DEBUG} || 0;
102 $ENV{REMOTE_CLIENT} = $REMOTE_CLIENT = $ENV{REMOTE_CLIENT} || 'remote-fd';
103 $ENV{REMOTE_ADDR} = $REMOTE_ADDR = $ENV{REMOTE_ADDR} || undef;
104 $ENV{REMOTE_FILE} = $REMOTE_FILE = $ENV{REMOTE_FILE} || "/tmp";
105 $ENV{REMOTE_PORT} = $REMOTE_PORT = $ENV{REMOTE_PORT} || 9102;
106 $ENV{REMOTE_PASSWORD} = $REMOTE_PASSWORD = $ENV{REMOTE_PASSWORD} || "xxx";
107 $ENV{REMOTE_STORE_ADDR}=$REMOTE_STORE_ADDR=$ENV{REMOTE_STORE_ADDR} || undef;
109 $estat = $rstat = $bstat = $zstat = 0;
114 system("$rscripts/cleanup");
122 system("$bin/bacula start");
124 open(FP, ">$tmp/bcmd");
125 print FP "sql\ntruncate client_group;\ntruncate client_group_member;\nupdate Media set LocationId=0;\ntruncate location;\n\n";
127 system("cat $tmp/bcmd | $bin/bconsole >/dev/null");
134 system("$bin/bacula stop");
140 my ($file, $type, $name) = @_;
142 open(FP, $file) or die "Can't open $file";
143 my $content = join("", <FP>);
145 if ($content =~ m/(^$type {[^}]+?Name\s*=\s*"?$name"?[^}]+?^})/ms) {
155 my $ret = get_resource(@_);
161 sub check_min_volume_size
163 my ($size, @vol) = @_;
166 foreach my $v (@vol) {
167 if (! -f "$tmp/$v") {
168 print "ERR: $tmp/$v not accessible\n";
172 if (-s "$tmp/$v" < $size) {
173 print "ERR: $tmp/$v too small\n";
181 sub check_max_volume_size
183 my ($size, @vol) = @_;
186 foreach my $v (@vol) {
187 if (! -f "$tmp/$v") {
188 print "ERR: $tmp/$v not accessible\n";
192 if (-s "$tmp/$v" > $size) {
193 print "ERR: $tmp/$v too big\n";
201 sub add_to_backup_list
203 open(FP, ">>$tmp/file-list") or die "Can't open $tmp/file-list for update $!";
204 print FP join("\n", @_);
208 # update client definition for the current test
209 # it permits to test remote client
212 my ($new_passwd, $new_address, $new_port) = @_;
215 open(FP, "$conf/bacula-dir.conf") or die "can't open source $!";
216 open(NEW, ">$tmp/bacula-dir.conf.$$") or die "can't open dest $!";
217 while (my $l = <FP>) {
218 if (!$in_client && $l =~ /^Client {/) {
222 if ($in_client && $l =~ /Address/i) {
223 $l = "Address = $new_address\n";
226 if ($in_client && $l =~ /FDPort/i) {
227 $l = "FDPort = $new_port\n";
230 if ($in_client && $l =~ /Password/i) {
231 $l = "Password = \"$new_passwd\"\n";
234 if ($in_client && $l =~ /^}/) {
241 my $ret = copy("$tmp/bacula-dir.conf.$$", "$conf/bacula-dir.conf");
242 unlink("$tmp/bacula-dir.conf.$$");
246 # open a directory and update all files
247 sub update_some_files
253 print "Update files in $dest\n";
254 opendir(DIR, $dest) || die "$!";
258 open(FP, ">$f") or die "$f $!";
259 print FP "$t update $f\n";
265 print "$nb files updated\n";
268 # create big number of files in a given directory
269 # Inputs: dest destination directory
270 # nb number of file to create
272 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
273 sub create_many_files
275 my ($dest, $nb) = @_;
280 $base = chr($nb % 26 + 65); # We use a base directory A-Z
283 if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
284 print "Files already created\n";
288 # auto flush stdout for dots
290 print "Create $nb files into $dest\n";
291 for(my $i=0; $i < 26; $i++) {
292 $base = chr($i + 65);
293 mkdir("$dest/$base") if (! -d "$dest/$base");
295 for(my $i=0; $i<=$nb; $i++) {
296 $base = chr($i % 26 + 65);
297 open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
301 open(FP, ">$dir/b${base}a${i}csq$base") or die "$dir $!";
302 print FP "$base $i\n";
306 $dir = "$dest/$base/$base$i$base";
309 print "." if (!($i % 10000));
314 # create big number of dirs in a given directory
315 # Inputs: dest destination directory
316 # nb number of dirs to create
318 # perl -Mscripts::functions -e 'create_many_dirs("$cwd/files", 100000)'
321 my ($dest, $nb) = @_;
326 $base = chr($nb % 26 + 65); # We use a base directory A-Z
327 $base2 = chr(($nb+10) % 26 + 65);
329 if (-d "$dest/$base/$base2/$base/a${base}a${nb}aaa${base}") {
330 print "Files already created\n";
334 # auto flush stdout for dots
336 print "Create $nb dirs into $dest\n";
337 for(my $i=0; $i < 26; $i++) {
338 $base = chr($i + 65);
339 $base2 = chr(($i+10) % 26 + 65);
340 mkdir("$dest/$base");
341 mkdir("$dest/$base/$base2");
342 mkdir("$dest/$base/$base2/$base$base2");
343 mkdir("$dest/$base/$base2/$base$base2/$base$base2");
344 mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base");
346 for(my $i=0; $i<=$nb; $i++) {
347 $base = chr($i % 26 + 65);
348 $base2 = chr(($i+10) % 26 + 65);
349 mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base/a${base}a${i}aaa$base");
350 print "." if (!($i % 10000));
357 if (grep {/Wanted SQL_ASCII, got UTF8/}
358 `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
360 print "Found database encoding problem, please modify the ",
361 "database encoding (SQL_ASCII)\n";
366 # You can change the maximum concurrent jobs for any config file
367 # If specified, you can change only one Resource or one type of
368 # resource at the time (optional)
369 # set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100);
370 # set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Director');
371 # set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Device', 'Drive-0');
372 sub set_maximum_concurrent_jobs
374 my ($file, $nb, $obj, $name) = @_;
376 die "Can't get new maximumconcurrentjobs"
379 add_attribute($file, "Maximum Concurrent Jobs", $nb, $obj, $name);
382 # You can add option to a resource
383 # add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Director');
384 # add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Storage', 'FileStorage');
387 my ($file, $attr, $value, $obj, $name) = @_;
388 my ($cur_obj, $cur_name, $done);
390 open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
391 open(SRC, $file) or die "Can't open $file";
392 while (my $l = <SRC>)
399 if ($l =~ /^(\w+) {/) {
404 if ($l =~ /^\s*\Q$attr\E/i) {
405 if (!$obj || $cur_obj eq $obj) {
406 if (!$name || $cur_name eq $name) {
407 $l =~ s/\Q$attr\E\s*=\s*.+/$attr = $value/ig;
413 if ($l =~ /^\s*Name\s*=\s*"?([\w\d\.-]+)"?/i) {
419 if ($cur_obj eq $obj) {
420 if (!$name || $cur_name eq $name) {
421 $l = " $attr = $value\n$l";
425 $cur_name = $cur_obj = undef;
431 copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
434 # This test the list jobs output to check differences
435 # Input: read file argument
436 # check if all jobids in argument are present in the first
437 # 'list jobs' and not present in the second
438 # Output: exit(1) if something goes wrong and print error
442 my %to_check = map { $_ => 1} @_;
447 open(FP, $f) or die "Can't open $f $!";
448 while (my $l = <FP>) # read all files to check
450 if ($l =~ /list jobs/) {
454 if ($nb_list_job == 2) {
455 foreach my $jobid (keys %to_check) {
456 if (!$seen{$jobid}) {
457 print "ERROR: in $f, can't find $jobid in first 'list jobs'\n";
464 if ($nb_list_job == 0) {
467 if ($l =~ /Pruned (\d+) Job for client/) {
469 print "ERROR: in $f, Prune command returns $1 jobs, want $nb\n";
474 if ($l =~ /No Jobs found to prune/) {
476 print "ERROR: in $f, Prune command returns 0 job, want $nb\n";
482 # | 1 | NightlySave | 2010-06-16 22:43:05 | B | F | 27 | 4173577 | T |
483 if ($l =~ /^\|\s+(\d+)/) {
484 if ($nb_list_job == 1) {
492 foreach my $jobid (keys %to_check) {
493 if (!$seen{$jobid}) {
494 print "ERROR: in $f, $jobid in still present in the 2nd 'list jobs'\n";
498 if ($nb_list_job != 2) {
499 print "ERROR: in $f, not enough 'list jobs'\n";
505 # This test ensure that 'list copies' displays only each copy one time
507 # Input: read stream from stdin or with file list argument
508 # check the number of copies with the ARGV[1]
509 # Output: exit(1) if something goes wrong and print error
510 sub check_multiple_copies
512 my ($nb_to_found) = @_;
514 my $in_list_copies=0; # are we or not in a list copies block
515 my $nb_found=0; # count the number of copies found
519 while (my $l = <>) # read all files to check
521 if ($l =~ /list copies/) {
527 # not in a list copies anymore
528 if ($in_list_copies && $l =~ /^ /) {
534 # | 3 | Backup.2009-09-28 | 9 | DiskChangerMedia |
535 if ($in_list_copies && $l =~ /^\|\s+\d+/) {
536 my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
537 if (exists $seen{$jobid}) {
538 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
541 $seen{$jobid}=$copyid;
547 # test the number of copies against the given arg
548 if ($nb_to_found && ($nb_to_found != $nb_found)) {
549 print "ERROR: Found wrong number of copies ",
550 "($nb_to_found != $nb_found)\n";
557 use POSIX qw/strftime/;
561 print strftime('%F %T', localtime(time+$sec)), "\n";
567 print join("\n", @_), "\n";
573 open(FP, ">$REMOTE_FILE/bacula-fd.conf") or
574 die "ERROR: Can't open $REMOTE_FILE/bacula-fd.conf $!";
578 Password = \"$REMOTE_PASSWORD\"
582 FDport = $REMOTE_PORT
583 WorkingDirectory = $REMOTE_FILE/working
584 Pid Directory = $REMOTE_FILE/working
585 Maximum Concurrent Jobs = 20
589 director = $HOST-dir = all, !skipped, !restored
593 system("mkdir -p '$REMOTE_FILE/working' '$REMOTE_FILE/save'");
594 system("rm -rf '$REMOTE_FILE/restore'");
597 close(STDIN); open(STDIN, "/dev/null");
598 close(STDOUT); open(STDOUT, ">/dev/null");
599 close(STDERR); open(STDERR, ">/dev/null");
600 exec("/opt/bacula/bin/bacula-fd -c $REMOTE_FILE/bacula-fd.conf");
604 $pid = `cat $REMOTE_FILE/working/bacula-fd.$REMOTE_PORT.pid`;
607 # create files and tweak rights
608 create_many_files("$REMOTE_FILE/save", 5000);
609 chdir("$REMOTE_FILE/save");
612 for my $g ( split(' ', $( )) {
617 # create a simple script to execute
618 open(FP, ">test.sh") or die "Can't open test.sh $!";
619 print FP "#!/bin/sh\n";
620 print FP "echo this is a script";
622 chmod 0755, "test.sh";
625 link("test.sh", "link-test.sh");
627 # create long filename
628 mkdir("b" x 255) or print "can't create long dir $!\n";
629 copy("test.sh", ("b" x 255) . '/' . ("a" x 255)) or print "can't create long dir $!\n";
631 # play with some symlinks
632 symlink("test.sh", "sym-test.sh");
633 symlink("$REMOTE_FILE/save/test.sh", "sym-abs-test.sh");
645 debug("Doing diff between save and restore");
646 system("ssh $REMOTE_ADDR " .
647 "$REMOTE_FILE/scripts/diff.pl -s $REMOTE_FILE/save -d $REMOTE_FILE/restore/$REMOTE_FILE/save");
653 debug("Kill remote bacula-fd");
654 system("ssh $REMOTE_ADDR " .
655 "'test -f $REMOTE_FILE/working/bacula-fd.$REMOTE_PORT.pid && " .
656 "kill `cat $REMOTE_FILE/working/bacula-fd.$REMOTE_PORT.pid`'");
661 system("ssh $REMOTE_ADDR mkdir -p '$REMOTE_FILE/scripts/'");
662 system("scp -q scripts/functions.pm scripts/diff.pl $REMOTE_ADDR:$REMOTE_FILE/scripts/");
663 system("scp -q config $REMOTE_ADDR:$REMOTE_FILE/");
664 debug("INFO: Configuring remote client");
665 system("ssh $REMOTE_ADDR 'cd $REMOTE_FILE && perl -Mscripts::functions -e remote_config'");