aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-11-12 12:57:36 +0100
committerLudovic Courtès <ludo@gnu.org>2016-11-12 13:04:45 +0100
commit166ba5b10207f44360e218d9e3f00772d09bc7cd (patch)
treea5b250cd74a0148399156a1d7d20d8245f306820
parent17cff9c66214be38de8ece0ce98f707823e25bf2 (diff)
downloadguix-166ba5b10207f44360e218d9e3f00772d09bc7cd.tar.gz
guix-166ba5b10207f44360e218d9e3f00772d09bc7cd.zip
substitute: Disable HTTPS certificate verification.
Fixes a regression introduced in 9e4e431e049fae3f1121c3be22cf13b174404ba8 as a consequence of bc3c41ce36349ed4ec758c70b48a7059e363043a. Reported by Marius Bakke <mbakke@fastmail.com>. * 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.
-rwxr-xr-xguix/scripts/substitute.scm19
1 files 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))