[PATCH 0/5] Cuirass/Hydra: evaluate jobs in an inferior

  • Done
  • quality assurance status badge
Details
2 participants
  • Ludovic Courtès
  • Mark H Weaver
Owner
unassigned
Submitted by
Ludovic Courtès
Severity
normal
L
L
Ludovic Courtès wrote on 26 Nov 2018 17:37
(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20181126163757.17399-1-ludo@gnu.org
Hello Guix!

This patch set changes the way we compute continuous integration jobs:
instead of letting Guile auto-compile all of Guix from its checkout,
we first build Guix in the same way as ‘guix pull’, open an inferior
to that Guix, and run the job evaluation code in that inferior.

I think it’s cleaner and it should be faster and less resource-hungry
than the current approach.

The build-aux/hydra/gnu-system.scm file will now rely on the
(guix channels) and (guix inferior) with the new ‘checkout->channel-instance’
and ‘inferior-eval-with-store’ procedures, which means that Cuirass
(and Hydra) will need to be using a recent Guix to be able to perform
the evaluation. Apart from that ‘gnu-system.scm’ is rather decoupled
from the Guix APIs.

To test it for real, we’ll first have to apply the patches that add these
two procedures to ‘master’ and to update the ‘guix’ package so we can
have a Cuirass instance running the latest and greatest.

Thoughts?

Ludo’.

Ludovic Courtès (5):
inferior: Add 'inferior-eval-with-store'.
hydra: Move job definitions to (gnu ci).
hydra: evaluate: Add the checkout to the store.
channels: Add 'checkout->channel-instance'.
hydra: Compute jobs in an inferior.

build-aux/hydra/evaluate.scm | 55 ++--
build-aux/hydra/gnu-system.scm | 448 +++------------------------------
gnu/ci.scm | 440 ++++++++++++++++++++++++++++++++
gnu/local.mk | 4 +-
guix/channels.scm | 12 +
guix/inferior.scm | 70 ++++--
guix/self.scm | 3 +-
tests/inferior.scm | 9 +
8 files changed, 573 insertions(+), 468 deletions(-)
create mode 100644 gnu/ci.scm

--
2.19.1
L
L
Ludovic Courtès wrote on 26 Nov 2018 17:45
[PATCH 3/5] hydra: evaluate: Add the checkout to the store.
(address . 33515@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20181126164524.17680-3-ludo@gnu.org
* build-aux/hydra/evaluate.scm <top level>: Add call to 'add-to-store'.
Use that as the 'file-name' attribute. Call 'primitive-load' in a
directory excursion to SOURCE.
---
build-aux/hydra/evaluate.scm | 55 +++++++++++++++++++++---------------
1 file changed, 33 insertions(+), 22 deletions(-)

Toggle diff (82 lines)
diff --git a/build-aux/hydra/evaluate.scm b/build-aux/hydra/evaluate.scm
index 5793c022ff..adb14808fa 100644
--- a/build-aux/hydra/evaluate.scm
+++ b/build-aux/hydra/evaluate.scm
@@ -22,6 +22,8 @@
;;; arguments and outputs an sexp of the jobs on standard output.
(use-modules (guix store)
+ (guix git-download)
+ ((guix build utils) #:select (with-directory-excursion))
(srfi srfi-19)
(ice-9 match)
(ice-9 pretty-print)
@@ -81,11 +83,6 @@ Otherwise return THING."
;; Load FILE, a Scheme file that defines Hydra jobs.
(let ((port (current-output-port))
(real-build-things build-things))
- (save-module-excursion
- (lambda ()
- (set-current-module %user-module)
- (primitive-load file)))
-
(with-store store
;; Make sure we don't resort to substitutes.
(set-build-options store
@@ -104,23 +101,37 @@ Otherwise return THING."
"'build-things' arguments: ~s~%" args)
(apply real-build-things store args)))
- ;; Call the entry point of FILE and print the resulting job sexp.
- (pretty-print
- (match ((module-ref %user-module
- (if (equal? cuirass? "cuirass")
- 'cuirass-jobs
- 'hydra-jobs))
- store `((guix
- . ((file-name . ,%top-srcdir)))))
- (((names . thunks) ...)
- (map (lambda (job thunk)
- (format (current-error-port) "evaluating '~a'... " job)
- (force-output (current-error-port))
- (cons job
- (assert-valid-job job
- (call-with-time-display thunk))))
- names thunks)))
- port))))
+ ;; Add %TOP-SRCDIR to the store with a proper Git predicate so we work
+ ;; from a clean checkout
+ (let ((source (add-to-store store "guix-source" #t
+ "sha256" %top-srcdir
+ #:select? (git-predicate %top-srcdir))))
+ (with-directory-excursion source
+ (save-module-excursion
+ (lambda ()
+ (set-current-module %user-module)
+ (format (current-error-port)
+ "loading '~a' relative to '~a'...~%"
+ file source)
+ (primitive-load file))))
+
+ ;; Call the entry point of FILE and print the resulting job sexp.
+ (pretty-print
+ (match ((module-ref %user-module
+ (if (equal? cuirass? "cuirass")
+ 'cuirass-jobs
+ 'hydra-jobs))
+ store `((guix
+ . ((file-name . ,source)))))
+ (((names . thunks) ...)
+ (map (lambda (job thunk)
+ (format (current-error-port) "evaluating '~a'... " job)
+ (force-output (current-error-port))
+ (cons job
+ (assert-valid-job job
+ (call-with-time-display thunk))))
+ names thunks)))
+ port)))))
((command _ ...)
(format (current-error-port) "Usage: ~a FILE [cuirass]
Evaluate the Hydra or Cuirass jobs defined in FILE.~%"
--
2.19.1
L
L
Ludovic Courtès wrote on 26 Nov 2018 17:45
[PATCH 1/5] inferior: Add 'inferior-eval-with-store'.
(address . 33515@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20181126164524.17680-1-ludo@gnu.org
* guix/inferior.scm (inferior-eval-with-store): New procedure, with code
formerly in 'inferior-package-derivation'.
(inferior-package-derivation): Rewrite in terms of
'inferior-eval-with-store'.
* tests/inferior.scm ("inferior-eval-with-store"): New test.
---
guix/inferior.scm | 70 ++++++++++++++++++++++++++++------------------
tests/inferior.scm | 9 ++++++
2 files changed, 52 insertions(+), 27 deletions(-)

Toggle diff (132 lines)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 1dbb9e1699..ccc1c27cb2 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -56,6 +56,7 @@
open-inferior
close-inferior
inferior-eval
+ inferior-eval-with-store
inferior-object?
inferior-packages
@@ -402,55 +403,70 @@ input/output ports.)"
(unless (port-closed? client)
(loop))))))
-(define* (inferior-package-derivation store package
- #:optional
- (system (%current-system))
- #:key target)
- "Return the derivation for PACKAGE, an inferior package, built for SYSTEM
-and cross-built for TARGET if TARGET is true. The inferior corresponding to
-PACKAGE must be live."
- ;; Create a named socket in /tmp and let the inferior of PACKAGE connect to
- ;; it and use it as its store. This ensures the inferior uses the same
- ;; store, with the same options, the same per-session GC roots, etc.
+(define (inferior-eval-with-store inferior store code)
+ "Evaluate CODE in INFERIOR, passing it STORE as its argument. CODE must
+thus be the code of a one-argument procedure that accepts a store."
+ ;; Create a named socket in /tmp and let INFERIOR connect to it and use it
+ ;; as its store. This ensures the inferior uses the same store, with the
+ ;; same options, the same per-session GC roots, etc.
(call-with-temporary-directory
(lambda (directory)
(chmod directory #o700)
(let* ((name (string-append directory "/inferior"))
(socket (socket AF_UNIX SOCK_STREAM 0))
- (inferior (inferior-package-inferior package))
(major (nix-server-major-version store))
(minor (nix-server-minor-version store))
(proto (logior major minor)))
(bind socket AF_UNIX name)
(listen socket 1024)
(send-inferior-request
- `(let ((socket (socket AF_UNIX SOCK_STREAM 0)))
+ `(let ((proc ,code)
+ (socket (socket AF_UNIX SOCK_STREAM 0)))
(connect socket AF_UNIX ,name)
;; 'port->connection' appeared in June 2018 and we can hardly
;; emulate it on older versions. Thus fall back to
;; 'open-connection', at the risk of talking to the wrong daemon or
;; having our build result reclaimed (XXX).
- (let* ((store (if (defined? 'port->connection)
- (port->connection socket #:version ,proto)
- (open-connection)))
- (package (hashv-ref %package-table
- ,(inferior-package-id package)))
- (drv ,(if target
- `(package-cross-derivation store package
- ,target
- ,system)
- `(package-derivation store package
- ,system))))
- (close-connection store)
- (close-port socket)
- (derivation-file-name drv)))
+ (let ((store (if (defined? 'port->connection)
+ (port->connection socket #:version ,proto)
+ (open-connection))))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (proc store))
+ (lambda ()
+ (close-connection store)
+ (close-port socket)))))
inferior)
(match (accept socket)
((client . address)
(proxy client (nix-server-socket store))))
(close-port socket)
- (read-derivation-from-file (read-inferior-response inferior))))))
+ (read-inferior-response inferior)))))
+
+(define* (inferior-package-derivation store package
+ #:optional
+ (system (%current-system))
+ #:key target)
+ "Return the derivation for PACKAGE, an inferior package, built for SYSTEM
+and cross-built for TARGET if TARGET is true. The inferior corresponding to
+PACKAGE must be live."
+ (define proc
+ `(lambda (store)
+ (let* ((package (hashv-ref %package-table
+ ,(inferior-package-id package)))
+ (drv ,(if target
+ `(package-cross-derivation store package
+ ,target
+ ,system)
+ `(package-derivation store package
+ ,system))))
+ (derivation-file-name drv))))
+
+ (and=> (inferior-eval-with-store (inferior-package-inferior package) store
+ proc)
+ read-derivation-from-file))
(define inferior-package->derivation
(store-lift inferior-package-derivation))
diff --git a/tests/inferior.scm b/tests/inferior.scm
index d1d5c00a77..d5a894ca8f 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -157,6 +157,15 @@
(close-inferior inferior)
result))
+(test-equal "inferior-eval-with-store"
+ (add-text-to-store %store "foo" "Hello, world!")
+ (let* ((inferior (open-inferior %top-builddir
+ #:command "scripts/guix")))
+ (inferior-eval-with-store inferior %store
+ '(lambda (store)
+ (add-text-to-store store "foo"
+ "Hello, world!")))))
+
(test-equal "inferior-package-derivation"
(map derivation-file-name
(list (package-derivation %store %bootstrap-guile "x86_64-linux")
--
2.19.1
L
L
Ludovic Courtès wrote on 26 Nov 2018 17:45
[PATCH 4/5] channels: Add 'checkout->channel-instance'.
(address . 33515@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20181126164524.17680-4-ludo@gnu.org
* guix/channels.scm (checkout->channel-instance): New procedure.
---
guix/channels.scm | 12 ++++++++++++
1 file changed, 12 insertions(+)

Toggle diff (32 lines)
diff --git a/guix/channels.scm b/guix/channels.scm
index 82389eb583..e57da68149 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -47,6 +47,7 @@
channel-instance-checkout
latest-channel-instances
+ checkout->channel-instance
latest-channel-derivation
channel-instances->manifest
channel-instances->derivation))
@@ -114,6 +115,17 @@ CHANNELS."
(channel-instance channel commit checkout)))
channels))
+(define* (checkout->channel-instance checkout
+ #:key commit
+ (url checkout) (name 'guix))
+ "Return a channel instance for CHECKOUT, which is assumed to be a checkout
+of COMMIT at URL. Use NAME as the channel name."
+ (let* ((commit (or commit (make-string 40 #\0)))
+ (channel (channel (name name)
+ (commit commit)
+ (url url))))
+ (channel-instance channel commit checkout)))
+
(define %self-build-file
;; The file containing code to build Guix. This serves the same purpose as
;; a makefile, and, similarly, is intended to always keep this name.
--
2.19.1
L
L
Ludovic Courtès wrote on 26 Nov 2018 17:45
[PATCH 5/5] hydra: Compute jobs in an inferior.
(address . 33515@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20181126164524.17680-5-ludo@gnu.org
Previously we would rely on auto-compilation of all the Guix modules.
The complete evaluation would take ~15mn on berlin.guixsd.org and
require lots of RAM. This approach should be faster since potentially
only part of the modules are rebuilt. Furthermore, as a side-effect, it
builds the derivations that 'guix pull' uses.

* build-aux/hydra/gnu-system.scm: Remove 'eval-when' form.
(hydra-jobs): New procedure.
* gnu/ci.scm (package->alist, qemu-jobs, system-test-jobs)
(tarball-jobs): Return strings for the 'license' field.
* guix/self.scm (compiled-guix)[*cli-modules*]: Add (gnu ci).
---
build-aux/hydra/gnu-system.scm | 71 ++++++++++++++++++++--------------
gnu/ci.scm | 20 +++++++---
guix/self.scm | 3 +-
3 files changed, 58 insertions(+), 36 deletions(-)

Toggle diff (160 lines)
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index 150c2bdf4f..db91440854 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -23,39 +23,50 @@
;;; tool.
;;;
-(use-modules (system base compile))
-
-(eval-when (expand load eval)
-
- ;; Pre-load the compiler so we don't end up auto-compiling it.
- (compile #t)
-
- ;; Use our very own Guix modules.
- (set! %fresh-auto-compile #t)
-
- ;; Ignore .go files except for Guile's. This is because our checkout in the
- ;; store has mtime set to the epoch, and thus .go files look newer, even
- ;; though they may not correspond. Use 'reverse' so that /gnu/store/…-guile
- ;; comes before /run/current-system/profile.
- (set! %load-compiled-path
- (list
- (dirname (dirname (search-path (reverse %load-compiled-path)
- "ice-9/boot-9.go")))))
-
- (and=> (assoc-ref (current-source-location) 'filename)
- (lambda (file)
- (let ((dir (canonicalize-path
- (string-append (dirname file) "/../.."))))
- (format (current-error-port) "prepending ~s to the load path~%"
- dir)
- (set! %load-path (cons dir %load-path))))))
-
-(use-modules (gnu ci))
+(use-modules (guix inferior) (guix channels)
+ (guix)
+ (guix ui)
+ (ice-9 match))
;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
;; port to the bit bucket, let us write to the error port instead.
(setvbuf (current-error-port) _IOLBF)
(set-current-output-port (current-error-port))
-;; Return the procedure from (gnu ci).
-hydra-jobs
+(define (hydra-jobs store arguments)
+ "Return a list of jobs where each job is a NAME/THUNK pair."
+ (define checkout
+ (or (assq-ref arguments 'guix) ;Hydra on hydra
+ (assq-ref arguments 'guix-modular))) ;Cuirass on berlin
+
+ (define commit
+ (assq-ref checkout 'revision))
+
+ (define source
+ (assq-ref checkout 'file-name))
+
+ (define instance
+ (checkout->channel-instance source #:commit commit))
+
+ (define derivation
+ ;; Compute the derivation of Guix for COMMIT.
+ (run-with-store store
+ (channel-instances->derivation (list instance))))
+
+ (show-what-to-build store (list derivation))
+ (build-derivations store (list derivation))
+
+ ;; Open an inferior for the just-built Guix.
+ (let ((inferior (open-inferior (derivation->output-path derivation))))
+ (inferior-eval '(use-modules (gnu ci) (ice-9 match)) inferior)
+
+ (map (match-lambda
+ ((name . fields)
+ ;; Hydra expects a thunk, so here it is.
+ (cons name (lambda () fields))))
+ (inferior-eval-with-store inferior store
+ `(lambda (store)
+ (map (match-lambda
+ ((name . thunk)
+ (cons name (thunk))))
+ (hydra-jobs store ',arguments)))))))
diff --git a/gnu/ci.scm b/gnu/ci.scm
index 8ece08e453..8daf9e7e35 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -27,7 +27,8 @@
#:use-module (guix derivations)
#:use-module (guix monads)
#:use-module (guix ui)
- #:use-module ((guix licenses) #:select (gpl3+))
+ #:use-module ((guix licenses)
+ #:select (gpl3+ license? license-name))
#:use-module ((guix utils) #:select (%current-system))
#:use-module ((guix scripts system) #:select (read-operating-system))
#:use-module ((guix scripts pack)
@@ -69,7 +70,16 @@
#:graft? #f)))
(description . ,(package-synopsis package))
(long-description . ,(package-description package))
- (license . ,(package-license package))
+
+ ;; XXX: Hydra ignores licenses that are not a <license> structure or a
+ ;; list thereof.
+ (license . ,(let loop ((license (package-license package)))
+ (match license
+ ((? license?)
+ (license-name license))
+ ((lst ...)
+ (map loop license)))))
+
(home-page . ,(package-home-page package))
(maintainers . ("bug-guix@gnu.org"))
(max-silent-time . ,(or (assoc-ref (package-properties package)
@@ -133,7 +143,7 @@ SYSTEM."
(description . "Stand-alone QEMU image of the GNU system")
(long-description . "This is a demo stand-alone QEMU image of the GNU
system.")
- (license . ,gpl3+)
+ (license . ,(license-name gpl3+))
(home-page . ,%guix-home-page-url)
(maintainers . ("bug-guix@gnu.org"))))
@@ -192,7 +202,7 @@ system.")
(description . ,(format #f "GuixSD '~a' system test"
(system-test-name test)))
(long-description . ,(system-test-description test))
- (license . ,gpl3+)
+ (license . ,(license-name gpl3+))
(home-page . ,%guix-home-page-url)
(maintainers . ("bug-guix@gnu.org")))))
@@ -213,7 +223,7 @@ system.")
(description . "Stand-alone binary Guix tarball")
(long-description . "This is a tarball containing binaries of Guix and
all its dependencies, and ready to be installed on non-GuixSD distributions.")
- (license . ,gpl3+)
+ (license . ,(license-name gpl3+))
(home-page . ,%guix-home-page-url)
(maintainers . ("bug-guix@gnu.org"))))
diff --git a/guix/self.scm b/guix/self.scm
index 96fef44e78..065705641d 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -613,7 +613,8 @@ assumed to be part of MODULES."
(define *cli-modules*
(scheme-node "guix-cli"
- (scheme-modules* source "/guix/scripts")
+ (append (scheme-modules* source "/guix/scripts")
+ `((gnu ci)))
(list *core-modules* *extra-modules*
*core-package-modules* *package-modules*
*system-modules*)
--
2.19.1
L
L
Ludovic Courtès wrote on 26 Nov 2018 17:45
[PATCH 2/5] hydra: Move job definitions to (gnu ci).
(address . 33515@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20181126164524.17680-2-ludo@gnu.org
* build-aux/hydra/gnu-system.scm: Move code to...
* gnu/ci.scm: ... here. New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
build-aux/hydra/gnu-system.scm | 403 +-----------------------------
gnu/ci.scm | 430 +++++++++++++++++++++++++++++++++
gnu/local.mk | 4 +-
3 files changed, 436 insertions(+), 401 deletions(-)
create mode 100644 gnu/ci.scm

Toggle diff (462 lines)
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index d6b0132807..150c2bdf4f 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -50,409 +50,12 @@
dir)
(set! %load-path (cons dir %load-path))))))
-(use-modules (guix config)
- (guix store)
- (guix grafts)
- (guix profiles)
- (guix packages)
- (guix derivations)
- (guix monads)
- (guix ui)
- ((guix licenses) #:select (gpl3+))
- ((guix utils) #:select (%current-system))
- ((guix scripts system) #:select (read-operating-system))
- ((guix scripts pack)
- #:select (lookup-compressor self-contained-tarball))
- (gnu bootloader)
- (gnu bootloader u-boot)
- (gnu packages)
- (gnu packages gcc)
- (gnu packages base)
- (gnu packages gawk)
- (gnu packages guile)
- (gnu packages gettext)
- (gnu packages compression)
- (gnu packages multiprecision)
- (gnu packages make-bootstrap)
- (gnu packages package-management)
- (gnu system)
- (gnu system vm)
- (gnu system install)
- (gnu tests)
- (srfi srfi-1)
- (srfi srfi-26)
- (ice-9 match))
+(use-modules (gnu ci))
;; XXX: Debugging hack: since `hydra-eval-guile-jobs' redirects the output
;; port to the bit bucket, let us write to the error port instead.
(setvbuf (current-error-port) _IOLBF)
(set-current-output-port (current-error-port))
-(define* (package->alist store package system
- #:optional (package-derivation package-derivation))
- "Convert PACKAGE to an alist suitable for Hydra."
- (parameterize ((%graft? #f))
- `((derivation . ,(derivation-file-name
- (package-derivation store package system
- #:graft? #f)))
- (description . ,(package-synopsis package))
- (long-description . ,(package-description package))
- (license . ,(package-license package))
- (home-page . ,(package-home-page package))
- (maintainers . ("bug-guix@gnu.org"))
- (max-silent-time . ,(or (assoc-ref (package-properties package)
- 'max-silent-time)
- 3600)) ;1 hour by default
- (timeout . ,(or (assoc-ref (package-properties package) 'timeout)
- 72000))))) ;20 hours by default
-
-(define (package-job store job-name package system)
- "Return a job called JOB-NAME that builds PACKAGE on SYSTEM."
- (let ((job-name (symbol-append job-name (string->symbol ".")
- (string->symbol system))))
- `(,job-name . ,(cut package->alist store package system))))
-
-(define (package-cross-job store job-name package target system)
- "Return a job called TARGET.JOB-NAME that cross-builds PACKAGE for TARGET on
-SYSTEM."
- `(,(symbol-append (string->symbol target) (string->symbol ".") job-name
- (string->symbol ".") (string->symbol system)) .
- ,(cute package->alist store package system
- (lambda* (store package system #:key graft?)
- (package-cross-derivation store package target system
- #:graft? graft?)))))
-
-(define %core-packages
- ;; Note: Don't put the '-final' package variants because (1) that's
- ;; implicit, and (2) they cannot be cross-built (due to the explicit input
- ;; chain.)
- (list gcc-4.8 gcc-4.9 gcc-5 glibc binutils
- gmp mpfr mpc coreutils findutils diffutils patch sed grep
- gawk gnu-gettext hello guile-2.0 guile-2.2 zlib gzip xz
- %bootstrap-binaries-tarball
- %binutils-bootstrap-tarball
- (%glibc-bootstrap-tarball)
- %gcc-bootstrap-tarball
- %guile-bootstrap-tarball
- %bootstrap-tarballs))
-
-(define %packages-to-cross-build
- %core-packages)
-
-(define %cross-targets
- '("mips64el-linux-gnu"
- "mips64el-linux-gnuabi64"
- "arm-linux-gnueabihf"
- "aarch64-linux-gnu"
- "powerpc-linux-gnu"
- "i586-pc-gnu" ;aka. GNU/Hurd
- "i686-w64-mingw32"))
-
-(define %guixsd-supported-systems
- '("x86_64-linux" "i686-linux" "armhf-linux"))
-
-(define %u-boot-systems
- '("armhf-linux"))
-
-(define (qemu-jobs store system)
- "Return a list of jobs that build QEMU images for SYSTEM."
- (define (->alist drv)
- `((derivation . ,(derivation-file-name drv))
- (description . "Stand-alone QEMU image of the GNU system")
- (long-description . "This is a demo stand-alone QEMU image of the GNU
-system.")
- (license . ,gpl3+)
- (home-page . ,%guix-home-page-url)
- (maintainers . ("bug-guix@gnu.org"))))
-
- (define (->job name drv)
- (let ((name (symbol-append name (string->symbol ".")
- (string->symbol system))))
- `(,name . ,(lambda ()
- (parameterize ((%graft? #f))
- (->alist drv))))))
-
- (define MiB
- (expt 2 20))
-
- (if (member system %guixsd-supported-systems)
- (if (member system %u-boot-systems)
- (list (->job 'flash-image
- (run-with-store store
- (mbegin %store-monad
- (set-guile-for-build (default-guile))
- (system-disk-image
- (operating-system (inherit installation-os)
- (bootloader (bootloader-configuration
- (bootloader u-boot-bootloader)
- (target #f))))
- #:disk-image-size
- (* 1024 MiB))))))
- (list (->job 'usb-image
- (run-with-store store
- (mbegin %store-monad
- (set-guile-for-build (default-guile))
- (system-disk-image installation-os
- #:disk-image-size
- (* 1024 MiB)))))
- (->job 'iso9660-image
- (run-with-store store
- (mbegin %store-monad
- (set-guile-for-build (default-guile))
- (system-disk-image installation-os
- #:file-system-type
- "iso9660"))))))
- '()))
-
-(define (system-test-jobs store system)
- "Return a list of jobs for the system tests."
- (define (test->thunk test)
- (lambda ()
- (define drv
- (run-with-store store
- (mbegin %store-monad
- (set-current-system system)
- (set-grafting #f)
- (set-guile-for-build (default-guile))
- (system-test-value test))))
-
- `((derivation . ,(derivation-file-name drv))
- (description . ,(format #f "GuixSD '~a' system test"
- (system-test-name test)))
- (long-description . ,(system-test-description test))
- (license . ,gpl3+)
- (home-page . ,%guix-home-page-url)
- (maintainers . ("bug-guix@gnu.org")))))
-
- (define (->job test)
- (let ((name (string->symbol
- (string-append "test." (system-test-name test)
- "." system))))
- (cons name (test->thunk test))))
-
- (if (member system %guixsd-supported-systems)
- (map ->job (all-system-tests))
- '()))
-
-(define (tarball-jobs store system)
- "Return Hydra jobs to build the self-contained Guix binary tarball."
- (define (->alist drv)
- `((derivation . ,(derivation-file-name drv))
- (description . "Stand-alone binary Guix tarball")
- (long-description . "This is a tarball containing binaries of Guix and
-all its dependencies, and ready to be installed on non-GuixSD distributions.")
- (license . ,gpl3+)
- (home-page . ,%guix-home-page-url)
- (maintainers . ("bug-guix@gnu.org"))))
-
- (define (->job name drv)
- (let ((name (symbol-append name (string->symbol ".")
- (string->symbol system))))
- `(,name . ,(lambda ()
- (parameterize ((%graft? #f))
- (->alist drv))))))
-
- ;; XXX: Add a job for the stable Guix?
- (list (->job 'binary-tarball
- (run-with-store store
- (mbegin %store-monad
- (set-guile-for-build (default-guile))
- (>>= (profile-derivation (packages->manifest (list guix)))
- (lambda (profile)
- (self-contained-tarball "guix-binary" profile
- #:localstatedir? #t
- #:compressor
- (lookup-compressor "xz")))))
- #:system system))))
-
-(define job-name
- ;; Return the name of a package's job.
- (compose string->symbol
- (cut package-full-name <> "-")))
-
-(define package->job
- (let ((base-packages
- (delete-duplicates
- (append-map (match-lambda
- ((_ package _ ...)
- (match (package-transitive-inputs package)
- (((_ inputs _ ...) ...)
- inputs))))
- (%final-inputs)))))
- (lambda (store package system)
- "Return a job for PACKAGE on SYSTEM, or #f if this combination is not
-valid."
- (cond ((member package base-packages)
- (package-job store (symbol-append 'base. (job-name package))
- package system))
- ((supported-package? package system)
- (let ((drv (package-derivation store package system
- #:graft? #f)))
- (and (substitutable-derivation? drv)
- (package-job store (job-name package)
- package system))))
- (else
- #f)))))
-
-(define (all-packages)
- "Return the list of packages to build."
- (define (adjust package result)
- (cond ((package-replacement package)
- (cons* package ;build both
- (package-replacement package)
- result))
- ((package-superseded package)
- result) ;don't build it
- (else
- (cons package result))))
-
- (fold-packages adjust
- (fold adjust '() ;include base packages
- (match (%final-inputs)
- (((labels packages _ ...) ...)
- packages)))
- #:select? (const #t))) ;include hidden packages
-
-(define (arguments->manifests arguments)
- "Return the list of manifests extracted from ARGUMENTS."
- (map (match-lambda
- ((input-name . relative-path)
- (let* ((checkout (assq-ref arguments (string->symbol input-name)))
- (base (assq-ref checkout 'file-name)))
- (in-vicinity base relative-path))))
- (assq-ref arguments 'manifests)))
-
-(define (manifests->packages store manifests)
- "Return the list of packages found in MANIFESTS."
- (define (load-manifest manifest)
- (save-module-excursion
- (lambda ()
- (set-current-module (make-user-module '((guix profiles) (gnu))))
- (primitive-load manifest))))
-
- (delete-duplicates!
- (map manifest-entry-item
- (append-map (compose manifest-entries
- load-manifest)
- manifests))))
-
-
-;;;
-;;; Hydra entry point.
-;;;
-
-(define (hydra-jobs store arguments)
- "Return Hydra jobs."
- (define subset
- (match (assoc-ref arguments 'subset)
- ("core" 'core) ; only build core packages
- ("hello" 'hello) ; only build hello
- (((? string?) (? string?) ...) 'list) ; only build selected list of packages
- ("manifests" 'manifests) ; only build packages in the list of manifests
- (_ 'all))) ; build everything
-
- (define systems
- (match (assoc-ref arguments 'systems)
- (#f %hydra-supported-systems)
- ((lst ...) lst)
- ((? string? str) (call-with-input-string str read))))
-
- (define (cross-jobs system)
- (define (from-32-to-64? target)
- ;; Return true if SYSTEM is 32-bit and TARGET is 64-bit. This hack
- ;; prevents known-to-fail cross-builds from i686-linux or armhf-linux to
- ;; mips64el-linux-gnuabi64.
- (and (or (string-prefix? "i686-" system)
- (string-prefix? "i586-" system)
- (string-prefix? "armhf-" system))
- (string-contains target "64"))) ;x86_64, mips64el, aarch64, etc.
-
- (define (same? target)
- ;; Return true if SYSTEM and TARGET are the same thing. This is so we
- ;; don't try to cross-compile to 'mips64el-linux-gnu' from
- ;; 'mips64el-linux'.
- (or (string-contains target system)
- (and (string-prefix? "armhf" system) ;armhf-linux
- (string-prefix? "arm" target)))) ;arm-linux-gnueabihf
-
- (define (pointless? target)
- ;; Return #t if it makes no sense to cross-build to TARGET from SYSTEM.
- (match system
- ((or "x86_64-linux" "i686-linux")
- (if (string-contains target "mingw")
- (not (string=? "x86_64-linux" system))
- #f))
- (_
- ;; Don't try to cross-compile from non-Intel platforms: this isn't
- ;; very useful and these are often brittle configurations.
- #t)))
-
- (define (either proc1 proc2 proc3)
- (lambda (x)
- (or (proc1 x) (proc2 x) (proc3 x))))
-
- (append-map (lambda (target)
- (map (lambda (package)
- (package-cross-job store (job-name package)
- package target system))
- %packages-to-cross-build))
- (remove (either from-32-to-64? same? pointless?)
- %cross-targets)))
-
- ;; Turn off grafts. Grafting is meant to happen on the user's machines.
- (parameterize ((%graft? #f))
- ;; Return one job for each package, except bootstrap packages.
- (append-map (lambda (system)
- (format (current-error-port)
- "evaluating for '~a' (heap size: ~a MiB)...~%"
- system
- (round
- (/ (assoc-ref (gc-stats) 'heap-size)
- (expt 2. 20))))
- (invalidate-derivation-caches!)
- (case subset
- ((all)
- ;; Build everything, including replacements.
- (let ((all (all-packages))
- (job (lambda (package)
- (package->job store package
- system))))
- (append (filter-map job all)
- (qemu-jobs store system)
- (system-test-jobs store system)
- (tarball-jobs store system)
- (cross-jobs system))))
- ((core)
- ;; Build core packages only.
- (append (map (lambda (package)
- (package-job store (job-name package)
- package system))
- %core-packages)
- (cross-jobs system)))
- ((hello)
- ;; Build hello package only.
- (if (string=? system (%current-system))
- (let ((hello (specification->package "hello")))
- (list (package-job store (job-name hello) hello system)))
- '()))
- ((list)
- ;; Build selected list of packages only.
- (if (string=? system (%current-system))
- (let* ((names (assoc-ref arguments 'subset))
- (packages (map specification->package names)))
- (map (lambda (package)
- (package-job store (job-name package)
- package system))
- packages))
- '()))
- ((manifests)
- ;; Build packages in the list of manifests.
- (let* ((manifests (arguments->manifests arguments))
- (packages (manifests->packages store manifests)))
- (map (lambda (package)
- (package-job store (job-name package)
- package system))
- packages)))
- (else
- (error "unknown subset" subset))))
- systems)))
+;; Return the procedure from (gnu ci).
+hydra-jobs
diff --git a/gnu/ci.scm b/gnu/ci.scm
new file mode 100644
index 0000000000..8ece08e453
--- /dev/null
+++ b/gnu/ci.scm
@@ -0,0 +1,430 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu ci)
+ #:use-module (guix config)
+ #:use-module (guix store)
+ #:use-module (guix grafts)
+ #:use-module (guix profiles)
+ #:use-module (guix packages)
+ #:use-module (guix derivations)
+ #:use-module (guix monads)
+ #:use-module (guix ui)
+ #:use-module ((guix licenses) #:select (gpl3+))
+ #:use-module ((guix utils) #:select (%current-system))
+ #:use-module ((guix scripts system) #:select (read-operating-system))
+ #:use-module ((guix scripts pack)
+ #:select (lookup-compressor self-contained-tarball))
+ #:use-module (gnu bootloader)
+ #:use-module (gnu bootloader u-boot)
+ #:use-module (gnu packages)
+ #:use-module (gnu packages gcc)

This message was truncated. Download the full message here.
L
L
Ludovic Courtès wrote on 28 Nov 2018 10:51
Re: [bug#33515] [PATCH 0/5] Cuirass/Hydra: evaluate jobs in an inferior
(address . 33515@debbugs.gnu.org)
877egx7cnm.fsf@gnu.org
Ludovic Courtès <ludo@gnu.org> skribis:

Toggle quote (7 lines)
> The build-aux/hydra/gnu-system.scm file will now rely on the
> (guix channels) and (guix inferior) with the new ‘checkout->channel-instance’
> and ‘inferior-eval-with-store’ procedures, which means that Cuirass
> (and Hydra) will need to be using a recent Guix to be able to perform
> the evaluation. Apart from that ‘gnu-system.scm’ is rather decoupled
> from the Guix APIs.

I’ve applied these bits for now:

fe5db4eb03 channels: Add 'checkout->channel-instance'.
94c0e61fe7 inferior: Add 'inferior-eval-with-store'.

Ludo’.
L
L
Ludovic Courtès wrote on 27 Dec 2018 18:27
(address . 33515@debbugs.gnu.org)(name . Mark H Weaver)(address . mhw@netris.org)
87bm56aniw.fsf@gnu.org
Hello!

Ludovic Courtès <ludo@gnu.org> skribis:

Toggle quote (15 lines)
> This patch set changes the way we compute continuous integration jobs:
> instead of letting Guile auto-compile all of Guix from its checkout,
> we first build Guix in the same way as ‘guix pull’, open an inferior
> to that Guix, and run the job evaluation code in that inferior.
>
> I think it’s cleaner and it should be faster and less resource-hungry
> than the current approach.
>
> The build-aux/hydra/gnu-system.scm file will now rely on the
> (guix channels) and (guix inferior) with the new ‘checkout->channel-instance’
> and ‘inferior-eval-with-store’ procedures, which means that Cuirass
> (and Hydra) will need to be using a recent Guix to be able to perform
> the evaluation. Apart from that ‘gnu-system.scm’ is rather decoupled
> from the Guix APIs.

I’ve pushed the patches to the ‘wip-ci-inferior’ branch and created
these two jobsets:


Evaluation with Cuirass on berlin went fine.

I suspect evaluation on hydra will fail though, because it’s probably
running an older Guix version; we’ll have to upgrade there. Mark, would
you like to take a look?

Ludo’.
M
M
Mark H Weaver wrote on 28 Dec 2018 05:21
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 33515@debbugs.gnu.org)
87bm56waau.fsf@netris.org
Hi Ludovic,

Ludovic Courtès <ludo@gnu.org> writes:

Toggle quote (29 lines)
> Ludovic Courtès <ludo@gnu.org> skribis:
>
>> This patch set changes the way we compute continuous integration jobs:
>> instead of letting Guile auto-compile all of Guix from its checkout,
>> we first build Guix in the same way as ‘guix pull’, open an inferior
>> to that Guix, and run the job evaluation code in that inferior.
>>
>> I think it’s cleaner and it should be faster and less resource-hungry
>> than the current approach.
>>
>> The build-aux/hydra/gnu-system.scm file will now rely on the
>> (guix channels) and (guix inferior) with the new ‘checkout->channel-instance’
>> and ‘inferior-eval-with-store’ procedures, which means that Cuirass
>> (and Hydra) will need to be using a recent Guix to be able to perform
>> the evaluation. Apart from that ‘gnu-system.scm’ is rather decoupled
>> from the Guix APIs.
>
> I’ve pushed the patches to the ‘wip-ci-inferior’ branch and created
> these two jobsets:
>
> https://berlin.guixsd.org/jobset/wip-ci-inferior
> https://hydra.gnu.org/jobset/gnu/wip-ci-inferior
>
> Evaluation with Cuirass on berlin went fine.
>
> I suspect evaluation on hydra will fail though, because it’s probably
> running an older Guix version; we’ll have to upgrade there. Mark, would
> you like to take a look?

Indeed, the evaluation eventually failed on hydra.gnu.org. I then
upgraded 'guix' in both root's and hydra's profiles to the latest
version and tried again. This time it failed almost immediately, with
the following error:

Toggle snippet (42 lines)
evaluator hydra-eval-guile-jobs
hydra-eval-guile-jobs returned exit code 1:
adding `/gnu/store/y4m61z51s28kmiff2hzbr7xm6f4lsk80-git-export' to the load path
Backtrace:
In ice-9/eval.scm:
293:34 19 (_ #<module (#{ g257}#) 2949a00>)
In ice-9/boot-9.scm:
2862:4 18 (define-module* _ #:filename _ #:pure _ #:version _ # _ ?)
2875:24 17 (_)
222:17 16 (map1 (((guix git)) ((guix records)) ((guix gexp)) (#) ?))
2788:17 15 (resolve-interface (guix git) #:select _ #:hide _ # _ # ?)
2714:10 14 (_ (guix git) _ _ #:ensure _)
2982:16 13 (try-module-autoload _ _)
2312:4 12 (save-module-excursion #<procedure 472d510 at ice-9/boo?>)
3002:22 11 (_)
In unknown file:
10 (primitive-load-path "guix/git" #<procedure 4749f20 at ?>)
In ice-9/eval.scm:
721:20 9 (primitive-eval (define-module (guix git) #:use-module ?))
In ice-9/psyntax.scm:
1235:36 8 (expand-top-sequence ((define-module (guix git) # # ?)) ?)
1182:24 7 (parse _ (("placeholder" placeholder)) ((top) #(# # ?)) ?)
285:10 6 (parse _ (("placeholder" placeholder)) (()) _ c&e (eval) ?)
In ice-9/eval.scm:
293:34 5 (_ #<module (#{ g258}#) 2949780>)
In ice-9/boot-9.scm:
2862:4 4 (define-module* _ #:filename _ #:pure _ #:version _ # _ ?)
2875:24 3 (_)
222:17 2 (map1 (((git)) ((git object)) ((guix i18n)) ((guix ?)) ?))
2791:6 1 (resolve-interface _ #:select _ #:hide _ #:prefix _ # _ ?)
In unknown file:
0 (scm-error misc-error #f "~A ~S" ("no code for modu?" ?) ?)

ERROR: In procedure scm-error:
no code for module (git)

Some deprecated features have been used. Set the environment
variable GUILE_WARN_DEPRECATED to "detailed" and rerun the
program to get more information. Set it to "no" to suppress
this message.

For now, I rolled back both of the profiles that I updated.

This looks similar to the errors I encountered when trying to update
'guix' on the armhf build slaves, although the module it failed to load
in that case was different. In both cases, the wrapper for 'guix' is
failing to populate the GUILE_LOAD_PATH with all of the needed modules.

Mark
L
L
Ludovic Courtès wrote on 29 Dec 2018 00:19
(name . Mark H Weaver)(address . mhw@netris.org)(address . 33515@debbugs.gnu.org)
877eft8cjz.fsf@gnu.org
Hello,

Mark H Weaver <mhw@netris.org> skribis:

Toggle quote (41 lines)
> Indeed, the evaluation eventually failed on hydra.gnu.org. I then
> upgraded 'guix' in both root's and hydra's profiles to the latest
> version and tried again. This time it failed almost immediately, with
> the following error:
>
> evaluator hydra-eval-guile-jobs
> hydra-eval-guile-jobs returned exit code 1:
> adding `/gnu/store/y4m61z51s28kmiff2hzbr7xm6f4lsk80-git-export' to the load path
> Backtrace:
> In ice-9/eval.scm:
> 293:34 19 (_ #<module (#{ g257}#) 2949a00>)
> In ice-9/boot-9.scm:
> 2862:4 18 (define-module* _ #:filename _ #:pure _ #:version _ # _ ?)
> 2875:24 17 (_)
> 222:17 16 (map1 (((guix git)) ((guix records)) ((guix gexp)) (#) ?))
> 2788:17 15 (resolve-interface (guix git) #:select _ #:hide _ # _ # ?)
> 2714:10 14 (_ (guix git) _ _ #:ensure _)
> 2982:16 13 (try-module-autoload _ _)
> 2312:4 12 (save-module-excursion #<procedure 472d510 at ice-9/boo?>)
> 3002:22 11 (_)
> In unknown file:
> 10 (primitive-load-path "guix/git" #<procedure 4749f20 at ?>)
> In ice-9/eval.scm:
> 721:20 9 (primitive-eval (define-module (guix git) #:use-module ?))
> In ice-9/psyntax.scm:
> 1235:36 8 (expand-top-sequence ((define-module (guix git) # # ?)) ?)
> 1182:24 7 (parse _ (("placeholder" placeholder)) ((top) #(# # ?)) ?)
> 285:10 6 (parse _ (("placeholder" placeholder)) (()) _ c&e (eval) ?)
> In ice-9/eval.scm:
> 293:34 5 (_ #<module (#{ g258}#) 2949780>)
> In ice-9/boot-9.scm:
> 2862:4 4 (define-module* _ #:filename _ #:pure _ #:version _ # _ ?)
> 2875:24 3 (_)
> 222:17 2 (map1 (((git)) ((git object)) ((guix i18n)) ((guix ?)) ?))
> 2791:6 1 (resolve-interface _ #:select _ #:hide _ #:prefix _ # _ ?)
> In unknown file:
> 0 (scm-error misc-error #f "~A ~S" ("no code for modu?" ?) ?)
>
> ERROR: In procedure scm-error:
> no code for module (git)

I ran ‘guix pull’ and then installed guile-git in hydra’s profile, which
fixed this immediate issue. Now the evaluation failure is a bit more
enigmatic:

Toggle snippet (3 lines)
XML or text declaration not at start of entity at line 2, column 0, byte 1 at /usr/local/lib/perl5/site_perl/5.18.0/x86_64-linux/XML/Parser.pm line 187.

I’m guessing ‘hydra-eval-guile-jobs’ is not sending proper XML, or
perhaps we’re writing non-XML stuff to stdout that gets interspersed
with valid XML.

To be continued…

Ludo’.
L
L
Ludovic Courtès wrote on 6 Jan 2019 21:44
(name . Mark H Weaver)(address . mhw@netris.org)(address . 33515-done@debbugs.gnu.org)
875zv1y0qz.fsf@gnu.org
Hi,

Ludovic Courtès <ludo@gnu.org> skribis:

Toggle quote (12 lines)
> I ran ‘guix pull’ and then installed guile-git in hydra’s profile, which
> fixed this immediate issue. Now the evaluation failure is a bit more
> enigmatic:
>
> XML or text declaration not at start of entity at line 2, column 0, byte 1 at /usr/local/lib/perl5/site_perl/5.18.0/x86_64-linux/XML/Parser.pm line 187.
>
> I’m guessing ‘hydra-eval-guile-jobs’ is not sending proper XML, or
> perhaps we’re writing non-XML stuff to stdout that gets interspersed
> with valid XML.
>
> To be continued…

This was caused by an extra newline at the beginning of the XML output.

Pushed now to master:

b5f8c2c885 hydra: Compute jobs in an inferior.
65ff85dcee hydra: evaluate: Add the checkout to the store.
59fb5c1cdb hydra: Move job definitions to (gnu ci).
afb82831fa build-self: Don't clobber the output port.

Ludo’.
Closed
?