I'm working on an adhoc GUI so that I can easily view a bunch of data from the VMWare Perl SDK without having to setup a bunch of scripts under IIS. The basic idea is to start up the script, and have it fork two processes. One is the HTTP::Daemon web server, and then two seconds later its the Win32::IEAutomation run browser. It's not pretty, I admit, but I'm slightly comfortable with the VMPerlSDK than the VMCOMSDK. Plus I'm kind of curious to see if I can get this to work.
As far as I can tell, the program starts okay. The fork works. The little URI parser works. The only problem is whenever I try to call /quit to shutdown the server, the script explodes.
Any suggestions (aside from how this should be done with IIS and AutoIT, I know, I know) would be appreciated. Thanks!
#!/usr/bin/perl -w
use Data::Dumper;
use HTTP::Daemon;
use HTTP::Status;
use HTTP::Response;
use strict;
use warnings;
use Win32::IEAutomation;
sub MainPage {
return<<eol
<html>
<head><title>Test</title></head>
<body>
<h3>Home</h3>
<p><a href="/quit">Quit</a></p>
</body>
</html>
eol
}
# Parses out web variables
sub WebParse {
my ($wstring) = @_;
my %webs = ();
# gets key/value data
my @pairs = split(/&/, $wstring);
# puts the key name into an array
foreach my $pair (@pairs) {
my ($kname, $kval) = split (/=/, $pair);
$kval =~ tr/+/ /;
$kval =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$webs{$kname} = $kval;
}
return(%webs);
}
sub StartServer {
my $PORT = shift;
my $ALLOWED = shift;
my $d = HTTP::Daemon->new(ReuseAddr => 1, LocalAddr => $ALLOWED, LocalPort => $PORT) || die;
# Prints a startup message
print "Please contact me at: <URL:", $d->url, ">\n";
my $xt = 0;
BLOOP: while (my $c = $d->accept) {
while (my $r = $c->get_request) {
# Handles requests with the GET or POST methods
if ($r->method =~ m/GET/i || $r->method =~ m/POST/i) {
my $uri = $r->uri; my %ENV = ();
$ENV{REQUEST_METHOD} = $r->method;
$ENV{CONTENT_TYPE} = join('; ', $r->content_type);
$ENV{CONTENT_LENGTH} = $r->content_length || '';
$ENV{SCRIPT_NAME} = $uri->path || 1;
$ENV{REMOTE_ADDR} = $c->peerhost();
if ($r->method =~ m/GET/i) {
$ENV{QUERY_STRING} = $uri->query || '';
}
elsif ($r->method =~ m/POST/i) {
$ENV{QUERY_STRING} = $r->{"_content"} || '';
}
my %q = &WebParse($ENV{QUERY_STRING});
my $res = HTTP::Response->new("200");
if ($uri =~ m/quit/i) {
$res->content("Goodbye");
$xt=1;
}
else {
$res->content(MainPage());
}
$c->send_response($res);
}
# Otherwise
else {
$c->send_error("This server only accepts GET or POST methods");
}
if ($xt == 1) {
sleep(2);
$c->force_last_request();
last BLOOP;
}
$c->close;
}
undef($c);
}
$d->close;
undef($d);
exit;
}
sub StartInterface {
my $PORT = shift;
my $ALLOWED = shift;
my $ie = Win32::IEAutomation->new(visible => 1, maximize => 1);
$ie->gotoURL("http://".$ALLOWED.":".$PORT."/");
exit;
}
# Return Status
my $STATUS = 1;
# Server port number
my $PORT = 9005;
# The server that's allowed to talk to this one
my $ALLOWED = "127.0.0.1";
my $pid = fork();
if ($pid == 0) {
StartServer($PORT, $ALLOWED);
} else {
sleep(2);
StartInterface($PORT, $ALLOWED);
}
exit;
before you close your daemon $d, shutdown the socket and tell the parent pid to quit: