ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-26 22:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

lint: Report details about FTP errors.

Browse source 
* 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:
Ludovic Courtès 2015-03-19 11:45:04 +01:00
parent 284fe31394
commit 661c99a434
1 changed files with 11 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
guix/scripts/lint.scm
View file

@ -268,11 +268,11 @@ (define 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 @@ (define (validate-uri uri package 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