diff options
| -rwxr-xr-x | tests/runserv.pl | 177 |
1 files changed, 0 insertions, 177 deletions
diff --git a/tests/runserv.pl b/tests/runserv.pl deleted file mode 100755 index fb39f47d2..000000000 --- a/tests/runserv.pl +++ /dev/null @@ -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; -}; - - - |