summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorMarius Bakke <marius@gnu.org>2021-08-12 00:30:27 +0200
committerMarius Bakke <marius@gnu.org>2021-08-12 00:30:27 +0200
commitc4133c43c7cfe2476ebfae87f9e4d10d96de9bc7 (patch)
tree47bd773d2f434384b54e56916c1a287dd8e51511 /guix
parentffa01e68859bb7a6daa9fcffdc8d77ca35db4bc0 (diff)
parent4eb0a5146ae5a195a29c79f586fcc1e58f7fa69b (diff)
Merge branch 'master' into core-updates-frozen
Conflicts: gnu/packages/algebra.scm gnu/packages/games.scm gnu/packages/golang.scm gnu/packages/kerberos.scm gnu/packages/mail.scm gnu/packages/python.scm gnu/packages/ruby.scm gnu/packages/scheme.scm gnu/packages/tex.scm gnu/packages/tls.scm gnu/packages/version-control.scm
Diffstat (limited to 'guix')
-rw-r--r--guix/inferior.scm18
-rw-r--r--guix/licenses.scm1
-rw-r--r--guix/scripts/import/cpan.scm9
-rw-r--r--guix/scripts/import/cran.scm9
-rw-r--r--guix/scripts/import/crate.scm10
-rw-r--r--guix/scripts/import/egg.scm9
-rw-r--r--guix/scripts/import/elpa.scm9
-rw-r--r--guix/scripts/import/gem.scm9
-rw-r--r--guix/scripts/import/gnu.scm9
-rw-r--r--guix/scripts/import/go.scm9
-rw-r--r--guix/scripts/import/hackage.scm9
-rw-r--r--guix/scripts/import/json.scm9
-rw-r--r--guix/scripts/import/opam.scm9
-rw-r--r--guix/scripts/import/pypi.scm9
-rw-r--r--guix/scripts/import/stackage.scm9
-rw-r--r--guix/scripts/import/texlive.scm9
-rw-r--r--guix/scripts/publish.scm6
-rw-r--r--guix/scripts/time-machine.scm14
-rw-r--r--guix/self.scm15
-rw-r--r--guix/store.scm30
-rw-r--r--guix/transformations.scm45
21 files changed, 139 insertions, 117 deletions
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 7c8e478f2a..81958baaa5 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -48,7 +48,7 @@
#:use-module (gcrypt hash)
#:autoload (guix cache) (maybe-remove-expired-cache-entries
file-expiration-time)
- #:autoload (guix ui) (show-what-to-build*)
+ #:autoload (guix ui) (build-notifier)
#:autoload (guix build utils) (mkdir-p)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -801,8 +801,10 @@ determines whether CHANNELS are authenticated."
(profile
(channel-instances->derivation instances)))
(mbegin %store-monad
- (show-what-to-build* (list profile))
+ ;; It's up to the caller to install a build handler to report
+ ;; what's going to be built.
(built-derivations (list profile))
+
;; Note: Caching is fine even when AUTHENTICATE? is false because
;; we always call 'latest-channel-instances?'.
(symlink* (derivation->output-path profile) cached)
@@ -821,10 +823,14 @@ This is a convenience procedure that people may use in manifests passed to
'guix package -m', for instance."
(define cached
(with-store store
- (cached-channel-instance store
- channels
- #:cache-directory cache-directory
- #:ttl ttl)))
+ ;; XXX: Install a build notifier out of convenience, so users know
+ ;; what's going on. However, we cannot be sure that its options, such
+ ;; as #:use-substitutes?, correspond to the daemon's default settings.
+ (with-build-handler (build-notifier)
+ (cached-channel-instance store
+ channels
+ #:cache-directory cache-directory
+ #:ttl ttl))))
(open-inferior cached))
;;; Local Variables:
diff --git a/guix/licenses.scm b/guix/licenses.scm
index 388023e619..c071aae4a9 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -47,7 +47,6 @@
cc0
cc-by2.0 cc-by3.0 cc-by4.0
cc-by-sa2.0 cc-by-sa3.0 cc-by-sa4.0
- cc-sampling-plus-1.0
cddl1.0 cddl1.1
cecill cecill-b cecill-c
artistic2.0 clarified-artistic
diff --git a/guix/scripts/import/cpan.scm b/guix/scripts/import/cpan.scm
index 77ffe1f38e..bdf5a1e423 100644
--- a/guix/scripts/import/cpan.scm
+++ b/guix/scripts/import/cpan.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -66,12 +67,8 @@ Import and convert the CPAN package for PACKAGE-NAME.\n"))
(define (guix-import-cpan . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm
index aa3ef324e0..3e4b038cc4 100644
--- a/guix/scripts/import/cran.scm
+++ b/guix/scripts/import/cran.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015, 2017, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -86,12 +87,8 @@ Import and convert the CRAN package for PACKAGE-NAME.\n"))
(define (guix-import-cran . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
index 3a96defb86..97152904ac 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -75,13 +76,8 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
(define (guix-import-crate . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
-
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
diff --git a/guix/scripts/import/egg.scm b/guix/scripts/import/egg.scm
index 7dbd6fcd5a..829cdc2ca0 100644
--- a/guix/scripts/import/egg.scm
+++ b/guix/scripts/import/egg.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -71,12 +72,8 @@ Import and convert the egg package for PACKAGE-NAME.\n"))
(define (guix-import-egg . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(let* ((opts (parse-options))
(repo (and=> (assoc-ref opts 'repo) string->symbol))
diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm
index d6b38e5c4b..052b0cc0e7 100644
--- a/guix/scripts/import/elpa.scm
+++ b/guix/scripts/import/elpa.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -80,12 +81,8 @@ Import the latest package named PACKAGE-NAME from an ELPA repository.\n"))
(define (guix-import-elpa . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm
index c64596b514..65d2bf10b4 100644
--- a/guix/scripts/import/gem.scm
+++ b/guix/scripts/import/gem.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -73,12 +74,8 @@ Import and convert the RubyGems package for PACKAGE-NAME.\n"))
(define (guix-import-gem . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
diff --git a/guix/scripts/import/gnu.scm b/guix/scripts/import/gnu.scm
index ae98370037..344e363abe 100644
--- a/guix/scripts/import/gnu.scm
+++ b/guix/scripts/import/gnu.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -81,12 +82,8 @@ Return a package declaration template for PACKAGE, a GNU package.\n"))
(define (guix-import-gnu . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
diff --git a/guix/scripts/import/go.scm b/guix/scripts/import/go.scm
index 74e8e60cce..e08a1e427e 100644
--- a/guix/scripts/import/go.scm
+++ b/guix/scripts/import/go.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2020 Katherine Cox-Buday <cox.katherine.e@gmail.com>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -83,12 +84,8 @@ that are not yet in Guix"))
(define (guix-import-go . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm
index 906dca24b1..83128fb816 100644
--- a/guix/scripts/import/hackage.scm
+++ b/guix/scripts/import/hackage.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -105,12 +106,8 @@ version.\n"))
(define (guix-import-hackage . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(define (run-importer package-name opts error-fn)
(let* ((arguments (list
diff --git a/guix/scripts/import/json.scm b/guix/scripts/import/json.scm
index d8d5c3a4af..a3b5e6d79c 100644
--- a/guix/scripts/import/json.scm
+++ b/guix/scripts/import/json.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -74,12 +75,8 @@ Import and convert the JSON package definition in PACKAGE-FILE.\n"))
(define (guix-import-json . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm
index da9392821c..64164e7cc4 100644
--- a/guix/scripts/import/opam.scm
+++ b/guix/scripts/import/opam.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -76,12 +77,8 @@ Import and convert the opam package for PACKAGE-NAME.\n"))
(define (guix-import-opam . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(let* ((opts (parse-options))
(repo (and=> (assoc-ref opts 'repo) string->symbol))
diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm
index 33167174e2..9170a0b359 100644
--- a/guix/scripts/import/pypi.scm
+++ b/guix/scripts/import/pypi.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -72,12 +73,8 @@ Import and convert the PyPI package for PACKAGE-NAME.\n"))
(define (guix-import-pypi . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
diff --git a/guix/scripts/import/stackage.scm b/guix/scripts/import/stackage.scm
index d77328dcbf..211ac73ada 100644
--- a/guix/scripts/import/stackage.scm
+++ b/guix/scripts/import/stackage.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -89,12 +90,8 @@ Import and convert the LTS Stackage package for PACKAGE-NAME.\n"))
(define (guix-import-stackage . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(define (run-importer package-name opts error-fn)
(let* ((arguments (list
diff --git a/guix/scripts/import/texlive.scm b/guix/scripts/import/texlive.scm
index 1cceee7051..6f0818e274 100644
--- a/guix/scripts/import/texlive.scm
+++ b/guix/scripts/import/texlive.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -73,12 +74,8 @@ Import and convert the Texlive package for PACKAGE-NAME.\n"))
(define (guix-import-texlive . args)
(define (parse-options)
;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index f35f81dc34..913cbd4fda 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -320,7 +320,7 @@ with COMPRESSION, starting at NAR-PATH."
(format #f "URL: ~a~%Compression: ~a~%~@[FileSize: ~a~%~]"
url (compression-type compression) file-size)))
-(define* (narinfo-string store store-path key
+(define* (narinfo-string store store-path
#:key (compressions (list %no-compression))
(nar-path "nar") (file-sizes '()))
"Generate a narinfo key/value string for STORE-PATH; an exception is raised
@@ -414,7 +414,7 @@ appropriate duration. NAR-PATH specifies the prefix for nar URLs."
`((cache-control (max-age . ,ttl)))
'()))
(cut display
- (narinfo-string store store-path (%private-key)
+ (narinfo-string store store-path
#:nar-path nar-path
#:compressions compressions)
<>)))))
@@ -566,7 +566,6 @@ requested using POOL."
(single-baker item
;; Check whether CACHED has been produced in the meantime.
(unless (file-exists? cached)
- ;; (format #t "baking ~s~%" item)
(bake-narinfo+nar cache item
#:ttl ttl
#:compressions compressions
@@ -654,7 +653,6 @@ requested using POOL."
(with-store store
(let ((sizes (filter-map compressed-nar-size compression)))
(display (narinfo-string store item
- (%private-key)
#:nar-path nar-path
#:compressions compressions
#:file-sizes sizes)
diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
index 4aafd432e8..5179ea035f 100644
--- a/guix/scripts/time-machine.scm
+++ b/guix/scripts/time-machine.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Konrad Hinsen <konrad.hinsen@fastmail.net>
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -141,13 +141,19 @@ Execute COMMAND ARGS... in an older version of Guix.\n"))
(let* ((opts (parse-args args))
(channels (channel-list opts))
(command-line (assoc-ref opts 'exec))
+ (substitutes? (assoc-ref opts 'substitutes?))
(authenticate? (assoc-ref opts 'authenticate-channels?)))
(when command-line
(let* ((directory
(with-store store
(with-status-verbosity (assoc-ref opts 'verbosity)
- (set-build-options-from-command-line store opts)
- (cached-channel-instance store channels
- #:authenticate? authenticate?))))
+ (with-build-handler (build-notifier #:use-substitutes?
+ substitutes?
+ #:verbosity
+ (assoc-ref opts 'verbosity)
+ #:dry-run? #f)
+ (set-build-options-from-command-line store opts)
+ (cached-channel-instance store channels
+ #:authenticate? authenticate?)))))
(executable (string-append directory "/bin/guix")))
(apply execl (cons* executable executable command-line))))))))
diff --git a/guix/self.scm b/guix/self.scm
index 530632db7d..79d93357a2 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -872,7 +872,9 @@ itself."
;; rebuilt when the version changes, which in turn means we
;; can have substitutes for it.
#:extra-modules
- `(((guix config) => ,(make-config.scm)))
+ `(((guix config)
+ => ,(make-config.scm
+ #:config-variables %default-config-variables)))
;; (guix man-db) is needed at build-time by (guix profiles)
;; but we don't need to compile it; not compiling it allows
@@ -974,6 +976,8 @@ itself."
(list *core-package-modules* *package-modules*
*extra-modules* *system-modules* *core-modules*
*cli-modules*) ;for (guix scripts pack), etc.
+ #:extra-files (file-imports source "gnu/tests/data"
+ (const #t))
#:extensions dependencies
#:guile-for-build guile-for-build))
@@ -1082,10 +1086,17 @@ itself."
(variables rest ...))))))
(variables %localstatedir %storedir %sysconfdir)))
+(define %default-config-variables
+ ;; Default values of the configuration variables above.
+ `((%localstatedir . "/var")
+ (%storedir . "/gnu/store")
+ (%sysconfdir . "/etc")))
+
(define* (make-config.scm #:key gzip xz bzip2
(package-name "GNU Guix")
(package-version "0")
(channel-metadata #f)
+ (config-variables %config-variables)
(bug-report-address "bug-guix@gnu.org")
(home-page-url "https://guix.gnu.org"))
@@ -1115,7 +1126,7 @@ itself."
#$@(map (match-lambda
((name . value)
#~(define-public #$name #$value)))
- %config-variables)
+ config-variables)
(define %store-directory
(or (and=> (getenv "NIX_STORE_DIR") canonicalize-path)
diff --git a/guix/store.scm b/guix/store.scm
index 1ab2b08b47..0463b0e8fa 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1358,11 +1358,28 @@ on the build output of a previous derivation."
(define (map/accumulate-builds store proc lst)
"Apply PROC over each element of LST, accumulating 'build-things' calls and
coalescing them into a single call."
- (define result
- (map (lambda (obj)
- (with-build-handler build-accumulator
- (proc obj)))
- lst))
+ (define accumulation-cutoff
+ ;; Threshold above which we stop accumulating unresolved nodes to avoid
+ ;; pessimal behavior where we keep stumbling upon the same .drv build
+ ;; requests with many incoming edges. See <https://bugs.gnu.org/49439>.
+ 30)
+
+ (define-values (result rest)
+ (let loop ((lst lst)
+ (result '())
+ (unresolved 0))
+ (match lst
+ ((head . tail)
+ (match (with-build-handler build-accumulator
+ (proc head))
+ ((? unresolved? obj)
+ (if (> unresolved accumulation-cutoff)
+ (values (reverse (cons obj result)) tail)
+ (loop tail (cons obj result) (+ 1 unresolved))))
+ (obj
+ (loop tail (cons obj result) unresolved))))
+ (()
+ (values (reverse result) lst)))))
(match (append-map (lambda (obj)
(if (unresolved? obj)
@@ -1370,6 +1387,7 @@ coalescing them into a single call."
'()))
result)
(()
+ ;; REST is necessarily empty.
result)
(to-build
;; We've accumulated things TO-BUILD. Actually build them and resume the
@@ -1382,7 +1400,7 @@ coalescing them into a single call."
;; unnecessary.
((unresolved-continuation obj) #f)
obj))
- result))))
+ (append result rest)))))
(define build-things
(let ((build (operation (build-things (string-list things)
diff --git a/guix/transformations.scm b/guix/transformations.scm
index b0c09a0c92..5122baa403 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -460,19 +460,46 @@ to the same package but with #:strip-binaries? #f in its 'arguments' field."
(rewrite obj)
obj)))
+(define (patched-source name source patches)
+ "Return a file-like object with the given NAME that applies PATCHES to
+SOURCE. SOURCE must itself be a file-like object of any type, including
+<git-checkout>, <local-file>, etc."
+ (define patch
+ (module-ref (resolve-interface '(gnu packages base)) 'patch))
+
+ (computed-file name
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (setenv "PATH" #+(file-append patch "/bin"))
+
+ ;; XXX: Assume SOURCE is a directory. This is true in
+ ;; most practical cases, where it's a <git-checkout>.
+ (copy-recursively #+source #$output)
+ (chdir #$output)
+ (for-each (lambda (patch)
+ (invoke "patch" "-p1" "--batch"
+ "-i" patch))
+ '(#+@patches))))))
+
(define (transform-package-patches specs)
"Return a procedure that, when passed a package, returns a package with
additional patches."
(define (package-with-extra-patches p patches)
- (if (origin? (package-source p))
- (package/inherit p
- (source (origin
- (inherit (package-source p))
- (patches (append (map (lambda (file)
- (local-file file))
- patches)
- (origin-patches (package-source p)))))))
- p))
+ (let ((patches (map (lambda (file)
+ (local-file file))
+ patches)))
+ (if (origin? (package-source p))
+ (package/inherit p
+ (source (origin
+ (inherit (package-source p))
+ (patches (append patches
+ (origin-patches (package-source p)))))))
+ (package/inherit p
+ (source (patched-source (string-append (package-full-name p "-")
+ "-source")
+ (package-source p) patches))))))
(define (coalesce-alist alist)
;; Coalesce multiple occurrences of the same key in ALIST.