Attempted, but failed, to reproduce bug 22403.

[wget] / tests / FTPServer.pm

diff --git a/tests/FTPServer.pm b/tests/FTPServer.pm
index f3c42d170d8c6d9d68be45b33b47511e9d246c4b..dd06538749fd83b6045af2c531380972455bf5d1 100644 (file)
--- 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,14 @@ 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'},
+                                        $self->{'_server_behavior'}),
+                '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 +620,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);
             }
@@ -685,7 +694,7 @@ sub new {
 }
 
 sub initialize {
-    my ($self, $urls) = @_;
+    my ($self, $urls, $behavior) = @_;
     my $paths = {_type => 'd'};
 
     # From a path like '/foo/bar/baz.txt', construct $paths such that
@@ -706,6 +715,7 @@ sub initialize {
     }
 
     $self->{'_paths'} = $paths;
+    $self->{'_behavior'} = $behavior;
 }
 
 sub get_info {
@@ -755,6 +765,9 @@ sub _format_for_list {
     my $size = 0;
     if ($info->{'_type'} eq 'f') {
         $size = length  $info->{'content'};
+        if ($self->{'_behavior'}{'bad_list'}) {
+            $size = 0;
+        }
     }
     my $date = strftime ("%b %e %H:%M", localtime);
     return "$mode_str 1  0  0  $size $date $name";