From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms9.migadu.com with LMTPS id 6KU8MM5uPWRkSQEASxT56A (envelope-from ) for ; Mon, 17 Apr 2023 18:07:42 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id mNIUMM5uPWScRQAAauVa8A (envelope-from ) for ; Mon, 17 Apr 2023 18:07:42 +0200 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 8C75F319E5 for ; Mon, 17 Apr 2023 18:07:42 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1poQKs-0007CY-20; Mon, 17 Apr 2023 11:00:06 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1poQKp-0007Bk-1z for guix-patches@gnu.org; Mon, 17 Apr 2023 11:00:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1poQKo-0007Qe-Ok for guix-patches@gnu.org; Mon, 17 Apr 2023 11:00:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1poQKo-0000Tk-5l for guix-patches@gnu.org; Mon, 17 Apr 2023 11:00:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#61363] [PATCH v3] self: Apply grafts to the outputs of the guix derivation. References: <871qn08uo7.fsf@cbaines.net> In-Reply-To: <871qn08uo7.fsf@cbaines.net> Resent-From: Christopher Baines Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 17 Apr 2023 15:00:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 61363 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 61363@debbugs.gnu.org Cc: Christopher Baines Received: via spool by 61363-submit@debbugs.gnu.org id=B61363.16817435731776 (code B ref 61363); Mon, 17 Apr 2023 15:00:02 +0000 Received: (at 61363) by debbugs.gnu.org; 17 Apr 2023 14:59:33 +0000 Received: from localhost ([127.0.0.1]:55779 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1poQKK-0000Sa-Qf for submit@debbugs.gnu.org; Mon, 17 Apr 2023 10:59:33 -0400 Received: from mira.cbaines.net ([212.71.252.8]:42478) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1poQKI-0000SM-0x for 61363@debbugs.gnu.org; Mon, 17 Apr 2023 10:59:31 -0400 Received: from localhost (unknown [IPv6:2a02:8010:68c1:0:54d1:d5d4:280e:f699]) by mira.cbaines.net (Postfix) with ESMTPSA id DE37317923; Mon, 17 Apr 2023 15:59:28 +0100 (BST) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 92f05399; Mon, 17 Apr 2023 14:59:28 +0000 (UTC) From: Christopher Baines Date: Mon, 17 Apr 2023 15:59:28 +0100 Message-Id: <20230417145928.16693-1-mail@cbaines.net> X-Mailer: git-send-email 2.39.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: guix-patches-bounces+larch=yhetil.org@gnu.org X-Migadu-Flow: FLOW_IN X-Migadu-Country: US ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" ARC-Seal: i=1; s=key1; d=yhetil.org; t=1681747662; a=rsa-sha256; cv=none; b=DUY5gLsLftXyN6XRvNgnIkWjvtnR7xWRXi73y1VjSFx01nJSxZPmgpWtH5mOd9ZVBtmyyt pCABjU3B78K1lqrw4qUE5ydsfIzEBq/KVWCbDKTOf+MCRFnovy8fdt98q8+aPU+og7xaWv jIRQdQ7PB2snZyL9QepB5LY/8uhSXoZ0KerJwt+/LX6A9jYlPMtetGJ6epsWPAVm/Lj3kR eR4IWZPnXAweKlAtvX5EU5PmVI4ONy5Otd5KfUe4fqZdiUxyiEGCVo6zB7LnMvETzrxVHV kHiR5XUcymZwfKkq8PxuMJvrxqm0G3GbiW3Ykts7792r6tQxYmoptsA1h8XmDg== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1681747662; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post; bh=mcZAPSU1fXe4Vy/I7Bv5de6knE/0Huar+QflKon334Y=; b=GjosCTDIsiSRYcw8C8bLVCfMHUVaQcAP/qbppg3gMqiTEUjklHXIUS5OmzX+E7Hrr2MtqB QzSzMdo5meLpcMqt7WcSkSMr6mXxbXxMxJN1HQiVfsB+OxVn/JoNSMqQyAne1f3pQi/MV2 nskKi7nJZjuAsgzAC+p7417gNA/dVNBMRjzmP7b97joPyitPFtkpWBBMKXp7lLaHqGB6Eq 7LU8iFqXeeILHBoWRRZs7W2mweaZE2ZUa6uvnD7o0/KmOOw+kaKoFBmjs5aDtbXUvVusrB 2f5uZXP5FLeDY3FYyU5+MDGuAmWkjlMbJVa71nF3Yn34G/nSao2iybLWO7IjNQ== X-Migadu-Spam-Score: -2.01 X-Spam-Score: -2.01 X-Migadu-Queue-Id: 8C75F319E5 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Scanner: scn0.migadu.com X-TUID: 3ilXDhAHFZjQ 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 --- build-aux/build-self.scm | 4 +- guix/self.scm | 101 +++++++++++++++++++++++++++++++-------- 2 files changed, 84 insertions(+), 21 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 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 obj packages) + explicit-grafting? + (obj explicit-grafting-obj) ;obj + (packages explicit-grafting-packages)) ;list of s + +(define (write-explicit-grafting rec port) + (match rec + (($ obj packages) + (format port "#" obj packages)))) + +(define (explicit-grafting obj packages) + (%explicit-grafting obj packages)) + +(define-gexp-compiler (explicit-grafting-compiler (explicit-grafting ) + system target) + (match 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))))) -- 2.39.1