this is the first attempt of a tiny and simple ftp server in perl for curl
test purposes
This commit is contained in:
Daniel Stenberg
Родитель
13e9a4d8f4
Коммит
b2ad1f68cc
|
|
@ -0,0 +1,251 @@
|
|||
#!/usr/bin/perl
|
||||
use Socket;
|
||||
use Carp;
|
||||
use FileHandle;
|
||||
|
||||
use strict;
|
||||
|
||||
sub spawn; # forward declaration
|
||||
sub logmsg { #print "$0 $$: @_ at ", scalar localtime, "\n"
|
||||
}
|
||||
|
||||
my $verbose=0; # set to 1 for debugging
|
||||
|
||||
my $port = 8921; # just a default
|
||||
do {
|
||||
if($ARGV[0] eq "-v") {
|
||||
$verbose=1;
|
||||
}
|
||||
elsif($ARGV[0] =~ /^(\d+)$/) {
|
||||
$port = $1;
|
||||
}
|
||||
} while(shift @ARGV);
|
||||
|
||||
my $proto = getprotobyname('tcp') || 6;
|
||||
|
||||
my $protocol;
|
||||
my $ftp_sendfile=""; # set to a file name when the file should be sent
|
||||
|
||||
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: $!";
|
||||
|
||||
print "$protocol server started on port $port\n";
|
||||
|
||||
open(PID, ">.ftpserver.pid");
|
||||
print PID $$;
|
||||
close(PID);
|
||||
|
||||
my $waitedpid = 0;
|
||||
my $paddr;
|
||||
|
||||
sub REAPER {
|
||||
$waitedpid = wait;
|
||||
$SIG{CHLD} = \&REAPER; # loathe sysV
|
||||
logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
|
||||
}
|
||||
|
||||
# USER is ok in fresh state
|
||||
my %commandok = ( "USER" => "fresh",
|
||||
"PASS" => "passwd",
|
||||
# "PASV" => "loggedin", we can't handle PASV yet
|
||||
"PORT" => "loggedin",
|
||||
"TYPE" => "loggedin|twosock",
|
||||
"LIST" => "twosock",
|
||||
);
|
||||
|
||||
# initially, we're in 'fresh' state
|
||||
my %statechange = ( 'USER' => 'passwd', # USER goes to passwd state
|
||||
'PASS' => 'loggedin', # PASS goes to loggedin state
|
||||
'PORT' => 'twosock', # PORT goes to twosock
|
||||
);
|
||||
|
||||
my %displaytext = ('USER' => '331 We are happy you popped in!', # output FTP line
|
||||
'PASS' => '230 Welcome you silly person',
|
||||
'PORT' => '200 You said PORT - I say FINE',
|
||||
'TYPE' => '200 I modify TYPE as you wanted',
|
||||
'LIST' => '150 Here comes a directory your way',
|
||||
);
|
||||
|
||||
my %commandfunc = ( 'PORT', \&PORT_command,
|
||||
'LIST', \&LIST_command);
|
||||
|
||||
sub LIST_command {
|
||||
$ftp_sendfile="ftptest"; # send this now
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub PORT_command {
|
||||
my $arg = $_[0];
|
||||
print STDERR "fooo: $arg\n";
|
||||
|
||||
# "193,15,23,1,172,201"
|
||||
|
||||
my $pid;
|
||||
if (!defined($pid = fork)) {
|
||||
logmsg "cannot fork: $!";
|
||||
return 1;
|
||||
} elsif ($pid) {
|
||||
logmsg "begat $pid";
|
||||
print STDERR "dasdasd a\n";
|
||||
return 0;
|
||||
}
|
||||
# else I'm the child -- go spawn
|
||||
|
||||
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($ftp_sendfile eq "") {
|
||||
sleep 1;
|
||||
}
|
||||
open(SEND, "<$ftp_sendfile") ||
|
||||
print STDERR "couldn't open file to send";
|
||||
|
||||
#while (defined($line = <SOCK>)) {
|
||||
#print STDERR $line;
|
||||
#}
|
||||
while(<SEND>) {
|
||||
print $_;
|
||||
}
|
||||
close(SEND);
|
||||
close(SOCK);
|
||||
|
||||
$ftp_sendfile="";
|
||||
|
||||
print STDERR "close()\n";
|
||||
|
||||
}
|
||||
|
||||
$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 {
|
||||
# < 220 pm1 FTP server (SunOS 5.7) ready.
|
||||
# > USER anonymous
|
||||
# < 331 Guest login ok, send ident as password.
|
||||
# > PASS curl_by_daniel@haxx.se
|
||||
# < 230 Guest login ok, access restrictions apply.
|
||||
# * We have successfully logged in
|
||||
# * Connected to pm1 (193.15.23.1)
|
||||
# > PASV
|
||||
# < 227 Entering Passive Mode (193,15,23,1,231,59)
|
||||
# * Connecting to pm1 (193.15.23.1) port 59195
|
||||
# > TYPE A
|
||||
# < 200 Type set to A.
|
||||
# > LIST
|
||||
# < 150 ASCII data connection for /bin/ls (193.15.23.1,59196) (0 bytes).
|
||||
# * Getting file with size: -1
|
||||
|
||||
# flush data:
|
||||
$| = 1;
|
||||
|
||||
print "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";
|
||||
|
||||
my $state="fresh";
|
||||
|
||||
while(1) {
|
||||
|
||||
last unless defined ($_ = <STDIN>);
|
||||
|
||||
# Remove trailing CRLF.
|
||||
s/[\n\r]+$//;
|
||||
|
||||
unless (m/^([A-Z]{3,4})\s?(.*)/i) {
|
||||
print STDERR
|
||||
"badly formed command received: ".$_;
|
||||
exit 0;
|
||||
}
|
||||
my $FTPCMD=$1;
|
||||
my $FTPARG=$2;
|
||||
my $full=$_;
|
||||
|
||||
print STDERR "GOT: ($1) $_\n";
|
||||
|
||||
my $ok = $commandok{$FTPCMD};
|
||||
if($ok !~ /$state/) {
|
||||
print "314 $FTPCMD not OK ($ok) in state: $state!\r\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
my $newstate=$statechange{$FTPCMD};
|
||||
if($newstate eq "") {
|
||||
# remain in the same state
|
||||
#print "314 Wwwwweeeeird internal error state: $state\r\n";
|
||||
#exit;
|
||||
}
|
||||
else {
|
||||
$state = $newstate;
|
||||
}
|
||||
|
||||
# see if the new state is a function caller.
|
||||
my $func = $commandfunc{$FTPCMD};
|
||||
if($func) {
|
||||
# it is!
|
||||
\&$func($FTPARG);
|
||||
print STDERR "MOOOOOOOOO\n";
|
||||
}
|
||||
|
||||
print STDERR "gone to state $state\n";
|
||||
|
||||
my $text = $displaytext{$FTPCMD};
|
||||
print "$text\r\n";
|
||||
}
|
||||
exit;
|
||||
# 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();
|
||||
}
|
||||
Загрузка…
Ссылка в новой задаче