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

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 @@ (define (check-start-with-package-name 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 @@ (define headers
((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 @@ (define 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 @@ (define (validate-uri uri package field)
"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))