]> sjero.net Git - wget/commitdiff
Automated merge.
authorMicah Cowan <micah@cowan.name>
Sun, 6 Sep 2009 21:08:56 +0000 (14:08 -0700)
committerMicah Cowan <micah@cowan.name>
Sun, 6 Sep 2009 21:08:56 +0000 (14:08 -0700)
src/ChangeLog
src/ftp.c
tests/ChangeLog
tests/FTPServer.pm
tests/FTPTest.pm
tests/Makefile.am
tests/Test-ftp-pasv-fail.px [new file with mode: 0755]
tests/Test-ftp-recursive.px [new file with mode: 0755]
tests/WgetTest.pm.in
tests/run-px

index 10e80080626d6736eaca65beb2a2c0602ffd02a2..0c60ebfb1869e29ebe6b886e2f2eea47c88be5c1 100644 (file)
@@ -1,3 +1,10 @@
+2009-09-06  Micah Cowan  <micah@cowan.name>
+
+       * ftp.c (getftp, ftp_loop_internal): Separate "len" input/output
+       parameter (with different meanings for input and output), into two
+       separate parameters, one input (passed_expected_bytes) and one
+       output (qtyread). Fixes bug #26870.
+
 2009-09-05  Steven Schubiger  <stsc@member.fsf.org>
 
        * retr.h: Declare set_local_file() to avoid build warnings.
index fdac83cf7a6f00c43a0d481cf386d4e315f6cb37..38f439fb1f4ecc666629f1c6dec216834c21bae0 100644 (file)
--- a/src/ftp.c
+++ b/src/ftp.c
@@ -240,7 +240,8 @@ static uerr_t ftp_get_listing (struct url *, ccon *, struct fileinfo **);
    connection to the server.  It always closes the data connection,
    and closes the control connection in case of error.  */
 static uerr_t
-getftp (struct url *u, wgint *len, wgint restval, ccon *con)
+getftp (struct url *u, wgint passed_expected_bytes, wgint *qtyread,
+        wgint restval, ccon *con)
 {
   int csock, dtsock, local_sock, res;
   uerr_t err = RETROK;          /* appease the compiler */
@@ -266,6 +267,8 @@ getftp (struct url *u, wgint *len, wgint restval, ccon *con)
   /* Make sure that at least *something* is requested.  */
   assert ((cmd & (DO_LIST | DO_CWD | DO_RETR | DO_LOGIN)) != 0);
 
+  *qtyread = restval;
+
   user = u->user;
   passwd = u->passwd;
   search_netrc (u->host, (const char **)&user, (const char **)&passwd, 1);
@@ -730,7 +733,7 @@ Error in server response, closing control connection.\n"));
   else /* do not CWD */
     logputs (LOG_VERBOSE, _("==> CWD not required.\n"));
 
-  if ((cmd & DO_RETR) && *len == 0)
+  if ((cmd & DO_RETR) && passed_expected_bytes == 0)
     {
       if (opt.verbose)
         {
@@ -739,7 +742,7 @@ Error in server response, closing control connection.\n"));
                        quotearg_style (escape_quoting_style, u->file));
         }
 
-      err = ftp_size (csock, u->file, len);
+      err = ftp_size (csock, u->file, &expected_bytes);
       /* FTPRERR */
       switch (err)
         {
@@ -758,8 +761,8 @@ Error in server response, closing control connection.\n"));
           abort ();
         }
         if (!opt.server_response)
-          logprintf (LOG_VERBOSE, *len ? "%s\n" : _("done.\n"),
-                     number_to_static_string (*len));
+          logprintf (LOG_VERBOSE, expected_bytes ? "%s\n" : _("done.\n"),
+                     number_to_static_string (expected_bytes));
     }
 
   /* If anything is to be retrieved, PORT (or PASV) must be sent.  */
@@ -1070,11 +1073,11 @@ Error in server response, closing control connection.\n"));
 
   /* Some FTP servers return the total length of file after REST
      command, others just return the remaining size. */
-  if (*len && restval && expected_bytes
-      && (expected_bytes == *len - restval))
+  if (passed_expected_bytes && restval && expected_bytes
+      && (expected_bytes == passed_expected_bytes - restval))
     {
       DEBUGP (("Lying FTP server found, adjusting.\n"));
-      expected_bytes = *len;
+      expected_bytes = passed_expected_bytes;
     }
 
   /* If no transmission was required, then everything is OK.  */
@@ -1203,10 +1206,11 @@ Error in server response, closing control connection.\n"));
   else
     fp = output_stream;
 
-  if (*len)
+  if (passed_expected_bytes)
     {
-      print_length (*len, restval, true);
-      expected_bytes = *len;    /* for fd_read_body's progress bar */
+      print_length (passed_expected_bytes, restval, true);
+      expected_bytes = passed_expected_bytes;
+        /* for fd_read_body's progress bar */
     }
   else if (expected_bytes)
     print_length (expected_bytes, restval, false);
@@ -1215,11 +1219,10 @@ Error in server response, closing control connection.\n"));
   flags = 0;
   if (restval && rest_failed)
     flags |= rb_skip_startpos;
-  *len = restval;
   rd_size = 0;
   res = fd_read_body (dtsock, fp,
                       expected_bytes ? expected_bytes - restval : 0,
-                      restval, &rd_size, len, &con->dltime, flags);
+                      restval, &rd_size, qtyread, &con->dltime, flags);
 
   tms = datetime_str (time (NULL));
   tmrate = retr_rate (rd_size, con->dltime);
@@ -1348,7 +1351,7 @@ static uerr_t
 ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
 {
   int count, orig_lp;
-  wgint restval, len = 0;
+  wgint restval, len = 0, qtyread = 0;
   char *tms, *locf;
   const char *tmrate = NULL;
   uerr_t err;
@@ -1428,7 +1431,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
            first attempt to clobber existing data.)  */
         restval = st.st_size;
       else if (count > 1)
-        restval = len;          /* start where the previous run left off */
+        restval = qtyread;          /* start where the previous run left off */
       else
         restval = 0;
 
@@ -1454,7 +1457,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
         len = f->size;
       else
         len = 0;
-      err = getftp (u, &len, restval, con);
+      err = getftp (u, len, &qtyread, restval, con);
 
       if (con->csock == -1)
         con->st &= ~DONE_CWD;
@@ -1484,7 +1487,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
         case FTPRETRINT:
           /* If the control connection was closed, the retrieval
              will be considered OK if f->size == len.  */
-          if (!f || len != f->size)
+          if (!f || qtyread != f->size)
             {
               printwhat (count, opt.ntry);
               continue;
@@ -1499,7 +1502,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
         }
       tms = datetime_str (time (NULL));
       if (!opt.spider)
-        tmrate = retr_rate (len - restval, con->dltime);
+        tmrate = retr_rate (qtyread - restval, con->dltime);
 
       /* If we get out of the switch above without continue'ing, we've
          successfully downloaded a file.  Remember this fact. */
@@ -1520,7 +1523,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
                      : _("%s (%s) - %s saved [%s]\n\n"),
                      tms, tmrate,
                      write_to_stdout ? "" : quote (locf),
-                     number_to_static_string (len));
+                     number_to_static_string (qtyread));
         }
       if (!opt.verbose && !opt.quiet)
         {
@@ -1529,7 +1532,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
              time. */
           char *hurl = url_string (u, URL_AUTH_HIDE_PASSWD);
           logprintf (LOG_NONVERBOSE, "%s URL: %s [%s] -> \"%s\" [%d]\n",
-                     tms, hurl, number_to_static_string (len), locf, count);
+                     tms, hurl, number_to_static_string (qtyread), locf, count);
           xfree (hurl);
         }
 
@@ -1540,7 +1543,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
             /* --dont-remove-listing was specified, so do count this towards the
                number of bytes and files downloaded. */
             {
-              total_downloaded_bytes += len;
+              total_downloaded_bytes += qtyread;
               numurls++;
             }
 
@@ -1555,7 +1558,7 @@ ftp_loop_internal (struct url *u, struct fileinfo *f, ccon *con)
              downloaded if they're going to be deleted.  People seeding proxies,
              for instance, may want to know how many bytes and files they've
              downloaded through it. */
-          total_downloaded_bytes += len;
+          total_downloaded_bytes += qtyread;
           numurls++;
 
           if (opt.delete_after)
index f6327b2e3939cf524046a9bc3c14f76d72e79cfb..a0f5185ae5086ae6b157e6e2e4633ddea4cb91f1 100644 (file)
@@ -1,3 +1,40 @@
+2009-09-06  Micah Cowan  <micah@cowan.name>
+
+       * 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  <micah@cowan.name>
+
+       * Test-ftp-recursive.px: Added.
+       * run-px, Makefile.am (EXTRA_DIST): Added Test-ftp-recursive.px.
+
+       * FTPTest.pm (_setup_server): Don't construct the "input"
+       directory's contents, just pass the URLs structure to
+       FTPServer->new.
+       * FTPServer.pm: Rewrote portions, so that the server now uses the
+       information from the %urls hash directly, rather than reading from
+       real files. Added an FTPPaths package to the file.
+
+2009-09-04  Micah Cowan  <micah@cowan.name>
+
+       * WgetTest.pm.in (run): Error-checking improvements.
+
 2009-09-05  Steven Schubiger  <stsc@member.fsf.org>
 
        * run-px: Introduce two new diagnostics: Skip and Unknown.
index edeb69ddc945215e70c33687c2127ee74788f060..981ddea63d21e680e7934bdfcf6bc6aabd3ac0f3 100644 (file)
@@ -61,101 +61,44 @@ my %_commands = (
 sub _CWD_command
 {
     my ($conn, $cmd, $path) = @_;
+    my $paths = $conn->{'paths'};
 
     local $_;
-    my $newdir = $conn->{dir};
-
-    # If the path starts with a "/" then it's an absolute path.
-    if (substr ($path, 0, 1) eq "/") {
-        $newdir = "";
-        $path =~ s,^/+,,;
-    }
+    my $new_path = FTPPaths::path_merge($conn->{'dir'}, $path);
 
     # Split the path into its component parts and process each separately.
-    my @elems = split /\//, $path;
-
-    foreach (@elems) {
-        if ($_ eq "" || $_ eq ".") {
-            # Ignore these.
-            next;
-        } elsif ($_ eq "..") {
-            # Go to parent directory.
-            if ($newdir eq "") {
-                print {$conn->{socket}} "550 Directory not found.\r\n";
-                return;
-            }
-            $newdir = substr ($newdir, 0, rindex ($newdir, "/"));
-        } else {
-            # Go into subdirectory, if it exists.
-            $newdir .= ("/" . $_);
-            if (! -d $conn->{rootdir} . $newdir) {
-                print {$conn->{socket}} "550 Directory not found.\r\n";
-                return;
-            }
-        }
+    if (! $paths->dir_exists($new_path)) {
+        print {$conn->{socket}} "550 Directory not found.\r\n";
+        return;
     }
 
-    $conn->{dir} = $newdir;
+    $conn->{'dir'} = $new_path;
+    print {$conn->{socket}} "200 directory changed to $new_path.\r\n";
 }
 
 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 $dir = $conn->{dir};
+    my $dir = $conn->{'dir'};
 
     print STDERR "_LIST_command - dir is: $dir\n";
 
-    # Absolute path?
-    if (substr ($path, 0, 1) eq "/") {
-        $dir = "/";
-        $path =~ s,^/+,,;
-    }
-
     # Parse the first elements of the path until we find the appropriate
     # working directory.
-    my @elems = split /\//, $path;
-    my ($wildcard, $filename);
     local $_;
 
-    for (my $i = 0; $i < @elems; ++$i) {
-        $_ = $elems[$i];
-        my $lastelement = $i == @elems-1;
-
-        if ($_ eq "" || $_ eq ".") { next } # Ignore these.
-        elsif ($_ eq "..") {
-            # Go to parent directory.
-            unless ($dir eq "/") {
-                $dir = substr ($dir, 0, rindex ($dir, "/"));
-            }
-        } else {
-            if (!$lastelement) { # These elements can only be directories.
-                unless (-d $conn->{rootdir} . $dir . $_) {
-                    print {$conn->{socket}} "550 File or directory not found.\r\n";
-                    return;
-                }
-                $dir .= $_;
-            } else { # It's the last element: check if it's a file, directory or wildcard.
-                if (-f $conn->{rootdir} . $dir . $_) {
-                    # It's a file.
-                    $filename = $_;
-                } elsif (-d $conn->{rootdir} . $dir . $_) {
-                    # It's a directory.
-                    $dir .= $_;
-                } elsif (/\*/ || /\?/) {
-                    # It is a wildcard.
-                    $wildcard = $_;
-                } else {
-                    print {$conn->{socket}} "550 File or directory not found.\r\n";
-                    return;
-                }
-            }
-        }
+    $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;
     }
 
     print STDERR "_LIST_command - dir is: $dir\n" if $log;
@@ -164,31 +107,13 @@ sub _LIST_command
 
     # Open a path back to the client.
     my $sock = __open_data_connection ($conn);
-
     unless ($sock) {
         print {$conn->{socket}} "425 Can't open data connection.\r\n";
         return;
     }
 
-    # If the path contains a directory name, extract it so that
-    # we can prefix it to every filename listed.
-    my $prefix = (($filename || $wildcard) && $path =~ /(.*\/).*/) ? $1 : "";
-
-    print STDERR "_LIST_command - prefix is: $prefix\n" if $log;
-
-    # OK, we're either listing a full directory, listing a single
-    # file or listing a wildcard.
-    if ($filename) {            # Single file.
-        __list_file ($sock, $prefix . $filename);
-    } else {                    # Wildcard or full directory $dirh.
-        unless ($wildcard) {
-            # Synthesize (fake) "total" field for directory listing.
-            print $sock "total 1 \r\n";
-        }
-
-        foreach (__get_file_list ($conn->{rootdir} . $dir, $wildcard)) {
-            __list_file ($sock, $prefix . $_);
-        }
+    for my $item (@$listing) {
+        print $sock "$item\r\n";
     }
 
     unless ($sock->close) {
@@ -320,62 +245,17 @@ sub _RETR_command
 {
     my ($conn, $cmd, $path) = @_;
 
-    my $dir = $conn->{dir};
-
-    # Absolute path?
-    if (substr ($path, 0, 1) eq "/") {
-        $dir = "/";
-        $path =~ s,^/+,,;
-        $path = "." if $path eq "";
-    }
-
-    # Parse the first elements of path until we find the appropriate
-    # working directory.
-    my @elems = split /\//, $path;
-    my $filename = pop @elems;
-
-    foreach (@elems) {
-        if ($_ eq "" || $_ eq ".") {
-            next # Ignore these.
-        } elsif ($_ eq "..") {
-            # Go to parent directory.
-            unless ($dir eq "/") {
-                $dir = substr ($dir, 0, rindex ($dir, "/"));
-            }
-        } else {
-            unless (-d $conn->{rootdir} . $dir . $_) {
-                print {$conn->{socket}} "550 File or directory not found.\r\n";
-                return;
-            }
-            $dir .= $_;
-        }
-    }
-
-    unless (defined $filename && length $filename) {
-        print {$conn->{socket}} "550 File or directory not found.\r\n";
-        return;
-    }
-
-    if ($filename eq "." || $filename eq "..") {
-        print {$conn->{socket}} "550 RETR command is not supported on directories.\r\n";
-        return;
-    }
-
-    my $fullname = $conn->{rootdir} . $dir . $filename;
-    unless (-f $fullname) {
-        print {$conn->{socket}} "550 RETR command is only supported on plain files.\r\n";
-        return;
-    }
+    $path = FTPPaths::path_merge($conn->{dir}, $path);
+    my $info = $conn->{'paths'}->get_info($path);
 
-    # Try to open the file.
-    unless (open (FILE, '<', $fullname)) {
-        print {$conn->{socket}} "550 File or directory not found.\r\n";
+    unless ($info->{'_type'} eq 'f') {
+        print {$conn->{socket}} "550 File not found.\r\n";
         return;
     }
 
     print {$conn->{socket}} "150 Opening " .
         ($conn->{type} eq 'A' ? "ASCII mode" : "BINARY mode") .
-        " data connection for file $filename.\r\n";
+        " data connection.\r\n";
 
     # Open a path back to the client.
     my $sock = __open_data_connection ($conn);
@@ -385,26 +265,25 @@ sub _RETR_command
         return;
     }
 
+    my $content = $info->{'content'};
+
+    # Restart the connection from previous point?
+    if ($conn->{restart}) {
+        $content = substr($content, $conn->{restart});
+        $conn->{restart} = 0;
+    }
+
     # What mode are we sending this file in?
     unless ($conn->{type} eq 'A') # Binary type.
     {
         my ($r, $buffer, $n, $w);
 
-        # Restart the connection from previous point?
-        if ($conn->{restart}) {
-            # VFS seek method only required to support relative forward seeks
-            #
-            # In Perl = 5.00503, SEEK_CUR is exported by IO::Seekable,
-            # in Perl >= 5.6, SEEK_CUR is exported by both IO::Seekable
-            # and Fcntl. Hence we 'use IO::Seekable' at the top of the
-            # file to get this symbol reliably in both cases.
-            sysseek (FILE, $conn->{restart}, SEEK_CUR);
-            $conn->{restart} = 0;
-        }
 
         # Copy data.
-        while ($r = sysread (FILE, $buffer, 65536))
+        while ($buffer = substr($content, 0, 65536))
         {
+            $r = length $buffer;
+
             # Restart alarm clock timer.
             alarm $conn->{idle_timeout};
 
@@ -415,7 +294,6 @@ sub _RETR_command
                 # Cleanup and exit if there was an error.
                 unless (defined $w) {
                     close $sock;
-                    close FILE;
                     print {$conn->{socket}} "426 File retrieval error: $!. Data connection has been closed.\r\n";
                     return;
                 }
@@ -427,7 +305,6 @@ sub _RETR_command
             if ($GOT_SIGURG) {
                 $GOT_SIGURG = 0;
                 close $sock;
-                close FILE;
                 print {$conn->{socket}} "426 Transfer aborted. Data connection closed.\r\n";
                 return;
             }
@@ -436,21 +313,13 @@ sub _RETR_command
         # Cleanup and exit if there was an error.
         unless (defined $r) {
             close $sock;
-            close FILE;
             print {$conn->{socket}} "426 File retrieval error: $!. Data connection has been closed.\r\n";
             return;
         }
     } else { # ASCII type.
-        # Restart the connection from previous point?
-        if ($conn->{restart}) {
-            for (my $i = 0; $i < $conn->{restart}; ++$i) {
-                getc FILE;
-            }
-            $conn->{restart} = 0;
-        }
-
         # Copy data.
-        while (defined ($_ = <FILE>)) {
+        my @lines = split /\r\n?|\n/, $content;
+        for (@lines) {
             # Remove any native line endings.
             s/[\n\r]+$//;
 
@@ -464,14 +333,13 @@ sub _RETR_command
             if ($GOT_SIGURG) {
                 $GOT_SIGURG = 0;
                 close $sock;
-                close FILE;
                 print {$conn->{socket}} "426 Transfer aborted. Data connection closed.\r\n";
                 return;
             }
         }
     }
 
-    unless (close ($sock) && close (FILE)) {
+    unless (close ($sock)) {
         print {$conn->{socket}} "550 File retrieval error: $!.\r\n";
         return;
     }
@@ -483,66 +351,19 @@ sub _SIZE_command
 {
     my ($conn, $cmd, $path) = @_;
 
-    my $dir = $conn->{dir};
-
-    # Absolute path?
-    if (substr ($path, 0, 1) eq "/") {
-        $dir = "/";
-        $path =~ s,^/+,,;
-        $path = "." if $path eq "";
-    }
-
-    # Parse the first elements of path until we find the appropriate
-    # working directory.
-    my @elems = split /\//, $path;
-    my $filename = pop @elems;
-
-    foreach (@elems) {
-        if ($_ eq "" || $_ eq ".") {
-            next # Ignore these.
-        } elsif ($_ eq "..") {
-            # Go to parent directory.
-            unless ($dir eq "/") {
-                $dir = substr ($dir, 0, rindex ($dir, "/"));
-            }
-        } else {
-            unless (-d $conn->{rootdir} . $dir . $_) {
-                print {$conn->{socket}} "550 File or directory not found.\r\n";
-                return;
-            }
-            $dir .= $_;
-        }
-    }
-
-    unless (defined $filename && length $filename) {
+    $path = FTPPaths::path_merge($conn->{dir}, $path);
+    my $info = $conn->{'paths'}->get_info($path);
+    unless ($info) {
         print {$conn->{socket}} "550 File or directory not found.\r\n";
         return;
     }
 
-    if ($filename eq "." || $filename eq "..") {
+    if ($info->{'_type'} eq 'd') {
         print {$conn->{socket}} "550 SIZE command is not supported on directories.\r\n";
         return;
     }
 
-    my $fullname = $conn->{rootdir} . $dir . $filename;
-    unless (-f $fullname) {
-        print {$conn->{socket}} "550 SIZE command is only supported on plain files.\r\n";
-        return;
-    }
-
-    my $size = 0;
-    if ($conn->{type} eq 'A') {
-        # ASCII mode: we have to count the characters by hand.
-        unless (open (FILE, '<', $filename)) {
-            print {$conn->{socket}} "550 Cannot calculate size of $filename.\r\n";
-            return;
-        }
-        $size++ while (defined (getc(FILE)));
-        close FILE;
-    } else {
-        # BINARY mode: we can use stat
-        $size = (stat($filename))[7];
-    }
+    my $size = length $info->{'content'};
 
     print {$conn->{socket}} "213 $size\r\n";
 }
@@ -616,140 +437,18 @@ sub __open_data_connection
 }
 
 
-sub __list_file
-{
-    my $sock = shift;
-    my $filename = shift;
-
-    # Get the status information.
-    my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
-        $atime, $mtime, $ctime, $blksize, $blocks)
-      = lstat $filename;
-
-    # If the file has been removed since we created this
-    # handle, then $dev will be undefined. Return immediately.
-    return unless defined $dev;
-
-    # Generate printable user/group.
-    my $user = getpwuid ($uid) || "-";
-    my $group = getgrgid ($gid) || "-";
-
-    # Permissions from mode.
-    my $perms = $mode & 0777;
-
-    # Work out the mode using special "_" operator which causes Perl
-    # to use the result of the previous stat call.
-    $mode = (-f _ ? 'f' :
-             (-d _ ? 'd' :
-              (-l _ ? 'l' :
-               (-p _ ? 'p' :
-                (-S _ ? 's' :
-                 (-b _ ? 'b' :
-                  (-c _ ? 'c' : '?')))))));
-
-    # Generate printable date (this logic is taken from GNU fileutils:
-    # src/ls.c: print_long_format).
-    my $time = time;
-    my $fmt;
-    if ($time > $mtime + 6 * 30 * 24 * 60 * 60 || $time < $mtime - 60 * 60) {
-        $fmt = "%b %e  %Y";
-    } else {
-        $fmt = "%b %e %H:%M";
-    }
-
-    my $fmt_time = strftime $fmt, localtime ($mtime);
-
-    # Generate printable permissions.
-    my $fmt_perms = join "",
-      ($perms & 0400 ? 'r' : '-'),
-      ($perms & 0200 ? 'w' : '-'),
-      ($perms & 0100 ? 'x' : '-'),
-      ($perms & 040 ? 'r' : '-'),
-      ($perms & 020 ? 'w' : '-'),
-      ($perms & 010 ? 'x' : '-'),
-      ($perms & 04 ? 'r' : '-'),
-      ($perms & 02 ? 'w' : '-'),
-      ($perms & 01 ? 'x' : '-');
-
-    # Printable file type.
-    my $fmt_mode = $mode eq 'f' ? '-' : $mode;
-
-    # If it's a symbolic link, display the link.
-    my $link;
-    if ($mode eq 'l') {
-        $link = readlink $filename;
-        die "readlink: $!" unless defined $link;
-    }
-    my $fmt_link = defined $link ? " -> $link" : "";
-
-    # Display the file.
-    my $line = sprintf
-      ("%s%s%4d %-8s %-8s %8d %s %s%s\r\n",
-       $fmt_mode,
-       $fmt_perms,
-       $nlink,
-       $user,
-       $group,
-       $size,
-       $fmt_time,
-       $filename,
-       $fmt_link);
-    $sock->print ($line);
-}
-
-
-sub __get_file_list
-{
-    my $dir = shift;
-    my $wildcard = shift;
-
-    opendir (DIRHANDLE, $dir)
-        or die "Cannot open directory!!!";
-
-    my @allfiles = readdir DIRHANDLE;
-    my @filenames = ();
-
-    if ($wildcard) {
-        # Get rid of . and ..
-        @allfiles = grep !/^\.{1,2}$/, @allfiles;
-
-        # Convert wildcard to a regular expression.
-        $wildcard = __wildcard_to_regex ($wildcard);
-
-        @filenames = grep /$wildcard/, @allfiles;
-    } else {
-        @filenames = @allfiles;
-    }
-
-    closedir (DIRHANDLE);
-
-    return sort @filenames;
-}
-
-
-sub __wildcard_to_regex
-{
-    my $wildcard = shift;
-
-    $wildcard =~ s,([^?*a-zA-Z0-9]),\\$1,g; # Escape punctuation.
-    $wildcard =~ s,\*,.*,g; # Turn * into .*
-    $wildcard =~ s,\?,.,g;  # Turn ? into .
-    $wildcard = "^$wildcard\$"; # Bracket it.
-
-    return $wildcard;
-}
-
-
 ###########################################################################
 # FTPSERVER CLASS
 ###########################################################################
 
 {
     my %_attr_data = ( # DEFAULT
-        _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
@@ -864,12 +563,13 @@ sub run
             print STDERR "in child\n" if $log;
 
             my $conn = { 
-                '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";
@@ -919,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);
             }
@@ -935,7 +642,150 @@ sub sockport {
     return $self->{_server_sock}->sockport;
 }
 
+
+package FTPPaths;
+
+use POSIX qw(strftime);
+
+# not a method
+sub final_component {
+    my $path = shift;
+
+    $path =~ s|.*/||;
+    return $path;
+}
+
+# not a method
+sub path_merge {
+    my ($a, $b) = @_;
+
+    return $a unless $b;
+
+    if ($b =~ m.^/.) {
+        $a = '';
+        $b =~ s.^/..;
+    }
+    $a =~ s./$..;
+
+    my @components = split('/', $b);
+
+    foreach my $c (@components) {
+        if ($c =~ /^\.?$/) {
+            next;
+        } elsif ($c eq '..') {
+            next if $a eq '';
+            $a =~ s|/[^/]*$||;
+        } else {
+            $a .= "/$c";
+        }
+    }
+
+    return $a;
+}
+
+sub new {
+    my ($this, @args) = @_;
+    my $class = ref($this) || $this;
+    my $self = {};
+    bless $self, $class;
+    $self->initialize(@args);
+    return $self;
+}
+
+sub initialize {
+    my ($self, $urls) = @_;
+    my $paths = {_type => 'd'};
+
+    # From a path like '/foo/bar/baz.txt', construct $paths such that
+    # $paths->{'foo'}->{'bar'}->{'baz.txt'} is
+    # $urls->{'/foo/bar/baz.txt'}.
+    for my $path (keys %$urls) {
+        my @components = split('/', $path);
+        shift @components;
+        my $x = $paths;
+        for my $c (@components) {
+            unless (exists $x->{$c}) {
+                $x->{$c} = {_type => 'd'};
+            }
+            $x = $x->{$c};
+        }
+        %$x = %{$urls->{$path}};
+        $x->{_type} = 'f';
+    }
+
+    $self->{'_paths'} = $paths;
+}
+
+sub get_info {
+    my ($self, $path, $node) = @_;
+    $node = $self->{'_paths'} unless $node;
+    my @components = split('/', $path);
+    shift @components if @components && $components[0] eq '';
+
+    for my $c (@components) {
+        if ($node->{'_type'} eq 'd') {
+            $node = $node->{$c};
+        } else {
+            return undef;
+        }
+    }
+    return $node;
+}
+
+sub dir_exists {
+    my ($self, $path) = @_;
+    return $self->exists($path, 'd');
+}
+
+sub exists {
+    # type is optional, in which case we don't check it.
+    my ($self, $path, $type) = @_;
+    my $paths = $self->{'_paths'};
+
+    die "Invalid path $path (not absolute).\n" unless $path =~ m.^/.;
+    my $info = $self->get_info($path);
+    return 0 unless defined($info);
+    return $info->{'_type'} eq $type if defined($type);
+    return 1;
+}
+
+sub _format_for_list {
+    my ($self, $name, $info) = @_;
+
+    # XXX: mode should be specifyable as part of the node info.
+    my $mode_str;
+    if ($info->{'_type'} eq 'd') {
+        $mode_str = 'dr-xr-xr-x';
+    } else {
+        $mode_str = '-r--r--r--';
+    }
+
+    my $size = 0;
+    if ($info->{'_type'} eq 'f') {
+        $size = length  $info->{'content'};
+    }
+    my $date = strftime ("%b %e %H:%M", localtime);
+    return "$mode_str 1  0  0  $size $date $name";
+}
+
+sub get_list {
+    my ($self, $path) = @_;
+    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});
+        }
+    } else {
+        push @$list, $self->_format_for_list(final_component($path), $info);
+    }
+
+    return $list;
+}
+
 1;
 
 # vim: et ts=4 sw=4
-
index 81b8b008eaa343f3d768e1d20c830fd8472f3e41..a820ef51a6ec3a25e0c50d0a119a91540113f668 100644 (file)
@@ -32,19 +32,10 @@ my $VERSION = 0.01;
 sub _setup_server {
     my $self = shift;
 
-    foreach my $url (keys %{$self->{_input}}) {
-        my $filename = $url;
-        $filename =~ s/^\///;
-        open (FILE, ">$filename")
-            or return "Test failed: cannot open input file $filename\n";
-
-        print FILE $self->{_input}->{$url}->{content}
-            or return "Test failed: cannot write input file $filename\n";
-
-        close (FILE);
-    }
-
-    $self->{_server} = FTPServer->new (LocalAddr => 'localhost',
+    $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!!!";
 }
@@ -53,6 +44,7 @@ sub _setup_server {
 sub _launch_server {
     my $self = shift;
     my $synch_func = shift;
+
     $self->{_server}->run ($synch_func);
 }
 
index ec68d6d5af685bcb8ea08937cf2e164129c3ae11..768bd084aeea42ae38fd700322ebfbaac9945544 100644 (file)
@@ -73,6 +73,8 @@ 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 \
              Test-ftp-iri-recursive.px \
diff --git a/tests/Test-ftp-pasv-fail.px b/tests/Test-ftp-pasv-fail.px
new file mode 100755 (executable)
index 0000000..0a8e26e
--- /dev/null
@@ -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 = <<EOF;
+I've included log output (using the -d switch) from when this happens
+below. You'll see that for the retry wget sends a REST command to
+reset the start position before starting the RETR command. I'm
+confused about the argument to REST: 51132. It's the full length in
+bytes of the file to be retrieved. The RETR then shows the entire
+contents of the file being skipped, and wget announces that it
+successfully retrieved and saved 0 bytes.
+EOF
+
+$afile =~ s/\n/\r\n/g;
+
+
+# code, msg, headers, content
+my %urls = (
+    '/afile.txt' => {
+        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/Test-ftp-recursive.px b/tests/Test-ftp-recursive.px
new file mode 100755 (executable)
index 0000000..5a86a16
--- /dev/null
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use FTPTest;
+
+
+###############################################################################
+
+my $afile = <<EOF;
+Some text.
+EOF
+
+my $bfile = <<EOF;
+Some more text.
+EOF
+
+$afile =~ s/\n/\r\n/;
+$bfile =~ s/\n/\r\n/;
+
+# code, msg, headers, content
+my %urls = (
+    '/foo/afile.txt' => {
+        content => $afile,
+    },
+    '/bar/baz/bfile.txt' => {
+        content => $bfile,
+    },
+);
+
+my $cmdline = $WgetTest::WGETPATH . " -S -nH -r ftp://localhost:{{port}}/";
+
+my $expected_error_code = 0;
+
+my %expected_downloaded_files = (
+    'foo/afile.txt' => {
+        content => $afile,
+    },
+    'bar/baz/bfile.txt' => {
+        content => $bfile,
+    },
+);
+
+###############################################################################
+
+my $the_test = FTPTest->new (name => "Test-ftp-recursive",
+                             input => \%urls, 
+                             cmdline => $cmdline, 
+                             errcode => $expected_error_code, 
+                             output => \%expected_downloaded_files);
+exit $the_test->run();
+
+# vim: et ts=4 sw=4
+
index c4c0d4d94dad44ccf3d4756fd5da59faeb397c93..58ad1405bef9808baa829cc9a2f15296701de728 100644 (file)
@@ -24,6 +24,7 @@ my @unexpected_downloads = ();
         _input        => {},
         _name         => "",
         _output       => {},
+        _server_behavior => {},
     );
 
     sub _default_for
@@ -69,12 +70,18 @@ sub new {
 sub run {
     my $self = shift;
     my $result_message = "Test successful.\n";
+    my $errcode;
 
     printf "Running test $self->{_name}\n";
 
     # Setup
-    $self->_setup();
+    my $new_result = $self->_setup();
     chdir ("$self->{_workdir}/$self->{_name}/input");
+    if (defined $new_result) {
+        $result_message = $new_result;
+        $errcode = 1;
+        goto cleanup;
+    }
 
     # Launch server
     my $pid = $self->_fork_and_launch_server();
@@ -84,7 +91,7 @@ sub run {
     my $cmdline = $self->{_cmdline};
     $cmdline = $self->_substitute_port($cmdline);
     print "Calling $cmdline\n";
-    my $errcode =
+    $errcode =
         ($cmdline =~ m{^/.*})
             ? system ($cmdline)
             : system ("$self->{_workdir}/../src/$cmdline");
@@ -99,13 +106,14 @@ sub run {
     # Verify download
     unless ($errcode == $self->{_errcode}) {
         $result_message = "Test failed: wrong code returned (was: $errcode, expected: $self->{_errcode})\n";
+        goto cleanup;
     }
     my $error_str;
     if ($error_str = $self->_verify_download()) {
         $result_message = $error_str;
     }
 
-    # Cleanup
+  cleanup:
     $self->_cleanup();
 
     print $result_message;
@@ -147,6 +155,7 @@ sub _setup {
     $self->_setup_server();
 
     chdir ($self->{_workdir});
+    return;
 }
 
 
@@ -157,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;
@@ -174,8 +235,10 @@ sub _verify_download {
         my $content = <FILE>;
         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,
index 29765c9516be14d9a027fa687f8cd362806b861d..52101fc6720bc2f7eddbb63f1914f70840e3159f 100755 (executable)
@@ -26,6 +26,8 @@ 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',
     'Test-ftp-iri-recursive.px',