channels: Add a #:system argument to channel-instances->manifest.

This allows computing a manifest for a specific system. Previously this was
possible, but only through changing %current-system, which caused the
derivation to be computed using that system as well (so computing a derivation
for aarch64-linux on x86_64-linux would require running aarch64-linux code).

This new argument adds the possibility of computing derivations for non-native
systems, without having to run non-native code.

I'm looking at this as it will enable the Guix Data Service to compute channel
instance derivations without relying on QEMU emulation for non-native
systems (it should be faster as well).

* guix/channels.scm (build-from-source): Add #:system argument and pass to
build.
(build-channel-instance): Add system argument and pass to build-from-source.
(channel-instance-derivations): Add #:system argument and pass to
build-channel-instance, also rename system to current-system-value.
(channel-instances->manifest): Add #:system argument and pass to
channel-instance-derivations.
This commit is contained in:
Christopher Baines 2021-04-24 08:04:14 +01:00
parent b7cbca221f
commit 34985fb6ae
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577

View file

@ -657,10 +657,11 @@ that unconditionally resumes the continuation."
store)))) store))))
(define* (build-from-source instance (define* (build-from-source instance
#:key core verbose? (dependencies '())) #:key core verbose? (dependencies '()) system)
"Return a derivation to build Guix from INSTANCE, using the self-build "Return a derivation to build Guix from INSTANCE, using the self-build
script contained therein. When CORE is true, build package modules under script contained therein. When CORE is true, build package modules under
SOURCE using CORE, an instance of Guix." SOURCE using CORE, an instance of Guix. By default, build for the current
system, or SYSTEM if specified."
(define name (define name
(symbol->string (symbol->string
(channel-name (channel-instance-channel instance)))) (channel-name (channel-instance-channel instance))))
@ -700,20 +701,22 @@ SOURCE using CORE, an instance of Guix."
(with-trivial-build-handler (with-trivial-build-handler
(build source (build source
#:verbose? verbose? #:version commit #:verbose? verbose? #:version commit
#:system system
#:channel-metadata (channel-instance->sexp instance) #:channel-metadata (channel-instance->sexp instance)
#:pull-version %pull-version)))) #:pull-version %pull-version))))
;; Build a set of modules that extend Guix using the standard method. ;; Build a set of modules that extend Guix using the standard method.
(standard-module-derivation name source core dependencies))) (standard-module-derivation name source core dependencies)))
(define* (build-channel-instance instance (define* (build-channel-instance instance system
#:optional core (dependencies '())) #:optional core (dependencies '()))
"Return, as a monadic value, the derivation for INSTANCE, a channel "Return, as a monadic value, the derivation for INSTANCE, a channel
instance. DEPENDENCIES is a list of extensions providing Guile modules that instance, for SYSTEM. DEPENDENCIES is a list of extensions providing Guile
INSTANCE depends on." modules that INSTANCE depends on."
(build-from-source instance (build-from-source instance
#:core core #:core core
#:dependencies dependencies)) #:dependencies dependencies
#:system system))
(define (resolve-dependencies instances) (define (resolve-dependencies instances)
"Return a procedure that, given one of the elements of INSTANCES, returns "Return a procedure that, given one of the elements of INSTANCES, returns
@ -743,9 +746,9 @@ list of instances it depends on."
(lambda (instance) (lambda (instance)
(vhash-foldq* cons '() instance edges))) (vhash-foldq* cons '() instance edges)))
(define (channel-instance-derivations instances) (define* (channel-instance-derivations instances #:key system)
"Return the list of derivations to build INSTANCES, in the same order as "Return the list of derivations to build INSTANCES, in the same order as
INSTANCES." INSTANCES. Build for the current system by default, or SYSTEM if specified."
(define core-instance (define core-instance
;; The 'guix' channel is treated specially: it's an implicit dependency of ;; The 'guix' channel is treated specially: it's an implicit dependency of
;; all the other channels. ;; all the other channels.
@ -757,13 +760,13 @@ INSTANCES."
(resolve-dependencies instances)) (resolve-dependencies instances))
(define (instance->derivation instance) (define (instance->derivation instance)
(mlet %store-monad ((system (current-system))) (mlet %store-monad ((system (if system (return system) (current-system))))
(mcached (if (eq? instance core-instance) (mcached (if (eq? instance core-instance)
(build-channel-instance instance) (build-channel-instance instance system)
(mlet %store-monad ((core (instance->derivation core-instance)) (mlet %store-monad ((core (instance->derivation core-instance))
(deps (mapm %store-monad instance->derivation (deps (mapm %store-monad instance->derivation
(edges instance)))) (edges instance))))
(build-channel-instance instance core deps))) (build-channel-instance instance system core deps)))
instance instance
system))) system)))
@ -865,9 +868,10 @@ derivation."
intro)))))) intro))))))
'())))) '()))))
(define (channel-instances->manifest instances) (define* (channel-instances->manifest instances #:key system)
"Return a profile manifest with entries for all of INSTANCES, a list of "Return a profile manifest with entries for all of INSTANCES, a list of
channel instances." channel instances. By default, build for the current system, or SYSTEM if
specified."
(define (instance->entry instance drv) (define (instance->entry instance drv)
(let ((commit (channel-instance-commit instance)) (let ((commit (channel-instance-commit instance))
(channel (channel-instance-channel instance))) (channel (channel-instance-channel instance)))
@ -883,7 +887,8 @@ channel instances."
(properties (properties
`((source ,(channel-instance->sexp instance))))))) `((source ,(channel-instance->sexp instance)))))))
(mlet* %store-monad ((derivations (channel-instance-derivations instances)) (mlet* %store-monad ((derivations (channel-instance-derivations instances
#:system system))
(entries -> (map instance->entry instances derivations))) (entries -> (map instance->entry instances derivations)))
(return (manifest entries)))) (return (manifest entries))))