aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-09-22 21:06:39 +0200
committerLudovic Courtès <ludo@gnu.org>2014-09-22 21:06:39 +0200
commit077bd18d223c2934fb52b7ab134271e1b574c481 (patch)
tree64c9d446a340db4837353b6da072a14e1247a7e5
parentcb150ca34f5daee327867c6a647d075c8a598c37 (diff)
downloadguix-077bd18d223c2934fb52b7ab134271e1b574c481.tar
guix-077bd18d223c2934fb52b7ab134271e1b574c481.tar.gz
download: Use the 'SERVER NAME' TLS extension when possible.
Fixes <http://bugs.gnu.org/18526>. Reported by Mark H. Weaver. * guix/build/download.scm (tls-wrap): Add 'server' parameter. Call 'set-session-server-name!' when (gnutls) defines it. (open-connection-for-uri): Adjust 'tls-wrap' call accordingly.
-rw-r--r--guix/build/download.scm18
1 files changed, 15 insertions, 3 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index d98933a907..c081f3b29b 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -112,13 +112,25 @@ 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))))
-(define (tls-wrap port)
- "Return PORT wrapped in a TLS connection."
+(define (tls-wrap port server)
+ "Return PORT wrapped in a TLS connection to SERVER. SERVER must be a DNS
+host name without trailing dot."
(define (log level str)
(format (current-error-port)
"gnutls: [~a|~a] ~a" (getpid) level str))
(let ((session (make-session connection-end/client)))
+
+ ;; Some servers such as 'cloud.github.com' require the client to support
+ ;; the 'SERVER NAME' extension. However, 'set-session-server-name!' is
+ ;; not available in older GnuTLS releases. See
+ ;; <http://bugs.gnu.org/18526> for details.
+ (if (module-defined? (resolve-interface '(gnutls))
+ 'set-session-server-name!)
+ (set-session-server-name! session server-name-type/dns server)
+ (format (current-error-port)
+ "warning: TLS 'SERVER NAME' extension not supported~%"))
+
(set-session-transport-fd! session (fileno port))
(set-session-default-priority! session)
(set-session-credentials! session (make-certificate-credentials))
@@ -169,7 +181,7 @@ which is not available during bootstrap."
(setvbuf s _IOFBF)
(if (eq? 'https (uri-scheme uri))
- (tls-wrap s)
+ (tls-wrap s (uri-host uri))
s))
(lambda args
;; Connection failed, so try one of the other addresses.