| Message ID | 20230417145928.16693-1-mail@cbaines.net |
|---|---|
| State | New |
| Headers | show |
| Series | [bug#61363,v3] self: Apply grafts to the outputs of the guix derivation. | expand |
Hi Chris, I am late to the party and probably do not well understand all that part. Just a quick comment in the same direction as Ludo. On Mon, 17 Apr 2023 at 15:59, Christopher Baines <mail@cbaines.net> wrote: > diff --git a/guix/self.scm b/guix/self.scm > index 74c953bd50..bbc0beaca8 100644 > --- a/guix/self.scm > +++ b/guix/self.scm [...] > + (if graft? > + (explicit-grafting obj > + (map (compose force cdr) %packages)) > + obj))) [...] > + (if graft? > + (explicit-grafting obj > + (map (compose force cdr) %packages)) > + obj))) It means that the grafts are only applied to %packages, right? Other said, defined by: --8<---------------cut here---------------start------------->8--- (define %packages (let ((ref (lambda (module variable) (delay (module-ref (resolve-interface `(gnu packages ,module)) variable))))) `(("guile" . ,(ref 'guile 'guile-3.0-latest)) ("guile-avahi" . ,(ref 'guile-xyz 'guile-avahi)) ("guile-json" . ,(ref 'guile 'guile-json-4)) ("guile-ssh" . ,(ref 'ssh 'guile-ssh)) ("guile-git" . ,(ref 'guile 'guile-git)) ("guile-semver" . ,(ref 'guile-xyz 'guile-semver)) ("guile-lib" . ,(ref 'guile-xyz 'guile-lib)) ("guile-sqlite3" . ,(ref 'guile 'guile-sqlite3)) ("guile-zlib" . ,(ref 'guile 'guile-zlib)) ("guile-lzlib" . ,(ref 'guile 'guile-lzlib)) ("guile-zstd" . ,(ref 'guile 'guile-zstd)) ("guile-gcrypt" . ,(ref 'gnupg 'guile-gcrypt)) ("guile-gnutls" . ,(ref 'tls 'guile-gnutls)) ("guix-daemon" . ,(ref 'package-management 'guix-daemon)) ("disarchive" . ,(ref 'backup 'disarchive)) ("guile-lzma" . ,(ref 'guile 'guile-lzma)) ("gzip" . ,(ref 'compression 'gzip)) ("bzip2" . ,(ref 'compression 'bzip2)) ("xz" . ,(ref 'compression 'xz)) ("po4a" . ,(ref 'gettext 'po4a)) ("gettext-minimal" . ,(ref 'gettext 'gettext-minimal)) ("gcc-toolchain" . ,(ref 'commencement 'gcc-toolchain)) ("glibc-utf8-locales" . ,(ref 'base 'glibc-utf8-locales)) ("graphviz" . ,(ref 'graphviz 'graphviz)) ("texinfo" . ,(ref 'texinfo 'texinfo))))) --8<---------------cut here---------------end--------------->8--- tweaked by e5c33837cbee98d460d9ae09b463501de6f15d97. And there is a slippery slope: the manual addition. These had been added with e5c33837cbee98d460d9ae09b463501de6f15d97: + ("glibc-utf8-locales" . ,(ref 'base 'glibc-utf8-locales)) + ("graphviz" . ,(ref 'graphviz 'graphviz)) + ("guix-daemon" . ,(ref 'package-management 'guix-daemon)) + ("texinfo" . ,(ref 'texinfo 'texinfo))))) Other said, what does it happen if we forget to manually update this list? Cheers, simon
Simon Tournier <zimon.toutoune@gmail.com> writes: > Hi Chris, > > I am late to the party and probably do not well understand all that > part. Just a quick comment in the same direction as Ludo. > > On Mon, 17 Apr 2023 at 15:59, Christopher Baines <mail@cbaines.net> wrote: > >> diff --git a/guix/self.scm b/guix/self.scm >> index 74c953bd50..bbc0beaca8 100644 >> --- a/guix/self.scm >> +++ b/guix/self.scm > > [...] > >> + (if graft? >> + (explicit-grafting obj >> + (map (compose force cdr) %packages)) >> + obj))) > > [...] > >> + (if graft? >> + (explicit-grafting obj >> + (map (compose force cdr) %packages)) >> + obj))) > > It means that the grafts are only applied to %packages, right? > > Other said, defined by: > > (define %packages > (let ((ref (lambda (module variable) > (delay > (module-ref (resolve-interface > `(gnu packages ,module)) > variable))))) > `(("guile" . ,(ref 'guile 'guile-3.0-latest)) > ("guile-avahi" . ,(ref 'guile-xyz 'guile-avahi)) > ("guile-json" . ,(ref 'guile 'guile-json-4)) > ("guile-ssh" . ,(ref 'ssh 'guile-ssh)) > ("guile-git" . ,(ref 'guile 'guile-git)) > ("guile-semver" . ,(ref 'guile-xyz 'guile-semver)) > ("guile-lib" . ,(ref 'guile-xyz 'guile-lib)) > ("guile-sqlite3" . ,(ref 'guile 'guile-sqlite3)) > ("guile-zlib" . ,(ref 'guile 'guile-zlib)) > ("guile-lzlib" . ,(ref 'guile 'guile-lzlib)) > ("guile-zstd" . ,(ref 'guile 'guile-zstd)) > ("guile-gcrypt" . ,(ref 'gnupg 'guile-gcrypt)) > ("guile-gnutls" . ,(ref 'tls 'guile-gnutls)) > ("guix-daemon" . ,(ref 'package-management 'guix-daemon)) > ("disarchive" . ,(ref 'backup 'disarchive)) > ("guile-lzma" . ,(ref 'guile 'guile-lzma)) > ("gzip" . ,(ref 'compression 'gzip)) > ("bzip2" . ,(ref 'compression 'bzip2)) > ("xz" . ,(ref 'compression 'xz)) > ("po4a" . ,(ref 'gettext 'po4a)) > ("gettext-minimal" . ,(ref 'gettext 'gettext-minimal)) > ("gcc-toolchain" . ,(ref 'commencement 'gcc-toolchain)) > ("glibc-utf8-locales" . ,(ref 'base 'glibc-utf8-locales)) > ("graphviz" . ,(ref 'graphviz 'graphviz)) > ("texinfo" . ,(ref 'texinfo 'texinfo))))) > > tweaked by e5c33837cbee98d460d9ae09b463501de6f15d97. And there is a > slippery slope: the manual addition. These had been added with > e5c33837cbee98d460d9ae09b463501de6f15d97: > > + ("glibc-utf8-locales" . ,(ref 'base 'glibc-utf8-locales)) > + ("graphviz" . ,(ref 'graphviz 'graphviz)) > + ("guix-daemon" . ,(ref 'package-management 'guix-daemon)) > + ("texinfo" . ,(ref 'texinfo 'texinfo))))) > > Other said, what does it happen if we forget to manually update this > list? Well, specification->package in (guix self) won't work for the missing packages. It's possible to use packages outside of this list, but that doesn't happen currently.
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm index 02822a2ee8..6d0037f20c 100644 --- a/build-aux/build-self.scm +++ b/build-aux/build-self.scm @@ -353,7 +353,9 @@ (define fake-git #:channel-metadata '#$channel-metadata #:pull-version - #$pull-version) + #$pull-version + #:graft? + #$(%graft?)) #:system system)) derivation-file-name)))))) #:module-path (list source)))) diff --git a/guix/self.scm b/guix/self.scm index 74c953bd50..bbc0beaca8 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -21,6 +21,7 @@ (define-module (guix self) #:use-module (guix config) #:use-module (guix modules) #:use-module (guix gexp) + #:use-module (guix grafts) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix discovery) @@ -31,6 +32,7 @@ (define-module (guix self) #:use-module ((guix build utils) #:select (find-files)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-35) #:use-module (ice-9 match) #:export (make-config.scm @@ -243,6 +245,50 @@ (define* (file-append* item file #:key (recursive? #t)) ;; which isn't great. (file-append item "/" file)))) +(define graft-derivation* + (store-lift graft-derivation)) + +(define package-grafts* + (store-lift package-grafts)) + +;; Apply grafts explicitly +(define-immutable-record-type <explicit-grafting> + (%explicit-grafting obj packages) + explicit-grafting? + (obj explicit-grafting-obj) ;obj + (packages explicit-grafting-packages)) ;list of <package>s + +(define (write-explicit-grafting rec port) + (match rec + (($ <explicit-grafting> obj packages) + (format port "#<explicit-grafting ~s ~s>" obj packages)))) + +(define (explicit-grafting obj packages) + (%explicit-grafting obj packages)) + +(define-gexp-compiler (explicit-grafting-compiler (explicit-grafting <explicit-grafting>) + system target) + (match explicit-grafting + (($ <explicit-grafting> obj packages) + (mlet* %store-monad ((drv (without-grafting + (lower-object obj system #:target target))) + (grafts + (mapm %store-monad + (lambda (pkg) + (package-grafts* pkg system #:target target)) + packages))) + (match (delete-duplicates + (concatenate grafts)) + (() + (return drv)) + (grafts + (mlet %store-monad ((guile (package->derivation + (guile-for-grafts) + system #:graft? #f))) + (graft-derivation* drv grafts + #:system system + #:guile guile)))))))) + (define* (locale-data source domain #:optional (directory domain)) "Return the locale data from 'po/DIRECTORY' in SOURCE, corresponding to @@ -753,7 +799,8 @@ (define* (compiled-guix source #:key (gzip (specification->package "gzip")) (bzip2 (specification->package "bzip2")) (xz (specification->package "xz")) - (guix (specification->package "guix"))) + (guix (specification->package "guix")) + (graft? #t)) "Return a file-like object that contains a compiled Guix." (define guile-avahi (specification->package "guile-avahi")) @@ -1023,25 +1070,34 @@ (define (built-modules node-subset) guile-lzma dependencies) #:guile guile-for-build - #:guile-version guile-version))) - (whole-package name modules dependencies - #:command command - #:guile guile-for-build - - ;; Include 'guix-daemon'. XXX: Here we inject an - ;; older snapshot of guix-daemon, but that's a good - ;; enough approximation for now. - #:daemon (specification->package "guix-daemon") - - #:info (info-manual source) - #:miscellany (miscellaneous-files source) - #:guile-version guile-version))) + #:guile-version guile-version)) + (obj + (whole-package name modules dependencies + #:command command + #:guile guile-for-build + + ;; Include 'guix-daemon'. XXX: Here we inject + ;; an older snapshot of guix-daemon, but + ;; that's a good enough approximation for now. + #:daemon (specification->package "guix-daemon") + + #:info (info-manual source) + #:miscellany (miscellaneous-files source) + #:guile-version guile-version))) + (if graft? + (explicit-grafting obj + (map (compose force cdr) %packages)) + obj))) ((= 0 pull-version) ;; Legacy 'guix pull': return the .scm and .go files as one ;; directory. - (built-modules (lambda (node) - (list (node-source node) - (node-compiled node))))) + (let ((obj (built-modules (lambda (node) + (list (node-source node) + (node-compiled node)))))) + (if graft? + (explicit-grafting obj + (map (compose force cdr) %packages)) + obj))) (else ;; Unsupported 'guix pull' version. #f))) @@ -1271,7 +1327,8 @@ (define (process-directory directory files output) (define* (guix-derivation source version #:optional (guile-version (effective-version)) #:key (pull-version 0) - channel-metadata) + channel-metadata + (graft? #t)) "Return, as a monadic value, the derivation to build the Guix from SOURCE for GUILE-VERSION. Use VERSION as the version string. Use CHANNEL-METADATA as the channel metadata sexp to include in (guix config). @@ -1308,7 +1365,11 @@ (define guile #:pull-version pull-version #:guile-version (if (>= pull-version 1) "3.0" guile-version) - #:guile-for-build guile))) + #:guile-for-build guile + #:graft? graft?))) (if guix - (lower-object guix) + (if graft? + (lower-object guix) + (without-grafting + (lower-object guix))) (return #f)))))
Rather than having grafts apply to the derivation itself. This moves grafting here to work like grafting for packages, where you can think of the grafted outputs as a transformed variant of the ungrafted outputs. I'm looking at this as it'll allow the Guix Data Service to compute the derivations without grafts, and for these to be useful for substitutes regardless of whether users are using grafts. * guix/self.scm (compiled-guix, guix-derivation): Add a #:graft? keyword argument, to control grafting when computing the guix derivation. * build-aux/build-self.scm (build-program): Call guix-derivation with #:graft? (%graft?) to make the compute-guix-derivation script use or not use grafts as desired. Signed-off-by: Christopher Baines <mail@cbaines.net> --- build-aux/build-self.scm | 4 +- guix/self.scm | 101 +++++++++++++++++++++++++++++++-------- 2 files changed, 84 insertions(+), 21 deletions(-)