aboutsummaryrefslogtreecommitdiff
path: root/tests/runserv.pl
diff options
context:
space:
mode:
Diffstat (limited to 'tests/runserv.pl')
-rwxr-xr-xtests/runserv.pl177
1 files changed, 177 insertions, 0 deletions
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;
+};
+
+
+