01/02: substitute: Add HTTPS support.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 9b7bd1b160be7c740a798c09e3b8986368b92036
Author: Ludovic Courtès <address@hidden>
Date:   Thu Mar 10 11:53:03 2016 +0100

    substitute: Add HTTPS support.
    
    Fixes <http://bugs.gnu.org/22937>.
    Reported by Chris Marusich <address@hidden>.
    
    * guix/scripts/substitute.scm (fetch): Add 'https' alongside 'http'.
    Use 'open-connection-for-uri' instead of 'open-socket-for-uri'.  Call
    'setvbuf' only when PORT matches 'file-port?'.
    (http-multiple-get): Likewise.  Change 'base-url' parameter to
    'base-uri'.
    (fetch-narinfos)[do-fetch]: Add 'https' case alongside 'http'.  Pass URI
    instead of URL to 'http-multiple-get'.
    * doc/guix.texi (Requirements): Move GnuTLS one level higher and mention
    HTTPS substitutes.
    (Substitutes): Mention HTTPS and recommend it.  Explain why servers
    are not authenticated.  Add "On Trusting Binaries" subsection.
---
 doc/guix.texi               |   35 +++++++++++++++++++++++++++--------
 guix/scripts/substitute.scm |   23 ++++++++++++++---------
 2 files changed, 41 insertions(+), 17 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 06b40fa..dbb2ae8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -485,18 +485,20 @@ The following dependencies are optional:
 
 @itemize
 @item
+Installing @uref{http://gnutls.org/, GnuTLS-Guile} will allow you to
+access @code{https} URLs for substitutes, which is highly recommended
+(@pxref{Substitutes}).  It also allows you to access HTTPS URLs with the
address@hidden download} command (@pxref{Invoking guix download}), the
address@hidden import pypi} command, and the @command{guix import cpan}
+command.  @xref{Guile Preparations, how to install the GnuTLS bindings
+for Guile,, gnutls-guile, GnuTLS-Guile}.
+
address@hidden
 Installing
 @url{http://savannah.nongnu.org/projects/guile-json/, Guile-JSON} will
 allow you to use the @command{guix import pypi} command (@pxref{Invoking
 guix import}).  It is of
 interest primarily for developers and not for casual users.
address@hidden
-Installing @uref{http://gnutls.org/, GnuTLS-Guile} will
-allow you to access @code{https} URLs with the @command{guix download}
-command (@pxref{Invoking guix download}), the @command{guix import pypi}
-command, and the @command{guix import cpan} command.  This is primarily
-of interest to developers.  @xref{Guile Preparations, how to install the
-GnuTLS bindings for Guile,, gnutls-guile, GnuTLS-Guile}.
 @end itemize
 
 Unless @code{--disable-daemon} was passed to @command{configure}, the
@@ -1703,6 +1705,13 @@ or to client tools such as @command{guix package}
 (@pxref{client-substitute-urls,, client @option{--substitute-urls}
 option}).
 
+Substitute URLs can be either HTTP or address@hidden HTTPS access,
+the Guile bindings of GnuTLS must be installed.  @xref{Requirements}.}
+HTTPS is recommended because communications are encrypted; conversely,
+using HTTP makes all communications visible to an eavesdropper, who
+could use the information gathered to determine, for instance, whether
+your system has unpatched security vulnerabilities.
+
 @cindex security
 @cindex digital signatures
 To allow Guix to download substitutes from @code{hydra.gnu.org}, you
@@ -1757,13 +1766,21 @@ one of the keys listed in the ACL.  It also detects and 
raises an error
 when attempting to use a substitute that has been tampered with.
 
 @vindex http_proxy
-Substitutes are downloaded over HTTP.  The @code{http_proxy} environment
+Substitutes are downloaded over HTTP or HTTPS.
+The @code{http_proxy} environment
 variable can be set in the environment of @command{guix-daemon} and is
 honored for downloads of substitutes.  Note that the value of
 @code{http_proxy} in the environment where @command{guix build},
 @command{guix package}, and other client commands are run has
 @emph{absolutely no effect}.
 
+When using HTTPS, the server's X.509 certificate is @emph{not} validated
+(in other words, the server is not authenticated), contrary to what
+HTTPS clients such as Web browsers usually do.  This is because Guix
+authenticates substitute information itself, as explained above, which
+is what we care about (whereas X.509 certificates are about
+authenticating bindings between domain names and public keys.)
+
 The substitute mechanism can be disabled globally by running
 @code{guix-daemon} with @code{--no-substitutes} (@pxref{Invoking
 guix-daemon}).  It can also be disabled temporarily by passing the
@@ -1771,6 +1788,8 @@ guix-daemon}).  It can also be disabled temporarily by 
passing the
 build}, and other command-line tools.
 
 
address@hidden On Trusting Binaries
+
 Today, each individual's control over their own computing is at the
 mercy of institutions, corporations, and groups with enough power and
 determination to subvert the computing infrastructure and exploit its
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 0a716a9..cc637c8 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -32,6 +32,7 @@
   #:use-module ((guix build utils) #:select (mkdir-p dump-port))
   #:use-module ((guix build download)
                 #:select (progress-proc uri-abbreviation
+                          open-connection-for-uri
                           store-path-abbreviation byte-count->string))
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
@@ -49,6 +50,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (web uri)
+  #:use-module (web http)
   #:use-module (web request)
   #:use-module (web response)
   #:use-module (guix http-client)
@@ -171,7 +173,7 @@ to the caller without emitting an error message."
      (let ((port (open-file (uri-path uri)
                             (if buffered? "rb" "r0b"))))
        (values port (stat:size (stat port)))))
-    ((http)
+    ((http https)
      (guard (c ((http-get-error? c)
                 (let ((code (http-get-error-code c)))
                   (if (and (= code 404) quiet-404?)
@@ -201,8 +203,8 @@ to the caller without emitting an error message."
                  (close-port port))))
            (begin
              (when (or (not port) (port-closed? port))
-               (set! port (open-socket-for-uri uri))
-               (unless buffered?
+               (set! port (open-connection-for-uri uri))
+               (unless (or buffered? (not (file-port? port)))
                  (setvbuf port _IONBF)))
              (http-fetch uri #:text? #f #:port port))))))
     (else
@@ -478,8 +480,8 @@ may be #f, in which case it indicates that PATH is 
unavailable at CACHE-URL."
                             ".narinfo")))
     (build-request (string->uri url) #:method 'GET)))
 
-(define (http-multiple-get base-url proc seed requests)
-  "Send all of REQUESTS to the server at BASE-URL.  Call PROC for each
+(define (http-multiple-get base-uri proc seed requests)
+  "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
 'fold'.  Return the final result."
@@ -487,9 +489,12 @@ read the response body, and the previous result, starting 
with SEED, Ã  la
                 (result   seed))
     ;; (format (current-error-port) "connecting (~a requests left)..."
     ;;         (length requests))
-    (let ((p (open-socket-for-uri base-url)))
+    (let ((p (open-connection-for-uri base-uri)))
+      ;; For HTTPS, P is not a file port and does not support 'setvbuf'.
+      (when (file-port? p)
+        (setvbuf p _IOFBF (expt 2 16)))
+
       ;; Send all of REQUESTS in a row.
-      (setvbuf p _IOFBF (expt 2 16))
       (for-each (cut write-request <> p) requests)
       (force-output p)
 
@@ -570,10 +575,10 @@ if file doesn't exist, and the narinfo otherwise."
 
   (define (do-fetch uri)
     (case (and=> uri uri-scheme)
-      ((http)
+      ((http https)
        (let ((requests (map (cut narinfo-request url <>) paths)))
          (update-progress!)
-         (let ((result (http-multiple-get url
+         (let ((result (http-multiple-get uri
                                           handle-narinfo-response '()
                                           requests)))
            (newline (current-error-port))