From 13512e1b8f63b4d8fcb188fac992aa390149fe65 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 14 Sep 2018 11:11:54 +0200 Subject: git-download: 'git-predicate' returns #f on Git errors. Fixes a regression introduced in aed0a594058a59bc3bb1d2686391dc0e8a181b1f whereby 'git-predicate' would throw to 'git-error instead of returning #f as the docstring says. * guix/git-download.scm (git-predicate): Return #f upon 'git-error'. --- guix/git-download.scm | 36 ++++++++++++++++++++---------------- 1 file changed, 20 insertions(+), 16 deletions(-) (limited to 'guix') diff --git a/guix/git-download.scm b/guix/git-download.scm index e6e0ec2ac5..24cf11be5e 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -179,24 +179,28 @@ are relative to DIRECTORY, which is not necessarily the root of the checkout." (define (git-predicate directory) "Return a predicate that returns true if a file is part of the Git checkout -living at DIRECTORY. Upon Git failure, return #f instead of a predicate. +living at DIRECTORY. If DIRECTORY does not lie within a Git checkout, and +upon Git errors, return #f instead of a predicate. The returned predicate takes two arguments FILE and STAT where FILE is an absolute file name and STAT is the result of 'lstat'." - (let* ((files (git-file-list directory)) - (inodes (fold (lambda (file result) - (let ((stat - (lstat (string-append directory "/" - file)))) - (vhash-consv (stat:ino stat) (stat:dev stat) - result))) - vlist-null - files))) - (lambda (file stat) - ;; Comparing file names is always tricky business so we rely on inode - ;; numbers instead. - (match (vhash-assv (stat:ino stat) inodes) - ((_ . dev) (= dev (stat:dev stat))) - (#f #f))))) + (catch 'git-error + (lambda () + (let* ((files (git-file-list directory)) + (inodes (fold (lambda (file result) + (let ((stat + (lstat (string-append directory "/" + file)))) + (vhash-consv (stat:ino stat) (stat:dev stat) + result))) + vlist-null + files))) + (lambda (file stat) + ;; Comparing file names is always tricky business so we rely on inode + ;; numbers instead. + (match (vhash-assv (stat:ino stat) inodes) + ((_ . dev) (= dev (stat:dev stat))) + (#f #f))))) + (const #f))) ;;; git-download.scm ends here -- cgit v1.2.3 From ebbfc59c21d9888d43f36d8f23862030ebaaacce Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 16 Sep 2018 21:38:23 +0200 Subject: graph: Add '--system'. * guix/scripts/graph.scm (%options, show-help): Add '--system'. (%default-options): Add 'system'. (guix-graph): Pass #:system to 'run-with-store'. --- doc/guix.texi | 7 +++++++ guix/scripts/graph.scm | 12 ++++++++++-- 2 files changed, 17 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index cccf166d03..9a19eb89cd 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7711,6 +7711,13 @@ This is useful to precisely refer to a package, as in this example: @example guix graph -e '(@@@@ (gnu packages commencement) gnu-make-final)' @end example + +@item --system=@var{system} +@itemx -s @var{system} +Display the graph for @var{system}---e.g., @code{i686-linux}. + +The package dependency graph is largely architecture-independent, but there +are some architecture-dependent bits that this option allows you to visualize. @end table diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 346ca4ea88..145a574dba 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -439,6 +439,10 @@ package modules, while attempting to retain user package modules." (option '(#\e "expression") #t #f (lambda (opt name arg result) (alist-cons 'expression arg result))) + (option '(#\s "system") #t #f + (lambda (opt name arg result) + (alist-cons 'system arg + (alist-delete 'system result eq?)))) (option '(#\h "help") #f #f (lambda args (show-help) @@ -462,6 +466,8 @@ Emit a representation of the dependency graph of PACKAGE...\n")) --list-types list the available graph types")) (display (G_ " -e, --expression=EXPR consider the package EXPR evaluates to")) + (display (G_ " + -s, --system=SYSTEM consider the graph for SYSTEM--e.g., \"i686-linux\"")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -472,7 +478,8 @@ Emit a representation of the dependency graph of PACKAGE...\n")) (define %default-options `((node-type . ,%package-node-type) - (backend . ,%graphviz-backend))) + (backend . ,%graphviz-backend) + (system . ,(%current-system)))) ;;; @@ -508,7 +515,8 @@ Emit a representation of the dependency graph of PACKAGE...\n")) (export-graph (concatenate nodes) (current-output-port) #:node-type type - #:backend backend))))))) + #:backend backend)) + #:system (assq-ref opts 'system)))))) #t) ;;; graph.scm ends here -- cgit v1.2.3 From 3c0e16391ed9a3e3e4611b940fb393c5f2ecea63 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 16 Sep 2018 21:58:19 +0200 Subject: channels: Add Guile-Git as a dependency of external channels. Fixes a regression introduced in aed0a594058a59bc3bb1d2686391dc0e8a181b1f whereby external channels would fail to build due to the lack of a (git) module. Reported by Alex ter Weele on #guix. * guix/channels.scm (channel-instance-derivations)[guile-gcrypt]: Remove. [dependencies]: New variable. Use it in the 2nd argument to 'build-channel-instance'. --- guix/channels.scm | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/channels.scm b/guix/channels.scm index cf833db8b9..2e7bffae9f 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -207,10 +207,16 @@ INSTANCES." (guix-channel? (channel-instance-channel instance))) instances)) - ;; Guile-Gcrypt is a dependency of CORE-INSTANCE. - (define guile-gcrypt - (module-ref (resolve-interface '(gnu packages gnupg)) - 'guile-gcrypt)) + (define dependencies + ;; Dependencies of CORE-INSTANCE. + ;; FIXME: It would be best not to hard-wire this information here and + ;; instead query it to CORE-INSTANCE. + (list (module-ref (resolve-interface '(gnu packages gnupg)) + 'guile-gcrypt) + (module-ref (resolve-interface '(gnu packages guile)) + 'guile-git) + (module-ref (resolve-interface '(gnu packages guile)) + 'guile-bytestructures))) (mlet %store-monad ((core (build-channel-instance core-instance))) (mapm %store-monad @@ -218,7 +224,7 @@ INSTANCES." (if (eq? instance core-instance) (return core) (build-channel-instance instance - (list core guile-gcrypt)))) + (cons core dependencies)))) instances))) (define (whole-package-for-legacy name modules) -- cgit v1.2.3 From b9e1fddfd8c29b2fa6252ef52a75daa14aaabd3e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Sep 2018 22:15:19 +0200 Subject: gnupg: Use 'gpgv' and keybox files; adjust 'guix refresh' accordingly. * guix/gnupg.scm (%gpgv-command, current-keyring): New variables (gnupg-verify): Add optional 'keyring' parameter. Use 'gpgv' instead of 'gpg' and pass it '--keyring'. (gnupg-receive-keys): Add optional 'keyring' parameter and honor it. (gnupg-verify*): Add #:keyring and honor it. * guix/scripts/refresh.scm (%options, show-help): Add '--keyring'. (guix-refresh): Parameterize CURRENT-KEYRING. * doc/guix.texi (Invoking guix refresh): Document '--keyring' and the keybox format. --- doc/guix.texi | 30 +++++++++++++++++++++++++ guix/gnupg.scm | 58 +++++++++++++++++++++++++++++++++++------------- guix/scripts/refresh.scm | 13 +++++++++-- 3 files changed, 83 insertions(+), 18 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 9a19eb89cd..8987b20fa9 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7268,6 +7268,36 @@ The following options can be used to customize GnuPG operation: Use @var{command} as the GnuPG 2.x command. @var{command} is searched for in @code{$PATH}. +@item --keyring=@var{file} +Use @var{file} as the keyring for upstream keys. @var{file} must be in the +@dfn{keybox format}. Keybox files usually have a name ending in @file{.kbx} +and the GNU@tie{}Privacy Guard (GPG) can manipulate these files +(@pxref{kbxutil, @command{kbxutil},, gnupg, Using the GNU Privacy Guard}, for +information on a tool to manipulate keybox files). + +When this option is omitted, @command{guix refresh} uses +@file{~/.config/guix/upstream/trustedkeys.kbx} as the keyring for upstream +signing keys. OpenPGP signatures are checked against keys from this keyring; +missing keys are downloaded to this keyring as well (see +@option{--key-download} below.) + +You can export keys from your default GPG keyring into a keybox file using +commands like this one: + +@example +gpg --export rms@@gnu.org | kbxutil --import-openpgp >> mykeyring.kbx +@end example + +Likewise, you can fetch keys to a specific keybox file like this: + +@example +gpg --no-default-keyring --keyring mykeyring.kbx \ + --recv-keys @value{OPENPGP-SIGNING-KEY-ID} +@end example + +@ref{GPG Configuration Options, @option{--keyring},, gnupg, Using the GNU +Privacy Guard}, for more information on GPG's @option{--keyring} option. + @item --key-download=@var{policy} Handle missing OpenPGP keys according to @var{policy}, which may be one of: diff --git a/guix/gnupg.scm b/guix/gnupg.scm index ac0ed5ab2d..b30ce461b4 100644 --- a/guix/gnupg.scm +++ b/guix/gnupg.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010, 2011, 2013, 2014, 2016 Ludovic Courtès +;;; Copyright © 2010, 2011, 2013, 2014, 2016, 2018 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. @@ -24,9 +24,12 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 i18n) #:use-module (srfi srfi-1) - #:use-module (guix ui) + #:use-module (guix i18n) + #:use-module ((guix utils) #:select (config-directory)) + #:use-module ((guix build utils) #:select (mkdir-p)) #:export (%gpg-command %openpgp-key-server + current-keyring gnupg-verify gnupg-verify* gnupg-status-good-signature? @@ -42,13 +45,25 @@ ;; The GnuPG 2.x command-line program name. (make-parameter (or (getenv "GUIX_GPG_COMMAND") "gpg"))) +(define %gpgv-command + ;; The 'gpgv' program. + (make-parameter (or (getenv "GUIX_GPGV_COMMAND") "gpgv"))) + +(define current-keyring + ;; The default keyring of "trusted keys". + (make-parameter (string-append (config-directory #:ensure? #f) + "/gpg/trustedkeys.kbx"))) + (define %openpgp-key-server ;; The default key server. Note that keys.gnupg.net appears to be ;; unreliable. (make-parameter "pgp.mit.edu")) -(define (gnupg-verify sig file) - "Verify signature SIG for FILE. Return a status s-exp if GnuPG failed." +(define* (gnupg-verify sig file + #:optional (keyring (current-keyring))) + "Verify signature SIG for FILE against the keys in KEYRING. All the keys in +KEYRING as assumed to be \"trusted\", whether or not they expired or were +revoked. Return a status s-exp if GnuPG failed." (define (status-line->sexp line) ;; See file `doc/DETAILS' in GnuPG. @@ -117,8 +132,8 @@ (loop (read-line input) (cons (status-line->sexp line) result))))) - (let* ((pipe (open-pipe* OPEN_READ (%gpg-command) "--status-fd=1" - "--verify" sig file)) + (let* ((pipe (open-pipe* OPEN_READ (%gpgv-command) "--status-fd=1" + "--keyring" keyring sig file)) (status (parse-status pipe))) ;; Ignore PIPE's exit status since STATUS above should contain all the ;; info we need. @@ -145,12 +160,21 @@ missing key." (_ #f))) status)) -(define (gnupg-receive-keys key-id server) - (system* (%gpg-command) "--keyserver" server "--recv-keys" key-id)) +(define* (gnupg-receive-keys key-id server + #:optional (keyring (current-keyring))) + (unless (file-exists? keyring) + (mkdir-p (dirname keyring)) + (call-with-output-file keyring (const #t))) ;create an empty keybox + + (system* (%gpg-command) "--keyserver" server + "--no-default-keyring" "--keyring" keyring + "--recv-keys" key-id)) (define* (gnupg-verify* sig file - #:key (key-download 'interactive) - (server (%openpgp-key-server))) + #:key + (key-download 'interactive) + (server (%openpgp-key-server)) + (keyring (current-keyring))) "Like `gnupg-verify', but try downloading the public key if it's missing. Return #t if the signature was good, #f otherwise. KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed values: 'always', 'never', @@ -161,15 +185,17 @@ and 'interactive' (default)." (define (download-and-try-again) ;; Download the missing key and try again. (begin - (gnupg-receive-keys missing server) - (gnupg-status-good-signature? (gnupg-verify sig file)))) + (gnupg-receive-keys missing server keyring) + (gnupg-status-good-signature? (gnupg-verify sig file + keyring)))) (define (receive?) (let ((answer - (begin (format #t (G_ "~a~a~%") - "Would you like to download this key " - "and add it to your keyring?") - (read-line)))) + (begin + (format #t (G_ "Would you like to add this key \ +to keyring '~a'?~%") + keyring) + (read-line)))) (string-match (locale-yes-regexp) answer))) (and missing diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index bcc23bd39c..58fc64db1f 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2015 Alex Kost @@ -89,6 +89,9 @@ (lambda (opt name arg result) (alist-cons 'list-dependent? #t result))) + (option '("keyring") #t #f + (lambda (opt name arg result) + (alist-cons 'keyring arg result))) (option '("key-server") #t #f (lambda (opt name arg result) (alist-cons 'key-server arg result))) @@ -138,6 +141,8 @@ specified with `--select'.\n")) -l, --list-dependent list top-level dependent packages that would need to be rebuilt as a result of upgrading PACKAGE...")) (newline) + (display (G_ " + --keyring=FILE use FILE as the keyring of upstream OpenPGP keys")) (display (G_ " --key-server=HOST use HOST as the OpenPGP key server")) (display (G_ " @@ -437,7 +442,11 @@ update would trigger a complete rebuild." (%openpgp-key-server))) (%gpg-command (or (assoc-ref opts 'gpg-command) - (%gpg-command)))) + (%gpg-command))) + (current-keyring + (or (assoc-ref opts 'keyring) + (string-append (config-directory) + "/upstream/trustedkeys.kbx")))) (for-each (cut update-package store <> updaters #:key-download key-download -- cgit v1.2.3 From 3809824199cdd52446176c9cd4761dd09f732542 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Sep 2018 22:00:26 +0200 Subject: store: Add missing buffer flushes. This could result in deadlock in unusual situations, whereby we'd start waiting for a reply while the query hasn't been flushed to the socket. * guix/store.scm (buffering-output-port)[flush]: Add call to 'force-output'. (add-to-store): Add call to 'write-buffered-output'. --- guix/store.scm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'guix') diff --git a/guix/store.scm b/guix/store.scm index af7f6980cf..cc5dcef247 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -770,6 +770,7 @@ bytevector) as its internal buffer, and a thunk to flush this output port." (define (flush) (put-bytevector port buffer 0 total) + (force-output port) (set! total 0)) (define (write bv offset count) @@ -927,6 +928,7 @@ path." (write-int (if recursive? 1 0) port) (write-string hash-algo port) (write-file file-name port #:select? select?) + (write-buffered-output server) (let loop ((done? (process-stderr server))) (or done? (loop (process-stderr server)))) (read-store-path port))))) -- cgit v1.2.3 From e83b2b0fdd2458242837b60d4da7f09802ca07a6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Sep 2018 22:02:31 +0200 Subject: git: Choose a saner default for '%repository-cache-directory'. * guix/git.scm (%repository-cache-directory): Use 'cache-directory' by default unless running as root. --- guix/git.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/git.scm b/guix/git.scm index 3d0eb93d9b..d007916662 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -36,7 +36,8 @@ latest-repository-commit)) (define %repository-cache-directory - (make-parameter "/var/cache/guix/checkouts")) + (make-parameter (string-append (cache-directory #:ensure? #f) + "/checkouts"))) (define-syntax-rule (with-libgit2 thunk ...) (begin -- cgit v1.2.3 From 000bbe02e21353f30c915d5b88f2de316d3634a1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 18 Sep 2018 21:37:23 +0200 Subject: store: Add another missing buffer flush. This is a followup to 3809824199cdd52446176c9cd4761dd09f732542. * guix/store.scm (add-file-tree-to-store): Add 'write-buffered-output' call. --- guix/store.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix') diff --git a/guix/store.scm b/guix/store.scm index cc5dcef247..f88cdefe87 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1044,6 +1044,7 @@ an arbitrary directory layout in the store without creating a derivation." #:file-port file-port #:symlink-target symlink-target #:directory-entries directory-entries) + (write-buffered-output server) (let loop ((done? (process-stderr server))) (or done? (loop (process-stderr server)))) (let ((result (read-store-path port))) -- cgit v1.2.3 From 912adda316886cef5f3f870e53d607bf8d02222f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 18 Sep 2018 22:49:41 +0200 Subject: describe: Work correctly on generation-less profiles. Previously a command like: $(readlink -f ~/.config/guix/current)/bin/guix describe would succeed without printing anything. * guix/scripts/describe.scm (display-profile-info): Don't call 'generation-file-name' when NUMBER is zero. * guix/scripts/pull.scm (display-profile-content): Likewise. --- guix/scripts/describe.scm | 6 ++++-- guix/scripts/pull.scm | 4 +++- 2 files changed, 7 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm index fdff07d0e3..c1a20fe26c 100644 --- a/guix/scripts/describe.scm +++ b/guix/scripts/describe.scm @@ -134,8 +134,10 @@ in the format specified by FMT." ;; Show most recently installed packages last. (reverse (manifest-entries - (profile-manifest (generation-file-name profile - number))))))))) + (profile-manifest + (if (zero? number) + profile + (generation-file-name profile number)))))))))) (display-package-search-path fmt)) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 976e054a84..c0686f16bf 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -233,7 +233,9 @@ way and displaying details about the channel's source code." ;; Show most recently installed packages last. (reverse (manifest-entries - (profile-manifest (generation-file-name profile number)))))) + (profile-manifest (if (zero? number) + profile + (generation-file-name profile number))))))) (define (indented-string str indent) "Return STR with each newline preceded by IDENT spaces." -- cgit v1.2.3 From 1d2b542d34ebec498d1424af81220a00ed0d6a24 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 18 Sep 2018 23:12:30 +0200 Subject: pull: Assume 'set-tls-certificate-locations!' is available. * guix/scripts/pull.scm (honor-lets-encrypt-certificates!): Call 'set-tls-certificate-locations!' unconditionally. --- guix/scripts/pull.scm | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) (limited to 'guix') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index c0686f16bf..04c8ef672f 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -176,17 +176,7 @@ Download and deploy the latest version of Guix.\n")) (certs (string-append (derivation->output-path drv) "/etc/ssl/certs"))) (build-derivations store (list drv)) - - ;; In the past Guile-Git would not provide this procedure. - (if (module-defined? (resolve-interface '(git)) - 'set-tls-certificate-locations!) - (set-tls-certificate-locations! certs) - (begin - ;; In this case we end up using whichever certificates OpenSSL - ;; chooses to use: $SSL_CERT_FILE, $SSL_CERT_DIR, or /etc/ssl/certs. - (warning (G_ "cannot enforce use of the Let's Encrypt \ -certificates~%")) - (warning (G_ "please upgrade Guile-Git~%")))))) + (set-tls-certificate-locations! certs))) (define (report-git-error error) "Report the given Guile-Git error." -- cgit v1.2.3 From 20f8d73face564deec2f21130fb465c8c3d9a8e9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 18 Sep 2018 23:19:18 +0200 Subject: pull: Use /etc/ssl/certs by default if it exists and is non-empty. Previously, on machines where /etc/ssl/certs did exist, we'd have this: $ unset SSL_CERT_DIR $ unset SSL_CERT_FILE $ guix pull Updating channel 'guix' from Git repository at 'https://git.savannah.gnu.org/git/guix.git'... guix pull: error: Git error: the SSL certificate is invalid This is because we'd let OpenSSL look for certificates in its default location, which is an empty directory in its own prefix. * guix/scripts/pull.scm (honor-x509-certificates): New procedure. (guix-pull): Use it instead of calling 'honor-lets-encrypt-certificates!'. --- guix/scripts/pull.scm | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 04c8ef672f..10e1a99e54 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -178,6 +178,17 @@ Download and deploy the latest version of Guix.\n")) (build-derivations store (list drv)) (set-tls-certificate-locations! certs))) +(define (honor-x509-certificates store) + "Use the right X.509 certificates for Git checkouts over HTTPS." + (let ((file (getenv "SSL_CERT_FILE")) + (directory (or (getenv "SSL_CERT_DIR") "/etc/ssl/certs"))) + (if (or (and file (file-exists? file)) + (and=> (stat directory #f) + (lambda (st) + (> (stat:nlink st) 2)))) + (set-tls-certificate-locations! directory file) + (honor-lets-encrypt-certificates! store)))) + (define (report-git-error error) "Report the given Guile-Git error." ;; Prior to Guile-Git commit b6b2760c2fd6dfaa5c0fedb43eeaff06166b3134, @@ -423,13 +434,7 @@ Use '~/.config/guix/channels.scm' instead.")) (parameterize ((%graft? (assoc-ref opts 'graft?)) (%repository-cache-directory cache)) (set-build-options-from-command-line store opts) - - ;; When certificates are already installed, use them. - ;; Otherwise, use the Let's Encrypt certificates, which we - ;; know Savannah uses. - (let ((certs (or (getenv "SSL_CERT_DIR") "/etc/ssl/certs"))) - (unless (file-exists? certs) - (honor-lets-encrypt-certificates! store))) + (honor-x509-certificates store) (let ((instances (latest-channel-instances store channels))) (format (current-error-port) -- cgit v1.2.3 From 7b6b7cdcc5d50cb25c140145b30028c5569c62af Mon Sep 17 00:00:00 2001 From: Andy Patterson Date: Thu, 30 Aug 2018 01:36:28 -0400 Subject: build-system/asdf: Handle all asdf dependency specifications. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add support for dependencies of the form (:version ), (:feature ) and (:require ), as defined by . * guix/build/lisp-utils.scm (normalize-dependency): New variable. (make-asd-file)[dependencies]: Use it to generate dependencies with normalized names. [dependency-name]: New variable. [registry]: Use it to flatten the normalized dependencies. Signed-off-by: Ludovic Courtès --- guix/build/lisp-utils.scm | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 21cb620d59..3a7afab43d 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -81,6 +81,20 @@ "Replace invalid characters in STR with a hyphen." (string-join (string-tokenize str valid-char-set) "-")) +(define (normalize-dependency dependency) + "Normalize the name of DEPENDENCY. Handles dependency definitions of the +dependency-def form described by +." + (match dependency + ((':version name rest ...) + `(:version ,(normalize-string name) ,@rest)) + ((':feature feature-specification dependency-specification) + `(:feature + ,feature-specification + ,(normalize-dependency dependency-specification))) + ((? string? name) (normalize-string name)) + (require-specification require-specification))) + (define (inputs->asd-file-map inputs) "Produce a hash table of the form (system . asd-file), where system is the name of an ASD system, and asd-file is the full path to its definition." @@ -273,16 +287,24 @@ system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS." (system-dependencies system system-asd-file))) (if (eq? 'NIL deps) '() - (map normalize-string deps)))) + (map normalize-dependency deps)))) (define lisp-input-map (inputs->asd-file-map inputs)) + (define dependency-name + (match-lambda + ((':version name _ ...) name) + ((':feature _ dependency-specification) + (dependency-name dependency-specification)) + ((? string? name) name) + (_ #f))) + (define registry (filter-map hash-get-handle (make-list (length dependencies) lisp-input-map) - dependencies)) + (map dependency-name dependencies))) (call-with-output-file asd-file (lambda (port) -- cgit v1.2.3 From 29a3ffb44623701c2c24b8e921e23d03dde02a4a Mon Sep 17 00:00:00 2001 From: Andy Patterson Date: Thu, 30 Aug 2018 01:36:29 -0400 Subject: build-system/asdf: Log lisp system invocations. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/lisp-system.scm: (lisp-eval-program): Log the arguments to system*. Signed-off-by: Ludovic Courtès --- guix/build/lisp-utils.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 3a7afab43d..9cf479dac5 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -119,9 +119,10 @@ name of an ASD system, and asd-file is the full path to its definition." (define (lisp-eval-program program) "Evaluate PROGRAM with a given LISP implementation." - (unless (zero? (apply system* - (lisp-invocation program))) - (error "lisp-eval-program failed!" (%lisp) program))) + (define invocation (lisp-invocation program)) + (format #t "Invoking ~a: ~{~s ~}~%" (%lisp-type) invocation) + (unless (zero? (apply system* invocation)) + (error "lisp-eval-program failed!" invocation))) (define (spread-statements program argument-name) "Return a list with the statements from PROGRAM spread between -- cgit v1.2.3 From e831a1668b0556068343dce8cecacef2014a96e9 Mon Sep 17 00:00:00 2001 From: Andy Patterson Date: Thu, 30 Aug 2018 01:36:30 -0400 Subject: build-system/asdf: Use invoke. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/lisp-utils.scm (lisp-eval-program): Replace system* and error handling with invoke. Signed-off-by: Ludovic Courtès --- guix/build/lisp-utils.scm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 9cf479dac5..7c0a68ca97 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -121,8 +121,7 @@ name of an ASD system, and asd-file is the full path to its definition." "Evaluate PROGRAM with a given LISP implementation." (define invocation (lisp-invocation program)) (format #t "Invoking ~a: ~{~s ~}~%" (%lisp-type) invocation) - (unless (zero? (apply system* invocation)) - (error "lisp-eval-program failed!" invocation))) + (apply invoke invocation)) (define (spread-statements program argument-name) "Return a list with the statements from PROGRAM spread between -- cgit v1.2.3 From 5f6908d664c3af6bd1805a769640ba5240602230 Mon Sep 17 00:00:00 2001 From: Andy Patterson Date: Thu, 30 Aug 2018 01:36:31 -0400 Subject: build-system/asdf: Adopt asdf conventions. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The asdf documentation specifies that asdf:load-asd should be preferred to calling load on a system definition file. * guix/build/lisp-utils.scm (compile-system): Replace load with asdf:load-asd. (system-dependencies): Likewise. (test-system): Likewise. Signed-off-by: Ludovic Courtès --- guix/build/lisp-utils.scm | 31 ++++++++++++++----------------- 1 file changed, 14 insertions(+), 17 deletions(-) (limited to 'guix') diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 7c0a68ca97..6470cfec97 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -152,8 +152,7 @@ with PROGRAM." first." (lisp-eval-program `((require :asdf) - (let ((*package* (find-package :asdf))) - (load ,asd-file)) + (asdf:load-asd (truename ,asd-file) :name ,(normalize-string system)) (asdf:operate 'asdf:compile-bundle-op ,system)))) (define (system-dependencies system asd-file) @@ -162,8 +161,7 @@ asdf:system-depends-on. First load the system's ASD-FILE." (define deps-file ".deps.sexp") (define program `((require :asdf) - (let ((*package* (find-package :asdf))) - (load ,asd-file)) + (asdf:load-asd (truename ,asd-file) :name ,(normalize-string system)) (with-open-file (stream ,deps-file :direction :output) (format stream @@ -203,19 +201,18 @@ asdf:system-depends-on. First load the system's ASD-FILE." Also load TEST-ASD-FILE if necessary." (lisp-eval-program `((require :asdf) - (let ((*package* (find-package :asdf))) - (load ,asd-file) - ,@(if test-asd-file - `((load ,test-asd-file)) - ;; Try some likely files. - (map (lambda (file) - `(when (uiop:file-exists-p ,file) - (load ,file))) - (list - (string-append system "-tests.asd") - (string-append system "-test.asd") - "tests.asd" - "test.asd")))) + (asdf:load-asd (truename ,asd-file) :name ,(normalize-string system)) + ,@(if test-asd-file + `((asdf:load-asd (truename ,test-asd-file))) + ;; Try some likely files. + (map (lambda (file) + `(when (uiop:file-exists-p ,file) + (asdf:load-asd (truename ,file)))) + (list + (string-append system "-tests.asd") + (string-append system "-test.asd") + "tests.asd" + "test.asd"))) (asdf:test-system ,system)))) (define (string->lisp-keyword . strings) -- cgit v1.2.3