Browse Source

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'.
gn-latest-20200428
Ludovic Courtès 2 years ago
parent
commit
c74f19d758
No known key found for this signature in database GPG Key ID: 90B11993D9AEBB5
  1. 144
      guix/scripts/environment.scm

144
guix/scripts/environment.scm

@ -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))
(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)))
;; 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)))))
(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?)))))))))))))))
Loading…
Cancel
Save