mirror of
https://github.com/curl/curl.git
synced 2025-02-17 14:59:45 +08:00
replaced by a working server!
This commit is contained in:
parent
d5e6404b8b
commit
d5b06bcf3b
177
tests/runserv.pl
177
tests/runserv.pl
@ -1,177 +0,0 @@
|
||||
#!/usr/bin/perl
|
||||
#
|
||||
# runserv.pl - run a dumb tcp server on a port for the curl test suite
|
||||
# derived from 'ftproxy' by Björn Stenberg/Linus Nielsen that was
|
||||
# derived from "fwdport.pl" by Tom Christiansen
|
||||
|
||||
use FileHandle;
|
||||
use Net::hostent; # Example 17-8 # by-name interface for host info
|
||||
use IO::Socket; # for creating server and client sockets
|
||||
use POSIX ":sys_wait_h"; # for reaping our dead children
|
||||
|
||||
my $localip = $ARGV[0];
|
||||
my $localport = $ARGV[1];
|
||||
|
||||
if(($localip eq "") ||
|
||||
($localport eq "")) {
|
||||
print "Usage: runserv.pl <ip> <port>\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
my (
|
||||
%Children, # hash of outstanding child processes
|
||||
$proxy_server, # the socket we accept() from
|
||||
$ME, # basename of this program
|
||||
);
|
||||
|
||||
($ME = $0) =~ s,.*/,,; # retain just basename of script name
|
||||
|
||||
start_server(); # launch our own server
|
||||
service_clients(); # wait for incoming
|
||||
print "[TCP server exited]\n";
|
||||
exit;
|
||||
|
||||
# begin our server
|
||||
sub start_server {
|
||||
$proxy_server = IO::Socket::INET->new(Listen => 5,
|
||||
LocalAddr => $localip,
|
||||
LocalPort => $localport,
|
||||
Proto => 'tcp',
|
||||
Reuse => 1)
|
||||
or die "can't open socket";
|
||||
|
||||
# print "[TCP server initialized";
|
||||
# print " on " . $proxy_server->sockhost() . ":" .
|
||||
# $proxy_server->sockport() . "]\n";
|
||||
}
|
||||
|
||||
sub service_clients {
|
||||
my (
|
||||
$local_client, # someone internal wanting out
|
||||
$lc_info, # local client's name/port information
|
||||
@rs_config, # temp array for remote socket options
|
||||
$rs_info, # remote server's name/port information
|
||||
$kidpid, # spawned child for each connection
|
||||
$file,
|
||||
$request,
|
||||
@headers
|
||||
);
|
||||
|
||||
$SIG{CHLD} = \&REAPER; # harvest the moribund
|
||||
|
||||
# print "Listening...\n";
|
||||
|
||||
while ($local_client = $proxy_server->accept()) {
|
||||
$lc_info = peerinfo($local_client);
|
||||
printf "[Connect from $lc_info]\n";
|
||||
|
||||
$kidpid = fork();
|
||||
die "Cannot fork" unless defined $kidpid;
|
||||
if ($kidpid) {
|
||||
$Children{$kidpid} = time(); # remember his start time
|
||||
close $local_client; # likewise
|
||||
next; # go get another client
|
||||
}
|
||||
|
||||
# now, read the data from the client
|
||||
# and pass back what we want it to have
|
||||
|
||||
undef $request;
|
||||
undef $path;
|
||||
undef $ver;
|
||||
undef @headers;
|
||||
$cl=0;
|
||||
$left=0;
|
||||
while(<$local_client>) {
|
||||
if($_ =~ /(GET|POST|HEAD) (.*) HTTP\/1.(\d)/) {
|
||||
$request=$1;
|
||||
$path=$2;
|
||||
$ver=$3;
|
||||
}
|
||||
elsif($_ =~ /^Content-Length: (\d*)/) {
|
||||
$cl=$1;
|
||||
}
|
||||
# print "RCV: $_";
|
||||
|
||||
push @headers, $_;
|
||||
|
||||
if($left > 0) {
|
||||
$left -= length($_);
|
||||
}
|
||||
|
||||
if(($_ eq "\r\n") or ($_ eq "")) {
|
||||
if($request eq "POST") {
|
||||
$left=$cl;
|
||||
}
|
||||
else {
|
||||
$left = -1; # force abort
|
||||
}
|
||||
}
|
||||
if($left < 0) {
|
||||
last;
|
||||
}
|
||||
}
|
||||
# print "Request: $request\n",
|
||||
# "Path: $path\n",
|
||||
# "Version: $ver\n";
|
||||
|
||||
#
|
||||
# we always start the path with a number, this is the
|
||||
# test number that this server will use to know what
|
||||
# contents to pass back to the client
|
||||
#
|
||||
if($path =~ /^\/(\d*)/) {
|
||||
$testnum=$1;
|
||||
}
|
||||
else {
|
||||
print "UKNOWN TEST CASE\n";
|
||||
exit;
|
||||
}
|
||||
open(INPUT, ">log/server.input");
|
||||
for(@headers) {
|
||||
print INPUT $_;
|
||||
}
|
||||
close(INPUT);
|
||||
|
||||
|
||||
# send a reply to the client
|
||||
open(DATA, "<data/reply$testnum.txt");
|
||||
while(<DATA>) {
|
||||
print $local_client $_;
|
||||
}
|
||||
close(DATA);
|
||||
|
||||
exit; # whoever's still alive bites it
|
||||
}
|
||||
}
|
||||
|
||||
# helper function to produce a nice string in the form HOST:PORT
|
||||
sub peerinfo {
|
||||
my $sock = shift;
|
||||
my $hostinfo = gethostbyaddr($sock->peeraddr);
|
||||
return sprintf("%s:%s",
|
||||
$hostinfo->name || $sock->peerhost,
|
||||
$sock->peerport);
|
||||
}
|
||||
|
||||
# somebody just died. keep harvesting the dead until
|
||||
# we run out of them. check how long they ran.
|
||||
sub REAPER {
|
||||
my $child;
|
||||
my $start;
|
||||
while (($child = waitpid(-1,WNOHANG)) > 0) {
|
||||
if ($start = $Children{$child}) {
|
||||
my $runtime = time() - $start;
|
||||
# printf "Child $child ran %dm%ss\n",
|
||||
# $runtime / 60, $runtime % 60;
|
||||
delete $Children{$child};
|
||||
} else {
|
||||
# print "Unknown child process $child exited $?\n";
|
||||
}
|
||||
}
|
||||
# If I had to choose between System V and 4.2, I'd resign. --Peter Honeyman
|
||||
$SIG{CHLD} = \&REAPER;
|
||||
};
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user