mirror of
https://github.com/moparisthebest/curl
synced 2024-12-21 23:58:49 -05:00
cut off the old perl one, this only runs the C coded version
This commit is contained in:
parent
6d8c7356d6
commit
6fe4a6fa9a
@ -1,15 +1,6 @@
|
|||||||
#!/usr/bin/perl
|
#!/usr/bin/env perl
|
||||||
use Socket;
|
|
||||||
use Carp;
|
|
||||||
use FileHandle;
|
|
||||||
|
|
||||||
#use strict;
|
use strict;
|
||||||
|
|
||||||
require "getpart.pm";
|
|
||||||
|
|
||||||
sub spawn; # forward declaration
|
|
||||||
sub logmsg { #print "$0 $$: @_ at ", scalar localtime, "\n"
|
|
||||||
}
|
|
||||||
|
|
||||||
my $verbose=0; # set to 1 for debugging
|
my $verbose=0; # set to 1 for debugging
|
||||||
|
|
||||||
@ -23,204 +14,4 @@ do {
|
|||||||
}
|
}
|
||||||
} while(shift @ARGV);
|
} while(shift @ARGV);
|
||||||
|
|
||||||
my $proto = getprotobyname('tcp') || 6;
|
exec("server/sws $port");
|
||||||
|
|
||||||
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();
|
|
||||||
}
|
|
||||||
|
Loading…
Reference in New Issue
Block a user