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 check_min_volume_size check_max_volume_size $estat $bstat $rstat $zstat
43 $cwd $bin $scripts $conf $rscripts $tmp $working extract_resource
44 $db_name $db_user $db_password $src $tmpsrc);
47 use File::Copy qw/copy/;
49 our ($cwd, $bin, $scripts, $conf, $rscripts, $tmp, $working, $estat, $bstat, $zstat, $rstat,
50 $db_name, $db_user, $db_password, $src, $tmpsrc, $HOST, $BASEPORT);
53 if ($estat || $rstat || $zstat || $bstat) {
59 # start by loading the ./config file
61 if (! -f "./config") {
62 die "Could not find ./config file\n";
64 # load the ./config file in a subshell doesn't allow to use "env" to display all variable
65 open(IN, ". ./config; env |") or die "Could not run shell: $!\n";
66 while ( my $l = <IN> ) {
68 ($envar,$enval) = split (/=/,$l,2);
69 $ENV{$envar} = $enval;
75 # set internal variable name and update environment variable
76 $ENV{db_name} = $db_name = $ENV{db_name} || 'regress';
77 $ENV{db_user} = $db_user = $ENV{db_user} || 'regress';
78 $ENV{db_password} = $db_password = $ENV{db_password} || '';
80 $ENV{bin} = $bin = $ENV{bin} || "$cwd/bin";
81 $ENV{tmp} = $tmp = $ENV{tmp} || "$cwd/tmp";
82 $ENV{src} = $src = $ENV{src} || "$cwd/src";
83 $ENV{conf} = $conf = $ENV{conf} || $bin;
84 $ENV{scripts} = $scripts = $ENV{scripts} || $bin;
85 $ENV{tmpsrc} = $tmpsrc = $ENV{tmpsrc} || "$cwd/tmp/build";
86 $ENV{working} = $working = $ENV{working} || "$cwd/working";
87 $ENV{rscripts} = $rscripts = $ENV{rscripts} || "$cwd/scripts";
88 $ENV{HOST} = $HOST = $ENV{HOST} || "localhost";
89 $ENV{BASEPORT} = $BASEPORT = $ENV{BASEPORT} || "8101";
91 $estat = $rstat = $bstat = $zstat = 0;
96 my ($file, $type, $name) = @_;
98 open(FP, $file) or die "Can't open $file";
99 my $content = join("", <FP>);
101 if ($content =~ m/(^$type {[^}]+?Name\s*=\s*"?$name"?[^}]+?^})/ms) {
108 sub check_min_volume_size
110 my ($size, @vol) = @_;
113 foreach my $v (@vol) {
114 if (! -f "$tmp/$v") {
115 print "ERR: $tmp/$v not accessible\n";
119 if (-s "$tmp/$v" < $size) {
120 print "ERR: $tmp/$v too small\n";
128 sub check_max_volume_size
130 my ($size, @vol) = @_;
133 foreach my $v (@vol) {
134 if (! -f "$tmp/$v") {
135 print "ERR: $tmp/$v not accessible\n";
139 if (-s "$tmp/$v" > $size) {
140 print "ERR: $tmp/$v too big\n";
148 sub add_to_backup_list
150 open(FP, ">>$tmp/file-list") or die "Can't open $tmp/file-list for update $!";
151 print FP join("\n", @_);
155 # update client definition for the current test
156 # it permits to test remote client
159 my ($new_passwd, $new_address, $new_port) = @_;
162 open(FP, "$conf/bacula-dir.conf") or die "can't open source $!";
163 open(NEW, ">$tmp/bacula-dir.conf.$$") or die "can't open dest $!";
164 while (my $l = <FP>) {
165 if (!$in_client && $l =~ /^Client {/) {
169 if ($in_client && $l =~ /Address/i) {
170 $l = "Address = $new_address\n";
173 if ($in_client && $l =~ /FDPort/i) {
174 $l = "FDPort = $new_port\n";
177 if ($in_client && $l =~ /Password/i) {
178 $l = "Password = \"$new_passwd\"\n";
181 if ($in_client && $l =~ /^}/) {
188 my $ret = copy("$tmp/bacula-dir.conf.$$", "$conf/bacula-dir.conf");
189 unlink("$tmp/bacula-dir.conf.$$");
193 # open a directory and update all files
194 sub update_some_files
200 print "Update files in $dest\n";
201 opendir(DIR, $dest) || die "$!";
205 open(FP, ">$f") or die "$f $!";
206 print FP "$t update $f\n";
212 print "$nb files updated\n";
215 # create big number of files in a given directory
216 # Inputs: dest destination directory
217 # nb number of file to create
219 # perl -Mscripts::functions -e 'create_many_files("$cwd/files", 100000)'
220 sub create_many_files
222 my ($dest, $nb) = @_;
227 $base = chr($nb % 26 + 65); # We use a base directory A-Z
230 if (-f "$dest/$base/a${base}a${nb}aaa${base}") {
231 print "Files already created\n";
235 # auto flush stdout for dots
237 print "Create $nb files into $dest\n";
238 for(my $i=0; $i < 26; $i++) {
239 $base = chr($i + 65);
240 mkdir("$dest/$base") if (! -d "$dest/$base");
242 for(my $i=0; $i<=$nb; $i++) {
243 $base = chr($i % 26 + 65);
244 open(FP, ">$dest/$base/a${base}a${i}aaa$base") or die "$dest/$base $!";
248 open(FP, ">$dir/b${base}a${i}csq$base") or die "$dir $!";
249 print FP "$base $i\n";
253 $dir = "$dest/$base/$base$i$base";
256 print "." if (!($i % 10000));
263 if (grep {/Wanted SQL_ASCII, got UTF8/}
264 `${bin}/bacula-dir -d50 -t -c ${conf}/bacula-dir.conf 2>&1`)
266 print "Found database encoding problem, please modify the ",
267 "database encoding (SQL_ASCII)\n";
272 # This test ensure that 'list copies' displays only each copy one time
274 # Input: read stream from stdin or with file list argument
275 # check the number of copies with the ARGV[1]
276 # Output: exit(1) if something goes wrong and print error
277 sub check_multiple_copies
279 my ($nb_to_found) = @_;
281 my $in_list_copies=0; # are we or not in a list copies block
282 my $nb_found=0; # count the number of copies found
286 while (my $l = <>) # read all files to check
288 if ($l =~ /list copies/) {
294 # not in a list copies anymore
295 if ($in_list_copies && $l =~ /^ /) {
301 # | 3 | Backup.2009-09-28 | 9 | DiskChangerMedia |
302 if ($in_list_copies && $l =~ /^\|\s+\d+/) {
303 my (undef, $jobid, undef, $copyid, undef) = split(/\s*\|\s*/, $l);
304 if (exists $seen{$jobid}) {
305 print "ERROR: $jobid/$copyid already known as $seen{$jobid}\n";
308 $seen{$jobid}=$copyid;
314 # test the number of copies against the given arg
315 if ($nb_to_found && ($nb_to_found != $nb_found)) {
316 print "ERROR: Found wrong number of copies ",
317 "($nb_to_found != $nb_found)\n";