X-Git-Url: http://sjero.net/git/?p=wget;a=blobdiff_plain;f=tests%2FFTPServer.pm;h=2ac72e3488dfa060c218d739befd3713496fa5d0;hp=981ddea63d21e680e7934bdfcf6bc6aabd3ac0f3;hb=c3835a425a2b441dd741c7edc1684310141fb385;hpb=544afabb39f03ab2adefdf62b6af51a81503eb58 diff --git a/tests/FTPServer.pm b/tests/FTPServer.pm index 981ddea6..2ac72e34 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"; @@ -372,7 +394,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 @@ -457,7 +486,7 @@ sub __open_data_connection $_attr_data{$attr}; } - sub _standard_keys + sub _standard_keys { keys %_attr_data; } @@ -489,6 +518,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; } @@ -562,9 +597,10 @@ sub run print STDERR "in child\n" if $log; - my $conn = { - 'paths' => FTPPaths->new($self->{'_input'}), - 'socket' => $socket, + my $conn = { + 'paths' => FTPPaths->new($self->{'_input'}, + $self->{'_server_behavior'}), + 'socket' => $socket, 'state' => $_connection_states{NEWCONN}, 'dir' => '/', 'restart' => 0, @@ -693,7 +729,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 @@ -714,6 +750,7 @@ sub initialize { } $self->{'_paths'} = $paths; + $self->{'_behavior'} = $behavior; } sub get_info { @@ -763,21 +800,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); @@ -786,6 +838,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