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"
79 WIN32_USER=Administrator
85 - run ./tests/backup-bacula-test to be sure that everything is ok
86 - start ./tests/win32-fd-test
88 I'm not very happy with this script, but it works :)
107 my $bacula_prefix="c:/Program Files/Bacula";
108 my $conf = "C:/Documents and Settings/All Users/Application Data/Bacula";
109 GetOptions("base=s" => \$base,
111 "prefix=s" => \$bacula_prefix,
115 pod2usage(-verbose => 2,
119 if (! -d $bacula_prefix) {
120 print "Could not find Bacula installation dir $bacula_prefix\n";
121 print "Won't be able to upgrade the version or modify the configuration\n";
124 if (-f "$bacula_prefix/bacula-fd.conf" and -f "$conf/bacula-fd.conf") {
125 print "Unable to determine bacula-fd location $bacula_prefix or $conf ?\n";
127 } elsif (-f "$bacula_prefix/bacula-fd.conf") {
128 $conf = $bacula_prefix;
131 #if (! -d "$base/bacula" || ! -d "$base/regress") {
132 # pod2usage(-verbose => 2,
134 # -message => "Can't find bacula or regress dir on $base\n");
137 # stop the fd service
140 return `net stop bacula-fd`;
143 # copy binaries for a new fd
146 copy("$base/bacula/src/win32/release32/bacula-fd.exe",
147 "c:/Program Files/bacula/bacula-fd.exe");
149 copy("$base/bacula/src/win32/release32/bacula.dll",
150 "c:/Program Files/bacula/bacula.dll");
153 # start the fd service
156 return `net start bacula-fd`;
159 # initialize the weird directory for runscript test
160 sub init_weird_runscript_test
164 if ($r->url !~ m!^/init_weird_runscript_test\?source=(\w:/[\w/]+)$!) {
165 return "ERR\nIncorrect url\n";
169 if (!chdir($source)) {
170 return "ERR\nCan't access to $source $!\n";
173 if (-d "weird_runscript") {
174 system("rmdir /Q /S weird_runscript");
177 mkdir("weird_runscript");
178 if (!chdir("weird_runscript")) {
179 return "ERR\nCan't access to $source $!\n";
182 open(FP, ">test.bat") or return "ERR\n";
183 print FP "\@echo off\n";
184 print FP "echo hello \%1\n";
187 copy("test.bat", "test space.bat") or return "ERR\n";
188 copy("test.bat", "test2 space.bat") or return "ERR\n";
189 copy("test.bat", "testé.bat") or return "ERR\n";
191 mkdir("dir space") or return "ERR\n";
192 copy("test.bat", "dir space") or return "ERR\n";
193 copy("testé.bat","dir space") or return "ERR\n";
194 copy("test2 space.bat", "dir space") or return "ERR\n";
196 mkdir("Évoilà") or return "ERR\n";
197 copy("test.bat", "Évoilà") or return "ERR\n";
198 copy("testé.bat","Évoilà") or return "ERR\n";
199 copy("test2 space.bat", "Évoilà") or return "ERR\n";
201 mkdir("Éwith space") or return "ERR\n";
202 copy("test.bat", "Éwith space") or return "ERR\n";
203 copy("testé.bat","Éwith space") or return "ERR\n";
204 copy("test2 space.bat", "Éwith space") or return "ERR\n";
208 # init the Attrib test by creating some files and settings attributes
213 if ($r->url !~ m!^/init_attrib_test\?source=(\w:/[\w/]+)$!) {
214 return "ERR\nIncorrect url\n";
219 if (!chdir($source)) {
220 return "ERR\nCan't access to $source $!\n";
223 # cleanup the old directory if any
224 if (-d "attrib_test") {
225 system("rmdir /Q /S attrib_test");
228 mkdir("attrib_test");
229 chdir("attrib_test");
232 mkdir("hidden/something");
233 system("attrib +H hidden");
236 mkdir("readonly/something");
237 system("attrib +R readonly");
240 mkdir("normal/something");
241 system("attrib -R -H -S normal");
244 mkdir("system/something");
245 system("attrib +S system");
247 mkdir("readonly_hidden");
248 mkdir("readonly_hidden/something");
249 system("attrib +R +H readonly_hidden");
251 my $ret = `attrib /S /D`;
252 $ret = strip_base($ret, $source);
260 open(FILE, $file) or return "Can't open $file $!";
262 return Digest::MD5->new->addfile(*FILE)->hexdigest;
265 # set $src and $dst before using Find call
270 my $f = $File::Find::name;
271 $f =~ s!^\Q$src\E/?!!i;
274 if (! -f "$dst/$f") {
275 $error .= "$dst/$f is missing\n";
277 my $a = md5sum("$src/$f");
278 my $b = md5sum("$dst/$f");
280 $error .= "$src/$f $a\n$dst/$f $b\n";
286 sub set_director_name
290 if ($r->url !~ m!^/set_director_name\?name=([\w\d\.\-]+);pass=([\w\d+]+)$!)
292 return "ERR\nIncorrect url\n";
295 my ($name, $pass) = ($1, $2);
297 open(ORG, "$conf/bacula-fd.conf") or return "ERR\nORG $!\n";
298 open(NEW, ">$conf/bacula-fd.conf.new") or return "ERR\nNEW $!\n";
300 my $in_dir=0; # don't use monitoring section
302 while (my $l = <ORG>)
304 if ($l =~ /^\s*Director\s+{/i) {
307 } elsif ($l =~ /^(\s*)Name\s*=/ and $in_dir) {
308 print NEW "${1}Name=$name$nb_dir\n";
309 } elsif ($l =~ /^(\s*)Password\s*=/ and $in_dir) {
310 print NEW "${1}Password=$pass\n";
311 } elsif ($l =~ /\s*}/ and $in_dir) {
322 move("$conf/bacula-fd.conf.new", "$conf/bacula-fd.conf")
328 # convert \ to / and strip the path
331 my ($data, $path) = @_;
333 $data =~ s!\Q$path!!sig;
337 # Compare two directories, make checksums, compare attribs and ACLs
342 if ($r->url !~ m!^/compare\?source=(\w:/[\w/]+);dest=(\w:/[\w/]+)$!) {
343 return "ERR\nIncorrect url\n";
346 my ($source, $dest) = ($1, $2);
348 if (!Cwd::chdir($source)) {
349 return "ERR\nCan't access to $source $!\n";
352 my $src_attrib = `attrib /D /S`;
353 $src_attrib = strip_base($src_attrib, $source);
355 if (!Cwd::chdir($dest)) {
356 return "ERR\nCan't access to $dest $!\n";
359 my $dest_attrib = `attrib /D /S`;
360 $dest_attrib = strip_base($dest_attrib, $dest);
362 if (lc($src_attrib) ne lc($dest_attrib)) {
363 return "ERR\n$src_attrib\n=========\n$dest_attrib\n";
366 ($src, $dst, $error) = ($source, $dest, '');
367 find(\&wanted, $source);
369 return "ERR\n$error";
379 if ($r->url !~ m!^/cleandir\?source=(\w:/[\w/]+)/restore$!) {
380 return "ERR\nIncorrect url\n";
385 if (! -d "$source/restore") {
386 return "ERR\nIncorrect path\n";
389 if (!chdir($source)) {
390 return "ERR\nCan't access to $source $!\n";
393 system("rmdir /Q /S restore");
400 Win32::InitiateSystemShutdown('', "\nSystem will now Reboot\!", 2, 0, 1 );
409 if ($r->url !~ m!^/set_service\?srv=([\w-]+);action=(\w+)$!) {
410 return "ERR\nIncorrect url\n";
412 my $out = `sc config $1 start= $2`;
413 if ($out !~ /SUCCESS/) {
424 if ($r->url !~ m!^/get_service\?srv=([\w-]+);state=(\w+)$!) {
425 return "ERR\nIncorrect url\n";
427 my $out = `sc query $1`;
437 if ($r->url !~ m!^/add_registry_key\?key=(\w+);val=(\w+)$!) {
438 return "ERR\nIncorrect url\n";
440 my ($k, $v) = ($1,$2);
443 or return "ERR\nCan't open tmp.reg $!\n";
445 print FP "Windows Registry Editor Version 5.00
447 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula]
452 system("regedit /s tmp.reg");
455 system("regedit /e tmp2.reg HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula");
457 open(FP, "<:encoding(UTF-16LE)", "tmp2.reg")
458 or return "ERR\nCan't open tmp2.reg $!\n";
459 while (my $l = <FP>) {
460 if ($l =~ /"$k"="$v"/) {
474 $self =~ s/\\/\\\\/g;
477 if ($r->url !~ m!^/set_auto_logon\?user=(\w+);pass=([\w\d\,:*+-]*)$!) {
478 return "ERR\nIncorrect url\n";
481 my $v = $2 || ''; # password can be empty
483 open(FP, ">c:/autologon.reg")
484 or return "ERR\nCan't open tmp.reg $!\n";
485 print FP "Windows Registry Editor Version 5.00
487 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Winlogon]
488 \"DefaultUserName\"=\"$k\"
489 \"DefaultPassword\"=\"$v\"
490 \"AutoAdminLogon\"=\"1\"
492 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Run]
493 \"regress\"=\"$p $self\"
497 system("regedit /s c:\autologon.reg");
500 system("regedit /e tmp2.reg \"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Winlogon\"");
502 open(FP, "<:encoding(UTF-16LE)", "tmp2.reg")
503 or return "ERR\nCan't open tmp2.reg $!\n";
504 while (my $l = <FP>) {
505 if ($l =~ /"AutoAdminLogon"="1"/) {
517 if ($r->url !~ m!^/del_registry_key\?key=(\w+)$!) {
518 return "ERR\nIncorrect url\n";
525 or return "ERR\nCan't open tmp.reg $!\n";
526 print FP "Windows Registry Editor Version 5.00
528 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula]
533 system("regedit /s tmp.reg");
534 system("regedit /e tmp2.reg HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula");
536 open(FP, "<:encoding(UTF-16LE)", "tmp2.reg")
537 or return "ERR\nCan't open tmp2.reg $!\n";
538 while (my $l = <FP>) {
553 if ($r->url !~ m!^/get_registry_key\?key=(\w+);val=(\w+)$!) {
554 return "ERR\nIncorrect url\n";
556 my ($k, $v) = ($1, $2);
559 system("regedit /e tmp2.reg HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula");
560 open(FP, "<:encoding(UTF-16LE)", "tmp2.reg")
561 or return "ERR\nCan't open tmp2.reg $!\n";
562 while (my $l = <FP>) {
563 if ($l =~ /"$k"="$v"/) {
576 use File::Find qw/find/;
579 if ($_ =~ /sqlcmd.exe/i) {
580 $mssql_bin = $File::Find::name;
584 # Verify that we can use SQLCMD.exe
589 if ($r->url !~ m!^/check_mssql\?user=(\w+);pass=(.+)$!) {
590 return "ERR\nIncorrect url\n";
592 ($mssql_user, $mssql_pass) = ($1, $2);
594 unless ($mssql_bin) {
595 find(\&find_mssql, 'c:/program files/microsoft sql server/');
602 print $mssql_bin, "\n";
604 my $res = `"$mssql_bin" -U $mssql_user -P $mssql_pass -Q "SELECT 'OK';"`;
606 print "Can't run sql\n";
612 # Create simple DB, a table and some information in
617 if ($r->url !~ m!^/setup_mssql_db\?db=([\w\d]+)$!) {
618 return "ERR\nIncorrect url\n";
622 unless ($mssql_bin) {
623 print "Can't find mssql bin\n";
627 my $res = `"$mssql_bin" -U $mssql_user -P $mssql_pass -Q "CREATE DATABASE $db;"`;
628 $res = `"$mssql_bin" -U $mssql_user -P $mssql_pass -d $db -Q "CREATE TABLE table1 (a int, b int);"`;
629 $res = `"$mssql_bin" -U $mssql_user -P $mssql_pass -d $db -Q "INSERT INTO table1 (a, b) VALUES (1,1);"`;
630 $res = `"$mssql_bin" -U $mssql_user -P $mssql_pass -d $db -Q "SELECT 'OK' FROM table1;"`;
633 print "Can't run sql\n";
644 if ($r->url !~ m!^/cleanup_mssql_db\?db=([\w\d]+)$!) {
645 return "ERR\nIncorrect url\n";
649 unless ($mssql_bin) {
650 print "Can't find mssql bin\n";
654 my $res = `"$mssql_bin" -U $mssql_user -P $mssql_pass -Q "DROP DATABASE $db;"`;
659 # truncate the table that is in database
660 sub truncate_mssql_table
664 if ($r->url !~ m!^/truncate_mssql_table\?db=([\w\d]+)$!) {
665 return "ERR\nIncorrect url\n";
669 unless ($mssql_bin) {
670 print "Can't find mssql bin\n";
674 my $res = `"$mssql_bin" -U $mssql_user -P $mssql_pass -d $db -Q "TRUNCATE TABLE table1;"`;
675 $res = `"$mssql_bin" -U $mssql_user -P $mssql_pass -d $db -Q "SELECT 'OK' FROM table1;"`;
678 print "Can't truncate\n";
684 # test that table1 contains some rows
685 sub test_mssql_content
689 if ($r->url !~ m!^/test_mssql_content\?db=([\w\d]+)$!) {
690 return "ERR\nIncorrect url\n";
694 unless ($mssql_bin) {
695 print "Can't find mssql bin\n";
699 my $res = `"$mssql_bin" -U $mssql_user -P $mssql_pass -d $db -Q "SELECT 'OK' FROM table1;"`;
702 print "no content\n";
712 if ($_ =~ /$mdf_to_find/i) {
713 $mssql_mdf = $File::Find::dir;
721 if ($r->url !~ m!^/online_mssql_db\?mdf=([\w\d]+);db=([\w\d]+)$!) {
722 return "ERR\nIncorrect url\n";
724 my ($mdf, $db) = ($1, $2);
725 $mdf_to_find = "$mdf.mdf";
727 find(\&find_mdf, 'c:/program files/microsoft sql server/');
728 $mssql_mdf =~ s:/:\\:g;
730 open(FP, ">c:/mssql.sql");
734 CREATE DATABASE [$db] ON
735 ( FILENAME = N'$mssql_mdf\\$mdf.mdf' ),
736 ( FILENAME = N'$mssql_mdf\\${mdf}_log.LDF' )
741 SELECT 'OK' FROM table1
745 my $res = `"$mssql_bin" -U $mssql_user -P $mssql_pass -i c:\\mssql.sql`;
746 #unlink("c:/mssql.sql");
748 print "no content\n";
754 # When adding an action, fill this hash with the right function
756 nop => sub { return "OK\n"; },
759 install => \&install_fd,
760 compare => \&compare,
761 init_attrib_test => \&init_attrib_test,
762 init_weird_runscript_test => \&init_weird_runscript_test,
763 set_director_name => \&set_director_name,
764 cleandir => \&cleandir,
765 add_registry_key => \&add_registry_key,
766 del_registry_key => \&del_registry_key,
767 get_registry_key => \&get_registry_key,
768 quit => sub { exit 0; },
770 set_service => \&set_service,
771 get_service => \&get_service,
772 set_auto_logon => \&set_auto_logon,
774 check_mssql => \&check_mssql,
775 setup_mssql_db => \&setup_mssql_db,
776 cleanup_mssql_db => \&cleanup_mssql_db,
777 truncate_mssql_table => \&truncate_mssql_table,
778 test_mssql_content => \&test_mssql_content,
779 online_mssql_db => \&online_mssql_db,
782 # handle client request
787 my $r = $c->get_request ;
790 $c->send_error(RC_FORBIDDEN) ;
793 if ($r->url->path !~ m!^/(\w+)!) {
794 $c->send_error(RC_NOT_FOUND) ;
799 if (($r->method eq 'GET')
800 and $action_list{$action})
802 my $ret = $action_list{$action}($r);
803 my $h = HTTP::Headers->new('Content-Type' => 'text/plain') ;
804 my $r = HTTP::Response->new(HTTP::Status::RC_OK,
807 $c->send_response($r) ;
809 $c->send_error(RC_NOT_FOUND) ;
815 my $d = HTTP::Daemon->new ( LocalPort => 8091,
817 || die "Error: Can't bind $!" ;
819 my $olddir = Cwd::cwd();
821 print "Starting daemon...\n";
823 my $ip = $c->peerhost;
825 $c->send_error(RC_FORBIDDEN) ;
826 } elsif ($src_ip && $ip ne $src_ip) {
827 $c->send_error(RC_FORBIDDEN) ;
829 handle_client($c, $ip) ;
831 $c->send_error(RC_FORBIDDEN) ;