diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-11-12 23:17:12 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-11-12 23:47:01 +0100 |
| commit | bd7e1ffae6c91680e3328974f94c3ead8d2f378d (patch) | |
| tree | 12ab64d7e5a58fd9679a911c7a20b47478faaab5 /guix | |
| parent | 1b9aefa394a57dabe38e0658a3b612e962d3fc5e (diff) | |
| download | guix-patches-bd7e1ffae6c91680e3328974f94c3ead8d2f378d.tar guix-patches-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.scm | 13 |
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)) |