nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

substitute: Disable HTTPS certificate verification. 

Fixes a regression introduced in
9e4e431e04 as a consequence of
bc3c41ce36.
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.
This commit is contained in:
Ludovic Courtès 2016-11-12 12:57:36 +01:00
parent 17cff9c662
commit 166ba5b102
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
guix/scripts/substitute.scm
View File

@ -210,10 +210,12 @@ provide."
(close-connection port)))) (close-connection port))))
(begin (begin
(when (or (not port) (port-closed? port)) (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))) (unless (or buffered? (not (file-port? port)))
(setvbuf port _IONBF))) (setvbuf port _IONBF)))
(http-fetch uri #:text? #f #:port port)))))) (http-fetch uri #:text? #f #:port port
#:verify-certificate? #f))))))
(else (else
(leave (_ "unsupported substitute URI scheme: ~a~%") (leave (_ "unsupported substitute URI scheme: ~a~%")
(uri->string uri))))) (uri->string uri)))))
@ -246,6 +248,7 @@ failure, return #f and #f."
#f)) #f))
((http https) ((http https)
(let ((port (open-connection-for-uri uri (let ((port (open-connection-for-uri uri
#:verify-certificate? #f
#:timeout %fetch-timeout))) #:timeout %fetch-timeout)))
(guard (c ((http-get-error? c) (guard (c ((http-get-error? c)
(warning (_ "while fetching '~a': ~a (~s)~%") (warning (_ "while fetching '~a': ~a (~s)~%")
@ -256,6 +259,7 @@ failure, return #f and #f."
(warning (_ "ignoring substitute server at '~s'~%") url) (warning (_ "ignoring substitute server at '~s'~%") url)
(values #f #f))) (values #f #f)))
(values (read-cache-info (http-fetch uri (values (read-cache-info (http-fetch uri
#:verify-certificate? #f
#:port port #:port port
#:keep-alive? #t)) #:keep-alive? #t))
port)))))) port))))))
@ -518,7 +522,7 @@ indicates that PATH is unavailable at CACHE-URL."
(build-request (string->uri url) #:method 'GET))) (build-request (string->uri url) #:method 'GET)))
(define* (http-multiple-get base-uri proc seed requests (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 "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 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 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)) (result seed))
;; (format (current-error-port) "connecting (~a requests left)..." ;; (format (current-error-port) "connecting (~a requests left)..."
;; (length requests)) ;; (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'. ;; For HTTPS, P is not a file port and does not support 'setvbuf'.
(when (file-port? p) (when (file-port? p)
(setvbuf p _IOFBF (expt 2 16))) (setvbuf p _IOFBF (expt 2 16)))
@ -627,9 +633,14 @@ if file doesn't exist, and the narinfo otherwise."
((http https) ((http https)
(let ((requests (map (cut narinfo-request url <>) paths))) (let ((requests (map (cut narinfo-request url <>) paths)))
(update-progress!) (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 (let ((result (http-multiple-get uri
handle-narinfo-response '() handle-narinfo-response '()
requests requests
#:verify-certificate? #f
#:port port))) #:port port)))
(close-connection port) (close-connection port)
(newline (current-error-port)) (newline (current-error-port))