diff options
| -rw-r--r-- | guix/profiles.scm | 91 |
1 files changed, 78 insertions, 13 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index a0a259bd4e..5ceba25def 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2014 Alex Kost <alezost@gmail.com> +;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; 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 |