From 3c0194bb72b5e7f3fa8ee7af167027027891f9aa Mon Sep 17 00:00:00 2001
From: Daniel Stenberg <daniel@haxx.se>
Date: Fri, 10 Nov 2000 15:24:09 +0000
Subject: initial checkin

---
 tests/runserv.pl | 177 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 177 insertions(+)
 create mode 100755 tests/runserv.pl

(limited to 'tests/runserv.pl')

diff --git a/tests/runserv.pl b/tests/runserv.pl
new file mode 100755
index 000000000..fb39f47d2
--- /dev/null
+++ b/tests/runserv.pl
@@ -0,0 +1,177 @@
+#!/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; 
+};
+
+
+
-- 
cgit v1.2.3