guix/guix
3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
Code Issues Releases Wiki Activity

lint: Have connections time out after 3 seconds.

Browse source 
* guix/scripts/lint.scm (probe-uri): Add #:timeout parameter.  Pass it
  to 'open-connection-for-uri' and 'ftp-open'.
  (validate-uri): Pass #:timeout 3 to 'probe-uri'.
This commit is contained in:
Ludovic Courtès 2015-11-12 23:17:12 +01:00
parent 1b9aefa394
commit bd7e1ffae6
1 changed files with 8 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
guix/scripts/lint.scm
View file

@ -266,10 +266,13 @@ the synopsis")
(check-start-with-package-name synopsis)
(check-synopsis-length synopsis))))
(define (probe-uri uri)
(define* (probe-uri uri #:key timeout)
"Probe URI, a URI object, and return two values: a symbol denoting the
probing status, such as 'http-response' when we managed to get an HTTP
response from URI, and additional details, such as the actual HTTP response."
response from URI, and additional details, such as the actual HTTP response.
TIMEOUT is the maximum number of seconds (possibly an inexact number) to wait
for connections to complete; when TIMEOUT is #f, wait as long as needed."
(define headers
'((User-Agent . "GNU Guile")
(Accept . "*/*")))
@ -280,7 +283,7 @@ response from URI, and additional details, such as the actual HTTP response."
((or 'http 'https)
(catch #t
(lambda ()
(let ((port (open-connection-for-uri uri))
(let ((port (open-connection-for-uri uri #:timeout timeout))
(request (build-request uri #:headers headers)))
(define response
(dynamic-wind
@ -313,7 +316,7 @@ response from URI, and additional details, such as the actual HTTP response."
('ftp
(catch #t
(lambda ()
(let ((conn (ftp-open (uri-host uri) 21)))
(let ((conn (ftp-open (uri-host uri) 21 #:timeout timeout)))
(define response
(dynamic-wind
(const #f)
@ -338,7 +341,7 @@ response from URI, and additional details, such as the actual HTTP response."
"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)))
(probe-uri uri #:timeout 3))) ;wait at most 3 seconds
(case status
((http-response)
(or (= 200 (response-code argument))