5 regress-win32.pl -- Helper for Windows regression tests
9 This perl script permits to run test Bacula Client Daemon on Windows.
11 - stop/start/upgrade the Bacula Client Daemon
12 - compare to subtree with checksums, attribs and ACL
13 - create test environments
17 X:\> regress-win32.pl [-b basedir] [-i ip_address] [-p c:/bacula]
19 X:\> perl regress-win32.pl ...
21 -b|--base=path Where to find regress and bacula directories
22 -i|--ip=ip Restrict access to this tool to this ip address
23 -p|--prefix=path Path to the windows installation
24 -h|--help Print this help
28 regress-win32.pl -b z:/git # will find z:/git/regress z:/git/bacula
30 regress-win32.pl -i 192.168.0.1 -b z:
34 This perl script needs a Perl distribution on the Windows Client
35 (http://strawberryperl.com)
37 You need to have the following subtree on x:
42 This script requires perl to work (http://strawberryperl.com), and by default
43 it assumes that Bacula is installed in the standard location. Once it's
44 started on the windows, you can do remote commands like:
47 - edit the bacula-fd.conf to change the director and password setting
48 - install a new binary version (not tested, no plugin support)
49 - create weird files and directories
50 - create files with windows attributes
51 - compare two directories (with md5)
54 To test it, you can follow this procedure
56 - install perl from http://strawberryperl.com on windows
57 - copy or export regress directory somewhere on your windows
58 - start the regress/scripts/regress-win32.pl (open it with perl.exe)
59 - create c:/tmp (not sure it's mandatory)
60 - make sure that the firewall is well configured or just disabled (needs
64 - edit config file to fill the following variables
66 WIN32_CLIENT="win2008-fd"
67 # Client FQDN or IP address
68 WIN32_ADDR="192.168.0.6"
69 # File or Directory to backup. This is put in the "File" directive
72 # Port of Win32 client
74 # Win32 Client password
76 # will be the ip address of the linux box
77 WIN32_STORE_ADDR="192.168.0.1"
80 - run ./tests/backup-bacula-test to be sure that everything is ok
81 - start ./tests/win32-fd-test
83 I'm not very happy with this script, but it works :)
102 my $bacula_prefix="c:/Program Files/Bacula";
103 my $conf = "C:/Documents and Settings/All Users/Application Data/Bacula";
104 GetOptions("base=s" => \$base,
106 "prefix=s" => \$bacula_prefix,
110 pod2usage(-verbose => 2,
114 if (! -d $bacula_prefix) {
115 print "Could not find Bacula installation dir $bacula_prefix\n";
116 print "Won't be able to upgrade the version or modify the configuration\n";
119 if (-f "$bacula_prefix/bacula-fd.conf" and -f "$conf/bacula-fd.conf") {
120 print "Unable to determine bacula-fd location $bacula_prefix or $conf ?\n";
122 } elsif (-f "$bacula_prefix/bacula-fd.conf") {
123 $conf = $bacula_prefix;
126 #if (! -d "$base/bacula" || ! -d "$base/regress") {
127 # pod2usage(-verbose => 2,
129 # -message => "Can't find bacula or regress dir on $base\n");
132 # stop the fd service
135 return `net stop bacula-fd`;
138 # copy binaries for a new fd
141 copy("$base/bacula/src/win32/release32/bacula-fd.exe",
142 "c:/Program Files/bacula/bacula-fd.exe");
144 copy("$base/bacula/src/win32/release32/bacula.dll",
145 "c:/Program Files/bacula/bacula.dll");
148 # start the fd service
151 return `net start bacula-fd`;
154 # initialize the weird directory for runscript test
155 sub init_weird_runscript_test
159 if ($r->url !~ m!^/init_weird_runscript_test\?source=(\w:/[\w/]+)$!) {
160 return "ERR\nIncorrect url\n";
164 if (!chdir($source)) {
165 return "ERR\nCan't access to $source $!\n";
168 if (-d "weird_runscript") {
169 system("rmdir /Q /S weird_runscript");
172 mkdir("weird_runscript");
173 if (!chdir("weird_runscript")) {
174 return "ERR\nCan't access to $source $!\n";
177 open(FP, ">test.bat") or return "ERR\n";
178 print FP "\@echo off\n";
179 print FP "echo hello \%1\n";
182 copy("test.bat", "test space.bat") or return "ERR\n";
183 copy("test.bat", "test2 space.bat") or return "ERR\n";
184 copy("test.bat", "testé.bat") or return "ERR\n";
186 mkdir("dir space") or return "ERR\n";
187 copy("test.bat", "dir space") or return "ERR\n";
188 copy("testé.bat","dir space") or return "ERR\n";
189 copy("test2 space.bat", "dir space") or return "ERR\n";
191 mkdir("Évoilà") or return "ERR\n";
192 copy("test.bat", "Évoilà") or return "ERR\n";
193 copy("testé.bat","Évoilà") or return "ERR\n";
194 copy("test2 space.bat", "Évoilà") or return "ERR\n";
196 mkdir("Éwith space") or return "ERR\n";
197 copy("test.bat", "Éwith space") or return "ERR\n";
198 copy("testé.bat","Éwith space") or return "ERR\n";
199 copy("test2 space.bat", "Éwith space") or return "ERR\n";
203 # init the Attrib test by creating some files and settings attributes
208 if ($r->url !~ m!^/init_attrib_test\?source=(\w:/[\w/]+)$!) {
209 return "ERR\nIncorrect url\n";
214 if (!chdir($source)) {
215 return "ERR\nCan't access to $source $!\n";
218 # cleanup the old directory if any
219 if (-d "attrib_test") {
220 system("rmdir /Q /S attrib_test");
223 mkdir("attrib_test");
224 chdir("attrib_test");
227 mkdir("hidden/something");
228 system("attrib +H hidden");
231 mkdir("readonly/something");
232 system("attrib +R readonly");
235 mkdir("normal/something");
236 system("attrib -R -H -S normal");
239 mkdir("system/something");
240 system("attrib +S system");
242 mkdir("readonly_hidden");
243 mkdir("readonly_hidden/something");
244 system("attrib +R +H readonly_hidden");
246 my $ret = `attrib /S /D`;
247 $ret = strip_base($ret, $source);
255 open(FILE, $file) or return "Can't open $file $!";
257 return Digest::MD5->new->addfile(*FILE)->hexdigest;
260 # set $src and $dst before using Find call
265 my $f = $File::Find::name;
266 $f =~ s!^\Q$src\E/?!!i;
269 if (! -f "$dst/$f") {
270 $error .= "$dst/$f is missing\n";
272 my $a = md5sum("$src/$f");
273 my $b = md5sum("$dst/$f");
275 $error .= "$src/$f $a\n$dst/$f $b\n";
281 sub set_director_name
285 if ($r->url !~ m!^/set_director_name\?name=([\w\d\.\-]+);pass=([\w\d+]+)$!)
287 return "ERR\nIncorrect url\n";
290 my ($name, $pass) = ($1, $2);
292 open(ORG, "$conf/bacula-fd.conf") or return "ERR\nORG $!\n";
293 open(NEW, ">$conf/bacula-fd.conf.new") or return "ERR\nNEW $!\n";
295 my $in_dir=0; # don't use monitoring section
297 while (my $l = <ORG>)
299 if ($l =~ /^\s*Director\s+{/i) {
302 } elsif ($l =~ /^(\s*)Name\s*=/ and $in_dir) {
303 print NEW "${1}Name=$name$nb_dir\n";
304 } elsif ($l =~ /^(\s*)Password\s*=/ and $in_dir) {
305 print NEW "${1}Password=$pass\n";
306 } elsif ($l =~ /\s*}/ and $in_dir) {
317 move("$conf/bacula-fd.conf.new", "$conf/bacula-fd.conf")
323 # convert \ to / and strip the path
326 my ($data, $path) = @_;
328 $data =~ s!\Q$path!!sig;
332 # Compare two directories, make checksums, compare attribs and ACLs
337 if ($r->url !~ m!^/compare\?source=(\w:/[\w/]+);dest=(\w:/[\w/]+)$!) {
338 return "ERR\nIncorrect url\n";
341 my ($source, $dest) = ($1, $2);
343 if (!Cwd::chdir($source)) {
344 return "ERR\nCan't access to $source $!\n";
347 my $src_attrib = `attrib /D /S`;
348 $src_attrib = strip_base($src_attrib, $source);
350 if (!Cwd::chdir($dest)) {
351 return "ERR\nCan't access to $dest $!\n";
354 my $dest_attrib = `attrib /D /S`;
355 $dest_attrib = strip_base($dest_attrib, $dest);
357 if (lc($src_attrib) ne lc($dest_attrib)) {
358 return "ERR\n$src_attrib\n=========\n$dest_attrib\n";
361 ($src, $dst, $error) = ($source, $dest, '');
362 find(\&wanted, $source);
364 return "ERR\n$error";
374 if ($r->url !~ m!^/cleandir\?source=(\w:/[\w/]+)/restore$!) {
375 return "ERR\nIncorrect url\n";
380 if (! -d "$source/restore") {
381 return "ERR\nIncorrect path\n";
384 if (!chdir($source)) {
385 return "ERR\nCan't access to $source $!\n";
388 system("rmdir /Q /S restore");
393 # When adding an action, fill this hash with the right function
397 install => \&install_fd,
398 compare => \&compare,
399 init_attrib_test => \&init_attrib_test,
400 init_weird_runscript_test => \&init_weird_runscript_test,
401 set_director_name => \&set_director_name,
402 cleandir => \&cleandir,
405 # handle client request
410 my $r = $c->get_request ;
413 $c->send_error(RC_FORBIDDEN) ;
416 if ($r->url->path !~ m!^/(\w+)!) {
417 $c->send_error(RC_NOT_FOUND) ;
422 if (($r->method eq 'GET')
423 and $action_list{$action})
425 my $ret = $action_list{$action}($r);
426 my $h = HTTP::Headers->new('Content-Type' => 'text/plain') ;
427 my $r = HTTP::Response->new(HTTP::Status::RC_OK,
430 $c->send_response($r) ;
432 $c->send_error(RC_NOT_FOUND) ;
438 my $d = HTTP::Daemon->new ( LocalPort => 8091,
440 || die "E : Can't bind $!" ;
442 my $olddir = Cwd::cwd();
445 my $ip = $c->peerhost;
447 $c->send_error(RC_FORBIDDEN) ;
448 } elsif ($src_ip && $ip ne $src_ip) {
449 $c->send_error(RC_FORBIDDEN) ;
451 handle_client($c, $ip) ;
453 $c->send_error(RC_FORBIDDEN) ;