Make client requests mostly suspendable

1 files changed, 32 insertions, 0 deletions

diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index a98121b..06c22c6 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -98,6 +98,8 @@
             get-port-metrics-updater
             get-guix-memory-metrics-updater
 
+            open-socket-for-uri*
+
             check-locale!
 
             core-guile-sleep))
@@ -1339,6 +1341,36 @@ again."
                                         proc)))))
      %memoization-tables)))
 
+;; Returns the port as well as the raw socket
+(define* (open-socket-for-uri* uri
+                               #:key (verify-certificate? #t)
+                               (non-blocking? #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)))
+
 (define (check-locale!)
   (with-exception-handler
       (lambda (exn)