R
rfoskett
Hi,
I'm trying to get a multiprocess win32 http daemon working however seem
to be having problems in getting the response back from the server.
The eventual aim of this is to have a prespawning SOAP server that can
expose OLE APIs to nonwindows platforms. I dont want to use the
obvious choice of fork as activeperl currently creates threads behind
the scene and so want to avoid any potential threadsafe issues with the
OLE classes.
Anyway, ive adapted the below code from this old article
http://www.webtechniques.com/archives/2000/03/junk/
When starting the daemon, then running individual client requests - the
inherited Win32 process correctly gets the request send by the client
however is not able to send back the response.
Any thoughts on how to fix this (or ideas on a better approach) would
be appreciated.
Thanks
Roger Foskett
#------------------------------------------------------------------------
# daemon.pl
use strict;
use warnings;
use HTTP:
aemon;
use HTTP::Status;
use HTTP::Response;
use HTTP::Headers;
use Win32:rocess;
my $listener = HTTP:aemon->new(
LocalAddr => '127.0.0.1',
LocalPort => 2112,
Listen => 5) ||
die ("Listener could not be created\n");
my $counter = 0;
print "$$] Listener waiting for Requests on ".$listener->url."\n";
# This loop monitors the port for connections
for(;my $c = $listener->accept; $c->close) {
print "\n$counter] Accepted Connection\n";
binmode $c;
spawn($c);
}
sub spawn {
my $c = shift;
# Make a backup of STDOUT and STDIN
#open( STDOUT_BACKUP, ">&STDOUT" );
open( STDIN_BACKUP, "<&STDIN" );
# redirect
my $socket_no = $c->fileno;
open(STDIN, "<&$socket_no") || die $!;
#open(STDOUT, ">&") || die $!; # where to ?
$c->close;
# Spawn process
my $obj;
Win32:rocess::Create($obj, $^X, "$^X serverx.pl", 1,
NORMAL_PRIORITY_CLASS, '.')
|| die "ERROR: failed to execute: $^X serverx.pl; ".
Win32::FormatMessage(Win32::GetLastError());
# Redirect STDOUT to what it used to be...
#open( STDOUT, ">&STDOUT_BACKUP" );
open( STDIN, "<&STDIN_BACKUP" );
# Close the backup of STDOUT
#close( STDOUT_BACKUP );
close( STDIN_BACKUP );
print "spawned ".$obj->GetProcessID."\n";
}
#------------------------------------------------------------------------
# serverx.pl
use strict;
use warnings;
use Cwd;
use lib getcwd;
use HTTP:aemon;
use SDaemon;
use HTTP::Status;
use IO::Select;
use Data:umper;
# Create a client connection object "the hard way"
my $c = HTTP:aemon::ClientConn->new_from_fd('STDIN', "+>");
# backfill the necessary client connection attributes
${*$c}{'httpd_daemon'} = SDaemon->new();
binmode $c;
$c->autoflush(1);
close STDIN;
my $i = 0;
while (my $req = $c->get_request()) {
print STDERR "$$] $i Request\n".$req->as_string."\n";
my $content = "<HTML><B>Pid: $$</B> ".(scalar
localtime())."</HTML>";
my $hdrs = HTTP::Headers->new(('Content-Length' =>
length($content)));
my $res = HTTP::Response->new(RC_OK,'',$hdrs,$content);
$c->send_response($res);
print STDERR "$$] $i sent response\n";
}
$c->close;
#------------------------------------------------------------------------
# SDaemon.pm
package SDaemon;
sub new {
my ($classname, $port) = @_;
my $self = {};
bless($self, $classname);
$self->{PORT} = $port;
return $self;
}
sub url {
my $u = 'http://127.0.0.1:'.$self->{PORT}.'/';
return $u;
}
sub product_tokens {
"libwww-perl-daemon/1.21";
}
1;
#------------------------------------------------------------------------
use strict;
use warnings;
use LWP:ebug qw(+ conns trace debug);
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
print "Sending request...\n";
my $res = $ua->post('http://127.0.0.1:2112',
[ 'q' => 'blah',
'pg' => 'q', 'avkw' => 'tgz', 'kl' => 'XX',
]
);
print "Got response\n";
if ($res->is_success) {
print "Content: ".$res->as_string."\n";
}
else {
die "ERROR: ".$res->status_line;
}
I'm trying to get a multiprocess win32 http daemon working however seem
to be having problems in getting the response back from the server.
The eventual aim of this is to have a prespawning SOAP server that can
expose OLE APIs to nonwindows platforms. I dont want to use the
obvious choice of fork as activeperl currently creates threads behind
the scene and so want to avoid any potential threadsafe issues with the
OLE classes.
Anyway, ive adapted the below code from this old article
http://www.webtechniques.com/archives/2000/03/junk/
When starting the daemon, then running individual client requests - the
inherited Win32 process correctly gets the request send by the client
however is not able to send back the response.
Any thoughts on how to fix this (or ideas on a better approach) would
be appreciated.
Thanks
Roger Foskett
#------------------------------------------------------------------------
# daemon.pl
use strict;
use warnings;
use HTTP:
aemon;use HTTP::Status;
use HTTP::Response;
use HTTP::Headers;
use Win32:
rocess;my $listener = HTTP:
aemon->new(LocalAddr => '127.0.0.1',
LocalPort => 2112,
Listen => 5) ||
die ("Listener could not be created\n");
my $counter = 0;
print "$$] Listener waiting for Requests on ".$listener->url."\n";
# This loop monitors the port for connections
for(;my $c = $listener->accept; $c->close) {
print "\n$counter] Accepted Connection\n";
binmode $c;
spawn($c);
}
sub spawn {
my $c = shift;
# Make a backup of STDOUT and STDIN
#open( STDOUT_BACKUP, ">&STDOUT" );
open( STDIN_BACKUP, "<&STDIN" );
# redirect
my $socket_no = $c->fileno;
open(STDIN, "<&$socket_no") || die $!;
#open(STDOUT, ">&") || die $!; # where to ?
$c->close;
# Spawn process
my $obj;
Win32:
rocess::Create($obj, $^X, "$^X serverx.pl", 1,NORMAL_PRIORITY_CLASS, '.')
|| die "ERROR: failed to execute: $^X serverx.pl; ".
Win32::FormatMessage(Win32::GetLastError());
# Redirect STDOUT to what it used to be...
#open( STDOUT, ">&STDOUT_BACKUP" );
open( STDIN, "<&STDIN_BACKUP" );
# Close the backup of STDOUT
#close( STDOUT_BACKUP );
close( STDIN_BACKUP );
print "spawned ".$obj->GetProcessID."\n";
}
#------------------------------------------------------------------------
# serverx.pl
use strict;
use warnings;
use Cwd;
use lib getcwd;
use HTTP:
aemon;use SDaemon;
use HTTP::Status;
use IO::Select;
use Data:
umper;# Create a client connection object "the hard way"
my $c = HTTP:
aemon::ClientConn->new_from_fd('STDIN', "+>");# backfill the necessary client connection attributes
${*$c}{'httpd_daemon'} = SDaemon->new();
binmode $c;
$c->autoflush(1);
close STDIN;
my $i = 0;
while (my $req = $c->get_request()) {
print STDERR "$$] $i Request\n".$req->as_string."\n";
my $content = "<HTML><B>Pid: $$</B> ".(scalar
localtime())."</HTML>";
my $hdrs = HTTP::Headers->new(('Content-Length' =>
length($content)));
my $res = HTTP::Response->new(RC_OK,'',$hdrs,$content);
$c->send_response($res);
print STDERR "$$] $i sent response\n";
}
$c->close;
#------------------------------------------------------------------------
# SDaemon.pm
package SDaemon;
sub new {
my ($classname, $port) = @_;
my $self = {};
bless($self, $classname);
$self->{PORT} = $port;
return $self;
}
sub url {
my $u = 'http://127.0.0.1:'.$self->{PORT}.'/';
return $u;
}
sub product_tokens {
"libwww-perl-daemon/1.21";
}
1;
#------------------------------------------------------------------------
use strict;
use warnings;
use LWP:
ebug qw(+ conns trace debug);use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
print "Sending request...\n";
my $res = $ua->post('http://127.0.0.1:2112',
[ 'q' => 'blah',
'pg' => 'q', 'avkw' => 'tgz', 'kl' => 'XX',
]
);
print "Got response\n";
if ($res->is_success) {
print "Content: ".$res->as_string."\n";
}
else {
die "ERROR: ".$res->status_line;
}