environment: Use 'with-build-handler'.
* guix/scripts/environment.scm (build-environment): Remove. (guix-environment): Wrap 'with-status-verbosity' in 'with-build-handler'. Remove 'dry-run?' conditional. Use 'built-derivations' instead of 'build-environment'.
This commit is contained in:
Ludovic Courtès
parent
2d5ee2c6e8
commit
c74f19d758
|
|
@ -1,6 +1,6 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2014, 2015, 2018 David Thompson <davet@gnu.org>
|
||||
;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
|
|
@ -364,19 +364,6 @@ for the corresponding packages."
|
|||
opts)
|
||||
manifest-entry=?)))
|
||||
|
||||
(define* (build-environment derivations opts)
|
||||
"Build the DERIVATIONS required by the environment using the build options
|
||||
in OPTS."
|
||||
(let ((substitutes? (assoc-ref opts 'substitutes?))
|
||||
(dry-run? (assoc-ref opts 'dry-run?)))
|
||||
(mbegin %store-monad
|
||||
(show-what-to-build* derivations
|
||||
#:use-substitutes? substitutes?
|
||||
#:dry-run? dry-run?)
|
||||
(if dry-run?
|
||||
(return #f)
|
||||
(built-derivations derivations)))))
|
||||
|
||||
(define (manifest->derivation manifest system bootstrap?)
|
||||
"Return the derivation for a profile of MANIFEST.
|
||||
BOOTSTRAP? specifies whether to use the bootstrap Guile to build the profile."
|
||||
|
|
@ -720,67 +707,68 @@ message if any test fails."
|
|||
|
||||
|
||||
(with-store store
|
||||
(with-status-verbosity (assoc-ref opts 'verbosity)
|
||||
(define manifest
|
||||
(options/resolve-packages store opts))
|
||||
(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)
|
||||
(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)))))
|
||||
(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)))
|
||||
;; 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)))))
|
||||
(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))
|
||||
;; 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 '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?))))
|
||||
(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?))))))))))))))
|
||||
(else
|
||||
(return
|
||||
(exit/status
|
||||
(launch-environment/fork command profile manifest
|
||||
#:white-list white-list
|
||||
#:pure? pure?)))))))))))))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue