X-Git-Url: http://sjero.net/git/?p=wget;a=blobdiff_plain;f=tests%2FFTPServer.pm;h=1603caaa251022b53460705d7e37a4de87094311;hp=2758ab1e5abdf0956f268b0857fd76f599c4ee7e;hb=320cfdcb658e8d6556ae9dfd902c2db1db866a6b;hpb=4a08094db88011153adadbf995103770b20d2a31

diff --git a/tests/FTPServer.pm b/tests/FTPServer.pm
index 2758ab1e..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 {
@@ -489,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;
 }
 
@@ -774,7 +811,7 @@ sub _format_for_list {
 }
 
 sub get_list {
-    my ($self, $path) = @_;
+    my ($self, $path, $no_hidden) = @_;
     my $info = $self->get_info($path);
     return undef unless defined $info;
     my $list = [];
@@ -782,7 +819,19 @@ sub get_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);
@@ -791,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