The culprit is that our client would not support the TLS ‘SERVER NAME’
extension, unlike the wget and gnutls-cli (this is enabled simply by
calling ‘gnutls_server_name_set’.) Here’s a proof-of-concept
workaround:
diff --git a/guix/build/download.scm b/guix/build/download.scm
index d98933a..b44302f 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -112,6 +112,24 @@ abbreviation of URI showing the scheme, host, and basename of the file."
"Hold a weak reference from FROM to TO."
(hashq-set! table from to))))
+(use-modules (system foreign))
+
+(define set-server-name!
+ (let* ((lib (string-append (getenv "HOME") "/.guix-profile/lib/libgnutls"))
+ (ptr (dynamic-func "gnutls_server_name_set"
+ (dynamic-link lib)))
+ (proc (pointer->procedure int ptr
+ (list '* int '* size_t))))
+ (lambda (session type name)
+ ;; SESSION is a SMOB, and the 'gnutls_session_t' pointer is in its
+ ;; second cell.
+ (let* ((cell (make-pointer (+ (sizeof '*) (object-address session))))
+ (session (dereference-pointer cell)))
+ (zero? (proc session type
+ (string->pointer name) (string-length name)))))))
+
+(define GNUTLS_NAME_DNS 1)
+
(define (tls-wrap port)
"Return PORT wrapped in a TLS connection."
(define (log level str)
@@ -119,6 +137,7 @@ abbreviation of URI showing the scheme, host, and basename of the file."
"gnutls: [~a|~a] ~a" (getpid) level str))
(let ((session (make-session connection-end/client)))
+ (set-server-name! session GNUTLS_NAME_DNS "cloud.github.com")
(set-session-transport-fd! session (fileno port))
(set-session-default-priority! session)
(set-session-credentials! session (make-certificate-credentials))
I’ll add bindings for ‘gnutls_server_name_set’ in GnuTLS proper, and
then we can correctly address this bug.
Ludo’.
