02/03: lint: Report details about FTP errors.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 661c99a434185d2e96c02d41f45faaa1f3458536
Author: Ludovic Courtès <address@hidden>
Date:   Thu Mar 19 11:45:04 2015 +0100

    lint: Report details about FTP errors.
    
    * guix/scripts/lint.scm (probe-uri) <'ftp>: Pass more information about
      failures alongside 'ftp-response.
      (validate-uri) <ftp-response>: Handle it, and adjust "not reachable"
      message accordingly.
---
 guix/scripts/lint.scm |   19 +++++++++++--------
 1 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 681e557..c40d76b 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -268,11 +268,11 @@ response from URI, and additional details, such as the 
actual HTTP response."
                    (ftp-size conn (basename (uri-path uri))))
                  (lambda ()
                    (ftp-close conn))))
-             (values 'ftp-response #t)))
+             (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