diff options
| -rw-r--r-- | nar-herder/utils.scm | 39 |
1 files changed, 38 insertions, 1 deletions
diff --git a/nar-herder/utils.scm b/nar-herder/utils.scm index 2247231..4468ebb 100644 --- a/nar-herder/utils.scm +++ b/nar-herder/utils.scm @@ -54,7 +54,9 @@ check-locale! - with-port-timeouts)) + with-port-timeouts + set-socket-timeout + open-socket-for-uri*)) (define* (retry-on-error f #:key times delay ignore) (let loop ((attempt 1)) @@ -593,3 +595,38 @@ If already in the worker thread, call PROC immediately." (lambda (port) (wait port "w")))) (thunk))) + +(define* (set-socket-timeout port #:key (seconds 120)) + (when (defined? 'SO_RCVTIMEO) + ;; This is only supported on Guile 3.0.9 and later + (setsockopt port SOL_SOCKET SO_RCVTIMEO `(,seconds . 0)) + (setsockopt port SOL_SOCKET SO_SNDTIMEO `(,seconds . 0)))) + +;; Returns the port as well as the raw socket +(define* (open-socket-for-uri* uri + #:key (verify-certificate? #t)) + (define tls-wrap + (@@ (web client) tls-wrap)) + + (define https? + (eq? 'https (uri-scheme uri))) + + (define plain-uri + (if https? + (build-uri + 'http + #:userinfo (uri-userinfo uri) + #:host (uri-host uri) + #:port (or (uri-port uri) 443) + #:path (uri-path uri) + #:query (uri-query uri) + #:fragment (uri-fragment uri)) + uri)) + + (let ((s (open-socket-for-uri plain-uri))) + (values + (if https? + (tls-wrap s (uri-host uri) + #:verify-certificate? verify-certificate?) + s) + s))) |