mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-12 14:16:55 -05:00
lint: 'validate-uri' really returns #f on failure.
* guix/scripts/lint.scm (validate-uri): Always return #f on failure.
This commit is contained in:
parent
1a706ff5cf
commit
91a0b9cc0b
1 changed files with 12 additions and 9 deletions
|
@ -287,20 +287,22 @@ (define response
|
|||
(values 'unknown-protocol #f)))))
|
||||
|
||||
(define (validate-uri uri package field)
|
||||
"Return #t if the given URI can be reached, otherwise emit a
|
||||
"Return #t if the given URI can be reached, otherwise return #f and emit a
|
||||
warning for PACKAGE mentionning the FIELD."
|
||||
(let-values (((status argument)
|
||||
(probe-uri uri)))
|
||||
(case status
|
||||
((http-response)
|
||||
(or (= 200 (response-code argument))
|
||||
(emit-warning package
|
||||
(format #f
|
||||
(_ "URI ~a not reachable: ~a (~s)")
|
||||
(uri->string uri)
|
||||
(response-code argument)
|
||||
(response-reason-phrase argument))
|
||||
field)))
|
||||
(begin
|
||||
(emit-warning package
|
||||
(format #f
|
||||
(_ "URI ~a not reachable: ~a (~s)")
|
||||
(uri->string uri)
|
||||
(response-code argument)
|
||||
(response-reason-phrase argument))
|
||||
field)
|
||||
#f)))
|
||||
((ftp-response)
|
||||
(match argument
|
||||
(('ok) #t)
|
||||
|
@ -309,7 +311,8 @@ (define (validate-uri uri package field)
|
|||
(format #f
|
||||
(_ "URI ~a not reachable: ~a (~s)")
|
||||
(uri->string uri)
|
||||
code (string-trim-both message))))))
|
||||
code (string-trim-both message)))
|
||||
#f)))
|
||||
((getaddrinfo-error)
|
||||
(emit-warning package
|
||||
(format #f
|
||||
|
|
Loading…
Reference in a new issue