#61363 [PATCH 0/2] self: Apply grafts to the outputs of the guix derivation.

Message #11 received at 61363@debbugs.gnu.org (full text, mbox, reply):

Received: (at 61363) by debbugs.gnu.org; 8 Feb 2023 07:54:08 +0000
From debbugs-submit-bounces@debbugs.gnu.org Wed Feb 08 02:54:08 2023
Received: from localhost ([127.0.0.1]:54685 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces@debbugs.gnu.org>)
	id 1pPfHL-00009H-Jt
	for submit@debbugs.gnu.org; Wed, 08 Feb 2023 02:54:08 -0500
Received: from mira.cbaines.net ([212.71.252.8]:42178)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <mail@cbaines.net>) id 1pPfHJ-000092-JQ
 for 61363@debbugs.gnu.org; Wed, 08 Feb 2023 02:54:06 -0500
Received: from localhost (unknown [IPv6:2a02:1808:280:f63d:f055:17e:cfb4:3])
 by mira.cbaines.net (Postfix) with ESMTPSA id D08DF16D3C
 for <61363@debbugs.gnu.org>; Wed,  8 Feb 2023 07:54:04 +0000 (GMT)
Received: from localhost (localhost [local])
 by localhost (OpenSMTPD) with ESMTPA id d7e7ca6f
 for <61363@debbugs.gnu.org>; Wed, 8 Feb 2023 07:54:03 +0000 (UTC)
From: Christopher Baines <mail@cbaines.net>
To: 61363@debbugs.gnu.org
Subject: [PATCH 2/2] self: Apply grafts to the outputs of the guix derivation.
Date: Wed,  8 Feb 2023 08:54:03 +0100
Message-Id: <20230208075403.11788-2-mail@cbaines.net>
X-Mailer: git-send-email 2.38.1
In-Reply-To: <20230208075403.11788-1-mail@cbaines.net>
References: <20230208075403.11788-1-mail@cbaines.net>
MIME-Version: 1.0
X-Debbugs-Cc: zimon.toutoune@gmail.com
X-Debbugs-Cc: dev@jpoiret.xyz
X-Debbugs-Cc: rekado@elephly.net
X-Debbugs-Cc: othacehe@gnu.org
X-Debbugs-Cc: ludo@gnu.org
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.0 (/)
X-Debbugs-Envelope-To: 61363
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request@debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit@debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request@debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request@debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces@debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

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.
---
 build-aux/build-self.scm |  4 ++-
 guix/self.scm            | 65 ++++++++++++++++++++++++++--------------
 2 files changed, 45 insertions(+), 24 deletions(-)

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 93019e1c64..c944dbe9ce 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -752,7 +752,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"))
@@ -802,6 +803,12 @@ (define dependencies
                       guile-json guile-semver guile-ssh guile-sqlite3
                       guile-lib guile-zlib guile-lzlib guile-zstd)))
 
+  (define packages
+    (cons* gzip
+           bzip2
+           xz
+           dependencies))
+
   (define *core-modules*
     (scheme-node "guix-core"
                  '((guix)
@@ -1022,28 +1029,35 @@ (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 (module-ref (resolve-interface
-                                                '(gnu packages
-                                                      package-management))
-                                               '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 (module-ref (resolve-interface
+                                                      '(gnu packages
+                                                            package-management))
+                                                     'guix-daemon)
+
+                                #:info (info-manual source)
+                                #:miscellany (miscellaneous-files source)
+                                #:guile-version guile-version)))
+           (if graft?
+               (explicit-grafting obj 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 packages)
+               obj)))
         (else
          ;; Unsupported 'guix pull' version.
          #f)))
@@ -1273,7 +1287,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).
@@ -1310,7 +1325,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)))))
-- 
2.38.1

Send a report that this bug log contains spam.