Attached is a patch that attempts to build the manifest in an inferior. This fails because manifest->gexp returns a gexp that we can’t get out of the inferior to pass to build-profile.
So even more of the surrounding code would have to be evaluated in the inferior. @Ludo: your patch looks good to me. It’s a pragmatic, minimally invasive fix, so thumbs up emoji from me! Thank you! -- Ricardo
>From da3eaeea0d0082138284720dce60f6bdfc796f2b Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus <[email protected]> Date: Fri, 8 Jul 2022 08:40:27 +0200 Subject: [PATCH] channel stuff --- guix/channels.scm | 17 ++++++++-- guix/profiles.scm | 81 +++++++++++++++++++++++++++++++++++------------ 2 files changed, 75 insertions(+), 23 deletions(-) diff --git a/guix/channels.scm b/guix/channels.scm index ce1a60436f..45fba89685 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -896,6 +896,7 @@ (define (instance->entry instance drv) (define (package-cache-file manifest) "Build a package cache file for the instance in MANIFEST. This is meant to be used as a profile hook." + (pk 'package-cache-file manifest) (let ((profile (profile (content manifest) (hooks '())))) (define build #~(begin @@ -918,7 +919,12 @@ (define build (mkdir #$output)))) (gexp->derivation-in-inferior "guix-package-cache" build - profile + (pk 'guixx (manifest-entry-item + (manifest-lookup + manifest + (manifest-pattern + (name "guix"))))) + ;profile ;; If the Guix in PROFILE is too old and ;; lacks 'guix repl', don't build the cache @@ -936,8 +942,15 @@ (define %channel-profile-hooks (define (channel-instances->derivation instances) "Return the derivation of the profile containing INSTANCES, a list of channel instances." - (mlet %store-monad ((manifest (channel-instances->manifest instances))) + (mlet* %store-monad ((manifest (channel-instances->manifest instances)) + (drv -> (manifest-entry-item + (manifest-lookup + manifest + (manifest-pattern + (name "guix"))))) + (built (built-derivations (list drv)))) (profile-derivation manifest + #:inferior-guix (derivation->output-path drv) #:hooks %channel-profile-hooks))) (define latest-channel-instances* diff --git a/guix/profiles.scm b/guix/profiles.scm index 701852ae98..2d482cf91a 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -38,6 +38,10 @@ (define-module (guix profiles) #:use-module (guix records) #:use-module (guix packages) #:use-module (guix derivations) + #:autoload (guix inferior) (gexp->derivation-in-inferior + open-inferior + close-inferior + inferior-eval) #:use-module (guix search-paths) #:use-module (guix gexp) #:use-module (guix modules) @@ -1946,6 +1950,7 @@ (define* (profile-derivation manifest (allow-unsupported-packages? #f) (allow-collisions? #f) (relative-symlinks? #f) + (inferior-guix #f) system target) "Return a derivation that builds a profile (aka. 'user environment') with the given MANIFEST. The profile includes additional derivations returned by @@ -2013,6 +2018,33 @@ (define set-utf8-locale (package-version glibc-utf8-locales)))) (setlocale LC_ALL "en_US.utf8"))) + (define (manifest-gexp) + (pk 'man-gexp + (if inferior-guix + (let* ((inferior (open-inferior inferior-guix)) + (result + ;; TODO: this doesn't work because we can't lift the + ;; gexp out of the inferior. + (inferior-eval `(begin + (use-modules (guix profiles) + (guix derivations)) + ((@@ (guix profiles) manifest->gexp) + (manifest + (list + ,@(map (lambda (entry) + `(manifest-entry + (name ,(manifest-entry-name entry)) + (version ,(manifest-entry-version entry)) + (output ,(manifest-entry-output entry)) + (item (read-derivation-from-file + ,(derivation-file-name + (manifest-entry-item entry)))))) + (manifest-entries manifest)))))) + inferior))) + (close-inferior inferior) + result) + (manifest->gexp manifest)))) + (define builder (with-imported-modules '((guix build profiles) (guix build union) @@ -2031,32 +2063,39 @@ (define builder #+(if locales? set-utf8-locale #t) - (build-profile #$output '#$(manifest->gexp manifest) + (build-profile #$output '#$(manifest-gexp) #:extra-inputs '#$extra-inputs #:symlink #$(if relative-symlinks? #~symlink-relative #~symlink))))) - (gexp->derivation name builder - #:system system - #:target target - - ;; Don't complain about _IO* on Guile 2.2. - #:env-vars '(("GUILE_WARN_DEPRECATED" . "no")) - - ;; Not worth offloading. - #:local-build? #t - - ;; Disable substitution because it would trigger a - ;; connection to the substitute server, which is likely - ;; to have no substitute to offer. - #:substitutable? #f - - #:properties `((type . profile) - (profile - (count - . ,(length - (manifest-entries manifest)))))))) + (let ((proc (if inferior-guix + (lambda args + (apply gexp->derivation-in-inferior + name builder (pk 'inf inferior-guix) + args)) + (lambda args + (apply gexp->derivation + name builder args))))) + (proc #:system system + #:target target + + ;; Don't complain about _IO* on Guile 2.2. + #:env-vars '(("GUILE_WARN_DEPRECATED" . "no")) + + ;; Not worth offloading. + #:local-build? #t + + ;; Disable substitution because it would trigger a + ;; connection to the substitute server, which is likely + ;; to have no substitute to offer. + #:substitutable? #f + + #:properties `((type . profile) + (profile + (count + . ,(length + (manifest-entries manifest))))))))) ;; Declarative profile. (define-record-type* <profile> profile make-profile -- 2.36.1
