From cf2a703ad4a80373004dd821000637e6c8356260 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Thu, 4 Aug 2011 23:24:50 -0400
Subject: [PATCH] Make `ftp-make-file-seconds' use a correct year instead of
 2002.

This function was using 2002 when there's no year...  Updated it to use
the last occurrence of the guessed date, as described at
  http://files.stairways.com/other/ftp-list-specs-info.txt

This function still looks pretty bogus -- the RFC does *not* say
anything about the format of response to `LIST', so it's whatever
semi-random thing the server does.  (The above link looks like an
attempt to fix it, but I didn't see anything more official than that.)
From some looking around, it looks like ftp clients just try a bunch of
patterns against the text.  Add also warnings in the documentation about
this.

original commit: 234015b34d43a602dfcabe9365de9027531c2f9f
---
 collects/net/ftp-unit.rkt | 35 ++++++++++++++++++-----------------
 1 file changed, 18 insertions(+), 17 deletions(-)

diff --git a/collects/net/ftp-unit.rkt b/collects/net/ftp-unit.rkt
index af52609..e9ef6f4 100644
--- a/collects/net/ftp-unit.rkt
+++ b/collects/net/ftp-unit.rkt
@@ -11,8 +11,6 @@
 ;; opqaue record to represent an FTP connection:
 (define-struct ftp-connection (in out))
 
-(define tzoffset (date-time-zone-offset (seconds->date (current-seconds))))
-
 (define re:multi-response-start #rx#"^[0-9][0-9][0-9]-")
 (define re:response-end #rx#"^[0-9][0-9][0-9] ")
 
@@ -75,21 +73,24 @@
 (define re:date #rx#"(...) *(.*) (..):(..)|(...) *([0-9]*) +(....)")
 
 (define (ftp-make-file-seconds ftp-date-str)
-  (let ([date-list (regexp-match re:date (string->bytes/utf-8 ftp-date-str))])
-    (if (not (list-ref date-list 4))
-        (find-seconds 0
-                      0
-                      2
-                      (bytes->number (list-ref date-list 6))
-                      (get-month (list-ref date-list 5))
-                      (bytes->number (list-ref date-list 7)))
-        (+ (find-seconds 0
-                         (bytes->number (list-ref date-list 4))
-                         (bytes->number (list-ref date-list 3))
-                         (bytes->number (list-ref date-list 2))
-                         (get-month (list-ref date-list 1))
-                         2002)
-           tzoffset))))
+  (define date-list (regexp-match re:date (string->bytes/utf-8 ftp-date-str)))
+  (if (not (list-ref date-list 4))
+      (find-seconds 0 0 0
+                    (bytes->number (list-ref date-list 6))
+                    (get-month (list-ref date-list 5))
+                    (bytes->number (list-ref date-list 7)))
+      (let* ([cur-secs (current-seconds)]
+             [cur-date (seconds->date cur-secs)]
+             [cur-year (date-year cur-date)]
+             [tzofs    (date-time-zone-offset cur-date)]
+             [minute (bytes->number (list-ref date-list 4))]
+             [hour   (bytes->number (list-ref date-list 3))]
+             [day    (bytes->number (list-ref date-list 2))]
+             [month  (get-month (list-ref date-list 1))]
+             [guess  (+ (find-seconds 0 minute hour day month cur-year) tzofs)])
+        (if (guess . <= . cur-secs)
+          guess
+          (+ (find-seconds 0 minute hour day month (sub1 cur-year)) tzofs)))))
 
 (define re:passive #rx#"\\((.*),(.*),(.*),(.*),(.*),(.*)\\)")