From 836812dbff93f3c670903720d04129be60873e22 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 30 Jun 2023 19:11:45 +0100
Subject: Add some more network connection timeout helpers

---
 nar-herder/utils.scm | 39 ++++++++++++++++++++++++++++++++++++++-
 1 file changed, 38 insertions(+), 1 deletion(-)

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)))
-- 
cgit v1.2.3