Multi-process Win32 HTTP Daemon

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::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";
}

#------------------------------------------------------------------------
# serverx.pl
use 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;

#------------------------------------------------------------------------
# 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::Debug 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;
}

.

Relevant Pages

  • Re: Update Application value on multiple servers?
    ... Sub Application_OnStart ... >>> Can I update Applicationon server A in response ... There is no problem in updating the same ... >> updating Applicationvalue on server A in response ...
    (microsoft.public.inetserver.asp.general)
  • Re: Noobie Question on Forms
    ... > I've combine what you said with the other response and was able to get it ... > I have a module that has a sub Main ... > If it does not exist then I open a form and ask for the Server, Database, ... password to the registry. ...
    (microsoft.public.dotnet.languages.vb)
  • Re: client close the socket. how the server knows?
    ... the server know that the socket is closed from the client side. ... > Private Delegate Sub UpdateListBoxDel(ByVal Data As String) ... > Private Sub Button1_Click(ByVal sender As System.Object, ...
    (microsoft.public.dotnet.languages.vb)
  • .Net remoting doesnt work in Wan area.
    ... i try to broadcast events raised in server to ... Public Sub DoSomething ... Dim del As ... Dim clientProv As New BinaryClientFormatterSinkProvider ...
    (microsoft.public.dotnet.framework)
  • Re: How to get fastForward to work in the Windows Media Player Control?
    ... Sub ShutMeDown ... WMP is *client side*. ... Even if you could try to run WMP somehow at the server end, ... "Player" is not a child of Form1, it's a child of the Document object. ...
    (microsoft.public.windowsmedia.player.web)