ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu: nss-certs: Install only trusted CA certificates.

Browse source 
* gnu/packages/certs.scm (nss-certs): Only install certificates that include a
  non-empty "openssl-trust=" annotation.
This commit is contained in:
Mark H Weaver 2015-03-03 13:45:43 -05:00
parent 78ab0746a5
commit 41ce460133
1 changed files with 32 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
gnu/packages/certs.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -80,36 +81,47 @@ (define-public nss-certs
(arguments (arguments
`(#:modules ((guix build gnu-build-system) `(#:modules ((guix build gnu-build-system)
(guix build utils) (guix build utils)
(srfi srfi-26)) (rnrs io ports)
(srfi srfi-26)
(ice-9 regex))
#:imported-modules ((guix build gnu-build-system) #:imported-modules ((guix build gnu-build-system)
(guix build utils)) (guix build utils))
#:phases #:phases
(alist-cons-after (alist-cons-after
'unpack 'install 'unpack 'install
(lambda _ (lambda _
(let ((certsdir (string-append %output "/etc/ssl/certs/"))) (let ((certsdir (string-append %output "/etc/ssl/certs/"))
(trusted-rx (make-regexp "^# openssl-trust=[a-zA-Z]"
regexp/newline)))
(define (maybe-install-cert file)
(let ((cert (call-with-input-file file get-string-all)))
(when (regexp-exec trusted-rx cert)
(call-with-output-file
(string-append certsdir file)
(cut display cert <>)))))
(mkdir-p certsdir) (mkdir-p certsdir)
(with-directory-excursion "nss/lib/ckfw/builtins/" (with-directory-excursion "nss/lib/ckfw/builtins/"
;; extract single certificates from blob ;; extract single certificates from blob
(system* "certdata2pem.py" "certdata.txt") (system* "certdata2pem.py" "certdata.txt")
;; copy the .pem files into the output ;; copy selected .pem files into the output
(for-each (for-each maybe-install-cert
(lambda (file) ;; FIXME: Some of the file names are UTF8 (?) and
(copy-file file (string-append certsdir file))) ;; cause an error message such as find-files:
;; FIXME: Some of the file names are UTF8 (?) and cause an ;; ./EBG_Elektronik_Sertifika_Hizmet_Sa??lay??c??s??:2.8.76.175.115.66.28.142.116.2.pem:
;; error message such as ;; No such file or directory
;; find-files: (find-files "." ".*\\.pem")))
;; ./EBG_Elektronik_Sertifika_Hizmet_Sa??lay??c??s??:2.8.76.175.115.66.28.142.116.2.pem:
;; No such file or directory (with-directory-excursion certsdir
(find-files "." ".*\\.pem"))) ;; create symbolic links for and by openssl
(with-directory-excursion certsdir ;; Strangely, the call (system* "c_rehash" certsdir)
;; create symbolic links for and by openssl ;; from inside the build dir fails with
;; Strangely, the call (system* "c_rehash" certsdir) ;; "Usage error; try -help."
;; from inside the build dir fails with ;; This looks like a bug in openssl-1.0.2, but we can also
;; "Usage error; try -help." ;; switch into the target directory.
;; This looks like a bug in openssl-1.0.2, but we can also (system* "c_rehash" "."))))
;; switch into the target directory.
(system* "c_rehash" "."))))
(map (cut assq <> %standard-phases) (map (cut assq <> %standard-phases)
'(set-paths unpack))))) '(set-paths unpack)))))
(synopsis "CA certificates from Mozilla") (synopsis "CA certificates from Mozilla")