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
This commit is contained in:
Eli Barzilay 2011-08-04 23:24:50 -04:00
parent 7d51058755
commit cf2a703ad4

View File

@ -11,8 +11,6 @@
;; opqaue record to represent an FTP connection: ;; opqaue record to represent an FTP connection:
(define-struct ftp-connection (in out)) (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:multi-response-start #rx#"^[0-9][0-9][0-9]-")
(define re:response-end #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 re:date #rx#"(...) *(.*) (..):(..)|(...) *([0-9]*) +(....)")
(define (ftp-make-file-seconds ftp-date-str) (define (ftp-make-file-seconds ftp-date-str)
(let ([date-list (regexp-match re:date (string->bytes/utf-8 ftp-date-str))]) (define date-list (regexp-match re:date (string->bytes/utf-8 ftp-date-str)))
(if (not (list-ref date-list 4)) (if (not (list-ref date-list 4))
(find-seconds 0 (find-seconds 0 0 0
0 (bytes->number (list-ref date-list 6))
2 (get-month (list-ref date-list 5))
(bytes->number (list-ref date-list 6)) (bytes->number (list-ref date-list 7)))
(get-month (list-ref date-list 5)) (let* ([cur-secs (current-seconds)]
(bytes->number (list-ref date-list 7))) [cur-date (seconds->date cur-secs)]
(+ (find-seconds 0 [cur-year (date-year cur-date)]
(bytes->number (list-ref date-list 4)) [tzofs (date-time-zone-offset cur-date)]
(bytes->number (list-ref date-list 3)) [minute (bytes->number (list-ref date-list 4))]
(bytes->number (list-ref date-list 2)) [hour (bytes->number (list-ref date-list 3))]
(get-month (list-ref date-list 1)) [day (bytes->number (list-ref date-list 2))]
2002) [month (get-month (list-ref date-list 1))]
tzoffset)))) [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#"\\((.*),(.*),(.*),(.*),(.*),(.*)\\)") (define re:passive #rx#"\\((.*),(.*),(.*),(.*),(.*),(.*)\\)")