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 You can use a network share to your regress directory on linux
59 Then, copy a link to this script to your desktop
60 And double-click on it, and always open .pl file with perl.exe
62 - If you export the regress directory to your windows box and you
63 make windows binaries available, this script can update bacula version.
64 You need to put your binaries on:
65 regress/release32 and regress/release64
67 regress/build/src/win32/release32 and regress/build/src/win32/release64
69 - start the regress/scripts/regress-win32.pl (open it with perl.exe)
71 - make sure that the firewall is well configured or just disabled (needs
75 - edit config file to fill the following variables
77 WIN32_CLIENT="win2008-fd"
78 # Client FQDN or IP address
79 WIN32_ADDR="192.168.0.6"
80 # File or Directory to backup. This is put in the "File" directive
83 # Port of Win32 client
85 # Win32 Client password
87 # will be the ip address of the linux box
88 WIN32_STORE_ADDR="192.168.0.1"
90 WIN32_USER=Administrator
96 - run ./tests/backup-bacula-test to be sure that everything is ok
97 - start ./tests/win32-fd-test
99 I'm not very happy with this script, but it works :)
115 use File::Basename qw/dirname/;
120 my $bacula_prefix="c:/Program Files/Bacula";
121 my $conf = "C:/Documents and Settings/All Users/Application Data/Bacula";
122 GetOptions("base=s" => \$base,
124 "prefix=s" => \$bacula_prefix,
128 pod2usage(-verbose => 2,
132 if (! -d $bacula_prefix) {
133 print "regress-win32.pl: Could not find Bacula installation dir $bacula_prefix\n";
134 print "regress-win32.pl: Won't be able to upgrade the version or modify the configuration\n";
137 if (-f "$bacula_prefix/bacula-fd.conf" and -f "$conf/bacula-fd.conf") {
138 print "regress-win32.pl: Unable to determine bacula-fd location $bacula_prefix or $conf ?\n";
140 } elsif (-f "$bacula_prefix/bacula-fd.conf") {
141 $conf = $bacula_prefix;
144 #if (! -d "$base/bacula" || ! -d "$base/regress") {
145 # pod2usage(-verbose => 2,
147 # -message => "Can't find bacula or regress dir on $base\n");
150 # stop the fd service
153 return `net stop bacula-fd`;
160 if ($_ =~ /bacula-fd.exe/i) {
161 if ($File::Find::dir =~ /release$arch/) {
162 $bin_path = $File::Find::dir;
167 # copy binaries for a new fd
168 # to work, you need to mount the regress directory
172 if ($r->url !~ m!^/install$!) {
173 return "ERR\nIncorrect url: " . $r->url . "\n";
176 if (-d "c:/Program Files (x86)") {
182 # X:/regress/scripts/regress-win32.pl
183 # X:/scripts/regress-win32.pl
184 # perl script location
186 my $dir = dirname(dirname($0));
187 print "searching bacula-fd.exe in $dir\n";
188 find(\&find_binaries, ("$dir\\build\\src\\win32\\release$arch",
189 "$dir\\release$arch"));
192 return "ERR\nCan't find bacula-fd.exe in $dir\n";
195 print "Found binaries in $bin_path\n";
199 system("del \"c:\\Program Files\\bacula\\bacula.dll\"");
200 system("del \"c:\\Program Files\\bacula\\bacula-fd.exe\"");
201 system("del \"c:\\Program Files\\bacula\\plugins\\vss-fd.dll\"");
205 copy("$bin_path/bacula-fd.exe",
206 "c:/Program Files/bacula/bacula-fd.exe") or $ret="ERR\n$!\n";
208 copy("$bin_path/bacula.dll",
209 "c:/Program Files/bacula/bacula.dll") or $ret="ERR\n$!\n";
211 copy("$bin_path/vss-fd.dll",
212 "c:/Program Files/bacula/plugins/vss-fd.dll") or $ret="ERR\n$!\n";
218 # start the fd service
221 return `net start bacula-fd`;
224 # initialize the weird directory for runscript test
225 sub init_weird_runscript_test
229 if ($r->url !~ m!^/init_weird_runscript_test\?source=(\w:/[\w\d\-\./]+)$!) {
230 return "ERR\nIncorrect url: ". $r->url . "\n";
234 # Create $source if needed
237 system("mkdir $tmp");
239 if (!chdir($source)) {
240 return "ERR\nCan't access to $source $!\n";
243 if (-d "weird_runscript") {
244 system("rmdir /Q /S weird_runscript");
247 mkdir("weird_runscript");
248 if (!chdir("weird_runscript")) {
249 return "ERR\nCan't access to $source $!\n";
252 open(FP, ">test.bat") or return "ERR\n";
253 print FP "\@echo off\n";
254 print FP "echo hello \%1\n";
257 copy("test.bat", "test space.bat") or return "ERR\n";
258 copy("test.bat", "test2 space.bat") or return "ERR\n";
259 copy("test.bat", "testé.bat") or return "ERR\n";
261 mkdir("dir space") or return "ERR\n";
262 copy("test.bat", "dir space") or return "ERR\n";
263 copy("testé.bat","dir space") or return "ERR\n";
264 copy("test2 space.bat", "dir space") or return "ERR\n";
266 mkdir("Évoilà ") or return "ERR\n";
267 copy("test.bat", "Évoilà ") or return "ERR\n";
268 copy("testé.bat","Évoilà ") or return "ERR\n";
269 copy("test2 space.bat", "Évoilà ") or return "ERR\n";
271 mkdir("Éwith space") or return "ERR\n";
272 copy("test.bat", "Éwith space") or return "ERR\n";
273 copy("testé.bat","Éwith space") or return "ERR\n";
274 copy("test2 space.bat", "Éwith space") or return "ERR\n";
276 copy("test.bat", "a"x200);
277 system("mklink /J junc " . "a"x200); # TODO: need something for win2003
278 link("test.bat", "link.bat");
282 # init the Attrib test by creating some files and settings attributes
287 if ($r->url !~ m!^/init_attrib_test\?source=(\w:/[\w/]+)$!) {
288 return "ERR\nIncorrect url: " . $r->url . "\n";
292 system("mkdir $source");
294 if (!chdir($source)) {
295 return "ERR\nCan't access to $source $!\n";
298 # cleanup the old directory if any
299 if (-d "attrib_test") {
300 system("rmdir /Q /S attrib_test");
303 mkdir("attrib_test");
304 chdir("attrib_test");
307 mkdir("hidden/something");
308 system("attrib +H hidden");
311 mkdir("readonly/something");
312 system("attrib +R readonly");
315 mkdir("normal/something");
316 system("attrib -R -H -S normal");
319 mkdir("system/something");
320 system("attrib +S system");
322 mkdir("readonly_hidden");
323 mkdir("readonly_hidden/something");
324 system("attrib +R +H readonly_hidden");
326 my $ret = `attrib /S /D`;
327 $ret = strip_base($ret, $source);
335 open(FILE, $file) or return "Can't open $file $!";
337 return Digest::MD5->new->addfile(*FILE)->hexdigest;
340 # set $src and $dst before using Find call
345 my $f = $File::Find::name;
346 $f =~ s!^\Q$src\E/?!!i;
349 if (! -f "$dst/$f") {
350 $error .= "$dst/$f is missing\n";
352 my $a = md5sum("$src/$f");
353 my $b = md5sum("$dst/$f");
355 $error .= "$src/$f $a\n$dst/$f $b\n";
364 if ($r->url !~ m!^/create_schedtask\?name=([\w\d\-.]+)$!) {
365 return "ERR\nIncorrect url: " . $r->url . "\n";
368 my ($task,$pass) = ($1, $2);
369 my (undef, undef, $version, undef) = POSIX::uname();
370 if ($version < 6) { # win2003
371 $ret = `echo pass | SCHTASKS /Create /TN $task /SC ONLOGON /TR C:\\windows\\system32\\calc.exe /F 2>&1`;
373 $ret=`SCHTASKS /Create /TN $task /SC ONLOGON /F /TR C:\\windows\\system32\\calc.exe`;
376 if ($ret =~ /SUCCESS|has been created/) {
382 # SCHTASKS /Create [/S system [/U username [/P [password]]]]
383 # [/RU username [/RP password]] /SC schedule [/MO modifier] [/D day]
384 # [/M months] [/I idletime] /TN taskname /TR taskrun [/ST starttime]
385 # [/RI interval] [ {/ET endtime | /DU duration} [/K] [/XML xmlfile] [/V1]]
386 # [/SD startdate] [/ED enddate] [/IT | /NP] [/Z] [/F]
392 if ($r->url !~ m!^/del_schedtask\?name=([\w\d\-.]+)$!) {
393 return "ERR\nIncorrect url: " . $r->url . "\n";
396 my $ret=`SCHTASKS /Delete /TN $task /F`;
398 if ($ret =~ /SUCCESS/) {
408 if ($r->url !~ m!^/check_schedtask\?name=([\w\d\-.]+)$!) {
409 return "ERR\nIncorrect url: " . $r->url . "\n";
413 my (undef, undef, $version, undef) = POSIX::uname();
415 if ($version < 6) { # win2003
416 $ret=`SCHTASKS /Query`;
418 $ret=`SCHTASKS /Query /TN $task`;
421 if ($ret =~ /^($task .+)$/m) {
428 sub set_director_name
432 if ($r->url !~ m!^/set_director_name\?name=([\w\d\.\-]+);pass=([\w\d+\-\.*]+)$!)
434 return "ERR\nIncorrect url: " . $r->url . "\n";
437 my ($name, $pass) = ($1, $2);
439 open(ORG, "$conf/bacula-fd.conf") or return "ERR\nORG $!\n";
440 open(NEW, ">$conf/bacula-fd.conf.new") or return "ERR\nNEW $!\n";
442 my $in_dir=0; # don't use monitoring section
444 while (my $l = <ORG>)
446 if ($l =~ /^\s*Director\s+{/i) {
449 } elsif ($l =~ /^(\s*)Name\s*=/ and $in_dir) {
450 print NEW "${1}Name=$name$nb_dir\n";
451 } elsif ($l =~ /^(\s*)Password\s*=/ and $in_dir) {
452 print NEW "${1}Password=$pass\n";
453 } elsif ($l =~ /#(\s*Plugin.*)$/) {
455 } elsif ($l =~ /\s*}/ and $in_dir) {
466 move("$conf/bacula-fd.conf.new", "$conf/bacula-fd.conf")
469 return "ERR\nCan't set the director name\n";
472 # convert \ to / and strip the path
475 my ($data, $path) = @_;
477 $data =~ s!\Q$path!!sig;
481 # Compare two directories, make checksums, compare attribs and ACLs
486 if ($r->url !~ m!^/compare\?source=(\w:/[\w/]+);dest=(\w:/[\w/]+)$!) {
487 return "ERR\nIncorrect url: " . $r->url . "\n";
490 my ($source, $dest) = ($1, $2);
492 if (!Cwd::chdir($source)) {
493 return "ERR\nCan't access to $source $!\n";
496 my $src_attrib = `attrib /D /S`;
497 $src_attrib = strip_base($src_attrib, $source);
499 if (!Cwd::chdir($dest)) {
500 return "ERR\nCan't access to $dest $!\n";
503 my $dest_attrib = `attrib /D /S`;
504 $dest_attrib = strip_base($dest_attrib, $dest);
506 if (lc($src_attrib) ne lc($dest_attrib)) {
507 print "ERR\n$src_attrib\n=========\n$dest_attrib\n";
508 return "ERR\n$src_attrib\n=========\n$dest_attrib\n";
511 ($src, $dst, $error) = ($source, $dest, '');
512 find(\&wanted, $source);
514 return "ERR\n$error";
524 if ($r->url !~ m!^/cleandir\?source=(\w:/[\w/]+)/restore$!) {
525 return "ERR\nIncorrect url: " . $r->url . "\n";
530 if (! -d "$source/restore") {
531 return "ERR\nIncorrect path\n";
534 if (!chdir($source)) {
535 return "ERR\nCan't access to $source $!\n";
538 system("rmdir /Q /S restore");
545 Win32::InitiateSystemShutdown('', "\nSystem will now Reboot\!", 2, 0, 1 );
554 if ($r->url !~ m!^/set_service\?srv=([\w-]+);action=(\w+)$!) {
555 return "ERR\nIncorrect url: " . $r->url . "\n";
557 my $out = `sc config $1 start= $2`;
558 if ($out !~ /SUCCESS/) {
569 if ($r->url !~ m!^/get_service\?srv=([\w-]+);state=(\w+)$!) {
570 return "ERR\nIncorrect url: " . $r->url . "\n";
572 my $out = `sc query $1`;
582 if ($r->url !~ m!^/add_registry_key\?key=(\w+);val=(\w+)$!) {
583 return "ERR\nIncorrect url: " . $r->url . "\n";
585 my ($k, $v) = ($1,$2);
588 or return "ERR\nCan't open tmp.reg $!\n";
590 print FP "Windows Registry Editor Version 5.00
592 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula]
597 system("regedit /s tmp.reg");
600 system("regedit /e tmp2.reg HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula");
602 open(FP, "<:encoding(UTF-16LE)", "tmp2.reg")
603 or return "ERR\nCan't open tmp2.reg $!\n";
604 while (my $l = <FP>) {
605 if ($l =~ /"$k"="$v"/) {
618 my $self = $0; # perl script location
619 $self =~ s/\\/\\\\/g;
620 my $p = $^X; # perl.exe location
622 if ($r->url !~ m!^/set_auto_logon\?user=([\w\d\-+\.]+);pass=([\w\d\.\,:*+%\-]*)$!) {
623 return "ERR\nIncorrect url: " . $r->url . "\n";
626 my $v = $2 || ''; # password can be empty
627 my $ret = "ERR\nCan't find AutoAdminLogon key\n";
628 open(FP, ">c:/autologon.reg")
629 or return "ERR\nCan't open autologon.reg $!\n";
630 print FP "Windows Registry Editor Version 5.00
632 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Winlogon]
633 \"DefaultUserName\"=\"$k\"
634 \"DefaultPassword\"=\"$v\"
635 \"AutoAdminLogon\"=\"1\"
637 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Run]
638 \"regress\"=\"$p $self\"
640 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Reliability]
641 \"ShutdownReasonUI\"=dword:00000000
643 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Policies\\Microsoft\\Windows NT\\Reliability]
644 \"ShutdownReasonOn\"=dword:00000000
647 system("regedit /s c:\\autologon.reg");
650 system("regedit /e tmp2.reg \"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Winlogon\"");
652 open(FP, "<:encoding(UTF-16LE)", "tmp2.reg")
653 or return "ERR\nCan't open tmp2.reg $!\n";
654 while (my $l = <FP>) {
655 if ($l =~ /"AutoAdminLogon"="1"/) {
667 if ($r->url !~ m!^/del_registry_key\?key=(\w+)$!) {
668 return "ERR\nIncorrect url: " . $r->url . "\n";
675 or return "ERR\nCan't open tmp.reg $!\n";
676 print FP "Windows Registry Editor Version 5.00
678 [HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula]
683 system("regedit /s tmp.reg");
684 system("regedit /e tmp2.reg HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula");
686 open(FP, "<:encoding(UTF-16LE)", "tmp2.reg")
687 or return "ERR\nCan't open tmp2.reg $!\n";
688 while (my $l = <FP>) {
690 $ret = "ERR\nThe key $k is still present\n";
702 if ($r->url !~ m!^/get_registry_key\?key=(\w+);val=(\w+)$!) {
703 return "ERR\nIncorrect url: " . $r->url . "\n";
705 my ($k, $v) = ($1, $2);
706 my $ret = "ERR\nCan't get or verify registry key $k\n";
709 system("regedit /e tmp2.reg HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula");
710 open(FP, "<:encoding(UTF-16LE)", "tmp2.reg")
711 or return "ERR\nCan't open tmp2.reg $!\n";
712 while (my $l = <FP>) {
713 if ($l =~ /"$k"="$v"/) {
729 if ($_ =~ /sqlcmd.exe/i) {
730 $mssql_bin = $File::Find::name;
734 # Verify that we can use SQLCMD.exe
739 if ($r->url !~ m!^/check_mssql\?user=(\w*);pass=(.*)$!) {
740 return "ERR\nIncorrect url: " . $r->url . "\n";
742 ($mssql_user, $mssql_pass) = ($1, $2);
744 unless ($mssql_bin) {
745 find(\&find_mssql, 'c:/program files/microsoft sql server/');
747 unless ($mssql_bin) {
748 find(\&find_mssql, 'c:/program files (x86)/microsoft sql server/');
752 return "ERR\nCan't find SQLCMD.exe in c:/program files\n";
755 print $mssql_bin, "\n";
756 $mssql_cred = ($mssql_user)?"-U $mssql_user -P $mssql_pass":"";
757 my $res = `"$mssql_bin" $mssql_cred -Q "SELECT 'OK';"`;
759 return "ERR\nCan't verify the SQLCMD result\n" .
760 "Please verify that MSSQL is accepting connection:\n" .
761 "$mssql_bin $mssql_cred -Q \"SELECT 1;\"\n";
766 # Create simple DB, a table and some information in
771 if ($r->url !~ m!^/setup_mssql_db\?db=([\w\d]+)$!) {
772 return "ERR\nIncorrect url: " . $r->url . "\n";
776 unless ($mssql_bin) {
777 return "ERR\nCan't find mssql bin (run check_mssql first)\n";
780 my $res = `"$mssql_bin" $mssql_cred -Q "CREATE DATABASE $db;"`;
781 $res = `"$mssql_bin" $mssql_cred -d $db -Q "CREATE TABLE table1 (a int, b int);"`;
782 $res = `"$mssql_bin" $mssql_cred -d $db -Q "INSERT INTO table1 (a, b) VALUES (1,1);"`;
783 $res = `"$mssql_bin" $mssql_cred -d $db -Q "SELECT 'OK' FROM table1;"`;
786 return "ERR\nCan't verify the SQLCMD result\n" .
787 "Please verify that MSSQL is accepting connection:\n" .
788 "$mssql_bin $mssql_cred -Q \"SELECT 1;\"\n";
798 if ($r->url !~ m!^/cleanup_mssql_db\?db=([\w\d]+)$!) {
799 return "ERR\nIncorrect url: " . $r->url . "\n";
803 unless ($mssql_bin) {
804 return "ERR\nCan't find mssql bin\n";
807 my $res = `"$mssql_bin" $mssql_cred -Q "DROP DATABASE $db;"`;
812 # truncate the table that is in database
813 sub truncate_mssql_table
817 if ($r->url !~ m!^/truncate_mssql_table\?db=([\w\d]+)$!) {
818 return "ERR\nIncorrect url: " . $r->url . "\n";
822 unless ($mssql_bin) {
823 return "ERR\nCan't find mssql bin\n";
826 my $res = `"$mssql_bin" $mssql_cred -d $db -Q "TRUNCATE TABLE table1;"`;
827 $res = `"$mssql_bin" $mssql_cred -d $db -Q "SELECT 'OK' FROM table1;"`;
830 return "ERR\nCan't truncate $db.table1\n";
835 # test that table1 contains some rows
836 sub test_mssql_content
840 if ($r->url !~ m!^/test_mssql_content\?db=([\w\d]+)$!) {
841 return "ERR\nIncorrect url: " . $r->url . "\n";
845 unless ($mssql_bin) {
846 return "ERR\nCan't find mssql bin\n";
849 my $res = `"$mssql_bin" $mssql_cred -d $db -Q "SELECT 'OK' FROM table1;"`;
852 return "ERR\nNo content from $mssql_bin\n$res\n";
861 if ($_ =~ /$mdf_to_find/i) {
862 $mssql_mdf = $File::Find::dir;
870 if ($r->url !~ m!^/online_mssql_db\?mdf=([\w\d]+);db=([\w\d]+)$!) {
871 return "ERR\nIncorrect url: " . $r->url . "\n";
873 my ($mdf, $db) = ($1, $2);
874 $mdf_to_find = "$mdf.mdf";
876 find(\&find_mdf, 'c:/program files/microsoft sql server/');
877 unless ($mssql_mdf) {
878 find(\&find_mssql, 'c:/program files (x86)/microsoft sql server/');
880 unless ($mssql_mdf) {
881 return "ERR\nCan't find $mdf.mdf in c:/program files\n";
883 $mssql_mdf =~ s:/:\\:g;
885 open(FP, ">c:/mssql.sql");
889 CREATE DATABASE [$db] ON
890 ( FILENAME = N'$mssql_mdf\\$mdf.mdf' ),
891 ( FILENAME = N'$mssql_mdf\\${mdf}_log.LDF' )
896 SELECT 'OK' FROM table1
900 my $res = `"$mssql_bin" $mssql_cred -i c:\\mssql.sql`;
901 #unlink("c:/mssql.sql");
903 return "ERR\nNo content from $mssql_bin\n";
908 # create a script c:/del.cmd to delete protected files with runscript
912 if ($r->url !~ m!^/remove_dir\?file=([\w\d:\/\.\-+*]+);dest=([\w\d\.:\/]+)$!) {
913 return "ERR\nIncorrect url: " . $r->url . "\n";
915 my ($file, $cmd) = ($1, $2);
918 open(FP, ">$cmd") or return "ERR\nCan't open $file $!\n";
919 print FP "DEL /F /S /Q $file\n";
924 # When adding an action, fill this hash with the right function
926 nop => sub { return "OK\n"; },
929 install => \&install_fd,
930 compare => \&compare,
931 init_attrib_test => \&init_attrib_test,
932 init_weird_runscript_test => \&init_weird_runscript_test,
933 set_director_name => \&set_director_name,
934 cleandir => \&cleandir,
935 add_registry_key => \&add_registry_key,
936 del_registry_key => \&del_registry_key,
937 get_registry_key => \&get_registry_key,
938 quit => sub { exit 0; },
940 set_service => \&set_service,
941 get_service => \&get_service,
942 set_auto_logon => \&set_auto_logon,
943 remove_dir => \&remove_dir,
945 create_schedtask => \&create_schedtask,
946 del_schedtask => \&del_schedtask,
947 check_schedtask => \&check_schedtask,
949 check_mssql => \&check_mssql,
950 setup_mssql_db => \&setup_mssql_db,
951 cleanup_mssql_db => \&cleanup_mssql_db,
952 truncate_mssql_table => \&truncate_mssql_table,
953 test_mssql_content => \&test_mssql_content,
954 online_mssql_db => \&online_mssql_db,
964 # handle client request
969 my $r = $c->get_request ;
972 $c->send_error(RC_FORBIDDEN) ;
975 if ($r->url->path !~ m!^/(\w+)!) {
976 $c->send_error(RC_NOT_FOUND) ;
981 if (($r->method eq 'GET')
982 and $action_list{$action})
984 print "Exec $action:\n";
986 my $ret = $action_list{$action}($r);
987 my $h = HTTP::Headers->new('Content-Type' => 'text/plain') ;
988 my $r = HTTP::Response->new(HTTP::Status::RC_OK,
991 $c->send_response($r) ;
993 print "$action not found, probably a version problem\n";
994 $c->send_error(RC_NOT_FOUND) ;
1000 print "Starting regress-win32.pl daemon...\n";
1001 my $d = HTTP::Daemon->new ( LocalPort => 8091,
1003 || die "Error: Can't bind $!" ;
1005 my $olddir = Cwd::cwd();
1007 my $c = $d->accept ;
1008 my $ip = $c->peerhost;
1010 $c->send_error(RC_FORBIDDEN) ;
1011 } elsif ($src_ip && $ip ne $src_ip) {
1012 $c->send_error(RC_FORBIDDEN) ;
1014 handle_client($c, $ip) ;
1016 $c->send_error(RC_FORBIDDEN) ;
1022 # When we have the reload command, just close the http daemon