rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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 2020-03-25 15:01:15 +01:00
parent 2d5ee2c6e8
commit c74f19d758
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 61 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
guix/scripts/environment.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2018 David Thompson <davet@gnu.org> ;;; 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> ;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -364,19 +364,6 @@ for the corresponding packages."
opts) opts)
manifest-entry=?))) 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?) (define (manifest->derivation manifest system bootstrap?)
"Return the derivation for a profile of MANIFEST. "Return the derivation for a profile of MANIFEST.
BOOTSTRAP? specifies whether to use the bootstrap Guile to build the profile." 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-store store
(with-status-verbosity (assoc-ref opts 'verbosity) (with-build-handler (build-notifier #:use-substitutes?
(define manifest (assoc-ref opts 'substitutes?)
(options/resolve-packages store opts)) #: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. ;; Use the bootstrap Guile when requested.
(parameterize ((%graft? (assoc-ref opts 'graft?)) (parameterize ((%graft? (assoc-ref opts 'graft?))
(%guile-for-build (%guile-for-build
(package-derivation (package-derivation
store store
(if bootstrap? (if bootstrap?
%bootstrap-guile %bootstrap-guile
(canonical-package guile-2.2))))) (canonical-package guile-2.2)))))
(run-with-store store (run-with-store store
;; Containers need a Bourne shell at /bin/sh. ;; Containers need a Bourne shell at /bin/sh.
(mlet* %store-monad ((bash (environment-bash container? (mlet* %store-monad ((bash (environment-bash container?
bootstrap? bootstrap?
system)) system))
(prof-drv (manifest->derivation (prof-drv (manifest->derivation
manifest system bootstrap?)) manifest system bootstrap?))
(profile -> (derivation->output-path prof-drv)) (profile -> (derivation->output-path prof-drv))
(gc-root -> (assoc-ref opts 'gc-root))) (gc-root -> (assoc-ref opts 'gc-root)))
;; First build the inputs. This is necessary even for ;; First build the inputs. This is necessary even for
;; --search-paths. Additionally, we might need to build bash for ;; --search-paths. Additionally, we might need to build bash for
;; a container. ;; a container.
(mbegin %store-monad (mbegin %store-monad
(build-environment (if (derivation? bash) (built-derivations (if (derivation? bash)
(list prof-drv bash) (list prof-drv bash)
(list prof-drv)) (list prof-drv)))
opts) (mwhen gc-root
(mwhen gc-root (register-gc-root profile gc-root))
(register-gc-root profile gc-root))
(cond (cond
((assoc-ref opts 'dry-run?) ((assoc-ref opts 'search-paths)
(return #t)) (show-search-paths profile manifest #:pure? pure?)
((assoc-ref opts 'search-paths) (return #t))
(show-search-paths profile manifest #:pure? pure?) (container?
(return #t)) (let ((bash-binary
(container? (if bootstrap?
(let ((bash-binary (derivation->output-path bash)
(if bootstrap? (string-append (derivation->output-path bash)
(derivation->output-path bash) "/bin/sh"))))
(string-append (derivation->output-path bash) (launch-environment/container #:command command
"/bin/sh")))) #:bash bash-binary
(launch-environment/container #:command command #:user user
#:bash bash-binary #:user-mappings mappings
#:user user #:profile profile
#:user-mappings mappings #:manifest manifest
#:profile profile #:white-list white-list
#:manifest manifest #:link-profile? link-prof?
#:white-list white-list #:network? network?
#:link-profile? link-prof? #:map-cwd? (not no-cwd?))))
#:network? network?
#:map-cwd? (not no-cwd?))))
(else (else
(return (return
(exit/status (exit/status
(launch-environment/fork command profile manifest (launch-environment/fork command profile manifest
#:white-list white-list #:white-list white-list
#:pure? pure?)))))))))))))) #:pure? pure?)))))))))))))))