diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-03-25 10:52:52 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-03-25 10:52:52 +0100 |
| commit | 25d5b708a636ecf779035f75ad110574fc0262b9 (patch) | |
| tree | 7d8429a59b7523d79790c5f4cdb5b96fabe8494e /guix/scripts/lint.scm | |
| parent | 17287d7d47567aa1649250182e0f7ab11d5d55d1 (diff) | |
| parent | 614c2188420a266ec512c9c04af3bb2ea46c4dc4 (diff) | |
Merge branch 'master' into core-updates
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 |