guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

01/03: Merge branch 'master' into core-updates


From: guix-commits
Subject: 01/03: Merge branch 'master' into core-updates
Date: Thu, 26 Mar 2020 19:43:40 -0400 (EDT)

mbakke pushed a commit to branch core-updates
in repository guix.

commit 18af6870370226b4d502d7372844e7f2aded5887
Merge: 0ab8ad4 3089b70
Author: Marius Bakke <address@hidden>
AuthorDate: Fri Mar 27 00:12:15 2020 +0100

    Merge branch 'master' into core-updates
    
     Conflicts:
        gnu/packages/icu4c.scm
        gnu/packages/man.scm
        gnu/packages/python-xyz.scm
        guix/scripts/environment.scm
        guix/scripts/pack.scm
        guix/scripts/package.scm
        guix/scripts/pull.scm
        guix/store.scm

 .dir-locals.el                                     |     1 +
 Makefile.am                                        |     1 -
 build-aux/hydra/evaluate.scm                       |    85 +-
 build-aux/hydra/gnu-system.scm                     |     2 +
 doc/guix.texi                                      |    30 +-
 etc/guix-install.sh                                |     6 +-
 etc/system-tests.scm                               |     6 +-
 gnu/build/linux-modules.scm                        |    46 +-
 gnu/installer.scm                                  |    14 +-
 gnu/installer/final.scm                            |    13 +-
 gnu/installer/tests.scm                            |    11 +-
 gnu/local.mk                                       |     5 +
 gnu/machine/ssh.scm                                |   142 +-
 gnu/packages/audio.scm                             |    78 +
 gnu/packages/autotools.scm                         |    28 +-
 gnu/packages/aux-files/emacs/guix-emacs.el         |     2 -
 .../aux-files/linux-libre/5.4-arm-veyron.conf      |  5040 ----
 gnu/packages/backup.scm                            |    34 +-
 gnu/packages/bioconductor.scm                      |    24 +-
 gnu/packages/bioinformatics.scm                    |   143 +-
 gnu/packages/bittorrent.scm                        |    13 +-
 gnu/packages/cpp.scm                               |     5 +-
 gnu/packages/cran.scm                              |   267 +-
 gnu/packages/databases.scm                         |     7 +-
 gnu/packages/debug.scm                             |   236 +-
 gnu/packages/distributed.scm                       |     9 +-
 gnu/packages/emacs-xyz.scm                         |   226 +-
 gnu/packages/emacs.scm                             |   161 +-
 gnu/packages/engineering.scm                       |    16 +-
 gnu/packages/finance.scm                           |    57 +-
 gnu/packages/fpga.scm                              |    44 +-
 gnu/packages/games.scm                             |    37 +-
 gnu/packages/geo.scm                               |   406 +-
 gnu/packages/gnome-xyz.scm                         |     4 +-
 gnu/packages/gnu-pw-mgr.scm                        |     3 +-
 gnu/packages/gnupg.scm                             |     3 +-
 gnu/packages/golang.scm                            |   237 +-
 gnu/packages/graph.scm                             |     4 +-
 gnu/packages/graphics.scm                          |     4 +-
 gnu/packages/guile-xyz.scm                         |     8 +
 gnu/packages/icu4c.scm                             |    12 +
 gnu/packages/linux.scm                             |    70 +-
 gnu/packages/lisp.scm                              |     1 +
 gnu/packages/mail.scm                              |    10 +-
 gnu/packages/man.scm                               |    12 +
 gnu/packages/maths.scm                             |     4 +-
 gnu/packages/music.scm                             |    80 +
 gnu/packages/nano.scm                              |     4 +-
 gnu/packages/ncurses.scm                           |     5 +-
 gnu/packages/parallel.scm                          |     6 +-
 gnu/packages/patches/circos-remove-findbin.patch   |   544 +
 gnu/packages/patches/gnupg-default-pinentry.patch  |    15 +
 gnu/packages/patches/icu4c-CVE-2020-10531.patch    |   127 +
 .../linux-libre-support-for-Pinebook-Pro.patch     |  1135 +
 gnu/packages/perl.scm                              |   120 +
 gnu/packages/python-crypto.scm                     |   174 +
 gnu/packages/python-web.scm                        |    26 +
 gnu/packages/python-xyz.scm                        |   377 +-
 gnu/packages/rdf.scm                               |     3 +
 gnu/packages/statistics.scm                        |    26 +-
 gnu/packages/version-control.scm                   |    10 +-
 gnu/packages/video.scm                             |    19 +-
 gnu/packages/virtualization.scm                    |    28 -
 gnu/packages/wm.scm                                |     6 +-
 gnu/packages/xdisorg.scm                           |   125 +-
 gnu/services/base.scm                              |    14 +-
 gnu/services/desktop.scm                           |    33 +-
 gnu/services/nfs.scm                               |    18 +-
 gnu/system.scm                                     |    17 +-
 gnu/system/examples/asus-c201.tmpl                 |     2 +-
 gnu/tests/install.scm                              |   237 +-
 gnu/tests/linux-modules.scm                        |   103 +
 gnu/tests/nfs.scm                                  |     2 +-
 guix/build-system/linux-module.scm                 |   162 +-
 guix/build/download.scm                            |     7 +
 guix/build/emacs-utils.scm                         |    13 +-
 guix/build/linux-module-build-system.scm           |    17 +-
 guix/build/syscalls.scm                            |    64 +-
 guix/cache.scm                                     |     9 +-
 guix/import/cran.scm                               |    97 +-
 guix/import/crate.scm                              |     2 +-
 guix/licenses.scm                                  |    12 +
 guix/lint.scm                                      |    50 +-
 guix/packages.scm                                  |     8 +-
 guix/profiles.scm                                  |    58 +-
 guix/progress.scm                                  |     9 +-
 guix/scripts/archive.scm                           |    50 +-
 guix/scripts/build.scm                             |   118 +-
 guix/scripts/copy.scm                              |    89 +-
 guix/scripts/deploy.scm                            |    55 +-
 guix/scripts/environment.scm                       |   142 +-
 guix/scripts/lint.scm                              |    38 +-
 guix/scripts/pack.scm                              |   208 +-
 guix/scripts/package.scm                           |    33 +-
 guix/scripts/pull.scm                              |   137 +-
 guix/scripts/substitute.scm                        |     7 -
 guix/scripts/system.scm                            |    98 +-
 guix/scripts/weather.scm                           |     7 -
 guix/ssh.scm                                       |    22 +-
 guix/status.scm                                    |    10 +-
 guix/store.scm                                     |    75 +-
 guix/ui.scm                                        |   157 +-
 po/doc/guix-manual.de.po                           | 23650 ++++++++++-------
 po/doc/guix-manual.es.po                           | 23607 ++++++++++-------
 po/doc/guix-manual.ru.po                           | 22331 +++++++++-------
 po/guix/da.po                                      |  4263 +--
 po/guix/de.po                                      |  2964 ++-
 po/guix/es.po                                      |  3655 +--
 po/packages/de.po                                  | 26023 ++++++++++++++++++-
 tests/cache.scm                                    |     9 +-
 tests/guix-package.sh                              |     3 +-
 tests/store.scm                                    |    34 +-
 tests/ui.scm                                       |     4 +-
 113 files changed, 79704 insertions(+), 39416 deletions(-)

diff --cc gnu/packages/icu4c.scm
index 61e252c,3869016..88f97ef
--- a/gnu/packages/icu4c.scm
+++ b/gnu/packages/icu4c.scm
@@@ -36,7 -34,30 +36,8 @@@
  (define-public icu4c
    (package
     (name "icu4c")
+    (replacement icu4c/fixed)
 -   (version "64.2")
 +   (version "66.1")
     (source (origin
              (method url-fetch)
              (uri (string-append
@@@ -93,25 -106,17 +94,36 @@@ C/C++ part."
     (license x11)
     (home-page "http://site.icu-project.org/";)))
  
 +(define-public icu4c-build-root
 +  (package
 +    (inherit icu4c)
 +    (name "icu4c-build-root")
 +    (arguments
 +     (substitute-keyword-arguments (package-arguments icu4c)
 +       ((#:tests? _ '())
 +        #f)
 +       ((#:out-of-source? _ '())
 +        #t)
 +       ((#:phases phases)
 +        `(modify-phases ,phases
 +           (replace 'install
 +             (lambda* (#:key outputs #:allow-other-keys)
 +               (let ((out (assoc-ref outputs "out")))
 +                 (copy-recursively "../build" out)
 +                 #t)))))))
 +    (native-inputs '())))
 +
+ (define icu4c/fixed
+   (package
+     (inherit icu4c)
+     (source (origin
+               (inherit (package-source icu4c))
+               (patch-flags '("-p2"))
+               (patches (append
+                          (origin-patches (package-source icu4c))
+                          (search-patches
+                            "icu4c-CVE-2020-10531.patch")))))))
+ 
  (define-public java-icu4j
    (package
      (name "java-icu4j")
diff --cc gnu/packages/ncurses.scm
index 52819e9,a969f3f..ec0fc6a
--- a/gnu/packages/ncurses.scm
+++ b/gnu/packages/ncurses.scm
@@@ -5,8 -5,9 +5,9 @@@
  ;;; Copyright © 2016 ng0 <address@hidden>
  ;;; Copyright © 2016 Efraim Flashner <address@hidden>
  ;;; Copyright © 2016 Jan Nieuwenhuizen <address@hidden>
 -;;; Copyright © 2017, 2019 Marius Bakke <address@hidden>
 +;;; Copyright © 2017, 2019, 2020 Marius Bakke <address@hidden>
  ;;; Copyright © 2018, 2019 Tobias Geerinckx-Rice <address@hidden>
+ ;;; Copyright © 2020 Michael Rohleder <address@hidden>
  ;;;
  ;;; This file is part of GNU Guix.
  ;;;
diff --cc gnu/packages/perl.scm
index b990aba,eb02d5e..590945c
--- a/gnu/packages/perl.scm
+++ b/gnu/packages/perl.scm
@@@ -22,9 -22,9 +22,10 @@@
  ;;; Copyright © 2018, 2019 Pierre Neidhardt <address@hidden>
  ;;; Copyright © 2018 Kei Kebreau <address@hidden>
  ;;; Copyright © 2019 Alex Griffin <address@hidden>
 +;;; Copyright © 2019 Mathieu Othacehe <address@hidden>
  ;;; Copyright © 2019 Stephen J. Scheck <address@hidden>
  ;;; Copyright © 2020 Vincent Legoll <address@hidden>
+ ;;; Copyright © 2020 Paul Garlick <address@hidden>
  ;;;
  ;;; This file is part of GNU Guix.
  ;;;
diff --cc gnu/packages/python-xyz.scm
index 7b4db5f,f4b50ab..8617f63
--- a/gnu/packages/python-xyz.scm
+++ b/gnu/packages/python-xyz.scm
@@@ -65,9 -65,8 +65,9 @@@
  ;;; Copyright © 2019 Jacob MacDonald <address@hidden>
  ;;; Copyright © 2019 Giacomo Leidi <address@hidden>
  ;;; Copyright © 2019 Wiktor Żelazny <address@hidden>
- ;;; Copyright © 2019 Tanguy Le Carrour <address@hidden>
+ ;;; Copyright © 2019, 2020 Tanguy Le Carrour <address@hidden>
  ;;; Copyright © 2019 Mădălin Ionel Patrașcu <address@hidden>
 +;;; Copyright © 2020 Riku Viitanen <address@hidden>
  ;;; Copyright © 2020 Jakub Kądziołka <address@hidden>
  ;;; Copyright © 2020 sirgazil <address@hidden>
  ;;; Copyright © 2020 Sebastian Schott <address@hidden>
@@@ -16777,10 -16789,14 +16890,15 @@@ that is accessible to other projects de
          (base32
           "0fm0w5id2yhqld95hg2m636vjgkz377rvgdfqaxc25vbylr9lklp"))))
      (build-system python-build-system)
 -    (native-inputs
 -     `(("python-tox" ,python-tox)))
 +    (arguments
 +     ;; FIXME: Tests require many extra dependencies, and would introduce
 +     ;; a circular dependency on hypothesis, which uses this package.
 +     '(#:tests? #f))
+     (propagated-inputs
+      `(("python-appdirs" ,python-appdirs)
+        ("python-distlib" ,python-distlib)
+        ("python-filelock" ,python-filelock)
 -       ("python-importlib-metadata" ,python-importlib-metadata) ;; python < 
3.8
 -       ("python-six" ,python-six)))
++       ("python-six" ,python-six-bootstrap)))
      (home-page "http://www.grantjenks.com/docs/sortedcontainers/";)
      (synopsis "Sorted List, Sorted Dict, Sorted Set")
      (description
diff --cc guix/scripts/environment.scm
index e2fe805,ca12346..e6f45d3
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@@ -718,67 -707,68 +705,68 @@@ message if any test fails.
  
  
        (with-store store
-         (with-status-verbosity (assoc-ref opts 'verbosity)
-           (define manifest
-             (options/resolve-packages store opts))
- 
-           (set-build-options-from-command-line store opts)
- 
-           ;; Use the bootstrap Guile when requested.
-           (parameterize ((%graft? (assoc-ref opts 'graft?))
-                          (%guile-for-build
-                           (package-derivation
-                            store
-                            (if bootstrap?
-                                %bootstrap-guile
-                                (default-guile)))))
-             (run-with-store store
-               ;; Containers need a Bourne shell at /bin/sh.
-               (mlet* %store-monad ((bash       (environment-bash container?
-                                                                  bootstrap?
-                                                                  system))
-                                    (prof-drv   (manifest->derivation
-                                                 manifest system bootstrap?))
-                                    (profile -> (derivation->output-path 
prof-drv))
-                                    (gc-root -> (assoc-ref opts 'gc-root)))
- 
-                 ;; First build the inputs.  This is necessary even for
-                 ;; --search-paths.  Additionally, we might need to build bash 
for
-                 ;; a container.
-                 (mbegin %store-monad
-                   (build-environment (if (derivation? bash)
-                                          (list prof-drv bash)
-                                          (list prof-drv))
-                                      opts)
-                   (mwhen gc-root
-                     (register-gc-root profile gc-root))
- 
-                   (cond
-                    ((assoc-ref opts 'dry-run?)
-                     (return #t))
-                    ((assoc-ref opts 'search-paths)
-                     (show-search-paths profile manifest #:pure? pure?)
-                     (return #t))
-                    (container?
-                     (let ((bash-binary
-                            (if bootstrap?
-                                (derivation->output-path bash)
-                                (string-append (derivation->output-path bash)
-                                               "/bin/sh"))))
-                       (launch-environment/container #:command command
-                                                     #:bash bash-binary
-                                                     #:user user
-                                                     #:user-mappings mappings
-                                                     #:profile profile
-                                                     #:manifest manifest
-                                                     #:white-list white-list
-                                                     #:link-profile? link-prof?
-                                                     #:network? network?
-                                                     #:map-cwd? (not 
no-cwd?))))
- 
-                    (else
-                     (return
-                      (exit/status
-                       (launch-environment/fork command profile manifest
-                                                #:white-list white-list
-                                                #:pure? pure?))))))))))))))
+         (with-build-handler (build-notifier #:use-substitutes?
+                                             (assoc-ref opts 'substitutes?)
+                                             #:dry-run?
+                                             (assoc-ref opts 'dry-run?))
+           (with-status-verbosity (assoc-ref opts 'verbosity)
+             (define manifest
+               (options/resolve-packages store opts))
+ 
+             (set-build-options-from-command-line store opts)
+ 
+             ;; Use the bootstrap Guile when requested.
+             (parameterize ((%graft? (assoc-ref opts 'graft?))
+                            (%guile-for-build
+                             (package-derivation
+                              store
+                              (if bootstrap?
+                                  %bootstrap-guile
 -                                 (canonical-package guile-2.2)))))
++                                 (default-guile)))))
+               (run-with-store store
+                 ;; Containers need a Bourne shell at /bin/sh.
+                 (mlet* %store-monad ((bash       (environment-bash container?
+                                                                    bootstrap?
+                                                                    system))
+                                      (prof-drv   (manifest->derivation
+                                                   manifest system bootstrap?))
+                                      (profile -> (derivation->output-path 
prof-drv))
+                                      (gc-root -> (assoc-ref opts 'gc-root)))
+ 
+                   ;; First build the inputs.  This is necessary even for
+                   ;; --search-paths.  Additionally, we might need to build 
bash for
+                   ;; a container.
+                   (mbegin %store-monad
+                     (built-derivations (if (derivation? bash)
+                                            (list prof-drv bash)
+                                            (list prof-drv)))
+                     (mwhen gc-root
+                       (register-gc-root profile gc-root))
+ 
+                     (cond
+                      ((assoc-ref opts 'search-paths)
+                       (show-search-paths profile manifest #:pure? pure?)
+                       (return #t))
+                      (container?
+                       (let ((bash-binary
+                              (if bootstrap?
+                                  (derivation->output-path bash)
+                                  (string-append (derivation->output-path bash)
+                                                 "/bin/sh"))))
+                         (launch-environment/container #:command command
+                                                       #:bash bash-binary
+                                                       #:user user
+                                                       #:user-mappings mappings
+                                                       #:profile profile
+                                                       #:manifest manifest
+                                                       #:white-list white-list
+                                                       #:link-profile? 
link-prof?
+                                                       #:network? network?
+                                                       #:map-cwd? (not 
no-cwd?))))
+ 
+                      (else
+                       (return
+                        (exit/status
+                         (launch-environment/fork command profile manifest
+                                                  #:white-list white-list
+                                                  #:pure? pure?)))))))))))))))
diff --cc guix/scripts/pack.scm
index 045fd16,b6fb738..9d981c0
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@@ -1022,108 -1026,106 +1026,106 @@@ Create a bundle of PACKAGE.\n")
          ;; Set the build options before we do anything else.
          (set-build-options-from-command-line store opts)
  
-         (parameterize ((%graft? (assoc-ref opts 'graft?))
-                        (%guile-for-build (package-derivation
-                                           store
-                                           (if (assoc-ref opts 'bootstrap?)
-                                               %bootstrap-guile
-                                               (default-guile))
-                                           (assoc-ref opts 'system)
-                                           #:graft? (assoc-ref opts 'graft?))))
-           (let* ((dry-run?    (assoc-ref opts 'dry-run?))
-                  (derivation? (assoc-ref opts 'derivation-only?))
-                  (relocatable? (assoc-ref opts 'relocatable?))
-                  (proot?      (eq? relocatable? 'proot))
-                  (manifest    (let ((manifest (manifest-from-args store 
opts)))
-                                 ;; Note: We cannot honor '--bootstrap' here 
because
-                                 ;; 'glibc-bootstrap' lacks 'libc.a'.
-                                 (if relocatable?
-                                     (map-manifest-entries
-                                      (cut wrapped-manifest-entry <> #:proot? 
proot?)
-                                      manifest)
-                                     manifest)))
-                  (pack-format (assoc-ref opts 'format))
-                  (name        (string-append (symbol->string pack-format)
-                                              "-pack"))
-                  (target      (assoc-ref opts 'target))
-                  (bootstrap?  (assoc-ref opts 'bootstrap?))
-                  (compressor  (if bootstrap?
-                                   bootstrap-xz
-                                   (assoc-ref opts 'compressor)))
-                  (archiver    (if (equal? pack-format 'squashfs)
-                                   squashfs-tools
-                                   (if bootstrap?
-                                       %bootstrap-coreutils&co
-                                       tar)))
-                  (symlinks    (assoc-ref opts 'symlinks))
-                  (build-image (match (assq-ref %formats pack-format)
-                                 ((? procedure? proc) proc)
-                                 (#f
-                                  (leave (G_ "~a: unknown pack format~%")
-                                         pack-format))))
-                  (localstatedir? (assoc-ref opts 'localstatedir?))
-                  (entry-point    (assoc-ref opts 'entry-point))
-                  (profile-name   (assoc-ref opts 'profile-name))
-                  (gc-root        (assoc-ref opts 'gc-root)))
-             (define (lookup-package package)
-               (manifest-lookup manifest (manifest-pattern (name package))))
- 
-             (when (null? (manifest-entries manifest))
-               (warning (G_ "no packages specified; building an empty 
pack~%")))
- 
-             (when (and (eq? pack-format 'squashfs)
-                        (not (any lookup-package '("bash" "bash-minimal"))))
-               (warning (G_ "Singularity requires you to provide a shell~%"))
-               (display-hint (G_ "Add @code{bash} or @code{bash-minimal} \
+         (with-build-handler (build-notifier #:dry-run?
+                                             (assoc-ref opts 'dry-run?)
+                                             #:use-substitutes?
+                                             (assoc-ref opts 'substitutes?))
+           (parameterize ((%graft? (assoc-ref opts 'graft?))
+                          (%guile-for-build (package-derivation
+                                             store
+                                             (if (assoc-ref opts 'bootstrap?)
+                                                 %bootstrap-guile
 -                                                (canonical-package guile-2.2))
++                                                (default-guile))
+                                             (assoc-ref opts 'system)
+                                             #:graft? (assoc-ref opts 
'graft?))))
+             (let* ((derivation? (assoc-ref opts 'derivation-only?))
+                    (relocatable? (assoc-ref opts 'relocatable?))
+                    (proot?      (eq? relocatable? 'proot))
+                    (manifest    (let ((manifest (manifest-from-args store 
opts)))
+                                   ;; Note: We cannot honor '--bootstrap' here 
because
+                                   ;; 'glibc-bootstrap' lacks 'libc.a'.
+                                   (if relocatable?
+                                       (map-manifest-entries
+                                        (cut wrapped-manifest-entry <> 
#:proot? proot?)
+                                        manifest)
+                                       manifest)))
+                    (pack-format (assoc-ref opts 'format))
+                    (name        (string-append (symbol->string pack-format)
+                                                "-pack"))
+                    (target      (assoc-ref opts 'target))
+                    (bootstrap?  (assoc-ref opts 'bootstrap?))
+                    (compressor  (if bootstrap?
+                                     bootstrap-xz
+                                     (assoc-ref opts 'compressor)))
+                    (archiver    (if (equal? pack-format 'squashfs)
+                                     squashfs-tools
+                                     (if bootstrap?
+                                         %bootstrap-coreutils&co
+                                         tar)))
+                    (symlinks    (assoc-ref opts 'symlinks))
+                    (build-image (match (assq-ref %formats pack-format)
+                                   ((? procedure? proc) proc)
+                                   (#f
+                                    (leave (G_ "~a: unknown pack format~%")
+                                           pack-format))))
+                    (localstatedir? (assoc-ref opts 'localstatedir?))
+                    (entry-point    (assoc-ref opts 'entry-point))
+                    (profile-name   (assoc-ref opts 'profile-name))
+                    (gc-root        (assoc-ref opts 'gc-root)))
+               (define (lookup-package package)
+                 (manifest-lookup manifest (manifest-pattern (name package))))
+ 
+               (when (null? (manifest-entries manifest))
+                 (warning (G_ "no packages specified; building an empty 
pack~%")))
+ 
+               (when (and (eq? pack-format 'squashfs)
+                          (not (any lookup-package '("bash" "bash-minimal"))))
+                 (warning (G_ "Singularity requires you to provide a shell~%"))
+                 (display-hint (G_ "Add @code{bash} or @code{bash-minimal} \
  to your package list.")))
  
-             (run-with-store store
-               (mlet* %store-monad ((profile (profile-derivation
-                                              manifest
- 
-                                              ;; Always produce relative
-                                              ;; symlinks for Singularity (see
-                                              ;; <https://bugs.gnu.org/34913>).
-                                              #:relative-symlinks?
-                                              (or relocatable?
-                                                  (eq? 'squashfs pack-format))
- 
-                                              #:hooks (if bootstrap?
-                                                          '()
-                                                          
%default-profile-hooks)
-                                              #:locales? (not bootstrap?)
-                                              #:target target))
-                                    (drv (build-image name profile
-                                                      #:target
-                                                      target
-                                                      #:compressor
-                                                      compressor
-                                                      #:symlinks
-                                                      symlinks
-                                                      #:localstatedir?
-                                                      localstatedir?
-                                                      #:entry-point
-                                                      entry-point
-                                                      #:profile-name
-                                                      profile-name
-                                                      #:archiver
-                                                      archiver)))
-                 (mbegin %store-monad
-                   (munless derivation?
-                     (show-what-to-build* (list drv)
-                                          #:use-substitutes?
-                                          (assoc-ref opts 'substitutes?)
-                                          #:dry-run? dry-run?))
-                   (mwhen derivation?
-                     (return (format #t "~a~%"
-                                     (derivation-file-name drv))))
-                   (munless (or derivation? dry-run?)
-                     (built-derivations (list drv))
-                     (mwhen gc-root
-                       (register-root* (match (derivation->output-paths drv)
-                                         (((names . items) ...)
-                                          items))
-                                       gc-root))
-                     (return (format #t "~a~%"
-                                     (derivation->output-path drv))))))
-               #:system (assoc-ref opts 'system))))))))
+               (run-with-store store
+                 (mlet* %store-monad ((profile (profile-derivation
+                                                manifest
+ 
+                                                ;; Always produce relative
+                                                ;; symlinks for Singularity 
(see
+                                                ;; 
<https://bugs.gnu.org/34913>).
+                                                #:relative-symlinks?
+                                                (or relocatable?
+                                                    (eq? 'squashfs 
pack-format))
+ 
+                                                #:hooks (if bootstrap?
+                                                            '()
+                                                            
%default-profile-hooks)
+                                                #:locales? (not bootstrap?)
+                                                #:target target))
+                                      (drv (build-image name profile
+                                                        #:target
+                                                        target
+                                                        #:compressor
+                                                        compressor
+                                                        #:symlinks
+                                                        symlinks
+                                                        #:localstatedir?
+                                                        localstatedir?
+                                                        #:entry-point
+                                                        entry-point
+                                                        #:profile-name
+                                                        profile-name
+                                                        #:archiver
+                                                        archiver)))
+                   (mbegin %store-monad
+                     (mwhen derivation?
+                       (return (format #t "~a~%"
+                                       (derivation-file-name drv))))
+                     (munless derivation?
+                       (built-derivations (list drv))
+                       (mwhen gc-root
+                         (register-root* (match (derivation->output-paths drv)
+                                           (((names . items) ...)
+                                            items))
+                                         gc-root))
+                       (return (format #t "~a~%"
+                                       (derivation->output-path drv))))))
+                 #:system (assoc-ref opts 'system)))))))))
diff --cc guix/scripts/package.scm
index bdddc11,110d4f2..8af0a7a
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@@ -949,10 -940,14 +938,14 @@@ option processing with 'parse-command-l
                         (%graft? (assoc-ref opts 'graft?)))
            (with-status-verbosity (assoc-ref opts 'verbosity)
              (set-build-options-from-command-line (%store) opts)
-             (parameterize ((%guile-for-build
-                             (package-derivation
-                              (%store)
-                              (if (assoc-ref opts 'bootstrap?)
-                                  %bootstrap-guile
-                                  (default-guile)))))
-               (process-actions (%store) opts)))))))
+             (with-build-handler (build-notifier #:use-substitutes?
+                                                 (assoc-ref opts 'substitutes?)
+                                                 #:dry-run?
+                                                 (assoc-ref opts 'dry-run?))
+               (parameterize ((%guile-for-build
+                               (package-derivation
+                                (%store)
+                                (if (assoc-ref opts 'bootstrap?)
+                                    %bootstrap-guile
 -                                   (canonical-package guile-2.2)))))
++                                   (default-guile)))))
+                 (process-actions (%store) opts))))))))
diff --cc guix/scripts/pull.scm
index 1c54560,b7e0a4a..dbd0243
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@@ -773,38 -759,37 +759,37 @@@ Use '~/.config/guix/channels.scm' inste
                  (with-status-verbosity (assoc-ref opts 'verbosity)
                    (parameterize ((%current-system (assoc-ref opts 'system))
                                   (%graft? (assoc-ref opts 'graft?)))
-                     (set-build-options-from-command-line store opts)
-                     (ensure-default-profile)
-                     (honor-x509-certificates store)
- 
-                     (let ((instances (latest-channel-instances store 
channels)))
-                       (format (current-error-port)
-                               (N_ "Building from this channel:~%"
-                                   "Building from these channels:~%"
-                                   (length instances)))
-                       (for-each (lambda (instance)
-                                   (let ((channel
-                                          (channel-instance-channel instance)))
-                                     (format (current-error-port)
-                                             "  ~10a~a\t~a~%"
-                                             (channel-name channel)
-                                             (channel-url channel)
-                                             (string-take
-                                              (channel-instance-commit 
instance)
-                                              7))))
-                                 instances)
-                       (parameterize ((%guile-for-build
-                                       (package-derivation
-                                        store
-                                        (if (assoc-ref opts 'bootstrap?)
-                                            %bootstrap-guile
-                                            (default-guile)))))
-                         (with-profile-lock profile
-                           (run-with-store store
-                             (build-and-install instances profile
-                                                #:dry-run?
-                                                (assoc-ref opts 'dry-run?)
-                                                #:use-substitutes?
-                                                (assoc-ref opts 
'substitutes?)))))))))))))))
+                     (with-build-handler (build-notifier #:use-substitutes?
+                                                         substitutes?
+                                                         #:dry-run? dry-run?)
+                       (set-build-options-from-command-line store opts)
+                       (ensure-default-profile)
+                       (honor-x509-certificates store)
+ 
+                       (let ((instances (latest-channel-instances store 
channels)))
+                         (format (current-error-port)
+                                 (N_ "Building from this channel:~%"
+                                     "Building from these channels:~%"
+                                     (length instances)))
+                         (for-each (lambda (instance)
+                                     (let ((channel
+                                            (channel-instance-channel 
instance)))
+                                       (format (current-error-port)
+                                               "  ~10a~a\t~a~%"
+                                               (channel-name channel)
+                                               (channel-url channel)
+                                               (string-take
+                                                (channel-instance-commit 
instance)
+                                                7))))
+                                   instances)
+                         (parameterize ((%guile-for-build
+                                         (package-derivation
+                                          store
+                                          (if (assoc-ref opts 'bootstrap?)
+                                              %bootstrap-guile
 -                                             (canonical-package guile-2.2)))))
++                                             (default-guile)))))
+                           (with-profile-lock profile
+                             (run-with-store store
+                               (build-and-install instances 
profile)))))))))))))))
  
  ;;; pull.scm ends here
diff --cc guix/store.scm
index d42f76f,fdaae27..5dea264
--- a/guix/store.scm
+++ b/guix/store.scm
@@@ -103,8 -103,8 +103,9 @@@
              add-text-to-store
              add-to-store
              add-file-tree-to-store
 +            file-mapping->tree
              binary-file
+             with-build-handler
              build-things
              build
              query-failed-paths
@@@ -1223,45 -1223,46 +1224,85 @@@ an arbitrary directory layout in the st
              (hash-set! cache tree result)
              result)))))
  
 +(define (file-mapping->tree mapping)
 +  "Convert MAPPING, an alist like:
 +
 +  ((\"guix/build/utils.scm\" . \"…/utils.scm\"))
 +
 +to a tree suitable for 'add-file-tree-to-store' and 'interned-file-tree'."
 +  (let ((mapping (map (match-lambda
 +                        ((destination . source)
 +                         (cons (string-tokenize destination %not-slash)
 +                               source)))
 +                      mapping)))
 +    (fold (lambda (pair result)
 +            (match pair
 +              ((destination . source)
 +               (let loop ((destination destination)
 +                          (result result))
 +                 (match destination
 +                   ((file)
 +                    (let* ((mode (stat:mode (stat source)))
 +                           (type (if (zero? (logand mode #o100))
 +                                     'regular
 +                                     'executable)))
 +                      (alist-cons file
 +                                  `(,type (file ,source))
 +                                  result)))
 +                   ((file rest ...)
 +                    (let ((directory (assoc-ref result file)))
 +                      (alist-cons file
 +                                  `(directory
 +                                    ,@(loop rest
 +                                            (match directory
 +                                              (('directory . entries) entries)
 +                                              (#f '()))))
 +                                  (if directory
 +                                      (alist-delete file result)
 +                                      result)))))))))
 +          '()
 +          mapping)))
 +
+ (define current-build-prompt
+   ;; When true, this is the prompt to abort to when 'build-things' is called.
+   (make-parameter #f))
+ 
+ (define (call-with-build-handler handler thunk)
+   "Register HANDLER as a \"build handler\" and invoke THUNK."
+   (define tag
+     (make-prompt-tag "build handler"))
+ 
+   (parameterize ((current-build-prompt tag))
+     (call-with-prompt tag
+       thunk
+       (lambda (k . args)
+         ;; Since HANDLER may call K, which in turn may call 'build-things'
+         ;; again, reinstate a prompt (thus, it's not a tail call.)
+         (call-with-build-handler handler
+                                  (lambda ()
+                                    (apply handler k args)))))))
+ 
+ (define (invoke-build-handler store things mode)
+   "Abort to 'current-build-prompt' if it is set."
+   (or (not (current-build-prompt))
+       (abort-to-prompt (current-build-prompt) store things mode)))
+ 
+ (define-syntax-rule (with-build-handler handler exp ...)
+   "Register HANDLER as a \"build handler\" and invoke THUNK.  When
+ 'build-things' is called within the dynamic extent of the call to THUNK,
+ HANDLER is invoked like so:
+ 
+   (HANDLER CONTINUE STORE THINGS MODE)
+ 
+ where CONTINUE is the continuation, and the remaining arguments are those that
+ were passed to 'build-things'.
+ 
+ Build handlers are useful to announce a build plan with 'show-what-to-build'
+ and to implement dry runs (by not invoking CONTINUE) in a way that gracefully
+ deals with \"dynamic dependencies\" such as grafts---derivations that depend
+ on the build output of a previous derivation."
+   (call-with-build-handler handler (lambda () exp ...)))
+ 
  (define build-things
    (let ((build (operation (build-things (string-list things)
                                          (integer mode))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]