unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Christopher Baines <mail@cbaines.net>
To: 71038@debbugs.gnu.org
Cc: "Christopher Baines" <guix@cbaines.net>,
	"Josselin Poiret" <dev@jpoiret.xyz>,
	"Ludovic Courtès" <ludo@gnu.org>,
	"Mathieu Othacehe" <othacehe@gnu.org>,
	"Simon Tournier" <zimon.toutoune@gmail.com>,
	"Tobias Geerinckx-Rice" <me@tobias.gr>
Subject: [bug#71038] [PATCH v2 2/2] guix: channels: Enable specifiying available builtin builders.
Date: Mon, 24 Jun 2024 14:43:46 +0100	[thread overview]
Message-ID: <319c7822ef542dc412d55af616ecbeb86b005c8b.1719236626.git.mail@cbaines.net> (raw)
In-Reply-To: <d854d02c05c91c4e5558b0785f4b0a77e3b781f4.1719236626.git.mail@cbaines.net>

When computing channel instance derivations.

This is useful when you want to generate compatible derivations that can be
run with a daemon that potentially doesn't support builtin builders that the
daemon you're using to generate the derivations has.

I'm looking at this in particular because I want to use this in the data
service, since it provides substitutes for derivations, and since these can be
built on other machines, it's useful to control which builtin builders they
depend on.

Fixes: <https://issues.guix.gnu.org/67250>.

* build-aux/build-self.scm (build-program): Accept
 #:assume-available-builtin-builders and pass along to port->connection or
open-connection as approriate.
(build): Accept and pass on #:assume-available-builtin-builders.
* guix/channels.scm (build-from-source, build-channel-instance,
channel-instance-derivations, channel-instances->manifest,
channel-instances->derivation): Accept and pass on
 #:assume-available-builtin-builders.

Change-Id: I315c990de66c6f7dca25a859165a5568abe385ea
---
 build-aux/build-self.scm | 33 ++++++++++++++------
 guix/channels.scm        | 67 ++++++++++++++++++++++++++++++----------
 2 files changed, 74 insertions(+), 26 deletions(-)

diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index 02822a2ee8..c14bebd0b1 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -241,8 +241,12 @@ (define guile-gcrypt
 
 (define* (build-program source version
                         #:optional (guile-version (effective-version))
-                        #:key (pull-version 0) (channel-metadata #f))
-  "Return a program that computes the derivation to build Guix from SOURCE."
+                        #:key (pull-version 0) (channel-metadata #f)
+                        assume-available-builtin-builders)
+  "Return a program that computes the derivation to build Guix from SOURCE.
+If ASSUME-AVAILABLE-BUILTIN-BUILDERS is provided, it should be a list of
+strings and this will be used instead of the builtin builders provided by the
+build daemon, from within the generated build program."
   (define select?
     ;; Select every module but (guix config) and non-Guix modules.
     ;; Also exclude (guix channels): it is autoloaded by (guix describe), but
@@ -331,11 +335,20 @@ (define* (build-program source version
                          ;; case, attempt to open a new connection.
                          (let* ((proto (string->number protocol-version))
                                 (store (if (integer? proto)
-                                           (port->connection (duplicate-port
-                                                              (current-input-port)
-                                                              "w+0")
-                                                             #:version proto)
-                                           (open-connection)))
+                                           (port->connection
+                                            (duplicate-port
+                                             (current-input-port)
+                                             "w+0")
+                                            #:version proto
+                                            #$@(if assume-available-builtin-builders
+                                                   #~(#:assume-available-builtin-builders
+                                                      '(#$@assume-available-builtin-builders))
+                                                   '()))
+                                           (open-connection
+                                            #$@(if assume-available-builtin-builders
+                                                   #~(#:assume-available-builtin-builders
+                                                      '(#$@assume-available-builtin-builders))
+                                                   '()))))
                                 (sock  (socket AF_UNIX SOCK_STREAM 0)))
                            ;; Connect to BUILD-OUTPUT and send it the raw
                            ;; build output.
@@ -406,7 +419,7 @@ (define* (build source
                 (guile-version (if (> pull-version 0)
                                    "3.0"
                                    (effective-version)))
-
+                assume-available-builtin-builders
                 #:allow-other-keys
                 #:rest rest)
   "Return a derivation that unpacks SOURCE into STORE and compiles Scheme
@@ -415,7 +428,9 @@ (define* (build source
   ;; SOURCE.
   (mlet %store-monad ((build  (build-program source version guile-version
                                              #:channel-metadata channel-metadata
-                                             #:pull-version pull-version))
+                                             #:pull-version pull-version
+                                             #:assume-available-builtin-builders
+                                             assume-available-builtin-builders))
                       (system (if system (return system) (current-system)))
                       (home -> (getenv "HOME"))
 
diff --git a/guix/channels.scm b/guix/channels.scm
index 0d7bc541cc..dfdf6cfe3f 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -704,11 +704,15 @@ (define (with-trivial-build-handler mvalue)
               store))))
 
 (define* (build-from-source instance
-                            #:key core verbose? (dependencies '()) system)
+                            #:key core verbose? (dependencies '()) system
+                            assume-available-builtin-builders)
   "Return a derivation to build Guix from INSTANCE, using the self-build
 script contained therein.  When CORE is true, build package modules under
 SOURCE using CORE, an instance of Guix.  By default, build for the current
-system, or SYSTEM if specified."
+system, or SYSTEM if specified.  If ASSUME-AVAILABLE-BUILTIN-BUILDERS is
+provided, it should be a list of strings and this will be used instead of the
+builtin builders provided by the build daemon for store connections used
+during this process."
   (define name
     (symbol->string
      (channel-name (channel-instance-channel instance))))
@@ -750,20 +754,28 @@ (define* (build-from-source instance
                   #:verbose? verbose? #:version commit
                   #:system system
                   #:channel-metadata (channel-instance->sexp instance)
-                  #:pull-version %pull-version))))
+                  #:pull-version %pull-version
+                  #:assume-available-builtin-builders
+                  assume-available-builtin-builders))))
 
       ;; Build a set of modules that extend Guix using the standard method.
       (standard-module-derivation name source core dependencies)))
 
 (define* (build-channel-instance instance system
-                                 #:optional core (dependencies '()))
+                                 #:optional core (dependencies '())
+                                 #:key assume-available-builtin-builders)
   "Return, as a monadic value, the derivation for INSTANCE, a channel
 instance, for SYSTEM.  DEPENDENCIES is a list of extensions providing Guile
-modules that INSTANCE depends on."
+modules that INSTANCE depends on.  If ASSUME-AVAILABLE-BUILTIN-BUILDERS is
+provided, it should be a list of strings and this will be used instead of the
+builtin builders provided by the build daemon for store connections used
+during this process."
   (build-from-source instance
                      #:core core
                      #:dependencies dependencies
-                     #:system system))
+                     #:system system
+                     #:assume-available-builtin-builders
+                     assume-available-builtin-builders))
 
 (define (resolve-dependencies instances)
   "Return a procedure that, given one of the elements of INSTANCES, returns
@@ -793,9 +805,13 @@ (define (resolve-dependencies instances)
   (lambda (instance)
     (vhash-foldq* cons '() instance edges)))
 
-(define* (channel-instance-derivations instances #:key system)
+(define* (channel-instance-derivations instances #:key system
+                                       assume-available-builtin-builders)
   "Return the list of derivations to build INSTANCES, in the same order as
-INSTANCES.  Build for the current system by default, or SYSTEM if specified."
+INSTANCES.  Build for the current system by default, or SYSTEM if specified.
+If ASSUME-AVAILABLE-BUILTIN-BUILDERS is provided, it should be a list of
+strings and this will be used instead of the builtin builders provided by the
+build daemon for store connections used during this process."
   (define core-instance
     ;; The 'guix' channel is treated specially: it's an implicit dependency of
     ;; all the other channels.
@@ -809,11 +825,15 @@ (define* (channel-instance-derivations instances #:key system)
   (define (instance->derivation instance)
     (mlet %store-monad ((system (if system (return system) (current-system))))
       (mcached (if (eq? instance core-instance)
-                   (build-channel-instance instance system)
+                   (build-channel-instance instance system
+                                           #:assume-available-builtin-builders
+                                           assume-available-builtin-builders)
                    (mlet %store-monad ((core (instance->derivation core-instance))
                                        (deps (mapm %store-monad instance->derivation
                                                    (edges instance))))
-                     (build-channel-instance instance system core deps)))
+                     (build-channel-instance instance system core deps
+                                             #:assume-available-builtin-builders
+                                             assume-available-builtin-builders)))
                instance
                system)))
 
@@ -915,10 +935,13 @@ (define (channel-instance->sexp instance)
                     intro))))))
             '()))))
 
-(define* (channel-instances->manifest instances #:key system)
+(define* (channel-instances->manifest instances #:key system
+                                      assume-available-builtin-builders)
   "Return a profile manifest with entries for all of INSTANCES, a list of
 channel instances.  By default, build for the current system, or SYSTEM if
-specified."
+specified.  If ASSUME-AVAILABLE-BUILTIN-BUILDERS is provided, it should be a
+list of strings and this will be used instead of the builtin builders provided
+by the build daemon for store connections used during this process."
   (define (instance->entry instance drv)
     (let ((commit  (channel-instance-commit instance))
           (channel (channel-instance-channel instance)))
@@ -934,8 +957,11 @@ (define* (channel-instances->manifest instances #:key system)
         (properties
          `((source ,(channel-instance->sexp instance)))))))
 
-  (mlet* %store-monad ((derivations (channel-instance-derivations instances
-                                                                  #:system system))
+  (mlet* %store-monad ((derivations (channel-instance-derivations
+                                     instances
+                                     #:system system
+                                     #:assume-available-builtin-builders
+                                     assume-available-builtin-builders))
                        (entries ->  (map instance->entry instances derivations)))
     (return (manifest entries))))
 
@@ -990,10 +1016,17 @@ (define %channel-profile-hooks
   ;; The default channel profile hooks.
   (cons package-cache-file %default-profile-hooks))
 
-(define (channel-instances->derivation instances)
+(define* (channel-instances->derivation instances
+                                        #:key assume-available-builtin-builders)
   "Return the derivation of the profile containing INSTANCES, a list of
-channel instances."
-  (mlet %store-monad ((manifest (channel-instances->manifest instances)))
+channel instances.  If ASSUME-AVAILABLE-BUILTIN-BUILDERS is provided, it
+should be a list of strings and this will be used instead of the builtin
+builders provided by the build daemon for store connections used during this
+process."
+  (mlet %store-monad ((manifest (channel-instances->manifest
+                                 instances
+                                 #:assume-available-builtin-builders
+                                 assume-available-builtin-builders)))
     ;; Emit a profile in format version so that, if INSTANCES denotes an old
     ;; Guix, it can still read that profile, for instance for the purposes of
     ;; 'guix describe'.
-- 
2.45.1





  reply	other threads:[~2024-06-24 13:44 UTC|newest]

Thread overview: 20+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2024-05-18 13:11 [bug#71038] [PATCH 0/2] Enable specifying the available builtin builders Christopher Baines
2024-05-18 13:19 ` [bug#71038] [PATCH 1/2] guix: store: " Christopher Baines
2024-05-18 13:19   ` [bug#71038] [PATCH 2/2] guix: channels: Enable specifiying " Christopher Baines
2024-05-22 10:58   ` [bug#71038] [PATCH 1/2] guix: store: Enable specifying the " Simon Tournier
2024-05-26  8:10     ` Christopher Baines
2024-05-27 17:19       ` Simon Tournier
2024-06-11 19:26         ` Christopher Baines
2024-06-24 13:43 ` [bug#71038] [PATCH v2 " Christopher Baines
2024-06-24 13:43   ` Christopher Baines [this message]
2024-07-04  9:17     ` [bug#71038] [PATCH v2 2/2] guix: channels: Enable specifiying " Ludovic Courtès
2024-07-04  9:14   ` [bug#71038] [PATCH v2 1/2] guix: store: Enable specifying the " Ludovic Courtès via Guix-patches
2024-07-04 11:50 ` [bug#71038] [PATCH v3 1/2] guix: store: Enable specifying the " Christopher Baines
2024-07-04 11:50   ` [bug#71038] [PATCH v3 2/2] guix: channels: Enable specifiying available " Christopher Baines
2024-07-16 10:05     ` Ludovic Courtès
2024-07-16 13:13       ` Christopher Baines
2024-07-16 12:48 ` [bug#71038] [PATCH v4 1/3] guix: store: Enable specifying the " Christopher Baines
2024-07-16 12:48   ` [bug#71038] [PATCH v4 2/3] guix: channels: Enable specifiying available " Christopher Baines
2024-07-16 12:48   ` [bug#71038] [PATCH v4 3/3] inferior: Use the host built-in-builders with inferior Christopher Baines
2024-07-18  9:35     ` Ludovic Courtès
2024-07-18 13:08       ` bug#71038: " Christopher Baines

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=319c7822ef542dc412d55af616ecbeb86b005c8b.1719236626.git.mail@cbaines.net \
    --to=mail@cbaines.net \
    --cc=71038@debbugs.gnu.org \
    --cc=dev@jpoiret.xyz \
    --cc=guix@cbaines.net \
    --cc=ludo@gnu.org \
    --cc=me@tobias.gr \
    --cc=othacehe@gnu.org \
    --cc=zimon.toutoune@gmail.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).