diff options
Diffstat (limited to 'guix/scripts/lint.scm')
-rw-r--r-- | guix/scripts/lint.scm | 27 |
1 files changed, 15 insertions, 12 deletions
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 69717b6317..c40d76b558 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -259,20 +259,20 @@ response from URI, and additional details, such as the actual HTTP response." ('ftp (catch #t (lambda () - (let ((port (ftp-open (uri-host uri) 21))) + (let ((conn (ftp-open (uri-host uri) 21))) (define response (dynamic-wind (const #f) (lambda () - (ftp-chdir port (dirname (uri-path uri))) - (ftp-size port (basename (uri-path uri)))) + (ftp-chdir conn (dirname (uri-path uri))) + (ftp-size conn (basename (uri-path uri)))) (lambda () - (ftp-close port)))) - (values 'ftp-response #t))) + (ftp-close conn)))) + (values 'ftp-response '(ok)))) (lambda (key . args) (case key - ((or ftp-error) - (values 'ftp-response #f)) + ((ftp-error) + (values 'ftp-response `(error ,@args))) ((getaddrinfo-error system-error gnutls-error) (values key args)) (else @@ -296,11 +296,14 @@ warning for PACKAGE mentionning the FIELD." (response-reason-phrase argument)) field))) ((ftp-response) - (when (not argument) - (emit-warning package - (format #f - (_ "URI ~a not reachable") - (uri->string uri))))) + (match argument + (('ok) #t) + (('error port command code message) + (emit-warning package + (format #f + (_ "URI ~a not reachable: ~a (~s)") + (uri->string uri) + code (string-trim-both message)))))) ((getaddrinfo-error) (emit-warning package (format #f |