diff --git a/src/ChangeLog b/src/ChangeLog index 10e80080..0c60ebfb 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2009-09-06 Micah Cowan + + * 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 * retr.h: Declare set_local_file() to avoid build warnings. diff --git a/src/ftp.c b/src/ftp.c index fdac83cf..38f439fb 100644 --- a/src/ftp.c +++ b/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) diff --git a/tests/ChangeLog b/tests/ChangeLog index f6327b2e..a0f5185a 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -1,3 +1,40 @@ +2009-09-06 Micah Cowan + + * 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 + + * 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 + + * WgetTest.pm.in (run): Error-checking improvements. + 2009-09-05 Steven Schubiger * run-px: Introduce two new diagnostics: Skip and Unknown. diff --git a/tests/FTPServer.pm b/tests/FTPServer.pm index edeb69dd..981ddea6 100644 --- a/tests/FTPServer.pm +++ b/tests/FTPServer.pm @@ -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 ($_ = )) { + 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 - diff --git a/tests/FTPTest.pm b/tests/FTPTest.pm index 81b8b008..a820ef51 100644 --- a/tests/FTPTest.pm +++ b/tests/FTPTest.pm @@ -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); } diff --git a/tests/Makefile.am b/tests/Makefile.am index ec68d6d5..768bd084 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -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 \ diff --git a/tests/Test-ftp-pasv-fail.px b/tests/Test-ftp-pasv-fail.px new file mode 100755 index 00000000..0a8e26e1 --- /dev/null +++ b/tests/Test-ftp-pasv-fail.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 = < { + 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 + diff --git a/tests/Test-ftp-recursive.px b/tests/Test-ftp-recursive.px new file mode 100755 index 00000000..5a86a166 --- /dev/null +++ b/tests/Test-ftp-recursive.px @@ -0,0 +1,55 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use FTPTest; + + +############################################################################### + +my $afile = < { + 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 + diff --git a/tests/WgetTest.pm.in b/tests/WgetTest.pm.in index c4c0d4d9..58ad1405 100644 --- a/tests/WgetTest.pm.in +++ b/tests/WgetTest.pm.in @@ -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 = ; 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, diff --git a/tests/run-px b/tests/run-px index 29765c95..52101fc6 100755 --- a/tests/run-px +++ b/tests/run-px @@ -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',