# connection states
my %_connection_states = (
- 'NEWCONN' => 0x01,
- 'WAIT4PWD' => 0x02,
+ 'NEWCONN' => 0x01,
+ 'WAIT4PWD' => 0x02,
'LOGGEDIN' => 0x04,
'TWOSOCKS' => 0x08,
);
# subset of FTP commands supported by these server and the respective
# connection states in which they are allowed
-my %_commands = (
+my %_commands = (
# Standard commands from RFC 959.
'CWD' => $_connection_states{LOGGEDIN} |
- $_connection_states{TWOSOCKS},
+ $_connection_states{TWOSOCKS},
# 'EPRT' => $_connection_states{LOGGEDIN},
-# 'EPSV' => $_connection_states{LOGGEDIN},
- 'LIST' => $_connection_states{TWOSOCKS},
+# 'EPSV' => $_connection_states{LOGGEDIN},
+ 'LIST' => $_connection_states{TWOSOCKS},
# 'LPRT' => $_connection_states{LOGGEDIN},
-# 'LPSV' => $_connection_states{LOGGEDIN},
- 'PASS' => $_connection_states{WAIT4PWD},
- 'PASV' => $_connection_states{LOGGEDIN},
- 'PORT' => $_connection_states{LOGGEDIN},
+# 'LPSV' => $_connection_states{LOGGEDIN},
+ 'PASS' => $_connection_states{WAIT4PWD},
+ 'PASV' => $_connection_states{LOGGEDIN},
+ 'PORT' => $_connection_states{LOGGEDIN},
'PWD' => $_connection_states{LOGGEDIN} |
- $_connection_states{TWOSOCKS},
+ $_connection_states{TWOSOCKS},
'QUIT' => $_connection_states{LOGGEDIN} |
- $_connection_states{TWOSOCKS},
- 'REST' => $_connection_states{TWOSOCKS},
- 'RETR' => $_connection_states{TWOSOCKS},
+ $_connection_states{TWOSOCKS},
+ 'REST' => $_connection_states{TWOSOCKS},
+ 'RETR' => $_connection_states{TWOSOCKS},
'SYST' => $_connection_states{LOGGEDIN},
'TYPE' => $_connection_states{LOGGEDIN} |
$_connection_states{TWOSOCKS},
- 'USER' => $_connection_states{NEWCONN},
+ 'USER' => $_connection_states{NEWCONN},
# From ftpexts Internet Draft.
'SIZE' => $_connection_states{LOGGEDIN} |
$_connection_states{TWOSOCKS},
my @elems = split /\//, $path;
foreach (@elems) {
- if ($_ eq "" || $_ eq ".") {
+ if ($_ eq "" || $_ eq ".") {
# Ignore these.
next;
} elsif ($_ eq "..") {
$dir = "/";
$path =~ s,^/+,,;
}
-
+
# Parse the first elements of the path until we find the appropriate
# working directory.
my @elems = split /\//, $path;
}
$dir .= $_;
} else { # It's the last element: check if it's a file, directory or wildcard.
- if (-f $conn->{rootdir} . $dir . $_) {
+ if (-f $conn->{rootdir} . $dir . $_) {
# It's a file.
$filename = $_;
- } elsif (-d $conn->{rootdir} . $dir . $_) {
+ } elsif (-d $conn->{rootdir} . $dir . $_) {
# It's a directory.
$dir .= $_;
} elsif (/\*/ || /\?/) {
}
}
}
-
+
print STDERR "_LIST_command - dir is: $dir\n" if $log;
-
+
print {$conn->{socket}} "150 Opening data connection for file listing.\r\n";
# Open a path back to the client.
# If the path contains a directory name, extract it so that
# we can prefix it to every filename listed.
my $prefix = (($filename || $wildcard) && $path =~ /(.*\/).*/) ? $1 : "";
-
+
print STDERR "_LIST_command - prefix is: $prefix\n" if $log;
# OK, we're either listing a full directory, listing a single
__list_file ($sock, $prefix . $_);
}
}
-
+
unless ($sock->close) {
print {$conn->{socket}} "550 Error closing data connection: $!\r\n";
return;
print STDERR "switching to LOGGEDIN state\n" if $log;
$conn->{state} = $_connection_states{LOGGEDIN};
-
+
if ($conn->{username} eq "anonymous") {
print {$conn->{socket}} "202 Anonymous user access is always granted.\r\n";
} else {
sub _PASV_command
{
my ($conn, $cmd, $rest) = @_;
-
+
# Open a listening socket - but don't actually accept on it yet.
"0" =~ /(0)/; # Perl 5.7 / IO::Socket::INET bug workaround.
my $sock = IO::Socket::INET->new (LocalHost => '127.0.0.1',
my $p2 = $sockport % 256;
$conn->{state} = $_connection_states{TWOSOCKS};
-
+
# We only accept connections from localhost.
print {$conn->{socket}} "227 Entering Passive Mode (127,0,0,1,$p1,$p2)\r\n";
}
sub _PWD_command
{
my ($conn, $cmd, $rest) = @_;
-
+
# See RFC 959 Appendix II and draft-ietf-ftpext-mlst-11.txt section 6.2.1.
my $pathname = $conn->{dir};
$pathname =~ s,/+$,, unless $pathname eq "/";
sub _REST_command
{
my ($conn, $cmd, $restart_from) = @_;
-
+
unless ($restart_from =~ /^([1-9][0-9]*|0)$/) {
print {$conn->{socket}} "501 REST command needs a numeric argument.\r\n";
return;
sub _RETR_command
{
my ($conn, $cmd, $path) = @_;
-
+
my $dir = $conn->{dir};
# Absolute path?
my $filename = pop @elems;
foreach (@elems) {
- if ($_ eq "" || $_ eq ".") {
+ if ($_ eq "" || $_ eq ".") {
next # Ignore these.
} elsif ($_ eq "..") {
# Go to parent directory.
unless (defined $filename && length $filename) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
- return;
+ return;
}
if ($filename eq "." || $filename eq "..") {
print {$conn->{socket}} "550 RETR command is not supported on directories.\r\n";
- return;
+ return;
}
-
+
my $fullname = $conn->{rootdir} . $dir . $filename;
unless (-f $fullname) {
print {$conn->{socket}} "550 RETR command is only supported on plain files.\r\n";
sub _SIZE_command
{
my ($conn, $cmd, $path) = @_;
-
+
my $dir = $conn->{dir};
# Absolute path?
my $filename = pop @elems;
foreach (@elems) {
- if ($_ eq "" || $_ eq ".") {
+ if ($_ eq "" || $_ eq ".") {
next # Ignore these.
} elsif ($_ eq "..") {
# Go to parent directory.
unless (defined $filename && length $filename) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
- return;
+ return;
}
if ($filename eq "." || $filename eq "..") {
print {$conn->{socket}} "550 SIZE command is not supported on directories.\r\n";
- return;
+ return;
}
my $fullname = $conn->{rootdir} . $dir . $filename;
sub _SYST_command
{
my ($conn, $cmd, $dummy) = @_;
-
+
print {$conn->{socket}} "215 UNIX Type: L8\r\n";
}
sub _TYPE_command
{
my ($conn, $cmd, $type) = @_;
-
+
# See RFC 959 section 5.3.2.
if ($type =~ /^([AI])$/i) {
$conn->{type} = 'A';
print STDERR "switching to WAIT4PWD state\n" if $log;
$conn->{state} = $_connection_states{WAIT4PWD};
-
+
if ($conn->{username} eq "anonymous") {
print {$conn->{socket}} "230 Anonymous user access granted.\r\n";
} else {
my @allfiles = readdir DIRHANDLE;
my @filenames = ();
-
+
if ($wildcard) {
# Get rid of . and ..
@allfiles = grep !/^\.{1,2}$/, @allfiles;
-
+
# Convert wildcard to a regular expression.
$wildcard = __wildcard_to_regex ($wildcard);
_reuseAddr => 1,
_rootDir => Cwd::getcwd(),
);
-
+
sub _default_for
{
my ($self, $attr) = @_;
}
-sub run
+sub run
{
my ($self, $synch_callback) = @_;
my $initialized = 0;
# the accept loop
while (my $client_addr = accept (my $socket, $server_sock))
- {
+ {
# turn buffering off on $socket
select((select($socket), $|=1)[0]);
-
- # find out who connected
+
+ # find out who connected
my ($client_port, $client_ip) = sockaddr_in ($client_addr);
my $client_ipnum = inet_ntoa ($client_ip);
if (1) { # Child process.
# install signals
- $SIG{URG} = sub {
- $GOT_SIGURG = 1;
+ $SIG{URG} = sub {
+ $GOT_SIGURG = 1;
};
$SIG{PIPE} = sub {
print STDERR "Connection idle timeout expired. Closing server.\n";
exit;
};
-
+
#$SIG{CHLD} = 'IGNORE';
'idle_timeout' => 60, # 1 minute timeout
'rootdir' => $self->{_rootDir},
};
-
+
print {$conn->{socket}} "220 GNU Wget Testing FTP Server ready.\r\n";
# command handling loop
print {$conn->{socket}} "530 Not logged in.\r\n";
next;
}
-
+
# Handle the QUIT command specially.
if ($cmd eq "QUIT") {
print {$conn->{socket}} "221 Goodbye. Service closing connection.\r\n";
} else { # Father
close $socket;
}
- }
+ }
$/ = $old_ils;
}
_name => "",
_output => {},
);
-
+
sub _default_for
{
my ($self, $attr) = @_;
$_attr_data{$attr};
}
- sub _standard_keys
+ sub _standard_keys
{
keys %_attr_data;
}
sub run {
my $self = shift;
my $result_message = "Test successful.\n";
-
+
printf "Running test $self->{_name}\n";
-
- # Setup
+
+ # Setup
$self->_setup();
chdir ("$self->{_workdir}/$self->{_name}/input");
-
+
# Launch server
my $pid = $self->_fork_and_launch_server();
-
+
# Call wget
chdir ("$self->{_workdir}/$self->{_name}/output");
my $cmdline = $self->{_cmdline};
$cmdline = $self->_substitute_port($cmdline);
print "Calling $cmdline\n";
- my $errcode =
- ($cmdline =~ m{^/.*})
+ my $errcode =
+ ($cmdline =~ m{^/.*})
? system ($cmdline)
: system ("$self->{_workdir}/../src/$cmdline");
# Shutdown server
- # if we didn't explicitely kill the server, we would have to call
- # waitpid ($pid, 0) here in order to wait for the child process to
+ # if we didn't explicitely kill the server, we would have to call
+ # waitpid ($pid, 0) here in order to wait for the child process to
# terminate
kill ('TERM', $pid);
chdir ($self->{_name});
mkdir ("input");
mkdir ("output");
-
+
# Setup existing files
chdir ("output");
foreach my $filename (keys %{$self->{_existing}}) {
- open (FILE, ">$filename")
+ open (FILE, ">$filename")
or return "Test failed: cannot open pre-existing file $filename\n";
my $file = $self->{_existing}->{$filename};
utime $file->{timestamp}, $file->{timestamp}, $filename
or return "Test failed: cannot set timestamp on pre-existing file $filename\n";
}
- }
-
+ }
+
chdir ("../input");
$self->_setup_server();
my $self = shift;
chdir ("$self->{_workdir}/$self->{_name}/output");
-
+
# use slurp mode to read file content
my $old_input_record_separator = $/;
undef $/;
-
+
while (my ($filename, $filedata) = each %{$self->{_output}}) {
- open (FILE, $filename)
+ open (FILE, $filename)
or return "Test failed: file $filename not downloaded\n";
-
+
my $content = <FILE>;
my $expected_content = $filedata->{'content'};
$expected_content = $self->_substitute_port($expected_content);
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
$atime, $mtime, $ctime, $blksize, $blocks) = stat FILE;
- $mtime == $filedata->{'timestamp'}
+ $mtime == $filedata->{'timestamp'}
or return "Test failed: wrong timestamp for file $filename\n";
}
-
+
close (FILE);
- }
-
- $/ = $old_input_record_separator;
+ }
+
+ $/ = $old_input_record_separator;
# make sure no unexpected files were downloaded
chdir ("$self->{_workdir}/$self->{_name}/output");
__dir_walk('.', sub { push @unexpected_downloads, $_[0] unless (exists $self->{_output}{$_[0]}) }, sub { shift; return @_ } );
- if (@unexpected_downloads) {
+ if (@unexpected_downloads) {
return "Test failed: unexpected downloaded files [" . join(', ', @unexpected_downloads) . "]\n";
}
}
-sub _fork_and_launch_server
+sub _fork_and_launch_server
{
my $self = shift;
if ($pid < 0) {
die "Cannot fork";
} elsif ($pid == 0) {
- # child
+ # child
close FROM_CHILD;
$self->_launch_server(sub { print TO_PARENT "SYNC\n"; close TO_PARENT });
} else {
projects / wget / commitdiff