From 1274565a64130012b40b053b989b7e2eaba1388f Mon Sep 17 00:00:00 2001 From: Micah Cowan Date: Sun, 6 Sep 2009 13:04:22 -0700 Subject: [PATCH] Regression test for getftp bug (fails). --- tests/ChangeLog | 21 +++++++++++++ tests/FTPServer.pm | 32 ++++++++++++------- tests/FTPTest.pm | 2 ++ tests/Makefile.am | 1 + tests/Test-ftp-pasv-fail.px | 58 ++++++++++++++++++++++++++++++++++ tests/WgetTest.pm.in | 63 ++++++++++++++++++++++++++++++++++--- tests/run-px | 1 + 7 files changed, 162 insertions(+), 16 deletions(-) create mode 100755 tests/Test-ftp-pasv-fail.px diff --git a/tests/ChangeLog b/tests/ChangeLog index 90907f4a..dcc98e04 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -1,3 +1,24 @@ +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. diff --git a/tests/FTPServer.pm b/tests/FTPServer.pm index f3c42d17..981ddea6 100644 --- a/tests/FTPServer.pm +++ b/tests/FTPServer.pm @@ -443,11 +443,12 @@ sub __open_data_connection { my %_attr_data = ( # DEFAULT - _input => undef, - _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 @@ -562,13 +563,13 @@ sub run print STDERR "in child\n" if $log; my $conn = { - 'paths' => FTPPaths->new($self->{'_input'}), - '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"; @@ -618,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); } diff --git a/tests/FTPTest.pm b/tests/FTPTest.pm index 85fc1dd3..a820ef51 100644 --- a/tests/FTPTest.pm +++ b/tests/FTPTest.pm @@ -33,6 +33,8 @@ sub _setup_server { my $self = shift; $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!!!"; diff --git a/tests/Makefile.am b/tests/Makefile.am index 4fb90b39..efbb5b4a 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -72,6 +72,7 @@ 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 \ 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/WgetTest.pm.in b/tests/WgetTest.pm.in index 01657412..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 @@ -151,10 +152,10 @@ sub _setup { } chdir ("../input"); - my $ret = $self->_setup_server(); + $self->_setup_server(); chdir ($self->{_workdir}); - return $ret; + return; } @@ -165,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; @@ -182,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 5c04b8cc..102c75dc 100755 --- a/tests/run-px +++ b/tests/run-px @@ -27,6 +27,7 @@ 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', -- 2.39.2