aboutsummaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-12 23:17:12 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-12 23:47:01 +0100
commitbd7e1ffae6c91680e3328974f94c3ead8d2f378d (patch)
tree12ab64d7e5a58fd9679a911c7a20b47478faaab5 /guix
parent1b9aefa394a57dabe38e0658a3b612e962d3fc5e (diff)
downloadgnu-guix-bd7e1ffae6c91680e3328974f94c3ead8d2f378d.tar
gnu-guix-bd7e1ffae6c91680e3328974f94c3ead8d2f378d.tar.gz
lint: Have connections time out after 3 seconds.
* 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'.
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/lint.scm13
1 files changed, 8 insertions, 5 deletions
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index b1707ade44..a7618ee286 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -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))