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";
}
####
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 = "Pid: $$ ".(scalar
localtime())."";
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;
####
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::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;
}