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
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) = @_;
359 my ($cur_obj, $cur_name);
361 die "Can't get new maximumconcurrentjobs"
364 open(FP, ">$tmp/1.$$") or die "Can't write to $tmp/1.$$";
365 open(SRC, $file) or die "Can't open $file";
366 while (my $l = <SRC>)
368 if ($l =~ /^(\w+) {/) {
372 if ($l =~ /maximum\s*concurrent\s*jobs/i) {
373 if (!$obj || $cur_obj eq $obj) {
374 if (!$name || $cur_name eq $name) {
375 $l =~ s/maximum\s*concurrent\s*jobs\s*=\s*\d+/Maximum Concurrent Jobs = $nb/ig;
380 if ($l =~ /Name\s*=\s*"?([\w\d\.-])"?/i) {
385 $cur_name = $cur_obj = undef;
391 copy("$tmp/1.$$", $file) or die "Can't copy $tmp/1.$$ to $file";
394 # This test ensure that 'list copies' displays only each copy one time
396 # Input: read stream from stdin or with file list argument
397 # check the number of copies with the ARGV[1]
398 # Output: exit(1) if something goes wrong and print error
399 sub check_multiple_copies
401 my ($nb_to_found) = @_;
403 my $in_list_copies=0; # are we or not in a list copies block
404 my $nb_found=0; # count the number of copies found
408 while (my $l = <>) # read all files to check
410 if ($l =~ /list copies/) {
416 # not in a list copies anymore
417 if ($in_list_copies && $l =~ /^ /) {
423 # | 3 | Backup.2009-09-28 | 9 | DiskChangerMedia |
424 if ($in_list_copies && $l =~ /^\|\s+\d+/) {
425 my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
426 if (exists $seen{$jobid}) {
427 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
430 $seen{$jobid}=$copyid;
436 # test the number of copies against the given arg
437 if ($nb_to_found && ($nb_to_found != $nb_found)) {
438 print "ERROR: Found wrong number of copies ",
439 "($nb_to_found != $nb_found)\n";
446 use POSIX qw/strftime/;
450 print strftime('%F %T', localtime(time+$sec)), "\n";