mirror of https://github.com/moparisthebest/wget
Automated merge.
This commit is contained in:
Micah Cowan
commit
544afabb39
|
|
@ -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
47
src/ftp.c
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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',
|
||||
|
|
|
|||
Loading…
Reference in New Issue