'use strict' compliant
better complains if there are missing input files for a test case explaced exit-calls with returns instead
This commit is contained in:
parent
885184aa14
commit
56c0c67dff
@ -3,14 +3,17 @@ use Socket;
|
|||||||
use Carp;
|
use Carp;
|
||||||
use FileHandle;
|
use FileHandle;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
|
||||||
sub spawn; # forward declaration
|
sub spawn; # forward declaration
|
||||||
sub logmsg { #print "$0 $$: @_ at ", scalar localtime, "\n"
|
sub logmsg { #print "$0 $$: @_ at ", scalar localtime, "\n"
|
||||||
}
|
}
|
||||||
|
|
||||||
my $port = $ARGV[0];
|
my $port = $ARGV[0];
|
||||||
my $proto = getprotobyname('tcp');
|
my $proto = getprotobyname('tcp') || 6;
|
||||||
$port = $1 if $port =~ /(\d+)/; # untaint port number
|
$port = $1 if $port =~ /(\d+)/; # untaint port number
|
||||||
|
|
||||||
|
my $protocol;
|
||||||
if($ARGV[1] =~ /^ftp$/i) {
|
if($ARGV[1] =~ /^ftp$/i) {
|
||||||
$protocol="FTP";
|
$protocol="FTP";
|
||||||
}
|
}
|
||||||
@ -18,6 +21,8 @@ else {
|
|||||||
$protocol="HTTP";
|
$protocol="HTTP";
|
||||||
}
|
}
|
||||||
|
|
||||||
|
my $verbose=0; # set to 1 for debugging
|
||||||
|
|
||||||
socket(Server, PF_INET, SOCK_STREAM, $proto)|| die "socket: $!";
|
socket(Server, PF_INET, SOCK_STREAM, $proto)|| die "socket: $!";
|
||||||
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
|
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
|
||||||
pack("l", 1)) || die "setsockopt: $!";
|
pack("l", 1)) || die "setsockopt: $!";
|
||||||
@ -40,18 +45,53 @@ sub REAPER {
|
|||||||
}
|
}
|
||||||
|
|
||||||
# USER is ok in fresh state
|
# USER is ok in fresh state
|
||||||
%commandok = ( "USER" => "fresh",
|
my %commandok = ( "USER" => "fresh",
|
||||||
"PASS" => "passwd",
|
"PASS" => "passwd",
|
||||||
"PASV" => "loggedin",
|
# "PASV" => "loggedin", we can't handle PASV yet
|
||||||
);
|
"PORT" => "loggedin",
|
||||||
|
);
|
||||||
|
|
||||||
%statechange = ( 'USER' => 'passwd', # USER goes to passwd state
|
my %statechange = ( 'USER' => 'passwd', # USER goes to passwd state
|
||||||
'PASS' => 'loggedin', # PASS goes to loggedin state
|
'PASS' => 'loggedin', # PASS goes to loggedin state
|
||||||
);
|
'PORT' => 'ported', # PORT goes to ported
|
||||||
|
);
|
||||||
|
|
||||||
%displaytext = ('USER' => '331 We are happy you popped in!', # output FTP line
|
my %displaytext = ('USER' => '331 We are happy you popped in!', # output FTP line
|
||||||
'PASS' => '230 Welcome you silly person',
|
'PASS' => '230 Welcome you silly person',
|
||||||
);
|
);
|
||||||
|
|
||||||
|
my %commandfunc = ( 'PORT', \&PORT_command );
|
||||||
|
|
||||||
|
sub PORT_command {
|
||||||
|
my $arg = $_[0];
|
||||||
|
print STDERR "fooo: $arg\n";
|
||||||
|
|
||||||
|
# "193,15,23,1,172,201"
|
||||||
|
|
||||||
|
if($arg !~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/) {
|
||||||
|
print STDERR "bad PORT-line: $arg\n";
|
||||||
|
print "314 silly you, go away\r\n";
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
my $iaddr = inet_aton("$1.$2.$3.$4");
|
||||||
|
my $paddr = sockaddr_in(($5<<8)+$6, $iaddr);
|
||||||
|
my $proto = getprotobyname('tcp') || 6;
|
||||||
|
|
||||||
|
socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "major failure";
|
||||||
|
print STDERR "socket()\n";
|
||||||
|
|
||||||
|
connect(SOCK, $paddr) || return 1;
|
||||||
|
print STDERR "connect()\n";
|
||||||
|
|
||||||
|
my $line;
|
||||||
|
while (defined($line = <SOCK>)) {
|
||||||
|
print STDERR $line;
|
||||||
|
}
|
||||||
|
|
||||||
|
close(SOCK);
|
||||||
|
print STDERR "close()\n";
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
$SIG{CHLD} = \&REAPER;
|
$SIG{CHLD} = \&REAPER;
|
||||||
|
|
||||||
@ -94,7 +134,7 @@ for ( $waitedpid = 0;
|
|||||||
"220-running the curl suite test server\r\n",
|
"220-running the curl suite test server\r\n",
|
||||||
"220 running the curl suite test server\r\n";
|
"220 running the curl suite test server\r\n";
|
||||||
|
|
||||||
$state="fresh";
|
my $state="fresh";
|
||||||
|
|
||||||
while(1) {
|
while(1) {
|
||||||
|
|
||||||
@ -109,12 +149,13 @@ for ( $waitedpid = 0;
|
|||||||
"badly formed command received: ".$_;
|
"badly formed command received: ".$_;
|
||||||
exit 0;
|
exit 0;
|
||||||
}
|
}
|
||||||
$FTPCMD=$1;
|
my $FTPCMD=$1;
|
||||||
$full=$_;
|
my $FTPARG=$2;
|
||||||
|
my $full=$_;
|
||||||
|
|
||||||
print STDERR "GOT: ($1) $_\n";
|
print STDERR "GOT: ($1) $_\n";
|
||||||
|
|
||||||
$ok = $commandok{$FTPCMD};
|
my $ok = $commandok{$FTPCMD};
|
||||||
if($ok !~ /$state/) {
|
if($ok !~ /$state/) {
|
||||||
print "314 $FTPCMD not OK ($ok) in state: $state!\r\n";
|
print "314 $FTPCMD not OK ($ok) in state: $state!\r\n";
|
||||||
exit;
|
exit;
|
||||||
@ -125,15 +166,24 @@ for ( $waitedpid = 0;
|
|||||||
print "314 Wwwwweeeeird internal error state: $state\r\n";
|
print "314 Wwwwweeeeird internal error state: $state\r\n";
|
||||||
exit;
|
exit;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# see if the new state is a function caller.
|
||||||
|
my $func = $commandfunc{$FTPCMD};
|
||||||
|
if($func) {
|
||||||
|
# it is!
|
||||||
|
spawn \&$func($FTPARG);
|
||||||
|
}
|
||||||
|
|
||||||
print STDERR "gone to state $state\n";
|
print STDERR "gone to state $state\n";
|
||||||
|
|
||||||
$text = $displaytext{$FTPCMD};
|
my $text = $displaytext{$FTPCMD};
|
||||||
print "$text\r\n";
|
print "$text\r\n";
|
||||||
}
|
}
|
||||||
exit;
|
exit;
|
||||||
}
|
}
|
||||||
# otherwise, we're doing HTTP
|
# otherwise, we're doing HTTP
|
||||||
|
|
||||||
|
my @headers;
|
||||||
while(<STDIN>) {
|
while(<STDIN>) {
|
||||||
if($_ =~ /([A-Z]*) (.*) HTTP\/1.(\d)/) {
|
if($_ =~ /([A-Z]*) (.*) HTTP\/1.(\d)/) {
|
||||||
$request=$1;
|
$request=$1;
|
||||||
@ -144,6 +194,10 @@ for ( $waitedpid = 0;
|
|||||||
$cl=$1;
|
$cl=$1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if($verbose) {
|
||||||
|
print STDERR "IN: $_";
|
||||||
|
}
|
||||||
|
|
||||||
push @headers, $_;
|
push @headers, $_;
|
||||||
|
|
||||||
if($left > 0) {
|
if($left > 0) {
|
||||||
@ -181,6 +235,7 @@ for ( $waitedpid = 0;
|
|||||||
# test number that this server will use to know what
|
# test number that this server will use to know what
|
||||||
# contents to pass back to the client
|
# contents to pass back to the client
|
||||||
#
|
#
|
||||||
|
my $testnum;
|
||||||
if($path =~ /.*\/(\d*)/) {
|
if($path =~ /.*\/(\d*)/) {
|
||||||
$testnum=$1;
|
$testnum=$1;
|
||||||
}
|
}
|
||||||
|
Loading…
x
Reference in New Issue
Block a user