Use open-socket-for-uri* from the build coordinator

As this makes the ports non-blocking by default.

2 files changed, 4 insertions, 36 deletions

diff --git a/guix-qa-frontpage/guix-data-service.scm b/guix-qa-frontpage/guix-data-service.scm
index 6518cd1..7ba98bc 100644
--- a/guix-qa-frontpage/guix-data-service.scm
+++ b/guix-qa-frontpage/guix-data-service.scm
@@ -90,46 +90,12 @@
         (guix-data-service-error-response-body exn)
         "query_parameters")))))
 
-;; 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)))
-
 (define* (guix-data-service-request url #:key (retry-times 0) (retry-delay 5))
   (define (make-request)
     (let ((port
            socket
            (open-socket-for-uri* (string->uri url))))
 
-      ;; This can't be done earlier as tls-wrap/guile-gnutls doesn't support
-      ;; handshake on a non blocking socket
-      (let ((flags (fcntl socket F_GETFL)))
-        (fcntl socket F_SETFL (logior O_NONBLOCK flags)))
-
       (let ((response
              body
              (http-get (string->uri url)
diff --git a/guix-qa-frontpage/utils.scm b/guix-qa-frontpage/utils.scm
index f0b47a9..70f4cd9 100644
--- a/guix-qa-frontpage/utils.scm
+++ b/guix-qa-frontpage/utils.scm
@@ -23,14 +23,16 @@
   #:use-module (ice-9 threads)
   #:use-module (fibers)
   #:use-module (fibers channels)
-  #:use-module ((guix-build-coordinator utils) #:select (with-port-timeouts))
+  #:use-module ((guix-build-coordinator utils) #:select (with-port-timeouts
+                                                         open-socket-for-uri*))
   #:use-module (guix-build-coordinator utils fibers)
   #:export (fiberize
             fibers-map
             fibers-batch-for-each
             fibers-for-each
             non-blocking)
-  #:re-export (with-fibers-port-timeouts))
+  #:re-export (with-fibers-port-timeouts
+               open-socket-for-uri*))
 
 (define* (fiberize proc #:key (parallelism 1))
   (let ((channel (make-channel)))