1 ################################################################
6 Bacula(R) - The Network Backup Solution
8 Copyright (C) 2000-2017 Kern Sibbald
10 The original author of Bacula is Kern Sibbald, with contributions
11 from many others, a complete list can be found in the file AUTHORS.
13 You may use this file and others of this release according to the
14 license defined in the LICENSE file, which includes the Affero General
15 Public License, v3.0 ("AGPLv3") and some additional permissions and
16 terms pursuant to its AGPLv3 Section 7.
18 This notice must be preserved when any source code is
19 conveyed and/or propagated.
21 Bacula(R) is a registered trademark of Kern Sibbald.
25 package scripts::functions;
26 use File::Basename qw/basename/;
27 # Export all functions needed to be used by a simple
28 # perl -Mscripts::functions -e '' script
30 our @ISA = qw(Exporter);
32 our @EXPORT = qw(update_some_files create_many_files check_multiple_copies
33 update_client $HOST $BASEPORT add_to_backup_list
34 run_bconsole run_bacula start_test end_test create_bconcmds
35 create_many_dirs cleanup start_bacula
36 get_dirname check_jobmedia_content
37 stop_bacula get_resource set_maximum_concurrent_jobs get_time
38 add_attribute check_prune_list check_min_volume_size
39 init_delta update_delta check_max_backup_size comment_out
40 create_many_files_size check_jobmedia $plugins debug p
41 check_max_volume_size $estat $bstat $rstat $zstat $cwd $bin
42 $scripts $conf $rscripts $tmp $working $dstat extract_resource
43 $db_name $db_user $db_password $src $tmpsrc $out $CLIENT docmd
44 set_global_maximum_concurrent_jobs check_volumes update_some_files_rep
45 remote_init remote_config remote_stop remote_diff remote_check
46 get_field_size get_field_ratio create_binfile get_bytes get_mbytes
50 use File::Copy qw/copy/;
52 our ($cwd, $bin, $scripts, $conf, $rscripts, $tmp, $working, $estat, $dstat,
53 $plugins, $bstat, $zstat, $rstat, $debug, $out, $TestName, $FORCE_ALIGNED,
54 $PREBUILT, $FORCE_CLOUD,
55 $REMOTE_CLIENT, $REMOTE_ADDR, $REMOTE_FILE, $REMOTE_PORT, $REMOTE_PASSWORD,
56 $REMOTE_STORE_ADDR, $REGRESS_DEBUG, $REMOTE_USER, $start_time, $end_time,
57 $db_name, $db_user, $db_password, $src, $tmpsrc, $HOST, $BASEPORT, $CLIENT);
60 if ($estat || $rstat || $zstat || $bstat || $dstat) {
66 # start by loading the ./config file
68 if (! -f "./config") {
69 die "Could not find ./config file\n";
71 # load the ./config file in a subshell doesn't allow to use "env" to display all variable
72 open(IN, ". ./config; set |") or die "Could not run shell: $!\n";
73 while ( my $l = <IN> ) {
75 if ($l =~ /^([\w\d]+)='?([^']+)'?/) {
76 next if ($1 eq 'SHELLOPTS'); # is in read-only
77 ($envar,$enval) = ($1, $2);
78 $ENV{$envar} = $enval;
85 # set internal variable name and update environment variable
86 $ENV{db_name} = $db_name = $ENV{db_name} || 'regress';
87 $ENV{db_user} = $db_user = $ENV{db_user} || 'regress';
88 $ENV{db_password} = $db_password = $ENV{db_password} || '';
90 $ENV{bin} = $bin = $ENV{bin} || "$cwd/bin";
91 $ENV{tmp} = $tmp = $ENV{tmp} || "$cwd/tmp";
92 $ENV{src} = $src = $ENV{src} || "$cwd/src";
93 $ENV{conf} = $conf = $ENV{conf} || $bin;
94 $ENV{scripts} = $scripts = $ENV{scripts} || $bin;
95 $ENV{plugins} = $plugins = $ENV{plugins} || "$bin/plugins";
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;
108 $ENV{REMOTE_USER} = $REMOTE_USER = $ENV{REMOTE_USER} || undef;
109 $ENV{FORCE_ALIGNED} = $FORCE_ALIGNED = $ENV{FORCE_ALIGNED} || 'no';
110 $ENV{FORCE_CLOUD} = $FORCE_CLOUD = $ENV{FORCE_CLOUD} || 'no';
111 $ENV{PREBUILT} = $PREBUILT = $ENV{PREBUILT} || 'no';
112 $ENV{CLIENT} = $CLIENT = $ENV{CLIENT} || "$HOST-fd";
114 $out = ($debug) ? '@tee' : '@out';
116 $TestName = basename($0);
118 $dstat = $estat = $rstat = $bstat = $zstat = 0;
121 # execute bconsole session
124 my $script = shift || "$tmp/bconcmds";
125 return docmd("cat $script | $bin/bconsole -c $conf/bconsole.conf");
128 # create a file-list for many tests using
129 # <$cwd/tmp/file-list as fileset
130 sub add_to_backup_list
132 open(FP, ">$tmp/file-list") or die "ERROR: Unable to open $tmp/file-list $@";
145 system("$rscripts/cleanup");
151 if ($FORCE_ALIGNED eq "yes") {
152 if ($PREBUILT ne "yes") {
153 system("make -C $cwd/build/src/plugins/sd install-aligned-plugin > /dev/null");
155 add_attribute("$conf/bacula-sd.conf", "Device Type", "Aligned", "Device");
156 add_attribute("$conf/bacula-sd.conf", "Plugin Directory", "$plugins", "Storage");
158 if ($FORCE_CLOUD eq "yes") {
159 add_attribute("$conf/bacula-sd.conf", "Device Type", "Cloud", "Device");
162 $start_time = time();
163 my $d = strftime('%R:%S', localtime($start_time));
164 print "\n\n === Starting $TestName at $d ===\n";
170 my $t = strftime('%R:%S', localtime($end_time));
171 my $d = strftime('%H:%M:%S', gmtime($end_time - $start_time));
173 if ( -f "$tmp/err.log") {
174 system("cat $tmp/err.log");
177 if ($estat != 0 || $zstat != 0 || $dstat != 0 || $bstat != 0 ) {
179 !!!!! $TestName failed!!! $t $d !!!!!
180 Status: estat=$estat zombie=$zstat backup=$bstat restore=$rstat diff=$dstat\n";
182 if ($bstat != 0 || $rstat != 0) {
183 print " !!! Bad termination status !!!\n";
185 print " !!! Restored files differ !!!\n";
187 print " Status: backup=$bstat restore=$rstat diff=$dstat\n";
188 print " Test owner of $ENV{SITE_NAME} is $ENV{EMAIL}\n";
190 print "\n\n === Ending $TestName at $t ($d) ===\n\n";
194 # create a console command file, can handle a list
197 open(FP, ">$tmp/bconcmds");
198 map { print FP "$_\n"; } @_;
206 system("sh -c '$cmd " . (($debug)?"":" >/dev/null") . "'");
213 $ret = docmd("$bin/bacula start");
216 create_bconcmds('@out /dev/null',
218 'truncate client_group;',
219 'truncate client_group_member;',
220 'update Media set LocationId=0;',
221 'truncate location;',
229 return docmd("$bin/bacula stop");
234 my $ret = `$bin/bdirjson -c $conf/bacula-dir.conf -l Name -r Director`;
235 if ($ret =~ /"Name": "(.+?)"/) {
242 my ($file, $type, $name) = @_;
244 open(FP, $file) or die "Can't open $file";
245 my $content = join("", <FP>);
247 if ($content =~ m/(^$type \{[^}]+?Name\s*=\s*"?$name"?[^}]+?^\})/ms) {
257 my $ret = get_resource(@_);
265 my ($file, $field) = @_;
268 my $pattern=$field."\\s*([\\d,]+)";
269 open(FP, $file) or die "ERROR: Can't open $file";
286 my ($file, $field) = @_;
290 my $pattern=$field."\\s*[\\d.]+%\\s+([\\d]+)\.[\\d]*:1"; # stop at the '.'
291 my $pattern2=$field."\\s*None";
292 open(FP, $file) or die "ERROR: Can't open $file";
312 sub check_max_backup_size
314 my ($file, $size) = @_;
318 open(FP, $file) or die "ERROR: Can't open $file";
322 if (/FD Bytes Written: +([\d,]+)/) {
332 print "ERROR: backup too big ($s > $size)\n";
340 sub check_min_volume_size
342 my ($size, @vol) = @_;
345 foreach my $v (@vol) {
346 if (! -f "$tmp/$v") {
347 print "ERR: $tmp/$v not accessible\n";
351 if (-s "$tmp/$v" < $size) {
352 print "ERR: $tmp/$v too small\n";
360 # check_volumes("tmp/log1.out", "tmp/log2.out", ...)
365 unlink("$tmp/check_volumes.out");
366 unlink("$tmp/check_volumes_data.out");
368 foreach my $f (@files) {
369 open(FP, $f) or next;
372 if ($f =~ /Wrote label to prelabeled Volume "(.+?)" on (?:dedup data|file) device "(.+?)" \((.+?)\)/) {
376 system("$bin/bls -c $conf/bacula-sd.conf -j -E -V \"$1\" \"$2\" &>> $tmp/check_volumes.out");
378 debug("Found problems for $1, traces are in $tmp/check_volumes.out");
381 system("$bin/bextract -t -c $conf/bacula-sd.conf -V \"$1\" \"$2\" /tmp &>> $tmp/check_volumes_data.out");
383 debug("Found problems for $1, traces are in $tmp/check_volumes_data.out");
395 # Here we want to list all cloud parts and check what we have in the catalog
398 my $tempfile = "$tmp/check_parts.$$";
399 open(FP, "|$bin/bconsole -c $conf/bconsole.conf >$tempfile");
400 print FP "\@echo File generated by scripts::function::check_part()\n";
402 print FP "SELECT 'Name', VolumeName, Storage.Name FROM Media JOIN Storage USING (StorageId) WHERE VolType = 14;\n";
405 unlink("$tmp/check_parts.out");
406 open(CMD, ">$tmp/bconsole.cmd");
407 print CMD "\@output $tmp/check_parts.out\n";
409 while (my $l = <FP>) {
410 $l =~ s/,//g; # Default bacula output is putting , every 1000
411 $l =~ s/\|/!/g; # | is a special char in regexp
412 if ($l =~ /!\s*Name\s*!\s*([\w\d-]+)\s*!\s*([\w\d-]+)\s*/) {
413 print CMD "cloud list volume=$1 storage=$2\n";
418 run_bconsole("$tmp/bconsole.cmd");
419 open(OUT, "$tmp/check_parts.out");
420 while (my $l = <OUT>) {
429 # This test is supposed to detect JobMedia corruption for all jobs
430 # stored in the catalog.
438 # SELECT JobId, Min(FirstIndex) AS A FROM JobMedia GROUP BY JobId HAVING Min(FirstIndex) > 1;
439 open(FP, "|$bin/bconsole -c $conf/bconsole.conf >$tmp/check_jobmedia.$$");
440 print FP "\@echo File generated by scripts::function::check_jobmedia()\n";
442 print FP "SELECT 'ERROR with FirstIndex not starting at 1 (JobId|FirstIndex)', JobId, Min(FirstIndex) AS A FROM JobMedia GROUP BY JobId HAVING Min(FirstIndex) > 1;\n";
443 print FP "SELECT 'ERROR with LastIndex != JobFiles (JobId|LastIndex|JobFiles)', JobId, Max(LastIndex), JobFiles FROM Job JOIN JobMedia USING (JobId) WHERE JobStatus = 'T' AND Type = 'B' GROUP BY JobId,JobFiles HAVING Max(LastIndex) != JobFiles;\n";
444 print FP "SELECT 'Index', JobId, FirstIndex, LastIndex, JobMediaId FROM JobMedia ORDER BY JobId, JobMediaId;\n";
445 print FP "SELECT 'Block', JobId, MediaId, StartFile, EndFile, StartBlock, EndBlock, JobMediaId FROM JobMedia ORDER BY JobId, JobMediaId;\n";
446 print FP "SELECT 'ERROR StartAddress > EndAddress (JobMediaId)', JobMediaId from JobMedia where ((CAST(StartFile AS bigint)<<32) + StartBlock) > ((CAST (EndFile AS bigint) <<32) + EndBlock);\n";
449 my $tempfile = "$tmp/check_jobmedia.$$";
451 while (my $l = <FP>) {
452 $l =~ s/,//g; # Default bacula output is putting , every 1000
453 $l =~ s/\|/!/g; # | is a special char in regexp
455 if ($l =~ /ERROR with LastIndex [\D]+(\d+)/) {
457 print "HINT: Some FileIndex are not covered by a JobMedia. It usually means that you ",
458 "can't restore jobs impacted (jobid $1)\n\n";
462 } elsif ($l =~ / ERROR /) {
465 # JobId FirstIndex LastIndex
466 # Index ! 1 ! 1 ! 2277 !
467 } elsif ($l =~ /Index\s*!\s*(\d+)\s*!\s*(\d+)\s*!\s*(\d+)\s*!/) {
468 my ($jobid, $first, $last) = ($1, $2, $3);
470 next if ($first == 0 && $last == 0);
472 if ($jobs{$jobid} && !($jobs{$jobid} == $first || $jobs{$jobid} == ($first - 1))) {
473 print "ERROR: found a gap in JobMedia, the FirstIndex is not equal to the previous LastIndex for jobid $jobid FirstIndex $first LastIndex $last PreviousLast $jobs{$jobid}\n";
476 $jobs{$jobid} = $last;
478 # JobId MediaId StartFile EndFile StartBlock EndBlock JobMediaId
479 # Block ! 2 ! 3 ! 1 ! 1 ! 129223 ! 999807168 ! 4 !
480 } elsif ($l =~ /Block\s*!\s*(\d+)\s*!\s*(\d+)\s*!\s*(\d+)\s*!\s*(\d+)\s*!\s*(\d+)\s*!\s*(\d+)\s*!/) {
481 my ($jobid, $mediaid, $firstfile, $lastfile, $firstblk, $lastblk) = ($1, $2, $3, $4, $5, $6);
483 my $first = ($firstfile << 32) + $firstblk;
484 my $last = ($lastfile << 32) + $lastblk;
486 if ($jobs{"$jobid:$mediaid"} && $jobs{"$jobid:$mediaid"} > $first) {
487 print "ERROR: in JobMedia, previous Block is before the current Block for jobid=$jobid mediaid=$mediaid (";
488 print $jobs{"$jobid:$mediaid"}, " > $first)\n";
491 if ($last < $first) {
492 print "ERROR: in JobMedia, the EndAddress is lower than the FirstAddress for JobId=$jobid MediaId=$mediaid ($last < $first)\n";
495 $jobs{"$jobid:$mediaid"} = $last;
500 print "ERROR: Found errors while checking JobMedia records, look the file $tempfile\n";
501 if (scalar(%jobids)) {
502 print " The JobId list to check is dumped to $tmp/bad-jobid.out\n";
503 open(FP, ">$tmp/bad-jobid.out");
504 print FP join("\n", keys %jobids), "\n";
511 # check if a volume is too big
512 # check_max_backup_size(10000, "vol1", "vol3");
513 sub check_max_volume_size
515 my ($size, @vol) = @_;
518 foreach my $v (@vol) {
519 if (! -f "$tmp/$v") {
520 print "ERR: $tmp/$v not accessible\n";
524 if (-s "$tmp/$v" > $size) {
525 print "ERR: $tmp/$v too big\n";
533 # update client definition for the current test
534 # it permits to test remote client
537 my ($new_passwd, $new_address, $new_port) = @_;
540 open(FP, "$conf/bacula-dir.conf") or die "can't open source $!";
541 open(NEW, ">$tmp/bacula-dir.conf.$$") or die "can't open dest $!";
542 while (my $l = <FP>) {
543 if (!$in_client && $l =~ /^Client \{/) {
547 if ($in_client && $l =~ /Address/i) {
548 $l = "Address = $new_address\n";
551 if ($in_client && $l =~ /FDPort/i) {
552 $l = "FDPort = $new_port\n";
555 if ($in_client && $l =~ /Password/i) {
556 $l = "Password = \"$new_passwd\"\n";
559 if ($in_client && $l =~ /^\}/) {
566 my $ret = copy("$tmp/bacula-dir.conf.$$", "$conf/bacula-dir.conf");
567 unlink("$tmp/bacula-dir.conf.$$");
571 # if you want to run this function more than 100 times, please, update this number
572 my $last_update = 100;
574 # open a directory and update all files
575 sub update_some_files_rep
577 my ($dest, $nbupdate)=@_;
585 $last_update = $nbupdate;
586 unlink("$tmp/last_update");
588 } elsif (-f "$tmp/last_update") {
589 $last_update = `cat $tmp/last_update`;
592 if ($last_update == 0) {
596 my $base = chr($last_update % 26 + 65); # We use a base directory A-Z
598 system("sh -c 'echo $last_update > $tmp/last_update'");
599 print "Update files in $dest\n";
600 opendir(DIR, "$dest/$base") || die "$!";
602 $f = "$dest/$base/$_";
603 if (($total++ % $last_update) == 0) {
605 # We delete some of them, and we replace them later
606 if ((($nb + $nbdel) % 11) == 0) {
610 open(FP, ">$dest/$base/$last_update-$nbdel.txt") or die "$f $!";
611 seek(FP, $last_update * 4000, 0);
612 print FP "$t update $f\n";
616 open(FP, ">>$f") or die "$f $!";
617 print FP "$t update $f\n";
625 print "$nb files updated, $nbdel deleted/created\n";
628 # open a directory and update all files
629 sub update_some_files
635 print "Update files in $dest\n";
636 opendir(DIR, $dest) || die "$!";
640 open(FP, ">$f") or die "$f $!";
641 print FP "$t update $f\n";
647 print "$nb files updated\n";
650 # create big number of files in a given directory
651 # Inputs: dest destination directory
652 # nb number of file to create
654 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
655 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000, 32000)'
656 sub create_many_files
658 my ($dest, $nb, $sparse_size) = @_;
661 $nb = $nb / 2; # We create 2 files per loop
663 $sparse_size = $sparse_size | 0;
665 $base = chr($nb % 26 + 65); # We use a base directory A-Z
668 if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
669 debug("Files already created\n");
673 # auto flush stdout for dots
675 print "Create ", $nb * 2, " files into $dest\n";
676 for(my $i=0; $i < 26; $i++) {
677 $base = chr($i + 65);
678 mkdir("$dest/$base") if (! -d "$dest/$base");
680 for(my $i=0; $i<=$nb; $i++) {
681 $base = chr($i % 26 + 65);
682 open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
685 seek(FP, ($sparse_size + $i)/2, 1);
689 seek(FP, ($sparse_size + $i)/2, 1);
694 open(FP, ">>$dir/b${base}a${i}csq$base") or die "$dir $!";
695 print FP "$base $i\n";
699 $dir = "$dest/$base/$base$i$base";
702 print "." if (!($i % 10000));
708 # create big number of files in a given directory
709 # Inputs: dest destination directory
710 # nb number of file to create
712 # perl -Mscripts::functions -e 'create_many_files_size("$cwd/files", 100000)'
713 sub create_many_files_size
715 my ($dest, $nb) = @_;
720 $base = chr($nb % 26 + 65); # We use a base directory A-Z
723 if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
724 debug("Files already created\n");
728 # auto flush stdout for dots
730 print "Create $nb files into $dest\n";
731 for(my $i=0; $i < 26; $i++) {
732 $base = chr($i + 65);
733 mkdir("$dest/$base") if (! -d "$dest/$base");
735 for(my $i=0; $i<=$nb; $i++) {
736 $base = chr($i % 26 + 65);
737 open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
738 print FP "$base" x $i;
741 print "." if (!($i % 10000));
746 # create big number of dirs in a given directory
747 # Inputs: dest destination directory
748 # nb number of dirs to create
750 # perl -Mscripts::functions -e 'create_many_dirs("$cwd/files", 100000)'
753 my ($dest, $nb) = @_;
758 $base = chr($nb % 26 + 65); # We use a base directory A-Z
759 $base2 = chr(($nb+10) % 26 + 65);
761 if (-d "$dest/$base/$base2/$base/a${base}a${nb}aaa${base}") {
762 debug("Files already created\n");
766 # auto flush stdout for dots
768 print "Create $nb dirs into $dest\n";
769 for(my $i=0; $i < 26; $i++) {
770 $base = chr($i + 65);
771 $base2 = chr(($i+10) % 26 + 65);
772 mkdir("$dest/$base");
773 mkdir("$dest/$base/$base2");
774 mkdir("$dest/$base/$base2/$base$base2");
775 mkdir("$dest/$base/$base2/$base$base2/$base$base2");
776 mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base");
778 for(my $i=0; $i<=$nb; $i++) {
779 $base = chr($i % 26 + 65);
780 $base2 = chr(($i+10) % 26 + 65);
781 mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base/a${base}a${i}aaa$base");
782 print "." if (!($i % 10000));
789 if (grep {/Wanted SQL_ASCII, got UTF8/}
790 `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
792 print "Found database encoding problem, please modify the ",
793 "database encoding (SQL_ASCII)\n";
798 sub set_global_maximum_concurrent_jobs
801 add_attribute("$conf/bacula-dir.conf", "MaximumConcurrentJobs", $nb, "Job");
802 add_attribute("$conf/bacula-dir.conf", "MaximumConcurrentJobs", $nb, "Client");
803 add_attribute("$conf/bacula-dir.conf", "MaximumConcurrentJobs", $nb, "Director");
804 add_attribute("$conf/bacula-dir.conf", "MaximumConcurrentJobs", $nb, "Storage");
805 add_attribute("$conf/bacula-sd.conf", "MaximumConcurrentJobs", $nb, "Storage");
806 add_attribute("$conf/bacula-sd.conf", "MaximumConcurrentJobs", $nb, "Device");
807 add_attribute("$conf/bacula-fd.conf", "MaximumConcurrentJobs", $nb, "FileDaemon");
810 # You can change the maximum concurrent jobs for any config file
811 # If specified, you can change only one Resource or one type of
812 # resource at the time (optional)
813 # set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100);
814 # set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Director');
815 # set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Device', 'Drive-0');
816 sub set_maximum_concurrent_jobs
818 my ($file, $nb, $obj, $name) = @_;
820 die "Can't get new maximumconcurrentjobs"
823 add_attribute($file, "Maximum Concurrent Jobs", $nb, $obj, $name);
826 # You can comment out a directive
827 # comment_out('$conf/bacula-dir.conf', 'FDTimeout', 'Job', 'test');
828 # comment_out('$conf/bacula-dir.conf', 'FDTimeout');
831 my ($file, $attr, $obj, $name) = @_;
832 my ($cur_obj, $cur_name, $done);
834 open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
835 open(SRC, $file) or die "Can't open $file";
836 while (my $l = <SRC>)
843 if ($l =~ /^(\w+) \{/) {
848 if ($l =~ /^\s*\Q$attr\E/i) {
849 if (!$obj || $cur_obj eq $obj) {
850 if (!$name || $cur_name eq $name) {
857 if ($l =~ /^\s*Name\s*=\s*"?([\w\d\.-]+)"?/i) {
864 copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
867 # You can add option to a resource
868 # add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Director');
869 # add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Storage', 'FileStorage');
872 my ($file, $attr, $value, $obj, $name) = @_;
873 my ($cur_obj, $cur_name, $done);
875 my $is_options = $obj && $obj eq 'Options';
876 if ($value =~ /\s/ && $value !~ m:[/"]:) { # exclude speed from the escape
877 $value = "\"$value\"";
879 open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
880 open(SRC, $file) or die "Can't open $file";
881 while (my $l = <SRC>)
888 if ($l =~ /^(\w+) \{/ || ($is_options && $l =~ /\s+(Options)\s*\{/)) {
893 if ($l =~ /^\s*\Q$attr\E/i) {
894 if (!$obj || $cur_obj eq $obj) {
895 if (!$name || $cur_name eq $name) {
896 $l =~ s/\Q$attr\E\s*=\s*.+/$attr = $value/ig;
902 if ($l =~ /^\s*Name\s*=\s*"?([\w\d\.-]+)"?/i) {
911 } elsif ($l =~ /^\}/) {
917 if ($cur_obj && $cur_obj eq $obj) {
918 if (!$name || $cur_name eq $name) {
919 $l =~ s/\}/\n $attr = $value\n\}/;
923 $cur_name = $cur_obj = undef;
929 copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
932 # This test the list jobs output to check differences
933 # Input: read file argument
934 # check if all jobids in argument are present in the first
935 # 'list jobs' and not present in the second
936 # Output: exit(1) if something goes wrong and print error
940 my %to_check = map { $_ => 1} @_;
945 open(FP, $f) or die "Can't open $f $!";
946 while (my $l = <FP>) # read all files to check
948 if ($l =~ /list jobs/) {
952 if ($nb_list_job == 2) {
953 foreach my $jobid (keys %to_check) {
954 if (!$seen{$jobid}) {
955 print "ERROR: in $f, can't find JobId=$jobid in first 'list jobs'\n";
962 if ($nb_list_job == 0) {
965 if ($l =~ /Pruned (\d+) Job for client/) {
967 print "ERROR: in $f, Prune command returns $1 jobs, want $nb\n";
972 if ($l =~ /No Jobs found to prune/) {
974 print "ERROR: in $f, Prune command returns 0 job, want $nb\n";
980 # | 1 | NightlySave | 2010-06-16 22:43:05 | B | F | 27 | 4173577 | T |
981 if ($l =~ /^\|\s+(\d+)/) {
982 if ($nb_list_job == 1) {
990 foreach my $jobid (keys %to_check) {
991 if (!$seen{$jobid}) {
992 print "******** listing of $f *********\n";
994 print "******** end listing of $f *********\n";
995 print "ERROR: in $f, JobId=$jobid should not be, but is still present in the 2nd 'list jobs'\n";
999 if ($nb_list_job != 2) {
1000 print "ERROR: in $f, not enough 'list jobs'\n";
1006 # This test ensure that 'list copies' displays only each copy one time
1008 # Input: read stream from stdin or with file list argument
1009 # check the number of copies with the ARGV[1]
1010 # Output: exit(1) if something goes wrong and print error
1011 sub check_multiple_copies
1013 my ($nb_to_found) = @_;
1015 my $in_list_copies=0; # are we or not in a list copies block
1016 my $nb_found=0; # count the number of copies found
1020 while (my $l = <>) # read all files to check
1022 if ($l =~ /list copies/) {
1028 # not in a list copies anymore
1029 if ($in_list_copies && $l =~ /^ /) {
1034 # list copies ouput:
1035 # | 3 | Backup.2009-09-28 | 9 | DiskChangerMedia |
1036 if ($in_list_copies && $l =~ /^\|\s+\d+/) {
1037 my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
1038 if (exists $seen{$jobid}) {
1039 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
1042 $seen{$jobid}=$copyid;
1048 # test the number of copies against the given arg
1049 if ($nb_to_found && ($nb_to_found != $nb_found)) {
1050 print "ERROR: Found wrong number of copies ",
1051 "($nb_to_found != $nb_found)\n";
1058 use POSIX qw/strftime/;
1062 print strftime('%F %T', localtime(time+$sec)), "\n";
1068 print join("\n", @_), "\n";
1074 debug("\n################################################################",
1076 "################################################################\n");
1079 # check if binaries are OK
1083 my $path = "/opt/bacula/bin";
1084 print "INFO: check binaries\n";
1085 foreach my $b (qw/bacula-fd bacula-dir bconsole bdirjson bsdjson
1086 bfdjson bbconsjson bacula-sd/)
1088 if (-x "$path/$b") {
1089 my $out = `$path/$b -? 2>&1`;
1090 if ($out !~ /Version:/g) {
1091 print "ERROR: with $b -?\n";
1092 system("$path/$b -?");
1097 foreach my $b (qw/bacula-sd/)
1099 if (-r "$path/$b") {
1100 my $libs = `ldd $path/$b`;
1101 if ($libs !~ /tokyocabinet/g) {
1102 print "ERROR: unable to find tokyocabinet for $b\n";
1114 open(FP, ">$REMOTE_FILE/bacula-fd.conf") or
1115 die "ERROR: Can't open $REMOTE_FILE/bacula-fd.conf $!";
1117 my $plugins = '/opt/bacula/bin';
1118 if (-d '/opt/bacula/plugins') {
1119 $plugins = '/opt/bacula/plugins';
1125 Password = \"$REMOTE_PASSWORD\"
1129 FDport = $REMOTE_PORT
1130 WorkingDirectory = $REMOTE_FILE/working
1131 Pid Directory = $REMOTE_FILE/working
1132 Plugin Directory = $plugins
1133 Maximum Concurrent Jobs = 20
1137 director = $HOST-dir = all, !skipped, !restored
1141 system("mkdir -p '$REMOTE_FILE/working' '$REMOTE_FILE/save'");
1142 system("rm -rf '$REMOTE_FILE/restore'");
1145 close(STDIN); open(STDIN, "/dev/null");
1146 close(STDOUT); open(STDOUT, ">/dev/null");
1147 close(STDERR); open(STDERR, ">/dev/null");
1148 exec("/opt/bacula/bin/bacula-fd -c $REMOTE_FILE/bacula-fd.conf");
1152 $pid = `cat $REMOTE_FILE/working/bacula-fd.$REMOTE_PORT.pid`;
1155 # create files and tweak rights
1156 create_many_files("$REMOTE_FILE/save", 5000);
1157 chdir("$REMOTE_FILE/save");
1160 for my $g ( split(' ', $( )) {
1165 # create a sparse file of 2MB
1166 init_delta("$REMOTE_FILE/save", 2000000);
1168 # create a simple script to execute
1169 open(FP, ">test.sh") or die "Can't open test.sh $!";
1170 print FP "#!/bin/sh\n";
1171 print FP "echo this is a script";
1173 chmod 0755, "test.sh";
1176 link("test.sh", "link-test.sh");
1178 # create long filename
1179 mkdir("b" x 255) or print "can't create long dir $!\n";
1180 copy("test.sh", ("b" x 255) . '/' . ("a" x 255)) or print "can't create long dir $!\n";
1182 # play with some symlinks
1183 symlink("test.sh", "sym-test.sh");
1184 symlink("$REMOTE_FILE/save/test.sh", "sym-abs-test.sh");
1196 debug("Doing diff between save and restore");
1197 system("ssh $REMOTE_USER$REMOTE_ADDR " .
1198 "$REMOTE_FILE/scripts/diff.pl -s $REMOTE_FILE/save -d $REMOTE_FILE/restore/$REMOTE_FILE/save");
1204 debug("Kill remote bacula-fd $REMOTE_ADDR");
1205 system("ssh $REMOTE_USER$REMOTE_ADDR " .
1206 "'test -f $REMOTE_FILE/working/bacula-fd.$REMOTE_PORT.pid && " .
1207 "kill `cat $REMOTE_FILE/working/bacula-fd.$REMOTE_PORT.pid`'");
1212 system("ssh $REMOTE_USER$REMOTE_ADDR mkdir -p '$REMOTE_FILE/scripts/'");
1213 system("scp -q scripts/functions.pm scripts/diff.pl $REMOTE_USER$REMOTE_ADDR:$REMOTE_FILE/scripts/");
1214 system("scp -q config $REMOTE_USER$REMOTE_ADDR:$REMOTE_FILE/");
1215 debug("INFO: Configuring remote client");
1216 system("ssh $REMOTE_USER$REMOTE_ADDR 'cd $REMOTE_FILE && perl -Mscripts::functions -e remote_config'");
1217 system("ssh $REMOTE_USER$REMOTE_ADDR 'cd $REMOTE_FILE && perl -Mscripts::functions -e remote_check'");
1222 my ($source, $cmd, $binonly) = @_;
1224 if (!open(FP1, $cmd)) {
1225 print "ERR\nCan't open $cmd $@\n";
1228 if (!open(FP, $source)) {
1229 print "ERR\nCan't open $source $@\n";
1232 while (my $l = <FP1>) {
1233 if ($l =~ /^(\d+):(\d+)/) {
1235 print "New chunk is $1:$2\n";
1238 sysread(FP, $buf, $2);
1251 my ($file, $offset, $len) = @_;
1253 if (!open(FP, $file)) {
1254 print "ERR\nCan't open $file $@\n";
1257 seek(FP, $offset, 0);
1258 sysread(FP, $buf, $len);
1265 my ($file, $nb) = @_;
1268 if (!open(FP, ">$file")) {
1269 print "ERR\nCan't create txt $file $@\n";
1272 for (my $i = 0; $i < $nb ; $i++) {
1273 foreach my $c ('a'..'z') {
1274 my $l = ($c x 1024);
1285 my ($source, $sparse_size) = @_;
1287 $sparse_size = $sparse_size || 100000000;
1289 # Create $source if needed
1290 system("mkdir -p '$source'");
1292 if (!chdir($source)) {
1293 print "ERR\nCan't access to $source $!\n";
1297 open(FP, ">text.txt") or return "ERR\nCan't create txt file $@\n";
1298 my $l = ($c x 80) . "\n";
1299 print FP $l x 40000;
1306 open(FP, ">sparse.dat") or return "ERR\nCan't create sparse $@\n";
1307 seek(FP, $sparse_size, 0);
1314 my ($source) = shift;
1316 if (!chdir($source)) {
1317 return "ERR\nCan't access to $source $!\n";
1323 open(FP, "+<sparse.dat") or return "ERR\nCan't update the sparse file $@\n";
1324 seek(FP, int(rand(-s "sparse.dat")), 0);
1331 open(FP, ">>text.txt") or return "ERR\nCan't update txt file $@\n";
1333 my $l = ($c x 80) . "\n";
1334 print FP $l x 40000;
1344 sub check_jobmedia_content
1347 my ($jobmedia, $bls) = @_;
1351 open(FP, $jobmedia);
1356 # volumename: Vol-0002
1361 # startblock: 903,387
1362 # endblock: 5,096,666
1364 while (my $line = <FP>) {
1365 if ($line =~ /(\w+): (.+)/) {
1366 my ($k, $t) = (lc($1), $2);
1370 if ($k eq 'endblock') {
1371 $jm->{startaddress} = ($jm->{startfile} << 32) + $jm->{startblock};
1372 $jm->{endaddress} = ($jm->{endfile} << 32) + $jm->{endblock};
1381 #File:blk=0:11160794 blk_num=0 blen=64512 First rec FI=SOS_LABEL SessId=10 SessTim=1424160078 Strm=10 rlen=152
1383 while (my $line = <FP>) {
1385 if ($line =~ /Ready to read from volume "(.+?)"/) {
1388 if ($line =~ /File:blk=(\d+):(\d+) blk_num=\d+ blen=(\d+)/) {
1390 my ($address, $len) = (($1<<32) + $2, $3);
1391 foreach $jm (@lst) {
1392 if ($volume eq $jm->{volumename} && $address >= $jm->{startaddress} && $address <= $jm->{endaddress})
1399 print "ERROR: Address=$address len=$len volume=$volume not in BSR!!\n";
1400 print "$line\nJobMedia:\n";
1401 foreach $jm (@lst) {
1402 if ($volume eq $jm->{volumename})
1404 print "JobMediaId=$jm->{jobmediaid}\tStartAddress=$jm->{startaddress}\tEndAddress=$jm->{endaddress}\n";