moparisthebest/wget
1
0
Fork 0
mirror of https://github.com/moparisthebest/wget synced 2024-07-03 16:38:41 -04:00
Code Issues Releases Wiki Activity

Automated merge.

Browse Source
This commit is contained in:
Micah Cowan 2009-09-06 14:08:56 -07:00
commit 544afabb39
10 changed files with 463 additions and 394 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/ChangeLog
View File

@ -1,3 +1,10 @@
2009-09-06 Micah Cowan <micah@cowan.name>
* ftp.c (getftp, ftp_loop_internal): Separate "len" input/output
parameter (with different meanings for input and output), into two
separate parameters, one input (passed_expected_bytes) and one
output (qtyread). Fixes bug #26870.
2009-09-05 Steven Schubiger <stsc@member.fsf.org>
* retr.h: Declare set_local_file() to avoid build warnings.

47
src/ftp.c
View File

@ -240,7 +240,8 @@ static uerr_t ftp_get_listing (struct url *, ccon *, struct fileinfo **);
connection to the server. It always closes the data connection,
and closes the control connection in case of error. */
static uerr_t
getftp (struct url *u, wgint *len, wgint restval, ccon *con)
getftp (struct url *u, wgint passed_expected_bytes, wgint *qtyread,
wgint restval, ccon *con)
{
int csock, dtsock, local_sock, res;
uerr_t err = RETROK; /* appease the compiler */
@ -266,6 +267,8 @@ getftp (struct url *u, wgint *len, wgint restval, ccon *con)
/* Make sure that at least *something* is requested. */
assert ((cmd & (DO_LIST | DO_CWD | DO_RETR | DO_LOGIN)) != 0);
*qtyread = restval;
user = u->user;
passwd = u->passwd;
search_netrc (u->host, (const char **)&user, (const char **)&passwd, 1);
@ -730,7 +733,7 @@ Error in server response, closing control connection.\n"));
else /* do not CWD */
logputs (LOG_VERBOSE, _("==> CWD not required.\n"));
if ((cmd & DO_RETR) && *len == 0)
if ((cmd & DO_RETR) && passed_expected_bytes == 0)
{
if (opt.verbose)
{
@ -739,7 +742,7 @@ Error in server response, closing control connection.\n"));
quotearg_style (escape_quoting_style, u->file));
}
err = ftp_size (csock, u->file, len);
err = ftp_size (csock, u->file, &expected_bytes);
/* FTPRERR */
switch (err)
{
@ -758,8 +761,8 @@ Error in server response, closing control connection.\n"));
abort ();
}
if (!opt.server_response)
logprintf (LOG_VERBOSE, *len ? "%s\n" : _("done.\n"),
number_to_static_string (*len));
logprintf (LOG_VERBOSE, expected_bytes ? "%s\n" : _("done.\n"),
number_to_static_string (expected_bytes));
}
/* If anything is to be retrieved, PORT (or PASV) must be sent. */
@ -1070,11 +1073,11 @@ Error in server response, closing control connection.\n"));
/* Some FTP servers return the total length of file after REST
command, others just return the remaining size. */
if (*len && restval && expected_bytes
&& (expected_bytes == *len - restval))
if (passed_expected_bytes && restval && expected_bytes
&& (expected_bytes == passed_expected_bytes - restval))
{
DEBUGP (("Lying FTP server found, adjusting.\n"));
expected_bytes = *len;
expected_bytes = passed_expected_bytes;
}
/* If no transmission was required, then everything is OK. */
@ -1203,10 +1206,11 @@ Error in server response, closing control connection.\n"));
else
fp = output_stream;
if (*len)
if (passed_expected_bytes)
{
print_length (*len, restval, true);
expected_bytes = *len; /* for fd_read_body's progress bar */
print_length (passed_expected_bytes, restval, true);
expected_bytes = passed_expected_bytes;
/* for fd_read_body's progress bar */
}
else if (expected_bytes)
print_length (expected_bytes, restval, false);
@ -1215,11 +1219,10 @@ Error in server response, closing control connection.\n"));
flags = 0;
if (restval && rest_failed)
flags |= rb_skip_startpos;
*len = restval;
rd_size = 0;
res = fd_read_body (dtsock, fp,
expected_bytes ? expected_bytes - restval : 0,
restval, &rd_size, len, &con->dltime, flags);
restval, &rd_size, qtyread, &con->dltime, flags);
tms = datetime_str (time (NULL));
tmrate = retr_rate (rd_size, con->dltime);
@ -1348,7 +1351,7 @@ static uerr_t
ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
{
int count, orig_lp;
wgint restval, len = 0;
wgint restval, len = 0, qtyread = 0;
char *tms, *locf;
const char *tmrate = NULL;
uerr_t err;
@ -1428,7 +1431,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
first attempt to clobber existing data.) */
restval = st.st_size;
else if (count > 1)
restval = len; /* start where the previous run left off */
restval = qtyread; /* start where the previous run left off */
else
restval = 0;
@ -1454,7 +1457,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
len = f->size;
else
len = 0;
err = getftp (u, &len, restval, con);
err = getftp (u, len, &qtyread, restval, con);
if (con->csock == -1)
con->st &= ~DONE_CWD;
@ -1484,7 +1487,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
case FTPRETRINT:
/* If the control connection was closed, the retrieval
will be considered OK if f->size == len. */
if (!f || len != f->size)
if (!f || qtyread != f->size)
{
printwhat (count, opt.ntry);
continue;
@ -1499,7 +1502,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
}
tms = datetime_str (time (NULL));
if (!opt.spider)
tmrate = retr_rate (len - restval, con->dltime);
tmrate = retr_rate (qtyread - restval, con->dltime);
/* If we get out of the switch above without continue'ing, we've
successfully downloaded a file. Remember this fact. */
@ -1520,7 +1523,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
: _("%s (%s) - %s saved [%s]\n\n"),
tms, tmrate,
write_to_stdout ? "" : quote (locf),
number_to_static_string (len));
number_to_static_string (qtyread));
}
if (!opt.verbose && !opt.quiet)
{
@ -1529,7 +1532,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
time. */
char *hurl = url_string (u, URL_AUTH_HIDE_PASSWD);
logprintf (LOG_NONVERBOSE, "%s URL: %s [%s] -> \"%s\" [%d]\n",
tms, hurl, number_to_static_string (len), locf, count);
tms, hurl, number_to_static_string (qtyread), locf, count);
xfree (hurl);
}
@ -1540,7 +1543,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
/* --dont-remove-listing was specified, so do count this towards the
number of bytes and files downloaded. */
{
total_downloaded_bytes += len;
total_downloaded_bytes += qtyread;
numurls++;
}
@ -1555,7 +1558,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
downloaded if they're going to be deleted. People seeding proxies,
for instance, may want to know how many bytes and files they've
downloaded through it. */
total_downloaded_bytes += len;
total_downloaded_bytes += qtyread;
numurls++;
if (opt.delete_after)

37
tests/ChangeLog
View File

@ -1,3 +1,40 @@
2009-09-06 Micah Cowan <micah@cowan.name>
* WgetTest.pm.in (_setup): Don't expect error codes from
_setup_server; none are returned.
(quotechar, _show_diff): Added facilities for expounding on where
output didn't match expectations.
(_verify_download): Use _show_diff.
* FTPTest.pm (_setup_server): Pass value of server_behavior to
FTPServer initialization.
* Test-ftp-pasv-fail.px: Added.
* run-px, Makefile.am (EXTRA_DIST): Added Test-ftp-pasv-fail.px.
* WgetTest.pm.in: Added "server_behavior" to the set of accepted
initialization values.
* FTPServer.pm (__open_data_connection): Add "server_behavior" to
the set of accepted initialization values.
(run): Honor the 'fail_on_pasv' server behavior setting, to
trigger the Wget getftp glitch.
2009-09-05 Micah Cowan <micah@cowan.name>
* Test-ftp-recursive.px: Added.
* run-px, Makefile.am (EXTRA_DIST): Added Test-ftp-recursive.px.
* FTPTest.pm (_setup_server): Don't construct the "input"
directory's contents, just pass the URLs structure to
FTPServer->new.
* FTPServer.pm: Rewrote portions, so that the server now uses the
information from the %urls hash directly, rather than reading from
real files. Added an FTPPaths package to the file.
2009-09-04 Micah Cowan <micah@cowan.name>
* WgetTest.pm.in (run): Error-checking improvements.
2009-09-05 Steven Schubiger <stsc@member.fsf.org>
* run-px: Introduce two new diagnostics: Skip and Unknown.

558
tests/FTPServer.pm
View File

@ -61,101 +61,44 @@ my %_commands = (
sub _CWD_command
{
my ($conn, $cmd, $path) = @_;
my $paths = $conn->{'paths'};
local $_;
my $newdir = $conn->{dir};
# If the path starts with a "/" then it's an absolute path.
if (substr ($path, 0, 1) eq "/") {
$newdir = "";
$path =~ s,^/+,,;
}
my $new_path = FTPPaths::path_merge($conn->{'dir'}, $path);
# Split the path into its component parts and process each separately.
my @elems = split /\//, $path;
foreach (@elems) {
if ($_ eq "" || $_ eq ".") {
# Ignore these.
next;
} elsif ($_ eq "..") {
# Go to parent directory.
if ($newdir eq "") {
print {$conn->{socket}} "550 Directory not found.\r\n";
return;
}
$newdir = substr ($newdir, 0, rindex ($newdir, "/"));
} else {
# Go into subdirectory, if it exists.
$newdir .= ("/" . $_);
if (! -d $conn->{rootdir} . $newdir) {
print {$conn->{socket}} "550 Directory not found.\r\n";
return;
}
}
if (! $paths->dir_exists($new_path)) {
print {$conn->{socket}} "550 Directory not found.\r\n";
return;
}
$conn->{dir} = $newdir;
$conn->{'dir'} = $new_path;
print {$conn->{socket}} "200 directory changed to $new_path.\r\n";
}
sub _LIST_command
{
my ($conn, $cmd, $path) = @_;
my $paths = $conn->{'paths'};
# This is something of a hack. Some clients expect a Unix server
# to respond to flags on the 'ls command line'. Remove these flags
# and ignore them. This is particularly an issue with ncftp 2.4.3.
$path =~ s/^-[a-zA-Z0-9]+\s?//;
my $dir = $conn->{dir};
my $dir = $conn->{'dir'};
print STDERR "_LIST_command - dir is: $dir\n";
# Absolute path?
if (substr ($path, 0, 1) eq "/") {
$dir = "/";
$path =~ s,^/+,,;
}
# Parse the first elements of the path until we find the appropriate
# working directory.
my @elems = split /\//, $path;
my ($wildcard, $filename);
local $_;
for (my $i = 0; $i < @elems; ++$i) {
$_ = $elems[$i];
my $lastelement = $i == @elems-1;
if ($_ eq "" || $_ eq ".") { next } # Ignore these.
elsif ($_ eq "..") {
# Go to parent directory.
unless ($dir eq "/") {
$dir = substr ($dir, 0, rindex ($dir, "/"));
}
} else {
if (!$lastelement) { # These elements can only be directories.
unless (-d $conn->{rootdir} . $dir . $_) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
return;
}
$dir .= $_;
} else { # It's the last element: check if it's a file, directory or wildcard.
if (-f $conn->{rootdir} . $dir . $_) {
# It's a file.
$filename = $_;
} elsif (-d $conn->{rootdir} . $dir . $_) {
# It's a directory.
$dir .= $_;
} elsif (/\*/ || /\?/) {
# It is a wildcard.
$wildcard = $_;
} else {
print {$conn->{socket}} "550 File or directory not found.\r\n";
return;
}
}
}
$dir = FTPPaths::path_merge($dir, $path);
my $listing = $paths->get_list($dir);
unless ($listing) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
return;
}
print STDERR "_LIST_command - dir is: $dir\n" if $log;
@ -164,31 +107,13 @@ sub _LIST_command
# Open a path back to the client.
my $sock = __open_data_connection ($conn);
unless ($sock) {
print {$conn->{socket}} "425 Can't open data connection.\r\n";
return;
}
# 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
# file or listing a wildcard.
if ($filename) { # Single file.
__list_file ($sock, $prefix . $filename);
} else { # Wildcard or full directory $dirh.
unless ($wildcard) {
# Synthesize (fake) "total" field for directory listing.
print $sock "total 1 \r\n";
}
foreach (__get_file_list ($conn->{rootdir} . $dir, $wildcard)) {
__list_file ($sock, $prefix . $_);
}
for my $item (@$listing) {
print $sock "$item\r\n";
}
unless ($sock->close) {
@ -320,62 +245,17 @@ sub _RETR_command
{
my ($conn, $cmd, $path) = @_;
my $dir = $conn->{dir};
$path = FTPPaths::path_merge($conn->{dir}, $path);
my $info = $conn->{'paths'}->get_info($path);
# Absolute path?
if (substr ($path, 0, 1) eq "/") {
$dir = "/";
$path =~ s,^/+,,;
$path = "." if $path eq "";
}
# Parse the first elements of path until we find the appropriate
# working directory.
my @elems = split /\//, $path;
my $filename = pop @elems;
foreach (@elems) {
if ($_ eq "" || $_ eq ".") {
next # Ignore these.
} elsif ($_ eq "..") {
# Go to parent directory.
unless ($dir eq "/") {
$dir = substr ($dir, 0, rindex ($dir, "/"));
}
} else {
unless (-d $conn->{rootdir} . $dir . $_) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
return;
}
$dir .= $_;
}
}
unless (defined $filename && length $filename) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
return;
}
if ($filename eq "." || $filename eq "..") {
print {$conn->{socket}} "550 RETR command is not supported on directories.\r\n";
return;
}
my $fullname = $conn->{rootdir} . $dir . $filename;
unless (-f $fullname) {
print {$conn->{socket}} "550 RETR command is only supported on plain files.\r\n";
return;
}
# Try to open the file.
unless (open (FILE, '<', $fullname)) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
unless ($info->{'_type'} eq 'f') {
print {$conn->{socket}} "550 File not found.\r\n";
return;
}
print {$conn->{socket}} "150 Opening " .
($conn->{type} eq 'A' ? "ASCII mode" : "BINARY mode") .
" data connection for file $filename.\r\n";
" data connection.\r\n";
# Open a path back to the client.
my $sock = __open_data_connection ($conn);
@ -385,26 +265,25 @@ sub _RETR_command
return;
}
my $content = $info->{'content'};
# Restart the connection from previous point?
if ($conn->{restart}) {
$content = substr($content, $conn->{restart});
$conn->{restart} = 0;
}
# What mode are we sending this file in?
unless ($conn->{type} eq 'A') # Binary type.
{
my ($r, $buffer, $n, $w);
# Restart the connection from previous point?
if ($conn->{restart}) {
# VFS seek method only required to support relative forward seeks
#
# In Perl = 5.00503, SEEK_CUR is exported by IO::Seekable,
# in Perl >= 5.6, SEEK_CUR is exported by both IO::Seekable
# and Fcntl. Hence we 'use IO::Seekable' at the top of the
# file to get this symbol reliably in both cases.
sysseek (FILE, $conn->{restart}, SEEK_CUR);
$conn->{restart} = 0;
}
# Copy data.
while ($r = sysread (FILE, $buffer, 65536))
while ($buffer = substr($content, 0, 65536))
{
$r = length $buffer;
# Restart alarm clock timer.
alarm $conn->{idle_timeout};
@ -415,7 +294,6 @@ sub _RETR_command
# Cleanup and exit if there was an error.
unless (defined $w) {
close $sock;
close FILE;
print {$conn->{socket}} "426 File retrieval error: $!. Data connection has been closed.\r\n";
return;
}
@ -427,7 +305,6 @@ sub _RETR_command
if ($GOT_SIGURG) {
$GOT_SIGURG = 0;
close $sock;
close FILE;
print {$conn->{socket}} "426 Transfer aborted. Data connection closed.\r\n";
return;
}
@ -436,21 +313,13 @@ sub _RETR_command
# Cleanup and exit if there was an error.
unless (defined $r) {
close $sock;
close FILE;
print {$conn->{socket}} "426 File retrieval error: $!. Data connection has been closed.\r\n";
return;
}
} else { # ASCII type.
# Restart the connection from previous point?
if ($conn->{restart}) {
for (my $i = 0; $i < $conn->{restart}; ++$i) {
getc FILE;
}
$conn->{restart} = 0;
}
# Copy data.
while (defined ($_ = <FILE>)) {
my @lines = split /\r\n?|\n/, $content;
for (@lines) {
# Remove any native line endings.
s/[\n\r]+$//;
@ -464,14 +333,13 @@ sub _RETR_command
if ($GOT_SIGURG) {
$GOT_SIGURG = 0;
close $sock;
close FILE;
print {$conn->{socket}} "426 Transfer aborted. Data connection closed.\r\n";
return;
}
}
}
unless (close ($sock) && close (FILE)) {
unless (close ($sock)) {
print {$conn->{socket}} "550 File retrieval error: $!.\r\n";
return;
}
@ -483,66 +351,19 @@ sub _SIZE_command
{
my ($conn, $cmd, $path) = @_;
my $dir = $conn->{dir};
# Absolute path?
if (substr ($path, 0, 1) eq "/") {
$dir = "/";
$path =~ s,^/+,,;
$path = "." if $path eq "";
}
# Parse the first elements of path until we find the appropriate
# working directory.
my @elems = split /\//, $path;
my $filename = pop @elems;
foreach (@elems) {
if ($_ eq "" || $_ eq ".") {
next # Ignore these.
} elsif ($_ eq "..") {
# Go to parent directory.
unless ($dir eq "/") {
$dir = substr ($dir, 0, rindex ($dir, "/"));
}
} else {
unless (-d $conn->{rootdir} . $dir . $_) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
return;
}
$dir .= $_;
}
}
unless (defined $filename && length $filename) {
$path = FTPPaths::path_merge($conn->{dir}, $path);
my $info = $conn->{'paths'}->get_info($path);
unless ($info) {
print {$conn->{socket}} "550 File or directory not found.\r\n";
return;
}
if ($filename eq "." || $filename eq "..") {
if ($info->{'_type'} eq 'd') {
print {$conn->{socket}} "550 SIZE command is not supported on directories.\r\n";
return;
}
my $fullname = $conn->{rootdir} . $dir . $filename;
unless (-f $fullname) {
print {$conn->{socket}} "550 SIZE command is only supported on plain files.\r\n";
return;
}
my $size = 0;
if ($conn->{type} eq 'A') {
# ASCII mode: we have to count the characters by hand.
unless (open (FILE, '<', $filename)) {
print {$conn->{socket}} "550 Cannot calculate size of $filename.\r\n";
return;
}
$size++ while (defined (getc(FILE)));
close FILE;
} else {
# BINARY mode: we can use stat
$size = (stat($filename))[7];
}
my $size = length $info->{'content'};
print {$conn->{socket}} "213 $size\r\n";
}
@ -616,140 +437,18 @@ sub __open_data_connection
}
sub __list_file
{
my $sock = shift;
my $filename = shift;
# Get the status information.
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
$atime, $mtime, $ctime, $blksize, $blocks)
= lstat $filename;
# If the file has been removed since we created this
# handle, then $dev will be undefined. Return immediately.
return unless defined $dev;
# Generate printable user/group.
my $user = getpwuid ($uid) || "-";
my $group = getgrgid ($gid) || "-";
# Permissions from mode.
my $perms = $mode & 0777;
# Work out the mode using special "_" operator which causes Perl
# to use the result of the previous stat call.
$mode = (-f _ ? 'f' :
(-d _ ? 'd' :
(-l _ ? 'l' :
(-p _ ? 'p' :
(-S _ ? 's' :
(-b _ ? 'b' :
(-c _ ? 'c' : '?')))))));
# Generate printable date (this logic is taken from GNU fileutils:
# src/ls.c: print_long_format).
my $time = time;
my $fmt;
if ($time > $mtime + 6 * 30 * 24 * 60 * 60 || $time < $mtime - 60 * 60) {
$fmt = "%b %e %Y";
} else {
$fmt = "%b %e %H:%M";
}
my $fmt_time = strftime $fmt, localtime ($mtime);
# Generate printable permissions.
my $fmt_perms = join "",
($perms & 0400 ? 'r' : '-'),
($perms & 0200 ? 'w' : '-'),
($perms & 0100 ? 'x' : '-'),
($perms & 040 ? 'r' : '-'),
($perms & 020 ? 'w' : '-'),
($perms & 010 ? 'x' : '-'),
($perms & 04 ? 'r' : '-'),
($perms & 02 ? 'w' : '-'),
($perms & 01 ? 'x' : '-');
# Printable file type.
my $fmt_mode = $mode eq 'f' ? '-' : $mode;
# If it's a symbolic link, display the link.
my $link;
if ($mode eq 'l') {
$link = readlink $filename;
die "readlink: $!" unless defined $link;
}
my $fmt_link = defined $link ? " -> $link" : "";
# Display the file.
my $line = sprintf
("%s%s%4d %-8s %-8s %8d %s %s%s\r\n",
$fmt_mode,
$fmt_perms,
$nlink,
$user,
$group,
$size,
$fmt_time,
$filename,
$fmt_link);
$sock->print ($line);
}
sub __get_file_list
{
my $dir = shift;
my $wildcard = shift;
opendir (DIRHANDLE, $dir)
or die "Cannot open directory!!!";
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);
@filenames = grep /$wildcard/, @allfiles;
} else {
@filenames = @allfiles;
}
closedir (DIRHANDLE);
return sort @filenames;
}
sub __wildcard_to_regex
{
my $wildcard = shift;
$wildcard =~ s,([^?*a-zA-Z0-9]),\\$1,g; # Escape punctuation.
$wildcard =~ s,\*,.*,g; # Turn * into .*
$wildcard =~ s,\?,.,g; # Turn ? into .
$wildcard = "^$wildcard\$"; # Bracket it.
return $wildcard;
}
###########################################################################
# FTPSERVER CLASS
###########################################################################
{
my %_attr_data = ( # DEFAULT
_localAddr => 'localhost',
_localPort => undef,
_reuseAddr => 1,
_rootDir => Cwd::getcwd(),
_input => undef,
_localAddr => 'localhost',
_localPort => undef,
_reuseAddr => 1,
_rootDir => Cwd::getcwd(),
_server_behavior => {},
);
sub _default_for
@ -864,12 +563,13 @@ sub run
print STDERR "in child\n" if $log;
my $conn = {
'socket' => $socket,
'state' => $_connection_states{NEWCONN},
'dir' => '/',
'restart' => 0,
'idle_timeout' => 60, # 1 minute timeout
'rootdir' => $self->{_rootDir},
'paths' => FTPPaths->new($self->{'_input'}),
'socket' => $socket,
'state' => $_connection_states{NEWCONN},
'dir' => '/',
'restart' => 0,
'idle_timeout' => 60, # 1 minute timeout
'rootdir' => $self->{_rootDir},
};
print {$conn->{socket}} "220 GNU Wget Testing FTP Server ready.\r\n";
@ -919,6 +619,13 @@ sub run
last;
}
if (defined ($self->{_server_behavior}{fail_on_pasv})
&& $cmd eq 'PASV') {
undef $self->{_server_behavior}{fail_on_pasv};
close $socket;
last;
}
# Run the command.
&{$command_table->{$cmd}} ($conn, $cmd, $rest);
}
@ -935,7 +642,150 @@ sub sockport {
return $self->{_server_sock}->sockport;
}
package FTPPaths;
use POSIX qw(strftime);
# not a method
sub final_component {
my $path = shift;
$path =~ s|.*/||;
return $path;
}
# not a method
sub path_merge {
my ($a, $b) = @_;
return $a unless $b;
if ($b =~ m.^/.) {
$a = '';
$b =~ s.^/..;
}
$a =~ s./$..;
my @components = split('/', $b);
foreach my $c (@components) {
if ($c =~ /^\.?$/) {
next;
} elsif ($c eq '..') {
next if $a eq '';
$a =~ s|/[^/]*$||;
} else {
$a .= "/$c";
}
}
return $a;
}
sub new {
my ($this, @args) = @_;
my $class = ref($this) || $this;
my $self = {};
bless $self, $class;
$self->initialize(@args);
return $self;
}
sub initialize {
my ($self, $urls) = @_;
my $paths = {_type => 'd'};
# From a path like '/foo/bar/baz.txt', construct $paths such that
# $paths->{'foo'}->{'bar'}->{'baz.txt'} is
# $urls->{'/foo/bar/baz.txt'}.
for my $path (keys %$urls) {
my @components = split('/', $path);
shift @components;
my $x = $paths;
for my $c (@components) {
unless (exists $x->{$c}) {
$x->{$c} = {_type => 'd'};
}
$x = $x->{$c};
}
%$x = %{$urls->{$path}};
$x->{_type} = 'f';
}
$self->{'_paths'} = $paths;
}
sub get_info {
my ($self, $path, $node) = @_;
$node = $self->{'_paths'} unless $node;
my @components = split('/', $path);
shift @components if @components && $components[0] eq '';
for my $c (@components) {
if ($node->{'_type'} eq 'd') {
$node = $node->{$c};
} else {
return undef;
}
}
return $node;
}
sub dir_exists {
my ($self, $path) = @_;
return $self->exists($path, 'd');
}
sub exists {
# type is optional, in which case we don't check it.
my ($self, $path, $type) = @_;
my $paths = $self->{'_paths'};
die "Invalid path $path (not absolute).\n" unless $path =~ m.^/.;
my $info = $self->get_info($path);
return 0 unless defined($info);
return $info->{'_type'} eq $type if defined($type);
return 1;
}
sub _format_for_list {
my ($self, $name, $info) = @_;
# XXX: mode should be specifyable as part of the node info.
my $mode_str;
if ($info->{'_type'} eq 'd') {
$mode_str = 'dr-xr-xr-x';
} else {
$mode_str = '-r--r--r--';
}
my $size = 0;
if ($info->{'_type'} eq 'f') {
$size = length $info->{'content'};
}
my $date = strftime ("%b %e %H:%M", localtime);
return "$mode_str 1 0 0 $size $date $name";
}
sub get_list {
my ($self, $path) = @_;
my $info = $self->get_info($path);
return undef unless defined $info;
my $list = [];
if ($info->{'_type'} eq 'd') {
for my $item (keys %$info) {
next if $item =~ /^_/;
push @$list, $self->_format_for_list($item, $info->{$item});
}
} else {
push @$list, $self->_format_for_list(final_component($path), $info);
}
return $list;
}
1;
# vim: et ts=4 sw=4

18
tests/FTPTest.pm
View File

@ -32,19 +32,10 @@ my $VERSION = 0.01;
sub _setup_server {
my $self = shift;
foreach my $url (keys %{$self->{_input}}) {
my $filename = $url;
$filename =~ s/^\///;
open (FILE, ">$filename")
or return "Test failed: cannot open input file $filename\n";
print FILE $self->{_input}->{$url}->{content}
or return "Test failed: cannot write input file $filename\n";
close (FILE);
}
$self->{_server} = FTPServer->new (LocalAddr => 'localhost',
$self->{_server} = FTPServer->new (input => $self->{_input},
server_behavior =>
$self->{_server_behavior},
LocalAddr => 'localhost',
ReuseAddr => 1,
rootDir => "$self->{_workdir}/$self->{_name}/input") or die "Cannot create server!!!";
}
@ -53,6 +44,7 @@ sub _setup_server {
sub _launch_server {
my $self = shift;
my $synch_func = shift;
$self->{_server}->run ($synch_func);
}

2
tests/Makefile.am
View File

@ -73,6 +73,8 @@ EXTRA_DIST = FTPServer.pm FTPTest.pm HTTPServer.pm HTTPTest.pm \
Test-E-k-K.px \
Test-E-k.px \
Test-ftp.px \
Test-ftp-pasv-fail.px \
Test-ftp-recursive.px \
Test-ftp-iri.px \
Test-ftp-iri-fallback.px \
Test-ftp-iri-recursive.px \

58
tests/Test-ftp-pasv-fail.px Executable file
View File

@ -0,0 +1,58 @@
#!/usr/bin/perl
use strict;
use warnings;
use FTPTest;
# This file exercises a problem in Wget, where if an error was
# encountered in ftp.c:getftp before the actual file download
# had started, Wget would believe that it had already downloaded the
# full contents of the file, and would send a corresponding (erroneous)
# REST value.
###############################################################################
# From bug report. :)
my $afile = <<EOF;
I've included log output (using the -d switch) from when this happens
below. You'll see that for the retry wget sends a REST command to
reset the start position before starting the RETR command. I'm
confused about the argument to REST: 51132. It's the full length in
bytes of the file to be retrieved. The RETR then shows the entire
contents of the file being skipped, and wget announces that it
successfully retrieved and saved 0 bytes.
EOF
$afile =~ s/\n/\r\n/g;
# code, msg, headers, content
my %urls = (
'/afile.txt' => {
content => $afile,
},
);
my $cmdline = $WgetTest::WGETPATH . " -S ftp://localhost:{{port}}/afile.txt";
my $expected_error_code = 0;
my %expected_downloaded_files = (
'afile.txt' => {
content => $afile,
},
);
###############################################################################
my $the_test = FTPTest->new (name => "Test-ftp-pasv-fail",
server_behavior => {fail_on_pasv => 1},
input => \%urls,
cmdline => $cmdline,
errcode => $expected_error_code,
output => \%expected_downloaded_files);
exit $the_test->run();
# vim: et ts=4 sw=4

55
tests/Test-ftp-recursive.px Executable file
View File

@ -0,0 +1,55 @@
#!/usr/bin/perl
use strict;
use warnings;
use FTPTest;
###############################################################################
my $afile = <<EOF;
Some text.
EOF
my $bfile = <<EOF;
Some more text.
EOF
$afile =~ s/\n/\r\n/;
$bfile =~ s/\n/\r\n/;
# code, msg, headers, content
my %urls = (
'/foo/afile.txt' => {
content => $afile,
},
'/bar/baz/bfile.txt' => {
content => $bfile,
},
);
my $cmdline = $WgetTest::WGETPATH . " -S -nH -r ftp://localhost:{{port}}/";
my $expected_error_code = 0;
my %expected_downloaded_files = (
'foo/afile.txt' => {
content => $afile,
},
'bar/baz/bfile.txt' => {
content => $bfile,
},
);
###############################################################################
my $the_test = FTPTest->new (name => "Test-ftp-recursive",
input => \%urls,
cmdline => $cmdline,
errcode => $expected_error_code,
output => \%expected_downloaded_files);
exit $the_test->run();
# vim: et ts=4 sw=4

73
tests/WgetTest.pm.in
View File

@ -24,6 +24,7 @@ my @unexpected_downloads = ();
_input => {},
_name => "",
_output => {},
_server_behavior => {},
);
sub _default_for
@ -69,12 +70,18 @@ sub new {
sub run {
my $self = shift;
my $result_message = "Test successful.\n";
my $errcode;
printf "Running test $self->{_name}\n";
# Setup
$self->_setup();
my $new_result = $self->_setup();
chdir ("$self->{_workdir}/$self->{_name}/input");
if (defined $new_result) {
$result_message = $new_result;
$errcode = 1;
goto cleanup;
}
# Launch server
my $pid = $self->_fork_and_launch_server();
@ -84,7 +91,7 @@ sub run {
my $cmdline = $self->{_cmdline};
$cmdline = $self->_substitute_port($cmdline);
print "Calling $cmdline\n";
my $errcode =
$errcode =
($cmdline =~ m{^/.*})
? system ($cmdline)
: system ("$self->{_workdir}/../src/$cmdline");
@ -99,13 +106,14 @@ sub run {
# Verify download
unless ($errcode == $self->{_errcode}) {
$result_message = "Test failed: wrong code returned (was: $errcode, expected: $self->{_errcode})\n";
goto cleanup;
}
my $error_str;
if ($error_str = $self->_verify_download()) {
$result_message = $error_str;
}
# Cleanup
cleanup:
$self->_cleanup();
print $result_message;
@ -147,6 +155,7 @@ sub _setup {
$self->_setup_server();
chdir ($self->{_workdir});
return;
}
@ -157,6 +166,58 @@ sub _cleanup {
File::Path::rmtree ($self->{_name}) unless $ENV{WGET_TEST_NO_CLEANUP};
}
# not a method
sub quotechar {
my $c = ord( shift );
if ($c >= 0x7 && $c <= 0xD) {
return '\\' . qw(a b t n v f r)[$c - 0x7];
} else {
return sprintf('\\x%02x', $c);
}
}
# not a method
sub _show_diff {
my $SNIPPET_SIZE = 10;
my ($expected, $actual) = @_;
my $str = '';
my $explen = length $expected;
my $actlen = length $actual;
if ($explen != $actlen) {
$str .= "Sizes don't match: expected = $explen, actual = $actlen\n";
}
my $min = $explen <= $actlen? $explen : $actlen;
my $line = 1;
my $col = 1;
my $i;
for ($i=0; $i != $min; ++$i) {
last if substr($expected, $i, 1) ne substr($actual, $i, 1);
if (substr($expected, $i, 1) eq '\n') {
$line++;
$col = 0;
} else {
$col++;
}
}
my $snip_start = $i - ($SNIPPET_SIZE / 2);
if ($snip_start < 0) {
$SNIPPET_SIZE += $snip_start; # Take it from the end.
$snip_start = 0;
}
my $exp_snip = substr($expected, $snip_start, $SNIPPET_SIZE);
my $act_snip = substr($actual, $snip_start, $SNIPPET_SIZE);
$exp_snip =~s/[^[:print:]]/ quotechar($&) /ge;
$act_snip =~s/[^[:print:]]/ quotechar($&) /ge;
$str .= "Mismatch at line $line, col $col:\n";
$str .= " $exp_snip\n";
$str .= " $act_snip\n";
return $str;
}
sub _verify_download {
my $self = shift;
@ -174,8 +235,10 @@ sub _verify_download {
my $content = <FILE>;
my $expected_content = $filedata->{'content'};
$expected_content = $self->_substitute_port($expected_content);
$content eq $expected_content
or return "Test failed: wrong content for file $filename\n";
unless ($content eq $expected_content) {
return "Test failed: wrong content for file $filename\n"
. _show_diff($expected_content, $content);
}
if (exists($filedata->{'timestamp'})) {
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,

2
tests/run-px
View File

@ -26,6 +26,8 @@ my @tests = (
'Test-E-k-K.px',
'Test-E-k.px',
'Test-ftp.px',
'Test-ftp-pasv-fail.px',
'Test-ftp-recursive.px',
'Test-ftp-iri.px',
'Test-ftp-iri-fallback.px',
'Test-ftp-iri-recursive.px',