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 extract_resource
48 $db_name $db_user $db_password $src $tmpsrc);
51 use File::Copy qw/copy/;
53 our ($cwd, $bin, $scripts, $conf, $rscripts, $tmp, $working, $estat, $bstat, $zstat, $rstat,
54 $db_name, $db_user, $db_password, $src, $tmpsrc, $HOST, $BASEPORT);
57 if ($estat || $rstat || $zstat || $bstat) {
63 # start by loading the ./config file
65 if (! -f "./config") {
66 die "Could not find ./config file\n";
68 # load the ./config file in a subshell doesn't allow to use "env" to display all variable
69 open(IN, ". ./config; env |") or die "Could not run shell: $!\n";
70 while ( my $l = <IN> ) {
72 ($envar,$enval) = split (/=/,$l,2);
73 $ENV{$envar} = $enval;
79 # set internal variable name and update environment variable
80 $ENV{db_name} = $db_name = $ENV{db_name} || 'regress';
81 $ENV{db_user} = $db_user = $ENV{db_user} || 'regress';
82 $ENV{db_password} = $db_password = $ENV{db_password} || '';
84 $ENV{bin} = $bin = $ENV{bin} || "$cwd/bin";
85 $ENV{tmp} = $tmp = $ENV{tmp} || "$cwd/tmp";
86 $ENV{src} = $src = $ENV{src} || "$cwd/src";
87 $ENV{conf} = $conf = $ENV{conf} || $bin;
88 $ENV{scripts} = $scripts = $ENV{scripts} || $bin;
89 $ENV{tmpsrc} = $tmpsrc = $ENV{tmpsrc} || "$cwd/tmp/build";
90 $ENV{working} = $working = $ENV{working} || "$cwd/working";
91 $ENV{rscripts} = $rscripts = $ENV{rscripts} || "$cwd/scripts";
92 $ENV{HOST} = $HOST = $ENV{HOST} || "localhost";
93 $ENV{BASEPORT} = $BASEPORT = $ENV{BASEPORT} || "8101";
95 $estat = $rstat = $bstat = $zstat = 0;
100 system("$rscripts/cleanup");
108 system("$bin/bacula start");
110 open(FP, ">$tmp/bcmd");
111 print FP "sql\ntruncate client_group;\ntruncate client_group_member;\nupdate Media set LocationId=0;\ntruncate location;\n\n";
113 system("cat $tmp/bcmd | $bin/bconsole >/dev/null");
120 system("$bin/bacula stop");
126 my ($file, $type, $name) = @_;
128 open(FP, $file) or die "Can't open $file";
129 my $content = join("", <FP>);
131 if ($content =~ m/(^$type {[^}]+?Name\s*=\s*"?$name"?[^}]+?^})/ms) {
141 my $ret = get_resource(@_);
147 sub check_min_volume_size
149 my ($size, @vol) = @_;
152 foreach my $v (@vol) {
153 if (! -f "$tmp/$v") {
154 print "ERR: $tmp/$v not accessible\n";
158 if (-s "$tmp/$v" < $size) {
159 print "ERR: $tmp/$v too small\n";
167 sub check_max_volume_size
169 my ($size, @vol) = @_;
172 foreach my $v (@vol) {
173 if (! -f "$tmp/$v") {
174 print "ERR: $tmp/$v not accessible\n";
178 if (-s "$tmp/$v" > $size) {
179 print "ERR: $tmp/$v too big\n";
187 sub add_to_backup_list
189 open(FP, ">>$tmp/file-list") or die "Can't open $tmp/file-list for update $!";
190 print FP join("\n", @_);
194 # update client definition for the current test
195 # it permits to test remote client
198 my ($new_passwd, $new_address, $new_port) = @_;
201 open(FP, "$conf/bacula-dir.conf") or die "can't open source $!";
202 open(NEW, ">$tmp/bacula-dir.conf.$$") or die "can't open dest $!";
203 while (my $l = <FP>) {
204 if (!$in_client && $l =~ /^Client {/) {
208 if ($in_client && $l =~ /Address/i) {
209 $l = "Address = $new_address\n";
212 if ($in_client && $l =~ /FDPort/i) {
213 $l = "FDPort = $new_port\n";
216 if ($in_client && $l =~ /Password/i) {
217 $l = "Password = \"$new_passwd\"\n";
220 if ($in_client && $l =~ /^}/) {
227 my $ret = copy("$tmp/bacula-dir.conf.$$", "$conf/bacula-dir.conf");
228 unlink("$tmp/bacula-dir.conf.$$");
232 # open a directory and update all files
233 sub update_some_files
239 print "Update files in $dest\n";
240 opendir(DIR, $dest) || die "$!";
244 open(FP, ">$f") or die "$f $!";
245 print FP "$t update $f\n";
251 print "$nb files updated\n";
254 # create big number of files in a given directory
255 # Inputs: dest destination directory
256 # nb number of file to create
258 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
259 sub create_many_files
261 my ($dest, $nb) = @_;
266 $base = chr($nb % 26 + 65); # We use a base directory A-Z
269 if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
270 print "Files already created\n";
274 # auto flush stdout for dots
276 print "Create $nb files into $dest\n";
277 for(my $i=0; $i < 26; $i++) {
278 $base = chr($i + 65);
279 mkdir("$dest/$base") if (! -d "$dest/$base");
281 for(my $i=0; $i<=$nb; $i++) {
282 $base = chr($i % 26 + 65);
283 open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
287 open(FP, ">$dir/b${base}a${i}csq$base") or die "$dir $!";
288 print FP "$base $i\n";
292 $dir = "$dest/$base/$base$i$base";
295 print "." if (!($i % 10000));
300 # create big number of dirs in a given directory
301 # Inputs: dest destination directory
302 # nb number of dirs to create
304 # perl -Mscripts::functions -e 'create_many_dirs("$cwd/files", 100000)'
307 my ($dest, $nb) = @_;
312 $base = chr($nb % 26 + 65); # We use a base directory A-Z
313 $base2 = chr(($nb+10) % 26 + 65);
315 if (-d "$dest/$base/$base2/$base/a${base}a${nb}aaa${base}") {
316 print "Files already created\n";
320 # auto flush stdout for dots
322 print "Create $nb dirs into $dest\n";
323 for(my $i=0; $i < 26; $i++) {
324 $base = chr($i + 65);
325 $base2 = chr(($i+10) % 26 + 65);
326 mkdir("$dest/$base");
327 mkdir("$dest/$base/$base2");
328 mkdir("$dest/$base/$base2/$base$base2");
329 mkdir("$dest/$base/$base2/$base$base2/$base$base2");
330 mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base");
332 for(my $i=0; $i<=$nb; $i++) {
333 $base = chr($i % 26 + 65);
334 $base2 = chr(($i+10) % 26 + 65);
335 mkdir("$dest/$base/$base2/$base$base2/$base$base2/$base2$base/a${base}a${i}aaa$base");
336 print "." if (!($i % 10000));
343 if (grep {/Wanted SQL_ASCII, got UTF8/}
344 `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
346 print "Found database encoding problem, please modify the ",
347 "database encoding (SQL_ASCII)\n";
352 # You can change the maximum concurrent jobs for any config file
353 # If specified, you can change only one Resource or one type of
354 # resource at the time (optional)
355 # set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100);
356 # set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Director');
357 # set_maximum_concurrent_jobs('$conf/bacula-dir.conf', 100, 'Device', 'Drive-0');
358 sub set_maximum_concurrent_jobs
360 my ($file, $nb, $obj, $name) = @_;
362 die "Can't get new maximumconcurrentjobs"
365 add_attribute($file, "Maximum Concurrent Jobs", $nb, $obj, $name);
369 # You can add option to a resource
370 # add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Director');
371 # add_attribute('$conf/bacula-dir.conf', 'FDTimeout', 1600, 'Storage', 'FileStorage');
374 my ($file, $attr, $value, $obj, $name) = @_;
375 my ($cur_obj, $cur_name, $done);
377 open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
378 open(SRC, $file) or die "Can't open $file";
379 while (my $l = <SRC>)
386 if ($l =~ /^(\w+) {/) {
391 if ($l =~ /\Q$attr\E/i) {
392 if (!$obj || $cur_obj eq $obj) {
393 if (!$name || $cur_name eq $name) {
394 $l =~ s/\Q$attr\E\s*=\s*.+/$attr = $value/ig;
400 if ($l =~ /Name\s*=\s*"?([\w\d\.-]+)"?/i) {
406 if ($cur_obj eq $obj) {
407 if (!$name || $cur_name eq $name) {
408 $l = " $attr = $value\n$l";
412 $cur_name = $cur_obj = undef;
418 copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
421 # This test the list jobs output to check differences
422 # Input: read file argument
423 # check if all jobids in argument are present in the first
424 # 'list jobs' and not present in the second
425 # Output: exit(1) if something goes wrong and print error
429 my %to_check = map { $_ => 1} @_;
434 open(FP, $f) or die "Can't open $f $!";
435 while (my $l = <FP>) # read all files to check
437 if ($l =~ /list jobs/) {
441 if ($nb_list_job == 2) {
442 foreach my $jobid (keys %to_check) {
443 if (!$seen{$jobid}) {
444 print "ERROR: in $f, can't find $jobid in first 'list jobs'\n";
451 if ($nb_list_job == 0) {
454 if ($l =~ /Pruned (\d+) Job for client/) {
456 print "ERROR: in $f, Prune command returns $1 jobs, want $nb\n";
461 if ($l =~ /No Jobs found to prune/) {
463 print "ERROR: in $f, Prune command returns 0 job, want $nb\n";
469 # | 1 | NightlySave | 2010-06-16 22:43:05 | B | F | 27 | 4173577 | T |
470 if ($l =~ /^\|\s+(\d+)/) {
471 if ($nb_list_job == 1) {
479 foreach my $jobid (keys %to_check) {
480 if (!$seen{$jobid}) {
481 print "ERROR: in $f, $jobid in still present in the 2nd 'list jobs'\n";
485 if ($nb_list_job != 2) {
486 print "ERROR: in $f, not enough 'list jobs'\n";
492 # This test ensure that 'list copies' displays only each copy one time
494 # Input: read stream from stdin or with file list argument
495 # check the number of copies with the ARGV[1]
496 # Output: exit(1) if something goes wrong and print error
497 sub check_multiple_copies
499 my ($nb_to_found) = @_;
501 my $in_list_copies=0; # are we or not in a list copies block
502 my $nb_found=0; # count the number of copies found
506 while (my $l = <>) # read all files to check
508 if ($l =~ /list copies/) {
514 # not in a list copies anymore
515 if ($in_list_copies && $l =~ /^ /) {
521 # | 3 | Backup.2009-09-28 | 9 | DiskChangerMedia |
522 if ($in_list_copies && $l =~ /^\|\s+\d+/) {
523 my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
524 if (exists $seen{$jobid}) {
525 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
528 $seen{$jobid}=$copyid;
534 # test the number of copies against the given arg
535 if ($nb_to_found && ($nb_to_found != $nb_found)) {
536 print "ERROR: Found wrong number of copies ",
537 "($nb_to_found != $nb_found)\n";
544 use POSIX qw/strftime/;
548 print strftime('%F %T', localtime(time+$sec)), "\n";