aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rwxr-xr-xtests/runserv.pl177
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;
-};
-
-
-