[PATCHES] profiles: Produce a single-file CA certificate bundle

[Mark H Weaver]

address@hidden (Ludovic Courtès) writes:

> Mark H Weaver <address@hidden> skribis:
>
>> In order to support multiple packages containing CA certs, it would be
>> good to handle creation of the single-file cert bundle in the profile
>> generation code, analogous to our handling of info "dir" files.  This
>> would allow us to create additional cert packages (e.g. one for
>> CAcert.org).
>>
>> I think it belongs in the profile generation code for the benefit of
>> users running Guix packages on top of another distro, where they might
>> not have root access.  They can simply set GIT_SSL_CAINFO and
>> SSL_CERT_FILE to ~/.guix-profile/etc/ssl/ca-certificates.crt
>>
>> What do you think?
>
> It’s a good but as of yet unimplemented idea.
>
> Although I now realize we could perhaps simple move the
> ‘certificate-bundle’ procedure to (guix profile), add the certificate
> package to the system profile, and make /etc/ssl a symlink to
> /run/current-system/profile/etc/ssl.

I've attached patches that implement this.  They assume that 993300f and
e979e6d are first reverted.  Comments and suggestions welcome.

It would also be good to add search-path-specifications for
SSL_CERT_FILE to 'openssl' and GIT_SSL_CAINFO to 'git' in core-updates,
but I'm not sure how best to do that.  Would you be willing to do it,
Ludovic?

      Mark

>From 0229c6c51a9341484a84f4cec112494b4fe67757 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Tue, 3 Mar 2015 02:09:30 -0500
Subject: [PATCH 1/2] profiles: Produce a single-file CA certificate bundle.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* guix/profiles.scm (ca-certificate-bundle): New procedure.
  (profile-derivation): Add 'ca-certificate-bundle?' keyword argument.  If
  true (the default), add the result of 'ca-certificate-bundle' to 'inputs'.

Co-Authored-By: Ludovic Courtès <address@hidden>
---
 guix/profiles.scm | 91 +++++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 78 insertions(+), 13 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index a0a259b..5ceba25 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2013 Nikita Karetnikov <address@hidden>
 ;;; Copyright © 2014 Alex Kost <address@hidden>
+;;; Copyright © 2015 Mark H Weaver <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -413,23 +414,87 @@ MANIFEST."
       (gexp->derivation "info-dir" build
                         #:modules '((guix build utils)))))
 
-(define* (profile-derivation manifest #:key (info-dir? #t))
+(define (ca-certificate-bundle manifest)
+  "Return a derivation that builds a single-file bundle containing the CA
+certificates in the /etc/ssl/certs sub-directories of the packages in
+MANIFEST.  Single-file bundles are required by programs such as Git and Lynx."
+  ;; See <http://lists.gnu.org/archive/html/guix-devel/2015-02/msg00429.html>
+  ;; for a discussion.
+
+  (define glibc-utf8-locales                      ;lazy reference
+    (module-ref (resolve-interface '(gnu packages base)) 'glibc-utf8-locales))
+
+  (define build
+    #~(begin
+        (use-modules (guix build utils)
+                     (rnrs io ports)
+                     (srfi srfi-1)
+                     (srfi srfi-26)
+                     (ice-9 ftw))
+
+        (define (pem-file? file)
+          (string-suffix? ".pem" file))
+
+        (define (ca-files top)
+          (let ((cert-dir (string-append top "/etc/ssl/certs")))
+            (map (cut string-append cert-dir "/" <>)
+                 (or (scandir cert-dir pem-file?) '()))))
+
+        (define (concatenate-files files result)
+          "Make RESULT the concatenation of all of FILES."
+          (define (dump file port)
+            (display (call-with-input-file file get-string-all)
+                     port)
+            (newline port))    ;required, see <https://bugs.debian.org/635570>
+
+          (call-with-output-file result
+            (lambda (port)
+              (for-each (cut dump <> port) files))))
+
+        ;; Some file names in the NSS certificates are UTF-8 encoded so
+        ;; install a UTF-8 locale.
+        (setenv "LOCPATH" (string-append #+glibc-utf8-locales "/lib/locale"))
+        (setlocale LC_ALL "en_US.UTF-8")
+
+        (let ((ca-files (append-map ca-files
+                                    '#$(manifest-inputs manifest)))
+              (result   (string-append #$output "/etc/ssl/certs")))
+          (mkdir-p result)
+          (concatenate-files ca-files
+                             (string-append result
+                                            "/ca-certificates.crt")))))
+
+  (gexp->derivation "ca-certificate-bundle" build
+                    #:modules '((guix build utils))
+                    #:local-build? #t))
+
+(define* (profile-derivation manifest
+                             #:key
+                             (info-dir? #t)
+                             (ca-certificate-bundle? #t))
   "Return a derivation that builds a profile (aka. 'user environment') with
-the given MANIFEST.  The profile includes a top-level Info 'dir' file, unless
-INFO-DIR? is #f."
+the given MANIFEST.  The profile includes a top-level Info 'dir' file unless
+INFO-DIR? is #f, and a single-file CA certificate bundle unless
+CA-CERTIFICATE-BUNDLE? is #f."
   (mlet %store-monad ((info-dir (if info-dir?
                                     (info-dir-file manifest)
-                                    (return #f))))
+                                    (return #f)))
+                      (ca-cert-bundle (if ca-certificate-bundle?
+                                          (ca-certificate-bundle manifest)
+                                          (return #f))))
     (define inputs
-      (if info-dir
-          ;; XXX: Here we use the tuple (INFO-DIR "out") just so that the list
-          ;; is unambiguous for the gexp code when MANIFEST has a single input
-          ;; denoted as a string (the pattern (DRV STRING) is normally
-          ;; interpreted in a gexp as "the STRING output of DRV".).  See
-          ;; 
<http://lists.gnu.org/archive/html/guix-devel/2014-12/msg00292.html>.
-          (cons (list info-dir "out")
-                (manifest-inputs manifest))
-          (manifest-inputs manifest)))
+      ;; XXX: Here we use tuples of the form (DIR "out") just so that the list
+      ;; is unambiguous for the gexp code when MANIFEST has a single input
+      ;; denoted as a string (the pattern (DRV STRING) is normally
+      ;; interpreted in a gexp as "the STRING output of DRV".).  See
+      ;; <http://lists.gnu.org/archive/html/guix-devel/2014-12/msg00292.html>.
+      (append (if info-dir
+                  `((,info-dir "out"))
+                  '())
+              (if ca-cert-bundle
+                  `((,ca-cert-bundle "out"))
+                  '())
+              (manifest-inputs manifest)))
 
     (define builder
       #~(begin
-- 
2.2.1

>From ff4bbad277c43cf17e8a90d9e26daa4ad631ba86 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Tue, 3 Mar 2015 02:14:14 -0500
Subject: [PATCH 2/2] system: Add /etc/ssl symlink; set needed variables in
 /etc/profile.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* gnu/build/activation.scm (activate-etc): Create /etc/ssl symlink.
* gnu/system.scm (etc-directory): Set SSL_CERT_DIR, SSL_CERT_FILE,
  and GIT_SSL_CAINFO in /etc/profile.

Co-Authored-By: Ludovic Courtès <address@hidden>
---
 gnu/build/activation.scm | 10 ++++++++++
 gnu/system.scm           |  5 +++++
 2 files changed, 15 insertions(+)

diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index dfadde3..909e971 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014 Ludovic Courtès <address@hidden>
+;;; Copyright © 2015 Mark H Weaver <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -200,6 +201,15 @@ numeric gid or #f."
 
   (format #t "populating /etc from ~a...~%" etc)
 
+  ;; Create the /etc/ssl -> /run/current-system/profile/etc/ssl symlink.  This
+  ;; symlink, to a target outside of the store, probably doesn't belong in the
+  ;; static 'etc' store directory.  However, if it were to be put there,
+  ;; beware that if /run/current-system/profile/etc/ssl doesn't exist at the
+  ;; time of activation (e.g. when installing a fresh system), the call to
+  ;; 'file-is-directory?' below will fail because it uses 'stat', not 'lstat'.
+  (rm-f "/etc/ssl")
+  (symlink "/run/current-system/profile/etc/ssl" "/etc/ssl")
+
   (rm-f "/etc/static")
   (symlink etc "/etc/static")
   (for-each (lambda (file)
diff --git a/gnu/system.scm b/gnu/system.scm
index 8060f74..8075910 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -454,6 +454,11 @@ export EMACSLOADPATH=:/etc/emacs
 # when /etc/machine-id is missing.  Make sure these warnings are non-fatal.
 export DBUS_FATAL_WARNINGS=0
 
+# These variables are honored by OpenSSL (libssl) and Git.
+export SSL_CERT_DIR=/etc/ssl/certs
+export SSL_CERT_FILE=\"$SSL_CERT_DIR/ca-certificates.crt\"
+export GIT_SSL_CAINFO=\"$SSL_CERT_FILE\"
+
 # Allow Aspell to find dictionaries installed in the user profile.
 export ASPELL_CONF=\"dict-dir $HOME/.guix-profile/lib/aspell\"
 "))
-- 
2.2.1