X-Git-Url: http://sjero.net/git/?p=wget;a=blobdiff_plain;f=tests%2FFTPServer.pm;h=1603caaa251022b53460705d7e37a4de87094311;hp=f3c42d170d8c6d9d68be45b33b47511e9d246c4b;hb=320cfdcb658e8d6556ae9dfd902c2db1db866a6b;hpb=ad4b678d2d8aac8644810319cb439994c1470a18 diff --git a/tests/FTPServer.pm b/tests/FTPServer.pm index f3c42d17..1603caaa 100644 --- a/tests/FTPServer.pm +++ b/tests/FTPServer.pm @@ -81,10 +81,25 @@ 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 $ReturnEmptyList = ( $paths->GetBehavior('list_empty_if_list_a') && + $path eq '-a'); + my $SkipHiddenFiles = ( $paths->GetBehavior('list_no_hidden_if_list') && + ( ! $path ) ); + + if ($paths->GetBehavior('list_fails_if_list_a') && $path eq '-a') + { + print {$conn->{socket}} "500 Unknown command\r\n"; + return; + } + + + if (!$paths->GetBehavior('list_dont_clean_path')) + { + # 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'}; @@ -94,12 +109,16 @@ sub _LIST_command # working directory. local $_; - $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; - } + my $listing; + if (!$ReturnEmptyList) + { + $dir = FTPPaths::path_merge($dir, $path); + $listing = $paths->get_list($dir,$SkipHiddenFiles); + unless ($listing) { + print {$conn->{socket}} "550 File or directory not found.\r\n"; + return; + } + } print STDERR "_LIST_command - dir is: $dir\n" if $log; @@ -112,9 +131,12 @@ sub _LIST_command return; } - for my $item (@$listing) { - print $sock "$item\r\n"; - } + if (!$ReturnEmptyList) + { + for my $item (@$listing) { + print $sock "$item\r\n"; + } + } unless ($sock->close) { print {$conn->{socket}} "550 Error closing data connection: $!\r\n"; @@ -276,12 +298,13 @@ sub _RETR_command # What mode are we sending this file in? unless ($conn->{type} eq 'A') # Binary type. { - my ($r, $buffer, $n, $w); - + my ($r, $buffer, $n, $w, $sent); # Copy data. - while ($buffer = substr($content, 0, 65536)) + $sent = 0; + while ($sent < length($content)) { + $buffer = substr($content, $sent, 65536); $r = length $buffer; # Restart alarm clock timer. @@ -308,6 +331,7 @@ sub _RETR_command print {$conn->{socket}} "426 Transfer aborted. Data connection closed.\r\n"; return; } + $sent += $r; } # Cleanup and exit if there was an error. @@ -372,7 +396,14 @@ sub _SYST_command { my ($conn, $cmd, $dummy) = @_; - print {$conn->{socket}} "215 UNIX Type: L8\r\n"; + if ($conn->{'paths'}->GetBehavior('syst_response')) + { + print {$conn->{socket}} $conn->{'paths'}->GetBehavior('syst_response') . "\r\n"; + } + else + { + print {$conn->{socket}} "215 UNIX Type: L8\r\n"; + } } sub _TYPE_command @@ -381,9 +412,9 @@ sub _TYPE_command # See RFC 959 section 5.3.2. if ($type =~ /^([AI])$/i) { - $conn->{type} = 'A'; + $conn->{type} = $1; } elsif ($type =~ /^([AI])\sN$/i) { - $conn->{type} = 'A'; + $conn->{type} = $1; } elsif ($type =~ /^L\s8$/i) { $conn->{type} = 'L8'; } else { @@ -443,11 +474,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 @@ -456,7 +488,7 @@ sub __open_data_connection $_attr_data{$attr}; } - sub _standard_keys + sub _standard_keys { keys %_attr_data; } @@ -488,6 +520,12 @@ sub new { Proto => 'tcp', Type => SOCK_STREAM) or die "bind: $!"; + + foreach my $file (keys %{$self->{_input}}) { + my $ref = \$self->{_input}{$file}{content}; + $$ref =~ s/{{port}}/$self->sockport/eg; + } + return $self; } @@ -561,14 +599,15 @@ 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}, + my $conn = { + '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 +657,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 +731,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 +752,7 @@ sub initialize { } $self->{'_paths'} = $paths; + $self->{'_behavior'} = $behavior; } sub get_info { @@ -755,21 +802,36 @@ 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"; } sub get_list { - my ($self, $path) = @_; + my ($self, $path, $no_hidden) = @_; 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}); + # 2013-10-17 Andrea Urbani (matfanjol) + # I skip the hidden files if requested + if (($no_hidden) && + (defined($info->{$item}->{'attr'})) && + (index($info->{$item}->{'attr'}, "H")>=0)) + { + # This is an hidden file and I don't want to see it! + print STDERR "get_list: Skipped hidden file [$item]\n"; + } + else + { + push @$list, $self->_format_for_list($item, $info->{$item}); + } } } else { push @$list, $self->_format_for_list(final_component($path), $info); @@ -778,6 +840,29 @@ sub get_list { return $list; } +# 2013-10-17 Andrea Urbani (matfanjol) +# It returns the behavior of the given name. +# In this file I handle also the following behaviors: +# list_dont_clean_path : if defined, the command +# $path =~ s/^-[a-zA-Z0-9]+\s?//; +# is not runt and the given path +# remains the original one +# list_empty_if_list_a : if defined, "LIST -a" returns an +# empty content +# list_fails_if_list_a : if defined, "LIST -a" returns an +# error +# list_no_hidden_if_list: if defined, "LIST" doesn't return +# hidden files. +# To define an hidden file add +# attr => "H" +# to the url files +# syst_response : if defined, its content is printed +# out as SYST response +sub GetBehavior { + my ($self, $name) = @_; + return $self->{'_behavior'}{$name}; +} + 1; # vim: et ts=4 sw=4