From 166ba5b10207f44360e218d9e3f00772d09bc7cd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 12 Nov 2016 12:57:36 +0100 Subject: substitute: Disable HTTPS certificate verification. Fixes a regression introduced in 9e4e431e049fae3f1121c3be22cf13b174404ba8 as a consequence of bc3c41ce36349ed4ec758c70b48a7059e363043a. Reported by Marius Bakke . * guix/scripts/substitute.scm (fetch): Pass #:verify-certificate? #f to 'open-connection-for-uri' and 'http-fetch'. (download-cache-info): Likewise. (http-multiple-get): Add #:verify-certificate? and honor it. (fetch-narinfos): Pass #:verify-certificate? #f. --- guix/scripts/substitute.scm | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 3d6fde0188..524b019a31 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -210,10 +210,12 @@ provide." (close-connection port)))) (begin (when (or (not port) (port-closed? port)) - (set! port (open-connection-for-uri uri)) + (set! port (open-connection-for-uri uri + #:verify-certificate? #f)) (unless (or buffered? (not (file-port? port))) (setvbuf port _IONBF))) - (http-fetch uri #:text? #f #:port port)))))) + (http-fetch uri #:text? #f #:port port + #:verify-certificate? #f)))))) (else (leave (_ "unsupported substitute URI scheme: ~a~%") (uri->string uri))))) @@ -246,6 +248,7 @@ failure, return #f and #f." #f)) ((http https) (let ((port (open-connection-for-uri uri + #:verify-certificate? #f #:timeout %fetch-timeout))) (guard (c ((http-get-error? c) (warning (_ "while fetching '~a': ~a (~s)~%") @@ -256,6 +259,7 @@ failure, return #f and #f." (warning (_ "ignoring substitute server at '~s'~%") url) (values #f #f))) (values (read-cache-info (http-fetch uri + #:verify-certificate? #f #:port port #:keep-alive? #t)) port)))))) @@ -518,7 +522,7 @@ indicates that PATH is unavailable at CACHE-URL." (build-request (string->uri url) #:method 'GET))) (define* (http-multiple-get base-uri proc seed requests - #:key port) + #:key port (verify-certificate? #t)) "Send all of REQUESTS to the server at BASE-URI. Call PROC for each response, passing it the request object, the response, a port from which to read the response body, and the previous result, starting with SEED, à la @@ -529,7 +533,9 @@ initial connection on which HTTP requests are sent." (result seed)) ;; (format (current-error-port) "connecting (~a requests left)..." ;; (length requests)) - (let ((p (or port (open-connection-for-uri base-uri)))) + (let ((p (or port (open-connection-for-uri base-uri + #:verify-certificate? + verify-certificate?)))) ;; For HTTPS, P is not a file port and does not support 'setvbuf'. (when (file-port? p) (setvbuf p _IOFBF (expt 2 16))) @@ -627,9 +633,14 @@ if file doesn't exist, and the narinfo otherwise." ((http https) (let ((requests (map (cut narinfo-request url <>) paths))) (update-progress!) + + ;; Note: Do not check HTTPS server certificates to avoid depending on + ;; the X.509 PKI. We can do it because we authenticate narinfos, + ;; which provides a much stronger guarantee. (let ((result (http-multiple-get uri handle-narinfo-response '() requests + #:verify-certificate? #f #:port port))) (close-connection port) (newline (current-error-port)) -- cgit v1.2.3