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.
This commit is contained in:
parent
284fe31394
commit
661c99a434
|
@ -268,11 +268,11 @@ response from URI, and additional details, such as the actual HTTP response."
|
||||||
(ftp-size conn (basename (uri-path uri))))
|
(ftp-size conn (basename (uri-path uri))))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(ftp-close conn))))
|
(ftp-close conn))))
|
||||||
(values 'ftp-response #t)))
|
(values 'ftp-response '(ok))))
|
||||||
(lambda (key . args)
|
(lambda (key . args)
|
||||||
(case key
|
(case key
|
||||||
((or ftp-error)
|
((ftp-error)
|
||||||
(values 'ftp-response #f))
|
(values 'ftp-response `(error ,@args)))
|
||||||
((getaddrinfo-error system-error gnutls-error)
|
((getaddrinfo-error system-error gnutls-error)
|
||||||
(values key args))
|
(values key args))
|
||||||
(else
|
(else
|
||||||
|
@ -296,11 +296,14 @@ warning for PACKAGE mentionning the FIELD."
|
||||||
(response-reason-phrase argument))
|
(response-reason-phrase argument))
|
||||||
field)))
|
field)))
|
||||||
((ftp-response)
|
((ftp-response)
|
||||||
(when (not argument)
|
(match argument
|
||||||
|
(('ok) #t)
|
||||||
|
(('error port command code message)
|
||||||
(emit-warning package
|
(emit-warning package
|
||||||
(format #f
|
(format #f
|
||||||
(_ "URI ~a not reachable")
|
(_ "URI ~a not reachable: ~a (~s)")
|
||||||
(uri->string uri)))))
|
(uri->string uri)
|
||||||
|
code (string-trim-both message))))))
|
||||||
((getaddrinfo-error)
|
((getaddrinfo-error)
|
||||||
(emit-warning package
|
(emit-warning package
|
||||||
(format #f
|
(format #f
|
||||||
|
|
Loading…
Reference in New Issue