diff options
| -rwxr-xr-x | tests/httpserver.pl | 215 |
1 files changed, 3 insertions, 212 deletions
diff --git a/tests/httpserver.pl b/tests/httpserver.pl index 2bbf839dd..7faef92f9 100755 --- a/tests/httpserver.pl +++ b/tests/httpserver.pl @@ -1,15 +1,6 @@ -#!/usr/bin/perl -use Socket; -use Carp; -use FileHandle; +#!/usr/bin/env perl -#use strict; - -require "getpart.pm"; - -sub spawn; # forward declaration -sub logmsg { #print "$0 $$: @_ at ", scalar localtime, "\n" - } +use strict; my $verbose=0; # set to 1 for debugging @@ -23,204 +14,4 @@ do { } } while(shift @ARGV); -my $proto = getprotobyname('tcp') || 6; - -socket(Server, PF_INET, SOCK_STREAM, $proto)|| die "socket: $!"; -setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, - pack("l", 1)) || die "setsockopt: $!"; -bind(Server, sockaddr_in($port, INADDR_ANY))|| die "bind: $!"; -listen(Server,SOMAXCONN) || die "listen: $!"; - -if($verbose) { - print "HTTP server started on port $port\n"; -} - -open(PID, ">.http.pid"); -print PID $$; -close(PID); - -my $PID=$$; - -my $waitedpid = 0; -my $paddr; - -sub REAPER { - $waitedpid = wait; - $SIG{CHLD} = \&REAPER; # loathe sysV - logmsg "reaped $waitedpid" . ($? ? " with exit $?" : ''); -} - -sub performcmd { - my @cmd = @_; - for(@cmd) { - if($_ =~ /^ *wait *(\d*)/) { - # instructed to sleep! - sleep($1); - } - } -} - -$SIG{CHLD} = \&REAPER; - -for ( $waitedpid = 0; - ($paddr = accept(Client,Server)) || $waitedpid; - $waitedpid = 0, close Client) -{ - next if $waitedpid and not $paddr; - my($port,$iaddr) = sockaddr_in($paddr); - my $name = gethostbyaddr($iaddr,AF_INET); - - logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port"; - - # this code is forked and run - spawn sub { - my ($request, $path, $ver, $left, $cl); - - my @headers; - - while(<STDIN>) { - if($_ =~ /([A-Z]*) (.*) HTTP\/1.(\d)/) { - $request=$1; - $path=$2; - $ver=$3; - } - elsif($_ =~ /^Content-Length: (\d*)/) { - $cl=$1; - } - - if($verbose) { - print STDERR "IN: $_"; - } - - push @headers, $_; - - if($left > 0) { - $left -= length($_); - if($left == 0) { - $left = -1; # just to force a loop break here - } - } - # print STDERR "RCV ($left): $_"; - - if(!$left && - ($_ eq "\r\n") or ($_ eq "")) { - if($request =~ /^(POST|PUT)$/) { - $left=$cl; - } - elsif($request =~ /^CONNECT$/) { - if($verbose) { - print STDERR "We're emulating a SSL proxy!\n"; - } - $left = -1; - } - else { - $left = -1; # force abort - } - } - if($left < 0) { - last; - } - } - - if($request =~ /^CONNECT$/) { - # ssl proxy mode - print "HTTP/1.1 400 WE CANNOT ROOL NOW\r\n", - "Server: bahoooba\r\n\r\n"; - exit; - } - elsif($path =~ /verifiedserver/) { - # this is a hard-coded query-string for the test script - # to verify that this is the server actually running! - print "HTTP/1.1 999 WE ROOLZ: $PID\r\n"; - exit; - } - else { - - # - # 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 - # - my $testnum; - if($path =~ /.*\/(\d*)/) { - $testnum=$1; - } - else { - $testnum=0; - } - open(INPUT, ">>log/server.input"); - - binmode(INPUT,":raw"); # this makes it work better on cygwin - - for(@headers) { - print INPUT $_; - } - close(INPUT); - - if(0 == $testnum ) { - print "HTTP/1.1 200 OK\r\n", - "header: yes\r\n", - "\r\n", - "You must enter a test number to get good data back\r\n"; - } - else { - my $part=""; - if($testnum > 10000) { - $part = $testnum % 10000; - $testnum = sprintf("%d", $testnum/10000); - } - if($verbose) { - print STDERR "OUT: sending reply $testnum (part $part)\n"; - } - - loadtest("data/test$testnum"); - - - my @cmd = getpart("reply", "cmd"); - performcmd(@cmd); - - # flush data: - $| = 1; - - # send a custom reply to the client - my @data = getpart("reply", "data$part"); - for(@data) { - print $_; - if($verbose) { - print STDERR "OUT: $_"; - } - } - my @postcmd = getpart("reply", "postcmd"); - performcmd(@postcmd); - } - } - # print "Hello there, $name, it's now ", scalar localtime, "\r\n"; - }; -} - - -sub spawn { - my $coderef = shift; - - - unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { - confess "usage: spawn CODEREF"; - } - - - my $pid; - if (!defined($pid = fork)) { - logmsg "cannot fork: $!"; - return; - } elsif ($pid) { - logmsg "begat $pid"; - return; # I'm the parent - } - # else I'm the child -- go spawn - - - open(STDIN, "<&Client") || die "can't dup client to stdin"; - open(STDOUT, ">&Client") || die "can't dup client to stdout"; - ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr"; - exit &$coderef(); -} +exec("server/sws $port"); |