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 set_maximum_concurrent_jobs get_time add_attribute check_prune_list
44 check_min_volume_size check_max_volume_size $estat $bstat $rstat $zstat
45 $cwd $bin $scripts $conf $rscripts $tmp $working extract_resource
46 $db_name $db_user $db_password $src $tmpsrc);
49 use File::Copy qw/copy/;
51 our ($cwd, $bin, $scripts, $conf, $rscripts, $tmp, $working, $estat, $bstat, $zstat, $rstat,
52 $db_name, $db_user, $db_password, $src, $tmpsrc, $HOST, $BASEPORT);
55 if ($estat || $rstat || $zstat || $bstat) {
61 # start by loading the ./config file
63 if (! -f "./config") {
64 die "Could not find ./config file\n";
66 # load the ./config file in a subshell doesn't allow to use "env" to display all variable
67 open(IN, ". ./config; env |") or die "Could not run shell: $!\n";
68 while ( my $l = <IN> ) {
70 ($envar,$enval) = split (/=/,$l,2);
71 $ENV{$envar} = $enval;
77 # set internal variable name and update environment variable
78 $ENV{db_name} = $db_name = $ENV{db_name} || 'regress';
79 $ENV{db_user} = $db_user = $ENV{db_user} || 'regress';
80 $ENV{db_password} = $db_password = $ENV{db_password} || '';
82 $ENV{bin} = $bin = $ENV{bin} || "$cwd/bin";
83 $ENV{tmp} = $tmp = $ENV{tmp} || "$cwd/tmp";
84 $ENV{src} = $src = $ENV{src} || "$cwd/src";
85 $ENV{conf} = $conf = $ENV{conf} || $bin;
86 $ENV{scripts} = $scripts = $ENV{scripts} || $bin;
87 $ENV{tmpsrc} = $tmpsrc = $ENV{tmpsrc} || "$cwd/tmp/build";
88 $ENV{working} = $working = $ENV{working} || "$cwd/working";
89 $ENV{rscripts} = $rscripts = $ENV{rscripts} || "$cwd/scripts";
90 $ENV{HOST} = $HOST = $ENV{HOST} || "localhost";
91 $ENV{BASEPORT} = $BASEPORT = $ENV{BASEPORT} || "8101";
93 $estat = $rstat = $bstat = $zstat = 0;
98 system("$rscripts/cleanup");
106 system("$bin/bacula start");
108 open(FP, ">$tmp/bcmd");
109 print FP "sql\ntruncate client_group;\ntruncate client_group_member;\nupdate Media set LocationId=0;\ntruncate location;\n\n";
111 system("cat $tmp/bcmd | $bin/bconsole >/dev/null");
118 system("$bin/bacula stop");
124 my ($file, $type, $name) = @_;
126 open(FP, $file) or die "Can't open $file";
127 my $content = join("", <FP>);
129 if ($content =~ m/(^$type {[^}]+?Name\s*=\s*"?$name"?[^}]+?^})/ms) {
139 my $ret = get_resource(@_);
145 sub check_min_volume_size
147 my ($size, @vol) = @_;
150 foreach my $v (@vol) {
151 if (! -f "$tmp/$v") {
152 print "ERR: $tmp/$v not accessible\n";
156 if (-s "$tmp/$v" < $size) {
157 print "ERR: $tmp/$v too small\n";
165 sub check_max_volume_size
167 my ($size, @vol) = @_;
170 foreach my $v (@vol) {
171 if (! -f "$tmp/$v") {
172 print "ERR: $tmp/$v not accessible\n";
176 if (-s "$tmp/$v" > $size) {
177 print "ERR: $tmp/$v too big\n";
185 sub add_to_backup_list
187 open(FP, ">>$tmp/file-list") or die "Can't open $tmp/file-list for update $!";
188 print FP join("\n", @_);
192 # update client definition for the current test
193 # it permits to test remote client
196 my ($new_passwd, $new_address, $new_port) = @_;
199 open(FP, "$conf/bacula-dir.conf") or die "can't open source $!";
200 open(NEW, ">$tmp/bacula-dir.conf.$$") or die "can't open dest $!";
201 while (my $l = <FP>) {
202 if (!$in_client && $l =~ /^Client {/) {
206 if ($in_client && $l =~ /Address/i) {
207 $l = "Address = $new_address\n";
210 if ($in_client && $l =~ /FDPort/i) {
211 $l = "FDPort = $new_port\n";
214 if ($in_client && $l =~ /Password/i) {
215 $l = "Password = \"$new_passwd\"\n";
218 if ($in_client && $l =~ /^}/) {
225 my $ret = copy("$tmp/bacula-dir.conf.$$", "$conf/bacula-dir.conf");
226 unlink("$tmp/bacula-dir.conf.$$");
230 # open a directory and update all files
231 sub update_some_files
237 print "Update files in $dest\n";
238 opendir(DIR, $dest) || die "$!";
242 open(FP, ">$f") or die "$f $!";
243 print FP "$t update $f\n";
249 print "$nb files updated\n";
252 # create big number of files in a given directory
253 # Inputs: dest destination directory
254 # nb number of file to create
256 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
257 sub create_many_files
259 my ($dest, $nb) = @_;
264 $base = chr($nb % 26 + 65); # We use a base directory A-Z
267 if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
268 print "Files already created\n";
272 # auto flush stdout for dots
274 print "Create $nb files into $dest\n";
275 for(my $i=0; $i < 26; $i++) {
276 $base = chr($i + 65);
277 mkdir("$dest/$base") if (! -d "$dest/$base");
279 for(my $i=0; $i<=$nb; $i++) {
280 $base = chr($i % 26 + 65);
281 open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
285 open(FP, ">$dir/b${base}a${i}csq$base") or die "$dir $!";
286 print FP "$base $i\n";
290 $dir = "$dest/$base/$base$i$base";
293 print "." if (!($i % 10000));
298 # create big number of dirs in a given directory
299 # Inputs: dest destination directory
300 # nb number of dirs to create
302 # perl -Mscripts::functions -e 'create_many_dirs("$cwd/files", 100000)'
305 my ($dest, $nb) = @_;
310 $base = chr($nb % 26 + 65); # We use a base directory A-Z
311 $base2 = chr(($nb+10) % 26 + 65);
313 if (-d "$dest/$base/$base2/$base/a${base}a${nb}aaa${base}") {
314 print "Files already created\n";
318 # auto flush stdout for dots
320 print "Create $nb dirs into $dest\n";
321 for(my $i=0; $i < 26; $i++) {
322 $base = chr($i + 65);
323 $base2 = chr(($i+10) % 26 + 65);
324 mkdir("$dest/$base");
325 mkdir("$dest/$base/$base2");
326 mkdir("$dest/$base/$base2/$base$base2");
327 mkdir("$dest/$base/$base2/$base$base2/$base$base2");
328 mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base");
330 for(my $i=0; $i<=$nb; $i++) {
331 $base = chr($i % 26 + 65);
332 $base2 = chr(($i+10) % 26 + 65);
333 mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base/a${base}a${i}aaa$base");
334 print "." if (!($i % 10000));
341 if (grep {/Wanted SQL_ASCII, got UTF8/}
342 `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
344 print "Found database encoding problem, please modify the ",
345 "database encoding (SQL_ASCII)\n";
350 # You can change the maximum concurrent jobs for any config file
351 # If specified, you can change only one Resource or one type of
352 # resource at the time (optional)
353 # set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100);
354 # set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Director');
355 # set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Device', 'Drive-0');
356 sub set_maximum_concurrent_jobs
358 my ($file, $nb, $obj, $name) = @_;
360 die "Can't get new maximumconcurrentjobs"
363 add_attribute($file, "Maximum Concurrent Jobs", $nb, $obj, $name);
367 # You can add option to a resource
368 # add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Director');
369 # add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Storage', 'FileStorage');
372 my ($file, $attr, $value, $obj, $name) = @_;
373 my ($cur_obj, $cur_name, $done);
375 open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
376 open(SRC, $file) or die "Can't open $file";
377 while (my $l = <SRC>)
384 if ($l =~ /^(\w+) {/) {
389 if ($l =~ /\Q$attr\E/i) {
390 if (!$obj || $cur_obj eq $obj) {
391 if (!$name || $cur_name eq $name) {
392 $l =~ s/\Q$attr\E\s*=\s*.+/$attr = $value/ig;
398 if ($l =~ /Name\s*=\s*"?([\w\d\.-]+)"?/i) {
404 if ($cur_obj eq $obj) {
405 if (!$name || $cur_name eq $name) {
406 $l = " $attr = $value\n$l";
410 $cur_name = $cur_obj = undef;
416 copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
419 # This test the list jobs output to check differences
420 # Input: read file argument
421 # check if all jobids in argument are present in the first
422 # 'list jobs' and not present in the second
423 # Output: exit(1) if something goes wrong and print error
427 my %to_check = map { $_ => 1} @_;
432 open(FP, $f) or die "Can't open $f $!";
433 while (my $l = <FP>) # read all files to check
435 if ($l =~ /list jobs/) {
439 if ($nb_list_job == 2) {
440 foreach my $jobid (keys %to_check) {
441 if (!$seen{$jobid}) {
442 print "ERROR: in $f, can't find $jobid in first 'list jobs'\n";
449 if ($nb_list_job == 0) {
452 if ($l =~ /Pruned (\d+) Job for client/) {
454 print "ERROR: in $f, Prune command returns $1 jobs, want $nb\n";
459 if ($l =~ /No Jobs found to prune/) {
461 print "ERROR: in $f, Prune command returns 0 job, want $nb\n";
467 # | 1 | NightlySave | 2010-06-16 22:43:05 | B | F | 27 | 4173577 | T |
468 if ($l =~ /^\|\s+(\d+)/) {
469 if ($nb_list_job == 1) {
477 foreach my $jobid (keys %to_check) {
478 if (!$seen{$jobid}) {
479 print "ERROR: in $f, $jobid in still present in the 2nd 'list jobs'\n";
486 # This test ensure that 'list copies' displays only each copy one time
488 # Input: read stream from stdin or with file list argument
489 # check the number of copies with the ARGV[1]
490 # Output: exit(1) if something goes wrong and print error
491 sub check_multiple_copies
493 my ($nb_to_found) = @_;
495 my $in_list_copies=0; # are we or not in a list copies block
496 my $nb_found=0; # count the number of copies found
500 while (my $l = <>) # read all files to check
502 if ($l =~ /list copies/) {
508 # not in a list copies anymore
509 if ($in_list_copies && $l =~ /^ /) {
515 # | 3 | Backup.2009-09-28 | 9 | DiskChangerMedia |
516 if ($in_list_copies && $l =~ /^\|\s+\d+/) {
517 my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
518 if (exists $seen{$jobid}) {
519 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
522 $seen{$jobid}=$copyid;
528 # test the number of copies against the given arg
529 if ($nb_to_found && ($nb_to_found != $nb_found)) {
530 print "ERROR: Found wrong number of copies ",
531 "($nb_to_found != $nb_found)\n";
538 use POSIX qw/strftime/;
542 print strftime('%F %T', localtime(time+$sec)), "\n";