suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add a timeout to the ftp poll.

Browse Source 
This is because the ftp mirror tends to become unresponsive often, but
it takes a huge amount of time to actually get a tmeout.
This commit is contained in:
Eli Barzilay 2011-12-26 19:38:27 -05:00
parent fa4c073b9e
commit 1160e423e2
1 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/meta/web/download/mirror-link.rkt
View File

@ -158,10 +158,13 @@ Polling a URL can result in one of four options:
(cdr (or (regexp-match #rx"^ftp://([^/:]+)(?::([0-9]+))?(/.*)$" url) (cdr (or (regexp-match #rx"^ftp://([^/:]+)(?::([0-9]+))?(/.*)$" url)
(error 'verify-ftp "bad ftp url: ~a" url))))) (error 'verify-ftp "bad ftp url: ~a" url)))))
(define port (or port? 21)) (define port (or port? 21))
(define r (define ch (make-channel))
(with-handlers ([exn:fail? exn-message]) (thread (lambda ()
(let ([c (ftp-establish-connection host port "anonymous" "anonymous@")]) (with-handlers ([exn:fail? exn-message])
(begin0 (ftp-directory-list c path) (ftp-close-connection c))))) (define c
(ftp-establish-connection host port "anonymous" "anonymous@"))
(begin0 (ftp-directory-list c path) (ftp-close-connection c)))))
(define r (or (sync/timeout 30 ch) "timeout"))
(cond [(not (and (list? r) (= 1 (length r)) (list? (car r)))) (cond [(not (and (list? r) (= 1 (length r)) (list? (car r))))
(eprintf "WARNING: failure getting ftp info for ~a~a\n" (eprintf "WARNING: failure getting ftp info for ~a~a\n"
url (if (string? r) (format " (~a)" r) "")) url (if (string? r) (format " (~a)" r) ""))