bacula/
regress/
+ This script requires perl to work (http://strawberryperl.com), and by default
+ it assumes that Bacula is installed in the standard location. Once it's
+ started on the windows, you can do remote commands like:
+ - start the service
+ - stop the service
+ - edit the bacula-fd.conf to change the director and password setting
+ - install a new binary version (not tested, no plugin support)
+ - create weird files and directories
+ - create files with windows attributes
+ - compare two directories (with md5)
+
+
+ To test it, you can follow this procedure
+ On the windows box:
+ - install perl from http://strawberryperl.com on windows
+ - copy or export regress directory somewhere on your windows
+ You can use a network share to your regress directory on linux
+ Then, copy a link to this script to your desktop
+ And double-click on it, and always open .pl file with perl.exe
+
+ - If you export the regress directory to your windows box and you
+ make windows binaries available, this script can update bacula version.
+ You need to put your binaries on:
+ regress/release32 and regress/release64
+ or
+ regress/build/src/win32/release32 and regress/build/src/win32/release64
+
+ - start the regress/scripts/regress-win32.pl (open it with perl.exe)
+ - create $WIN32_FILE
+ - make sure that the firewall is well configured or just disabled (needs
+ bacula and 8091/tcp)
+
+ On Linux box:
+ - edit config file to fill the following variables
+
+ WIN32_CLIENT="win2008-fd"
+ # Client FQDN or IP address
+ WIN32_ADDR="192.168.0.6"
+ # File or Directory to backup. This is put in the "File" directive
+ # in the FileSet
+ WIN32_FILE="c:/tmp"
+ # Port of Win32 client
+ WIN32_PORT=9102
+ # Win32 Client password
+ WIN32_PASSWORD="xxx"
+ # will be the ip address of the linux box
+ WIN32_STORE_ADDR="192.168.0.1"
+ # set for autologon
+ WIN32_USER=Administrator
+ WIN32_PASS=password
+ # set for MSSQL
+ WIN32_MSSQL_USER=sa
+ WIN32_MSSQL_PASS=pass
+ - type make setup
+ - run ./tests/backup-bacula-test to be sure that everything is ok
+ - start ./tests/win32-fd-test
+
+ I'm not very happy with this script, but it works :)
+
=cut
use strict;
use File::Find;
use Digest::MD5;
use Getopt::Long ;
+use POSIX;
+use File::Basename qw/dirname/;
my $base = 'x:';
my $src_ip = '';
}
if (! -d $bacula_prefix) {
- print "Could not find Bacula installation dir $bacula_prefix\n";
- print "Won't be able to upgrade the version or modify the configuration\n";
+ print "regress-win32.pl: Could not find Bacula installation dir $bacula_prefix\n";
+ print "regress-win32.pl: Won't be able to upgrade the version or modify the configuration\n";
}
if (-f "$bacula_prefix/bacula-fd.conf" and -f "$conf/bacula-fd.conf") {
- print "Unable to determine bacula-fd location $bacula_prefix or $conf ?\n";
+ print "regress-win32.pl: Unable to determine bacula-fd location $bacula_prefix or $conf ?\n";
} elsif (-f "$bacula_prefix/bacula-fd.conf") {
$conf = $bacula_prefix;
return `net stop bacula-fd`;
}
+my $arch;
+my $bin_path;
+sub find_binaries
+{
+ if ($_ =~ /bacula-fd.exe/i) {
+ if ($File::Find::dir =~ /release$arch/) {
+ $bin_path = $File::Find::dir;
+ }
+ }
+}
+
# copy binaries for a new fd
+# to work, you need to mount the regress directory
sub install_fd
{
- copy("$base/bacula/src/win32/release32/bacula-fd.exe",
- "c:/Program Files/bacula/bacula-fd.exe");
+ my ($r) = shift;
+ if ($r->url !~ m!^/install$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+
+ if (-d "c:/Program Files (x86)") {
+ $arch = "64";
+ } else {
+ $arch = "32";
+ }
- copy("$base/bacula/src/win32/release32/bacula.dll",
- "c:/Program Files/bacula/bacula.dll");
+ # X:/regress/scripts/regress-win32.pl
+ # X:/scripts/regress-win32.pl
+ # perl script location
+
+ my $dir = dirname(dirname($0));
+ print "searching bacula-fd.exe in $dir\n";
+ find(\&find_binaries, ("$dir\\build\\src\\win32\\release$arch",
+ "$dir\\release$arch"));
+
+ if (!$bin_path) {
+ return "ERR\nCan't find bacula-fd.exe in $dir\n";
+ }
+
+ print "Found binaries in $bin_path\n";
+
+ stop_fd();
+
+ system("del \"c:\\Program Files\\bacula\\bacula.dll\"");
+ system("del \"c:\\Program Files\\bacula\\bacula-fd.exe\"");
+ system("del \"c:\\Program Files\\bacula\\plugins\\vss-fd.dll\"");
+
+ my $ret="Ok\n";
+
+ copy("$bin_path/bacula-fd.exe",
+ "c:/Program Files/bacula/bacula-fd.exe") or $ret="ERR\n$!\n";
+
+ copy("$bin_path/bacula.dll",
+ "c:/Program Files/bacula/bacula.dll") or $ret="ERR\n$!\n";
+
+ copy("$bin_path/vss-fd.dll",
+ "c:/Program Files/bacula/plugins/vss-fd.dll") or $ret="ERR\n$!\n";
+
+ start_fd();
+ return "OK\n";
}
# start the fd service
return `net start bacula-fd`;
}
-# convert \ to / and strip the path
-sub strip_base
-{
- my ($data, $path) = @_;
- $data =~ s!\\!/!sg;
- $data =~ s!\Q$path!!sig;
- return $data;
-}
-
# initialize the weird directory for runscript test
sub init_weird_runscript_test
{
my ($r) = shift;
- if ($r->url !~ m!^/init_weird_runscript_test\?source=(\w:/[\w/]+)$!) {
- return "ERR\nIncorrect url\n";
+ if ($r->url !~ m!^/init_weird_runscript_test\?source=(\w:/[\w\d\-\./]+)$!) {
+ return "ERR\nIncorrect url: ". $r->url . "\n";
}
my $source = $1;
- if (!chdir($source)) {
+ # Create $source if needed
+ my $tmp = $source;
+ $tmp =~ s:/:\\:g;
+ system("mkdir $tmp");
+
+ if (!chdir($source)) {
return "ERR\nCan't access to $source $!\n";
}
- if (-d "weird_runcript") {
- system("rmdir /Q /S weird_runcript");
+ if (-d "weird_runscript") {
+ system("rmdir /Q /S weird_runscript");
}
- mkdir("weird_runcript");
- if (!chdir("weird_runcript")) {
+ mkdir("weird_runscript");
+ if (!chdir("weird_runscript")) {
return "ERR\nCan't access to $source $!\n";
}
copy("test.bat", "Éwith space") or return "ERR\n";
copy("testé.bat","Éwith space") or return "ERR\n";
copy("test2 space.bat", "Éwith space") or return "ERR\n";
+ mkdir("a"x200);
+ copy("test.bat", "a"x200);
+ system("mklink /J junc " . "a"x200); # TODO: need something for win2003
+ link("test.bat", "link.bat");
return "OK\n";
}
my ($r) = shift;
if ($r->url !~ m!^/init_attrib_test\?source=(\w:/[\w/]+)$!) {
- return "ERR\nIncorrect url\n";
+ return "ERR\nIncorrect url: " . $r->url . "\n";
}
my $source = $1;
+ system("mkdir $source");
if (!chdir($source)) {
return "ERR\nCan't access to $source $!\n";
}
}
-# Compare two directories, make checksums, compare attribs and ACLs
+sub create_schedtask
+{
+ my ($r) = shift;
+ if ($r->url !~ m!^/create_schedtask\?name=([\w\d\-.]+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my $ret='';
+ my ($task,$pass) = ($1, $2);
+ my (undef, undef, $version, undef) = POSIX::uname();
+ if ($version < 6) { # win2003
+ $ret = `echo pass | SCHTASKS /Create /TN $task /SC ONLOGON /TR C:\\windows\\system32\\calc.exe /F 2>&1`;
+ } else {
+ $ret=`SCHTASKS /Create /TN $task /SC ONLOGON /F /TR C:\\windows\\system32\\calc.exe`;
+ }
+
+ if ($ret =~ /SUCCESS|has been created/) {
+ return "OK\n$ret";
+ } else {
+ return "ERR\n$ret";
+ }
+#
+# SCHTASKS /Create [/S system [/U username [/P [password]]]]
+# [/RU username [/RP password]] /SC schedule [/MO modifier] [/D day]
+# [/M months] [/I idletime] /TN taskname /TR taskrun [/ST starttime]
+# [/RI interval] [ {/ET endtime | /DU duration} [/K] [/XML xmlfile] [/V1]]
+# [/SD startdate] [/ED enddate] [/IT | /NP] [/Z] [/F]
+}
+
+sub del_schedtask
+{
+ my ($r) = shift;
+ if ($r->url !~ m!^/del_schedtask\?name=([\w\d\-.]+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my ($task) = ($1);
+ my $ret=`SCHTASKS /Delete /TN $task /F`;
+
+ if ($ret =~ /SUCCESS/) {
+ return "OK\n$ret";
+ } else {
+ return "ERR\n$ret";
+ }
+}
+
+sub check_schedtask
+{
+ my ($r) = shift;
+ if ($r->url !~ m!^/check_schedtask\?name=([\w\d\-.]+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+
+ my ($task) = ($1);
+ my (undef, undef, $version, undef) = POSIX::uname();
+ my $ret;
+ if ($version < 6) { # win2003
+ $ret=`SCHTASKS /Query`;
+ } else {
+ $ret=`SCHTASKS /Query /TN $task`;
+ }
+
+ if ($ret =~ /^($task .+)$/m) {
+ return "OK\n$1\n";
+ } else {
+ return "ERR\n$ret";
+ }
+}
+
sub set_director_name
{
my ($r) = shift;
- if ($r->url !~ m!^/set_director_name\?name=([\w\d\.\-]+);pass=([\w\d+]+)$!)
+ if ($r->url !~ m!^/set_director_name\?name=([\w\d\.\-]+);pass=([\w\d+\-\.*]+)$!)
{
- return "ERR\nIncorrect url\n";
+ return "ERR\nIncorrect url: " . $r->url . "\n";
}
my ($name, $pass) = ($1, $2);
open(ORG, "$conf/bacula-fd.conf") or return "ERR\nORG $!\n";
open(NEW, ">$conf/bacula-fd.conf.new") or return "ERR\nNEW $!\n";
- my $in_dir=0;
+ my $in_dir=0; # don't use monitoring section
+ my $nb_dir="";
while (my $l = <ORG>)
{
if ($l =~ /^\s*Director\s+{/i) {
print NEW $l;
$in_dir = 1;
} elsif ($l =~ /^(\s*)Name\s*=/ and $in_dir) {
- print NEW "${1}Name=$name\n";
+ print NEW "${1}Name=$name$nb_dir\n";
} elsif ($l =~ /^(\s*)Password\s*=/ and $in_dir) {
print NEW "${1}Password=$pass\n";
+ } elsif ($l =~ /#(\s*Plugin.*)$/) {
+ print NEW $1;
} elsif ($l =~ /\s*}/ and $in_dir) {
print NEW $l;
$in_dir = 0;
- } elsif (!$in_dir) {
+ $nb_dir++;
+ } else {
print NEW $l;
}
}
move("$conf/bacula-fd.conf.new", "$conf/bacula-fd.conf")
and return "OK\n";
- return "ERR\n";
+ return "ERR\nCan't set the director name\n";
}
+# convert \ to / and strip the path
+sub strip_base
+{
+ my ($data, $path) = @_;
+ $data =~ s!\\!/!sg;
+ $data =~ s!\Q$path!!sig;
+ return $data;
+}
+
# Compare two directories, make checksums, compare attribs and ACLs
sub compare
{
my ($r) = shift;
- if ($r->url !~ m!^/compare\?source=([\w:/]+);dest=([\w:/]+)$!) {
- return "ERR\nIncorrect url\n";
+ if ($r->url !~ m!^/compare\?source=(\w:/[\w/]+);dest=(\w:/[\w/]+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
}
my ($source, $dest) = ($1, $2);
my $dest_attrib = `attrib /D /S`;
$dest_attrib = strip_base($dest_attrib, $dest);
- if ($src_attrib ne $dest_attrib) {
+ if (lc($src_attrib) ne lc($dest_attrib)) {
+ print "ERR\n$src_attrib\n=========\n$dest_attrib\n";
return "ERR\n$src_attrib\n=========\n$dest_attrib\n";
}
}
}
+sub cleandir
+{
+ my ($r) = shift;
+
+ if ($r->url !~ m!^/cleandir\?source=(\w:/[\w/]+)/restore$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+
+ my $source = $1;
+
+ if (! -d "$source/restore") {
+ return "ERR\nIncorrect path\n";
+ }
+
+ if (!chdir($source)) {
+ return "ERR\nCan't access to $source $!\n";
+ }
+
+ system("rmdir /Q /S restore");
+
+ return "OK\n";
+}
+
+sub reboot
+{
+ Win32::InitiateSystemShutdown('', "\nSystem will now Reboot\!", 2, 0, 1 );
+ exit 0;
+}
+
+# boot disabled auto
+sub set_service
+{
+ my ($r) = shift;
+
+ if ($r->url !~ m!^/set_service\?srv=([\w-]+);action=(\w+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my $out = `sc config $1 start= $2`;
+ if ($out !~ /SUCCESS/) {
+ return "ERR\n$out";
+ }
+ return "OK\n";
+}
+
+# RUNNING, STOPPED
+sub get_service
+{
+ my ($r) = shift;
+
+ if ($r->url !~ m!^/get_service\?srv=([\w-]+);state=(\w+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my $out = `sc query $1`;
+ if ($out !~ /$2/) {
+ return "ERR\n$out";
+ }
+ return "OK\n";
+}
+
+sub add_registry_key
+{
+ my ($r) = shift;
+ if ($r->url !~ m!^/add_registry_key\?key=(\w+);val=(\w+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my ($k, $v) = ($1,$2);
+ my $ret = "ERR";
+ open(FP, ">tmp.reg")
+ or return "ERR\nCan't open tmp.reg $!\n";
+
+ print FP "Windows Registry Editor Version 5.00
+
+[HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula]
+\"$k\"=\"$v\"
+
+";
+ close(FP);
+ system("regedit /s tmp.reg");
+
+ unlink("tmp2.reg");
+ system("regedit /e tmp2.reg HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula");
+
+ open(FP, "<:encoding(UTF-16LE)", "tmp2.reg")
+ or return "ERR\nCan't open tmp2.reg $!\n";
+ while (my $l = <FP>) {
+ if ($l =~ /"$k"="$v"/) {
+ $ret = "OK";
+ }
+ }
+ close(FP);
+ unlink("tmp.reg");
+ unlink("tmp2.reg");
+ return "$ret\n";
+}
+
+sub set_auto_logon
+{
+ my ($r) = shift;
+ my $self = $0; # perl script location
+ $self =~ s/\\/\\\\/g;
+ my $p = $^X; # perl.exe location
+ $p =~ s/\\/\\\\/g;
+ if ($r->url !~ m!^/set_auto_logon\?user=([\w\d\-+\.]+);pass=([\w\d\.\,:*+%\-]*)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my $k = $1;
+ my $v = $2 || ''; # password can be empty
+ my $ret = "ERR\nCan't find AutoAdminLogon key\n";
+ open(FP, ">c:/autologon.reg")
+ or return "ERR\nCan't open autologon.reg $!\n";
+ print FP "Windows Registry Editor Version 5.00
+
+[HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Winlogon]
+\"DefaultUserName\"=\"$k\"
+\"DefaultPassword\"=\"$v\"
+\"AutoAdminLogon\"=\"1\"
+
+[HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Run]
+\"regress\"=\"$p $self\"
+
+[HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Reliability]
+\"ShutdownReasonUI\"=dword:00000000
+
+[HKEY_LOCAL_MACHINE\\SOFTWARE\\Policies\\Microsoft\\Windows NT\\Reliability]
+\"ShutdownReasonOn\"=dword:00000000
+";
+ close(FP);
+ system("regedit /s c:\\autologon.reg");
+
+ unlink("tmp2.reg");
+ system("regedit /e tmp2.reg \"HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Winlogon\"");
+
+ open(FP, "<:encoding(UTF-16LE)", "tmp2.reg")
+ or return "ERR\nCan't open tmp2.reg $!\n";
+ while (my $l = <FP>) {
+ if ($l =~ /"AutoAdminLogon"="1"/) {
+ $ret = "OK\n";
+ }
+ }
+ close(FP);
+ unlink("tmp2.reg");
+ return $ret;
+}
+
+sub del_registry_key
+{
+ my ($r) = shift;
+ if ($r->url !~ m!^/del_registry_key\?key=(\w+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my $k = $1;
+ my $ret = "OK\n";
+
+ unlink("tmp2.reg");
+ open(FP, ">tmp.reg")
+ or return "ERR\nCan't open tmp.reg $!\n";
+ print FP "Windows Registry Editor Version 5.00
+
+[HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula]
+\"$k\"=-
+
+";
+ close(FP);
+ system("regedit /s tmp.reg");
+ system("regedit /e tmp2.reg HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula");
+
+ open(FP, "<:encoding(UTF-16LE)", "tmp2.reg")
+ or return "ERR\nCan't open tmp2.reg $!\n";
+ while (my $l = <FP>) {
+ if ($l =~ /"$k"=/) {
+ $ret = "ERR\nThe key $k is still present\n";
+ }
+ }
+ close(FP);
+ unlink("tmp.reg");
+ unlink("tmp2.reg");
+ return $ret;
+}
+
+sub get_registry_key
+{
+ my ($r) = shift;
+ if ($r->url !~ m!^/get_registry_key\?key=(\w+);val=(\w+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my ($k, $v) = ($1, $2);
+ my $ret = "ERR\nCan't get or verify registry key $k\n";
+
+ unlink("tmp2.reg");
+ system("regedit /e tmp2.reg HKEY_LOCAL_MACHINE\\SOFTWARE\\Bacula");
+ open(FP, "<:encoding(UTF-16LE)", "tmp2.reg")
+ or return "ERR\nCan't open tmp2.reg $!\n";
+ while (my $l = <FP>) {
+ if ($l =~ /"$k"="$v"/) {
+ $ret = "OK\n";
+ }
+ }
+ close(FP);
+ unlink("tmp2.reg");
+
+ return $ret;
+}
+
+my $mssql_user;
+my $mssql_pass;
+my $mssql_cred;
+my $mssql_bin;
+sub find_mssql
+{
+ if ($_ =~ /sqlcmd.exe/i) {
+ $mssql_bin = $File::Find::name;
+ }
+}
+
+# Verify that we can use SQLCMD.exe
+sub check_mssql
+{
+ my ($r) = shift;
+ my $ret = "ERR";
+ if ($r->url !~ m!^/check_mssql\?user=(\w*);pass=(.*)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ ($mssql_user, $mssql_pass) = ($1, $2);
+
+ unless ($mssql_bin) {
+ find(\&find_mssql, 'c:/program files/microsoft sql server/');
+ }
+ unless ($mssql_bin) {
+ find(\&find_mssql, 'c:/program files (x86)/microsoft sql server/');
+ }
+
+ if (!$mssql_bin) {
+ return "ERR\nCan't find SQLCMD.exe in c:/program files\n";
+ }
+
+ print $mssql_bin, "\n";
+ $mssql_cred = ($mssql_user)?"-U $mssql_user -P $mssql_pass":"";
+ my $res = `"$mssql_bin" $mssql_cred -Q "SELECT 'OK';"`;
+ if ($res !~ /OK/) {
+ return "ERR\nCan't verify the SQLCMD result\n" .
+ "Please verify that MSSQL is accepting connection:\n" .
+ "$mssql_bin $mssql_cred -Q \"SELECT 1;\"\n";
+ }
+ return "OK\n";
+}
+
+# Create simple DB, a table and some information in
+sub setup_mssql_db
+{
+ my ($r) = shift;
+ my $ret = "ERR";
+ if ($r->url !~ m!^/setup_mssql_db\?db=([\w\d]+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my $db = $1;
+
+ unless ($mssql_bin) {
+ return "ERR\nCan't find mssql bin (run check_mssql first)\n";
+ }
+
+ my $res = `"$mssql_bin" $mssql_cred -Q "CREATE DATABASE $db;"`;
+ $res = `"$mssql_bin" $mssql_cred -d $db -Q "CREATE TABLE table1 (a int, b int);"`;
+ $res = `"$mssql_bin" $mssql_cred -d $db -Q "INSERT INTO table1 (a, b) VALUES (1,1);"`;
+ $res = `"$mssql_bin" $mssql_cred -d $db -Q "SELECT 'OK' FROM table1;"`;
+
+ if ($res !~ /OK/) {
+ return "ERR\nCan't verify the SQLCMD result\n" .
+ "Please verify that MSSQL is accepting connection:\n" .
+ "$mssql_bin $mssql_cred -Q \"SELECT 1;\"\n";
+ }
+ return "OK\n";
+}
+
+# drop database
+sub cleanup_mssql_db
+{
+ my ($r) = shift;
+ my $ret = "ERR";
+ if ($r->url !~ m!^/cleanup_mssql_db\?db=([\w\d]+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my $db = $1;
+
+ unless ($mssql_bin) {
+ return "ERR\nCan't find mssql bin\n";
+ }
+
+ my $res = `"$mssql_bin" $mssql_cred -Q "DROP DATABASE $db;"`;
+
+ return "OK\n";
+}
+
+# truncate the table that is in database
+sub truncate_mssql_table
+{
+ my ($r) = shift;
+ my $ret = "ERR";
+ if ($r->url !~ m!^/truncate_mssql_table\?db=([\w\d]+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my $db = $1;
+
+ unless ($mssql_bin) {
+ return "ERR\nCan't find mssql bin\n";
+ }
+
+ my $res = `"$mssql_bin" $mssql_cred -d $db -Q "TRUNCATE TABLE table1;"`;
+ $res = `"$mssql_bin" $mssql_cred -d $db -Q "SELECT 'OK' FROM table1;"`;
+
+ if ($res =~ /OK/) {
+ return "ERR\nCan't truncate $db.table1\n";
+ }
+ return "OK\n";
+}
+
+# test that table1 contains some rows
+sub test_mssql_content
+{
+ my ($r) = shift;
+ my $ret = "ERR";
+ if ($r->url !~ m!^/test_mssql_content\?db=([\w\d]+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my $db = $1;
+
+ unless ($mssql_bin) {
+ return "ERR\nCan't find mssql bin\n";
+ }
+
+ my $res = `"$mssql_bin" $mssql_cred -d $db -Q "SELECT 'OK' FROM table1;"`;
+
+ if ($res !~ /OK/) {
+ return "ERR\nNo content from $mssql_bin\n$res\n";
+ }
+ return "OK\n";
+}
+
+my $mssql_mdf;
+my $mdf_to_find;
+sub find_mdf
+{
+ if ($_ =~ /$mdf_to_find/i) {
+ $mssql_mdf = $File::Find::dir;
+ }
+}
+
+# put a mdf online
+sub online_mssql_db
+{
+ my ($r) = shift;
+ if ($r->url !~ m!^/online_mssql_db\?mdf=([\w\d]+);db=([\w\d]+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my ($mdf, $db) = ($1, $2);
+ $mdf_to_find = "$mdf.mdf";
+
+ find(\&find_mdf, 'c:/program files/microsoft sql server/');
+ unless ($mssql_mdf) {
+ find(\&find_mssql, 'c:/program files (x86)/microsoft sql server/');
+ }
+ unless ($mssql_mdf) {
+ return "ERR\nCan't find $mdf.mdf in c:/program files\n";
+ }
+ $mssql_mdf =~ s:/:\\:g;
+
+ open(FP, ">c:/mssql.sql");
+ print FP "
+USE [master]
+GO
+CREATE DATABASE [$db] ON
+( FILENAME = N'$mssql_mdf\\$mdf.mdf' ),
+( FILENAME = N'$mssql_mdf\\${mdf}_log.LDF' )
+ FOR ATTACH
+GO
+USE [$db]
+GO
+SELECT 'OK' FROM table1
+GO
+";
+ close(FP);
+ my $res = `"$mssql_bin" $mssql_cred -i c:\\mssql.sql`;
+ #unlink("c:/mssql.sql");
+ if ($res !~ /OK/) {
+ return "ERR\nNo content from $mssql_bin\n";
+ }
+ return "OK\n";
+}
+
+# create a script c:/del.cmd to delete protected files with runscript
+sub remove_dir
+{
+ my ($r) = shift;
+ if ($r->url !~ m!^/remove_dir\?file=([\w\d:\/\.\-+*]+);dest=([\w\d\.:\/]+)$!) {
+ return "ERR\nIncorrect url: " . $r->url . "\n";
+ }
+ my ($file, $cmd) = ($1, $2);
+ $file =~ s:/:\\:g;
+
+ open(FP, ">$cmd") or return "ERR\nCan't open $file $!\n";
+ print FP "DEL /F /S /Q $file\n";
+ close(FP);
+ return "OK\n";
+}
+
# When adding an action, fill this hash with the right function
my %action_list = (
+ nop => sub { return "OK\n"; },
stop => \&stop_fd,
start => \&start_fd,
install => \&install_fd,
init_attrib_test => \&init_attrib_test,
init_weird_runscript_test => \&init_weird_runscript_test,
set_director_name => \&set_director_name,
+ cleandir => \&cleandir,
+ add_registry_key => \&add_registry_key,
+ del_registry_key => \&del_registry_key,
+ get_registry_key => \&get_registry_key,
+ quit => sub { exit 0; },
+ reboot => \&reboot,
+ set_service => \&set_service,
+ get_service => \&get_service,
+ set_auto_logon => \&set_auto_logon,
+ remove_dir => \&remove_dir,
+ reload => \&reload,
+ create_schedtask => \&create_schedtask,
+ del_schedtask => \&del_schedtask,
+ check_schedtask => \&check_schedtask,
+
+ check_mssql => \&check_mssql,
+ setup_mssql_db => \&setup_mssql_db,
+ cleanup_mssql_db => \&cleanup_mssql_db,
+ truncate_mssql_table => \&truncate_mssql_table,
+ test_mssql_content => \&test_mssql_content,
+ online_mssql_db => \&online_mssql_db,
);
+my $reload=0;
+sub reload
+{
+ $reload=1;
+ return "OK\n";
+}
+
# handle client request
sub handle_client
{
if (($r->method eq 'GET')
and $action_list{$action})
{
+ print "Exec $action:\n";
+
my $ret = $action_list{$action}($r);
my $h = HTTP::Headers->new('Content-Type' => 'text/plain') ;
my $r = HTTP::Response->new(HTTP::Status::RC_OK,
'OK', $h, $ret) ;
-
+ print $ret;
$c->send_response($r) ;
} else {
+ print "$action not found, probably a version problem\n";
$c->send_error(RC_NOT_FOUND) ;
}
$c->close;
}
+print "Starting regress-win32.pl daemon...\n";
my $d = HTTP::Daemon->new ( LocalPort => 8091,
ReuseAddr => 1)
- || die "E : Can't bind $!" ;
+ || die "Error: Can't bind $!" ;
my $olddir = Cwd::cwd();
while (1) {
- my ($c, $ip) = $d->accept ;
-# print "Connexion from $ip\n";
-# if (!$ip) {
-# $c->send_error(RC_FORBIDDEN) ;
-# } elsif ($src_ip && $ip ne $src_ip) {
-# $c->send_error(RC_FORBIDDEN) ;
-# } elsif ($c) {
+ my $c = $d->accept ;
+ my $ip = $c->peerhost;
+ if (!$ip) {
+ $c->send_error(RC_FORBIDDEN) ;
+ } elsif ($src_ip && $ip ne $src_ip) {
+ $c->send_error(RC_FORBIDDEN) ;
+ } elsif ($c) {
handle_client($c, $ip) ;
-# } else {
-# $c->send_error(RC_FORBIDDEN) ;
-# }
+ } else {
+ $c->send_error(RC_FORBIDDEN) ;
+ }
close($c) ;
+ undef $c;
chdir($olddir);
+
+ # When we have the reload command, just close the http daemon
+ # and exec ourself
+ if ($reload) {
+ $d->close();
+ undef $d;
+
+ exec("$^X $0");
+ }
}
projects / bacula / bacula / blobdiff