rfoskett has asked for the wisdom of the Perl Monks concerning the following question:
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.
Thanksserverx.pluse strict; use warnings; use HTTP::Daemon; use HTTP::Status; use HTTP::Response; use HTTP::Headers; use Win32::Process; my $listener = HTTP::Daemon->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::Process::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"; }
SDaemon.pmuse strict; use warnings; use Cwd; use lib getcwd; use HTTP::Daemon; use SDaemon; use HTTP::Status; use IO::Select; use Data::Dumper; # Create a client connection object "the hard way" my $c = HTTP::Daemon::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;
client.plpackage 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::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; }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Multi-process Win32 HTTP Daemon
by Errto (Vicar) on Apr 30, 2006 at 00:34 UTC | |
|
Re: Multi-process Win32 HTTP Daemon
by BrowserUk (Patriarch) on Apr 30, 2006 at 05:46 UTC | |
by rfoskett (Initiate) on Apr 30, 2006 at 10:06 UTC | |
by BrowserUk (Patriarch) on Apr 30, 2006 at 10:37 UTC | |
|
Re: Multi-process Win32 HTTP Daemon
by BrowserUk (Patriarch) on Apr 30, 2006 at 18:55 UTC | |
by rfoskett (Initiate) on Apr 30, 2006 at 19:13 UTC | |
|
Re: Multi-process Win32 HTTP Daemon
by shonorio (Hermit) on Apr 30, 2006 at 15:38 UTC |