all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [bug#46585] ci: Remove hydra support.
@ 2021-02-17  8:42 Mathieu Othacehe
  2021-02-22  9:59 ` Ludovic Courtès
  2021-03-24  3:25 ` [bug#46585] " zimoun
  0 siblings, 2 replies; 4+ messages in thread
From: Mathieu Othacehe @ 2021-02-17  8:42 UTC (permalink / raw)
  To: 46585

[-- Attachment #1: Type: text/plain, Size: 1595 bytes --]


Hello,

This removes hydra support to use Cuirass as the only continuous
integration system. It also simplifies the evaluation process. Here's
how it's working now:

* Cuirass fetches new commits and calls its "evaluate" process.

* The "evaluate" process calls the "cuirass-jobs" procedure in the
newly checkouted Guix "build-aux/cuirass/gnu-system.scm" file.

* The "hydra-jobs" procedure in "build-aux/hydra/gnu-system.scm" file
  starts the evaluation of "hydra-jobs" of (gnu ci) module in an
  inferior using the new commit.

* This procedure returns the list of all the package derivations at that
  very commit under Hydra job format.

* This list is converted to the Cuirass job format and written on the
  stdout port.

* The main Cuirass process reads the "evaluate" output using a pipe, and
  registers the derivation that needs to be built in database.

This is quite complex and it requires to pass around a huge list of
jobs, consuming a lot of memory.

Here's the simplified method:

* The first two steps are identical.

* The "cuirass-jobs" procedure starts the evaluation of "cuirass-jobs"
  of (gnu ci) module in an inferior using the new commit. This procedure
  is passed a registration callback that directly registers the given
  jobs in database. It doesn't return anything.

As the "register" procedure is a part of Cuirass, the inversion on
control caused by the inferior is problematic. I had to proxy the
registration requests from the inferior to the evaluation process using
a named pipe.

Other than that, the process seems now less obfuscated.

Thanks,

Mathieu

[-- Attachment #2: 0001-ci-Remove-hydra-support.patch --]
[-- Type: text/x-diff, Size: 54763 bytes --]

From c980a4a1357ca96c523e45b904cb2c2c1ead5b40 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Sun, 14 Feb 2021 17:34:49 +0100
Subject: [PATCH] ci: Remove hydra support.

This removes hydra support to use Cuirass as the only continuous integration
system. It also changes the way jobs are transmitted to Cuirass. The
"cuirass-jobs" procedure no longer returns jobs. Instead it is passed a
"register" callback that can be called to register jobs.

This decreases the memory consumption and increases the evaluation speed as
there's no need to operate a possibly huge list of jobs anymore.

* build-aux/hydra/gnu-system.scm: Remove it.
* build-aux/hydra/guix-modular.scm: Ditto.
* build-aux/hydra/guix.scm: Ditto.
* build-aux/cuirass/hydra-to-cuirass.scm: Ditto.
* Makefile.am (EXTRA_DIST): Update it.
(hydra-jobs.scm): Remove it.
(cuirass-jobs.scm): Update it.
* build-aux/hydra/evaluate.scm: Move it to ...
* build-aux/cuirass/evaluate.scm: ... here.
* build-aux/cuirass/guix-modular.scm: Adapt it to use the Cuirass register
procedure.
* build-aux/cuirass/gnu-system.scm: Ditto.
* gnu/ci.scm (package->alist): Remove it.
(register-job-from-drv): New procedure.
(package-job, package-cross-job, cross-jobs, image-jobs, system-test-jobs,
tarball-jobs): Add a register arguments and pass it to
"register-job-from-drv" procedure.
(hydra-jobs): Rename it to ...
(cuirass-jobs): ... this procedure. Also add a register argument.
---
 Makefile.am                               |  17 +-
 build-aux/{hydra => cuirass}/evaluate.scm |  30 +-
 build-aux/cuirass/gnu-system.scm          |  93 ++++-
 build-aux/cuirass/guix-modular.scm        |  83 ++++-
 build-aux/cuirass/hydra-to-cuirass.scm    |  47 ---
 build-aux/hydra/gnu-system.scm            |  88 -----
 build-aux/hydra/guix-modular.scm          |  91 -----
 build-aux/hydra/guix.scm                  | 106 ------
 gnu/ci.scm                                | 429 ++++++++++------------
 9 files changed, 373 insertions(+), 611 deletions(-)
 rename build-aux/{hydra => cuirass}/evaluate.scm (82%)
 delete mode 100644 build-aux/cuirass/hydra-to-cuirass.scm
 delete mode 100644 build-aux/hydra/gnu-system.scm
 delete mode 100644 build-aux/hydra/guix-modular.scm
 delete mode 100644 build-aux/hydra/guix.scm

diff --git a/Makefile.am b/Makefile.am
index 52537fb53d..85307707d6 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -603,14 +603,9 @@ EXTRA_DIST +=						\
   etc/historical-authorizations				\
   build-aux/build-self.scm				\
   build-aux/compile-all.scm				\
-  build-aux/hydra/evaluate.scm				\
-  build-aux/hydra/gnu-system.scm			\
-  build-aux/hydra/guix.scm				\
-  build-aux/hydra/guix-modular.scm			\
   build-aux/cuirass/gnu-system.scm			\
   build-aux/cuirass/guix-modular.scm			\
   build-aux/cuirass/hurd-manifest.scm			\
-  build-aux/cuirass/hydra-to-cuirass.scm		\
   build-aux/check-final-inputs-self-contained.scm	\
   build-aux/check-channel-news.scm			\
   build-aux/compile-as-derivation.scm			\
@@ -950,21 +945,13 @@ check-channel-news: $(GOBJECTS)
 	$(AM_V_at)$(top_builddir)/pre-inst-env "$(GUILE)"	\
 	  "$(top_srcdir)/build-aux/check-channel-news.scm"
 
-# Compute the Hydra jobs and write them in the target file.
-hydra-jobs.scm: $(GOBJECTS)
-	$(AM_V_at)$(MKDIR_P) "`dirname "$@"`"
-	$(AM_V_GEN)$(top_builddir)/pre-inst-env "$(GUILE)"		\
-	  "$(top_srcdir)/build-aux/hydra/evaluate.scm"			\
-	  "$(top_srcdir)/build-aux/hydra/gnu-system.scm" > "$@.tmp"
-	$(AM_V_at)mv "$@.tmp" "$@"
-
 # Compute the Cuirass jobs and write them in the target file.
 cuirass-jobs.scm: $(GOBJECTS)
 	$(AM_V_at)$(MKDIR_P) "`dirname "$@"`"
 	$(AM_V_GEN)$(top_builddir)/pre-inst-env "$(GUILE)"		\
-	  "$(top_srcdir)/build-aux/hydra/evaluate.scm"			\
+	  "$(top_srcdir)/build-aux/cuirass/evaluate.scm"			\
 	  "$(top_srcdir)/build-aux/cuirass/gnu-system.scm" 		\
-	  cuirass > "$@.tmp"
+	  "$@.tmp"
 	$(AM_V_at)mv "$@.tmp" "$@"
 
 .PHONY: gen-ChangeLog gen-AUTHORS gen-tarball-version
diff --git a/build-aux/hydra/evaluate.scm b/build-aux/cuirass/evaluate.scm
similarity index 82%
rename from build-aux/hydra/evaluate.scm
rename to build-aux/cuirass/evaluate.scm
index c74fcdb763..f2ad67a104 100644
--- a/build-aux/hydra/evaluate.scm
+++ b/build-aux/cuirass/evaluate.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -73,7 +74,7 @@ Otherwise return THING."
 \f
 ;; Without further ado...
 (match (command-line)
-  ((command file cuirass? ...)
+  ((command file output)
    ;; Load FILE, a Scheme file that defines Hydra jobs.
    (let ((port (current-output-port))
          (real-build-things build-things))
@@ -91,7 +92,7 @@ Otherwise return THING."
          ;; 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
+                                    "sha256" %top-srcdir
                                      #:select? (git-predicate %top-srcdir))))
            (with-directory-excursion source
              (save-module-excursion
@@ -102,23 +103,13 @@ Otherwise return THING."
                         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))))))
+           (call-with-output-file output
+             (lambda (port)
+               ((module-ref %user-module 'cuirass-jobs)
+                store
+                `((guix-modular . ((file-name . ,source))))
+                (lambda args
+                  (write args port))))))))))
   ((command _ ...)
    (format (current-error-port) "Usage: ~a FILE [cuirass]
 Evaluate the Hydra or Cuirass jobs defined in FILE.~%"
@@ -128,4 +119,3 @@ Evaluate the Hydra or Cuirass jobs defined in FILE.~%"
 ;;; Local Variables:
 ;;; eval: (put 'call-with-time 'scheme-indent-function 1)
 ;;; End:
-
diff --git a/build-aux/cuirass/gnu-system.scm b/build-aux/cuirass/gnu-system.scm
index 0eb834cfba..71f33691fc 100644
--- a/build-aux/cuirass/gnu-system.scm
+++ b/build-aux/cuirass/gnu-system.scm
@@ -1,5 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,5 +24,91 @@
 ;;; tool.
 ;;;
 
-(include "../hydra/gnu-system.scm")
-(include "hydra-to-cuirass.scm")
+(use-modules (guix inferior) (guix channels)
+             (guix)
+             (guix ui)
+             (srfi srfi-1)
+             (ice-9 match)
+             (ice-9 threads))
+
+;; 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) 'line)
+(set-current-output-port (current-error-port))
+
+(define (find-current-checkout arguments)
+  "Find the first checkout of ARGUMENTS that provided the current file.
+Return #f if no such checkout is found."
+  (let ((current-root
+         (canonicalize-path
+          (string-append (dirname (current-filename)) "/../.."))))
+    (find (lambda (argument)
+            (and=> (assq-ref argument 'file-name)
+                   (lambda (name)
+                     (string=? name current-root)))) arguments)))
+
+(define* (cuirass-jobs store arguments register)
+  "Return a list of jobs where each job is a NAME/THUNK pair."
+
+  (define checkout
+    (find-current-checkout arguments))
+
+  (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))))
+
+  ;; TODO: Remove 'show-what-to-build' call when Cuirass' 'evaluate' scripts
+  ;; uses 'with-build-handler'.
+  (show-what-to-build store (list derivation))
+  (build-derivations store (list derivation))
+
+  ;; Open an inferior for the just-built Guix.
+  (call-with-temporary-directory
+   (lambda (directory)
+     (let* ((name (string-append directory "/ci-inferior"))
+            (socket (socket AF_UNIX SOCK_STREAM 0))
+            (inferior (open-inferior (derivation->output-path derivation))))
+
+       ;; XXX: The inferior cannot call directly the register procedure that
+       ;; is declared in Cuirass.  Use a socket to proxy the inferior
+       ;; registration requests.
+       (call-with-new-thread
+        (lambda ()
+          (bind socket AF_UNIX name)
+          (listen socket 1024)
+          (match (select (list socket) '() '() 60)
+            (((_) () ())
+             (match (accept socket)
+               ((client . address)
+                (setvbuf client 'block 1024)
+                (let loop ((exp (read client)))
+                  (unless (eof-object? exp)
+                    (apply register exp)
+                    (loop (read client)))))))
+            ((() () ())
+             #f))
+          (close-port socket)))
+
+       (inferior-eval '(use-modules (gnu ci) (ice-9 match)) inferior)
+       (inferior-eval-with-store
+        inferior store
+        `(lambda (store)
+           (let* ((socket (socket AF_UNIX SOCK_STREAM 0))
+                  (register (lambda args
+                              (write args socket))))
+             (connect socket AF_UNIX ,name)
+             (setvbuf socket 'block 1024)
+             (cuirass-jobs store '((superior-guix-checkout . ,checkout)
+                                   ,@arguments)
+                           register)
+             (close-port socket))))))))
diff --git a/build-aux/cuirass/guix-modular.scm b/build-aux/cuirass/guix-modular.scm
index cbbdbf1133..0b546e55df 100644
--- a/build-aux/cuirass/guix-modular.scm
+++ b/build-aux/cuirass/guix-modular.scm
@@ -1,6 +1,83 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
 ;;;
-;;; This file defines Cuirass build jobs to build Guix itself.
+;;; 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/>.
+
+;;;
+;;; This file defines a continuous integration job to build the same modular
+;;; Guix as 'guix pull', which is defined in (guix self).
+;;;
+
+(use-modules (guix store)
+             (guix config)
+             (guix utils)
+             ((guix packages) #:select (%hydra-supported-systems))
+             (guix derivations)
+             (guix monads)
+             (srfi srfi-1)
+             (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) 'line)
+(set-current-output-port (current-error-port))
+
+(define* (build-job store register source version system)
+  "Register a Cuirass job a list building the modular Guix derivation from
+SOURCE for SYSTEM.  Use VERSION as the version identifier."
+  (define build
+    (primitive-load (string-append source "/build-aux/build-self.scm")))
+
+  (let ((name (string-append "guix." system))
+        (drv (run-with-store store
+               (build source #:version version #:system system
+                      #:pull-version 1
+                      #:guile-version "2.2"))))
+    (register name
+              #:derivation (derivation-file-name drv)
+              #:log (log-file store (derivation-file-name drv))
+              #:outputs (filter-map
+                         (lambda (res)
+                           (match res
+                             ((name . path)
+                              `(,name . ,path))))
+                         (derivation->output-paths drv))
+              #:nix-name (derivation-name drv)
+              #:system (derivation-system drv))))
+
+(define (cuirass-jobs store arguments register)
+  "Return Cuirass jobs."
+  (define systems
+    (match (assoc-ref arguments 'systems)
+      (#f              %hydra-supported-systems)
+      ((lst ...)       lst)
+      ((? string? str) (call-with-input-string str read))))
+
+  (define guix-checkout
+    (assq-ref arguments 'guix-modular))
+
+  (define version
+    (or (assq-ref guix-checkout 'revision)
+        "0.unknown"))
+
+  (let ((file (assq-ref guix-checkout 'file-name)))
+    (format (current-error-port) "using checkout ~s (~s; arguments: ~s)~%"
+            guix-checkout file arguments)
 
-(include "../hydra/guix-modular.scm")
-(include "hydra-to-cuirass.scm")
+    (for-each (lambda (system)
+                (build-job store register file version system))
+              systems)))
diff --git a/build-aux/cuirass/hydra-to-cuirass.scm b/build-aux/cuirass/hydra-to-cuirass.scm
deleted file mode 100644
index 75c77ea35a..0000000000
--- a/build-aux/cuirass/hydra-to-cuirass.scm
+++ /dev/null
@@ -1,47 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.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/>.
-
-;;;
-;;; This file defines the conversion of Hydra build jobs to Cuirass build
-;;; jobs.  It is meant to be included in other files.
-;;;
-
-(use-modules ((guix licenses)
-              #:select (license? license-name license-uri license-comment)))
-
-(define (cuirass-jobs store arguments)
-  "Return Cuirass jobs."
-  (map hydra-job->cuirass-job (hydra-jobs store arguments)))
-
-(define (hydra-job->cuirass-job hydra-job)
-  (let ((name (car hydra-job))
-        (job ((cdr hydra-job))))
-    (lambda _ (acons #:job-name (symbol->string name)
-                     (map symbol-alist-entry->keyword-alist-entry job)))))
-
-(define (symbol-alist-entry->keyword-alist-entry entry)
-  (cons (symbol->keyword (car entry)) (entry->sexp-entry (cdr entry))))
-
-(define (entry->sexp-entry o)
-  (match o
-    ((? license?) `((name . (license-name o))
-                    (uri . ,(license-uri o))
-                    (comment . ,(license-comment o))))
-    ((lst ...)
-     (map entry->sexp-entry lst))
-    (_ o)))
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
deleted file mode 100644
index a03324daeb..0000000000
--- a/build-aux/hydra/gnu-system.scm
+++ /dev/null
@@ -1,88 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
-;;; Copyright © 2018, 2019 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/>.
-
-;;;
-;;; This file defines build jobs for the Hydra continuation integration
-;;; tool.
-;;;
-
-(use-modules (guix inferior) (guix channels)
-             (guix)
-             (guix ui)
-             (srfi srfi-1)
-             (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) 'line)
-(set-current-output-port (current-error-port))
-
-(define (find-current-checkout arguments)
-  "Find the first checkout of ARGUMENTS that provided the current file.
-Return #f if no such checkout is found."
-  (let ((current-root
-         (canonicalize-path
-          (string-append (dirname (current-filename)) "/../.."))))
-    (find (lambda (argument)
-            (and=> (assq-ref argument 'file-name)
-                   (lambda (name)
-                     (string=? name current-root)))) arguments)))
-
-(define (hydra-jobs store arguments)
-  "Return a list of jobs where each job is a NAME/THUNK pair."
-
-  (define checkout
-    (find-current-checkout arguments))
-
-  (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))))
-
-  ;; TODO: Remove 'show-what-to-build' call when Cuirass' 'evaluate' scripts
-  ;; uses 'with-build-handler'.
-  (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 '((superior-guix-checkout . ,checkout)
-                                      ,@arguments))))))))
diff --git a/build-aux/hydra/guix-modular.scm b/build-aux/hydra/guix-modular.scm
deleted file mode 100644
index 060b84b8ef..0000000000
--- a/build-aux/hydra/guix-modular.scm
+++ /dev/null
@@ -1,91 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.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/>.
-
-;;;
-;;; This file defines a continuous integration job to build the same modular
-;;; Guix as 'guix pull', which is defined in (guix self).
-;;;
-
-(use-modules (guix store)
-             (guix config)
-             (guix utils)
-             ((guix packages) #:select (%hydra-supported-systems))
-             (guix derivations)
-             (guix monads)
-             ((guix licenses) #:prefix license:)
-             (srfi srfi-1)
-             (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) 'line)
-(set-current-output-port (current-error-port))
-
-(define* (build-job store source version system)
-  "Return a Hydra job a list building the modular Guix derivation from SOURCE
-for SYSTEM.  Use VERSION as the version identifier."
-  (lambda ()
-    (define build
-      (primitive-load (string-append source "/build-aux/build-self.scm")))
-
-    (let ((drv (run-with-store store
-                 (build source #:version version #:system system
-                        #:pull-version 1
-                        #:guile-version "2.2"))))
-      `((derivation . ,(derivation-file-name drv)) ;the latest 2.2.x
-        (log . ,(log-file store (derivation-file-name drv)))
-        (outputs . ,(filter-map (lambda (res)
-                                  (match res
-                                    ((name . path)
-                                     `(,name . ,path))))
-                                (derivation->output-paths drv)))
-        (nix-name . ,(derivation-name drv))
-        (system . ,(derivation-system drv))
-        (description . "Modular Guix")
-        (long-description
-         . "This is the modular Guix package as produced by 'guix pull'.")
-        (license . ,license:gpl3+)
-        (home-page . ,%guix-home-page-url)
-        (maintainers . (,%guix-bug-report-address))))))
-
-(define (hydra-jobs store arguments)
-  "Return Hydra jobs."
-  (define systems
-    (match (assoc-ref arguments 'systems)
-      (#f              %hydra-supported-systems)
-      ((lst ...)       lst)
-      ((? string? str) (call-with-input-string str read))))
-
-  (define guix-checkout
-    (or (assq-ref arguments 'guix)                ;Hydra on hydra
-        (assq-ref arguments 'guix-modular)))      ;Cuirass on berlin
-
-  (define version
-    (or (assq-ref guix-checkout 'revision)
-        "0.unknown"))
-
-  (let ((file (assq-ref guix-checkout 'file-name)))
-    (format (current-error-port) "using checkout ~s (~s; arguments: ~s)~%"
-            guix-checkout file arguments)
-
-    (map (lambda (system)
-           (let ((name (string->symbol
-                        (string-append "guix." system))))
-             `(,name
-               . ,(build-job store file version system))))
-         systems)))
diff --git a/build-aux/hydra/guix.scm b/build-aux/hydra/guix.scm
deleted file mode 100644
index 08193ec82e..0000000000
--- a/build-aux/hydra/guix.scm
+++ /dev/null
@@ -1,106 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.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/>.
-
-;;;
-;;; This file defines build jobs of Guix itself for the Hydra continuation
-;;; integration tool.
-;;;
-
-;; Attempt to use our very own Guix modules.
-(eval-when (expand load eval)
-
-  ;; Ignore any available .go, and force recompilation.  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.
-  (set! %fresh-auto-compile #t)
-
-  ;; Display which files are loaded.
-  (set! %load-verbosely #t)
-
-  (and=> (assoc-ref (current-source-location) 'filename)
-         (lambda (file)
-           (let ((dir (string-append (dirname file) "/../..")))
-             (format (current-error-port) "prepending ~s to the load path~%"
-                     dir)
-             (set! %load-path (cons dir %load-path))))))
-
-
-(use-modules (guix store)
-             (guix packages)
-             (guix utils)
-             (guix grafts)
-             (guix derivations)
-             (guix build-system gnu)
-             (gnu packages package-management)
-             (srfi srfi-1)
-             (srfi srfi-26)
-             (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))
-
-(define* (package->alist store package system
-                         #:optional (package-derivation package-derivation))
-  "Convert PACKAGE to an alist suitable for Hydra."
-  `((derivation . ,(derivation-file-name
-                    (parameterize ((%graft? #f))
-                      (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"))))
-
-(define (hydra-jobs store arguments)
-  "Return Hydra jobs."
-  (define systems
-    (match (filter-map (match-lambda
-                        (('system . value)
-                         value)
-                        (_ #f))
-                       arguments)
-      ((lst ..1)
-       lst)
-      (_
-       (list (%current-system)))))
-
-  (define guix-checkout
-    (assq-ref arguments 'guix))
-
-  (let ((file (assq-ref guix-checkout 'file-name)))
-    (format (current-error-port) "using checkout ~s (~s)~%"
-            guix-checkout file)
-
-    `((tarball . ,(cute package->alist store
-                        (dist-package guix file)
-                        (%current-system)))
-
-      ,@(map (lambda (system)
-               (let ((name (string->symbol
-                            (string-append "guix." system))))
-                 `(,name
-                   . ,(cute package->alist store
-                            (package
-                              (inherit guix)
-                              (version "latest")
-                              (source file))
-                            system))))
-             %hydra-supported-systems))))
diff --git a/gnu/ci.scm b/gnu/ci.scm
index 96bff64875..80c1553916 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2017, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
-;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
+;;; Copyright © 2020, 2021 Mathieu Othacehe <othacehe@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -64,67 +64,70 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
-  #:export (%cross-targets
+  #:export (%core-packages
+            %cross-targets
             channel-source->package
-            hydra-jobs))
+            cuirass-jobs))
 
 ;;; Commentary:
 ;;;
-;;; This file defines build jobs for the Hydra and Cuirass continuation
-;;; integration tools.
+;;; This file defines build jobs for Cuirass.
 ;;;
 ;;; Code:
 
-(define* (package->alist store package system
-                         #:optional (package-derivation package-derivation))
-  "Convert PACKAGE to an alist suitable for Hydra."
-  (parameterize ((%graft? #f))
-    (let ((drv (package-derivation store package system
-                                   #:graft? #f)))
-      `((derivation . ,(derivation-file-name drv))
-        (log . ,(log-file store (derivation-file-name drv)))
-        (outputs . ,(filter-map (lambda (res)
-                                  (match res
-                                    ((name . path)
-                                     `(,name . ,path))))
-                                (derivation->output-paths drv)))
-        (nix-name . ,(derivation-name drv))
-        (system . ,(derivation-system drv))
-        (description . ,(package-synopsis package))
-        (long-description . ,(package-description 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)
-                                           '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* (register-job-from-drv store drv
+                                #:key
+                                name
+                                register
+                                period
+                                (max-silent-time 3600)
+                                (timeout 3600))
+  "Register DRV in Cuirass by calling the REGISTER procedure."
+  ;; See "register-job" procedure in the (cuirass jobs) module.
+  (register name
+            #:derivation (derivation-file-name drv)
+            #:log (log-file store (derivation-file-name drv))
+            #:outputs (filter-map
+                       (lambda (res)
+                         (match res
+                           ((name . path)
+                            `(,name . ,path))))
+                       (derivation->output-paths drv))
+            #:nix-name (derivation-name drv)
+            #:system (derivation-system drv)
+            #:period period
+            #:max-silent-time max-silent-time
+            #:timeout timeout))
+
+(define* (package-job store job-name register package system
+                      #:key cross? target)
+  "Register a job called JOB-NAME that builds PACKAGE on SYSTEM."
+  (let ((job-name (string-append job-name "." system)))
+    (parameterize ((%graft? #f))
+      (let* ((drv (if cross?
+                      (package-cross-derivation store package target system
+                                                #:graft? #f)
+                      (package-derivation store package system
+                                          #:graft? #f)))
+             (max-silent-time (or (assoc-ref (package-properties package)
+                                             'max-silent-time)
+                                  3600))
+             (timeout (or (assoc-ref (package-properties package)
+                                     'timeout)
+                          72000)))
+        (register-job-from-drv store drv
+                               #:name job-name
+                               #:register register
+                               #:max-silent-time max-silent-time
+                               #:timeout timeout)))))
+
+(define (package-cross-job store job-name register package target system)
+  "Register a job called TARGET.JOB-NAME that cross-builds PACKAGE for TARGET
+on SYSTEM."
+  (let ((name (string-append target "." job-name "." system)))
+    (package-job store name register package system
+                 #:cross? #t
+                 #:target target)))
 
 (define %core-packages
   ;; Note: Don't put the '-final' package variants because (1) that's
@@ -157,8 +160,8 @@ SYSTEM."
     "i686-w64-mingw32"
     "x86_64-w64-mingw32"))
 
-(define (cross-jobs store system)
-  "Return a list of cross-compilation jobs for SYSTEM."
+(define (cross-jobs store register system)
+  "Register a list of cross-compilation jobs for 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
@@ -192,13 +195,14 @@ SYSTEM."
     (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 target)))
-              (remove (either from-32-to-64? same? pointless?)
-                      %cross-targets)))
+  (for-each (lambda (target)
+              (for-each (lambda (package)
+                          (package-cross-job store (job-name package)
+                                             register package
+                                             target system))
+                        (packages-to-cross-build target)))
+            (remove (either from-32-to-64? same? pointless?)
+                    %cross-targets)))
 
 ;; Architectures that are able to build or cross-build Guix System images.
 ;; This does not mean that other architectures are not supported, only that
@@ -215,36 +219,17 @@ SYSTEM."
 (define (hours hours)
   (* 3600 hours))
 
-(define (image-jobs store system)
+(define (image-jobs store register system)
   "Return a list of jobs that build images for SYSTEM.  Those jobs are
 expensive in storage and I/O operations, hence their periodicity is limited by
 passing the PERIOD argument."
-  (define (->alist drv)
-    `((derivation . ,(derivation-file-name drv))
-      (log . ,(log-file store (derivation-file-name drv)))
-      (outputs . ,(filter-map (lambda (res)
-                                (match res
-                                  ((name . path)
-                                   `(,name . ,path))))
-                              (derivation->output-paths drv)))
-      (nix-name . ,(derivation-name drv))
-      (system . ,(derivation-system drv))
-      (description . "Stand-alone image of the GNU system")
-      (long-description . "This is a demo stand-alone image of the GNU
-system.")
-      (license . ,(license-name gpl3+))
-      (period . ,(hours 48))
-      (max-silent-time . 3600)
-      (timeout . 3600)
-      (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))))))
+    (let ((name (string-append name "." system)))
+      (parameterize ((%graft? #f))
+        (register-job-from-drv store drv
+                               #:name name
+                               #:register register
+                               #:period (hours 48)))))
 
   (define (build-image image)
     (run-with-store store
@@ -256,25 +241,26 @@ system.")
     (expt 2 20))
 
   (if (member system %guix-system-supported-systems)
-      `(,(->job 'usb-image
+      `(,(->job "usb-image"
                 (build-image
                  (image
                   (inherit efi-disk-image)
                   (operating-system installation-os))))
-        ,(->job 'iso9660-image
+        ,(->job "iso9660-image"
                 (build-image
                  (image
                   (inherit (image-with-label
-                             iso9660-image
-                             (string-append "GUIX_" system "_"
-                                            (if (> (string-length %guix-version) 7)
-                                                (substring %guix-version 0 7)
-                                                %guix-version))))
+                            iso9660-image
+                            (string-append "GUIX_" system "_"
+                                           (if (> (string-length %guix-version) 7)
+                                               (substring %guix-version 0 7)
+                                               %guix-version))))
                   (operating-system installation-os))))
         ;; Only cross-compile Guix System images from x86_64-linux for now.
         ,@(if (string=? system "x86_64-linux")
               (map (lambda (image)
-                     (->job (image-name image) (build-image image)))
+                     (->job (symbol->string (image-name image))
+                            (build-image image)))
                    %guix-system-images)
               '()))
       '()))
@@ -319,122 +305,85 @@ system.")
     (native-inputs '())
     (propagated-inputs '())))
 
-(define* (system-test-jobs store system
+(define* (system-test-jobs store register system
                            #:key source commit)
-  "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))))
-
-      ;; Those tests are extremely expensive in I/O operations and storage
-      ;; size, use the "period" attribute to run them with a period of at
-      ;; least 48 hours.
-      `((derivation . ,(derivation-file-name drv))
-        (log . ,(log-file store (derivation-file-name drv)))
-        (outputs . ,(filter-map (lambda (res)
-                                  (match res
-                                    ((name . path)
-                                     `(,name . ,path))))
-                                (derivation->output-paths drv)))
-        (nix-name . ,(derivation-name drv))
-        (system . ,(derivation-system drv))
-        (description . ,(format #f "Guix '~a' system test"
-                                (system-test-name test)))
-        (long-description . ,(system-test-description test))
-        (license . ,(license-name gpl3+))
-        (period . ,(hours 48))
-        (max-silent-time . 3600)
-        (timeout . 3600)
-        (home-page . ,%guix-home-page-url)
-        (maintainers . ("bug-guix@gnu.org")))))
-
+  "Register a list of jobs for the system tests."
   (define (->job test)
-    (let ((name (string->symbol
-                 (string-append "test." (system-test-name test)
-                                "." system))))
-      (cons name (test->thunk test))))
+    (parameterize ((current-guix-package
+                    (channel-source->package source #:commit commit)))
+      (let ((name (string-append "test." (system-test-name test)
+                                 "." system))
+            (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)))))
+
+        ;; Those tests are extremely expensive in I/O operations and storage
+        ;; size, use the "period" attribute to run them with a period of at
+        ;; least 48 hours.
+        (register-job-from-drv store drv
+                               #:name name
+                               #:register register
+                               #:period (hours 24)))))
 
   (if (member system %guix-system-supported-systems)
       ;; Override the value of 'current-guix' used by system tests.  Using a
       ;; channel instance makes tests that rely on 'current-guix' less
       ;; expensive.  It also makes sure we get a valid Guix package when this
       ;; code is not running from a checkout.
-      (parameterize ((current-guix-package
-                      (channel-source->package source #:commit commit)))
-        (map ->job (all-system-tests)))
+      (for-each ->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))
-      (log . ,(log-file store (derivation-file-name drv)))
-      (outputs . ,(filter-map (lambda (res)
-                                (match res
-                                  ((name . path)
-                                   `(,name . ,path))))
-                              (derivation->output-paths drv)))
-      (nix-name . ,(derivation-name drv))
-      (system . ,(derivation-system 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 \"foreign\" distributions.")
-      (license . ,(license-name gpl3+))
-      (home-page . ,%guix-home-page-url)
-      (maintainers . ("bug-guix@gnu.org"))
-      (period . ,(hours 24))))
-
+(define (tarball-jobs store register system)
+  "Register jobs to build the self-contained Guix binary tarball."
   (define (->job name drv)
-    (let ((name (symbol-append name (string->symbol ".")
-                               (string->symbol system))))
-      `(,name . ,(lambda ()
-                   (parameterize ((%graft? #f))
-                     (->alist drv))))))
+    (let ((name (string-append name "." system)))
+      (parameterize ((%graft? #f))
+        (register-job-from-drv store drv
+                               #:name name
+                               #:register register
+                               #:period (hours 24)))))
 
   ;; 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))))
+  (->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 package-name))
+  package-name)
 
 (define package->job
   (let ((base-packages
          (delete-duplicates
           (append-map (match-lambda
-                       ((_ package _ ...)
-                        (match (package-transitive-inputs package)
-                          (((_ inputs _ ...) ...)
-                           inputs))))
+                        ((_ package _ ...)
+                         (match (package-transitive-inputs package)
+                           (((_ inputs _ ...) ...)
+                            inputs))))
                       (%final-inputs)))))
-    (lambda (store package system)
+    (lambda (store register 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))
+             (package-job store (string-append "base." (job-name package))
+                          register 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))))
+                                 register package system))))
             (else
              #f)))))
 
@@ -497,11 +446,11 @@ Return #f if no such checkout is found."
 
 \f
 ;;;
-;;; Hydra entry point.
+;;; Cuirass entry point.
 ;;;
 
-(define (hydra-jobs store arguments)
-  "Return Hydra jobs."
+(define (cuirass-jobs store arguments register)
+  "Register Cuirass jobs."
   (define subset
     (match (assoc-ref arguments 'subset)
       ("core" 'core)                              ; only build core packages
@@ -529,55 +478,57 @@ Return #f if no such checkout is found."
   ;; 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)
-                               (image-jobs store system)
-                               (system-test-jobs store system
-                                                 #:source source
-                                                 #:commit commit)
-                               (tarball-jobs store system)
-                               (cross-jobs store system))))
-                    ((core)
-                     ;; Build core packages only.
-                     (append (map (lambda (package)
-                                    (package-job store (job-name package)
-                                                 package system))
-                                  %core-packages)
-                             (cross-jobs store system)))
-                    ((hello)
-                     ;; Build hello package only.
-                     (let ((hello (specification->package "hello")))
-                       (list (package-job store (job-name hello) hello system))))
-                    ((list)
-                     ;; Build selected list of packages only.
-                     (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)))
+    (for-each (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 register
+                                              package system))))
+                     (filter-map job all)
+                     (image-jobs store register system)
+                     (system-test-jobs store register system
+                                       #:source source
+                                       #:commit commit)
+                     (tarball-jobs store register system)
+                     (cross-jobs store register system)))
+                  ((core)
+                   ;; Build core packages only.
+                   (begin
+                     (for-each (lambda (package)
+                                 (package-job store (job-name package)
+                                              register package system))
+                               %core-packages)
+                     (cross-jobs store register system)))
+                  ((hello)
+                   ;; Build hello package only.
+                   (let ((hello (specification->package "hello")))
+                     (list (package-job store (job-name hello)
+                                        register hello system))))
+                  ((list)
+                   ;; Build selected list of packages only.
+                   (let* ((names (assoc-ref arguments 'subset))
+                          (packages (map specification->package names)))
+                     (for-each (lambda (package)
+                                 (package-job store (job-name package)
+                                              register package system))
+                               packages)))
+                  ((manifests)
+                   ;; Build packages in the list of manifests.
+                   (let* ((manifests (arguments->manifests arguments))
+                          (packages (manifests->packages store manifests)))
+                     (for-each (lambda (package)
+                                 (package-job store (job-name package)
+                                              register package system))
+                               packages)))
+                  (else
+                   (error "unknown subset" subset))))
+              systems)))
-- 
2.24.0


^ permalink raw reply related	[flat|nested] 4+ messages in thread

* [bug#46585] ci: Remove hydra support.
  2021-02-17  8:42 [bug#46585] ci: Remove hydra support Mathieu Othacehe
@ 2021-02-22  9:59 ` Ludovic Courtès
  2021-03-26  9:52   ` bug#46585: " Mathieu Othacehe
  2021-03-24  3:25 ` [bug#46585] " zimoun
  1 sibling, 1 reply; 4+ messages in thread
From: Ludovic Courtès @ 2021-02-22  9:59 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 46585

Hi,

Mathieu Othacehe <othacehe@gnu.org> skribis:

> This removes hydra support to use Cuirass as the only continuous
> integration system.

Yay!  That part could have been a separate commit, for clarity, but
that’s okay.

> It also simplifies the evaluation process. Here's how it's working
> now:
>
> * Cuirass fetches new commits and calls its "evaluate" process.
>
> * The "evaluate" process calls the "cuirass-jobs" procedure in the
> newly checkouted Guix "build-aux/cuirass/gnu-system.scm" file.
>
> * The "hydra-jobs" procedure in "build-aux/hydra/gnu-system.scm" file
>   starts the evaluation of "hydra-jobs" of (gnu ci) module in an
>   inferior using the new commit.
>
> * This procedure returns the list of all the package derivations at that
>   very commit under Hydra job format.
>
> * This list is converted to the Cuirass job format and written on the
>   stdout port.
>
> * The main Cuirass process reads the "evaluate" output using a pipe, and
>   registers the derivation that needs to be built in database.
>
> This is quite complex and it requires to pass around a huge list of
> jobs, consuming a lot of memory.
>
> Here's the simplified method:
>
> * The first two steps are identical.
>
> * The "cuirass-jobs" procedure starts the evaluation of "cuirass-jobs"
>   of (gnu ci) module in an inferior using the new commit. This procedure
>   is passed a registration callback that directly registers the given
>   jobs in database. It doesn't return anything.
>
> As the "register" procedure is a part of Cuirass, the inversion on
> control caused by the inferior is problematic. I had to proxy the
> registration requests from the inferior to the evaluation process using
> a named pipe.

OK.  Another option, to avoid the callback, would have been to write
jobs to stdout as before, but to write them one by one instead of
building the entire list in memory.  Perhaps that would be slightly
simpler than the callback + named pipe?

> Other than that, the process seems now less obfuscated.

Yeah, thumbs up.  Do you know how this affects memory consumption?

Thanks!

Ludo’.




^ permalink raw reply	[flat|nested] 4+ messages in thread

* [bug#46585] ci: Remove hydra support.
  2021-02-17  8:42 [bug#46585] ci: Remove hydra support Mathieu Othacehe
  2021-02-22  9:59 ` Ludovic Courtès
@ 2021-03-24  3:25 ` zimoun
  1 sibling, 0 replies; 4+ messages in thread
From: zimoun @ 2021-03-24  3:25 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 46585

Hi Mathieu,

On Wed, 17 Feb 2021 at 09:42, Mathieu Othacehe <othacehe@gnu.org> wrote:

> This removes hydra support to use Cuirass as the only continuous
> integration system. It also simplifies the evaluation process. Here's
> how it's working now:

Have you pushed this patch as 76bea3f8bcd951ded88dfb7f8cad5bc3e5a1701f
without closing this report?


Thanks,
simon




^ permalink raw reply	[flat|nested] 4+ messages in thread

* bug#46585: ci: Remove hydra support.
  2021-02-22  9:59 ` Ludovic Courtès
@ 2021-03-26  9:52   ` Mathieu Othacehe
  0 siblings, 0 replies; 4+ messages in thread
From: Mathieu Othacehe @ 2021-03-26  9:52 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 46585-done


Hello,

> Yeah, thumbs up.  Do you know how this affects memory consumption?

Thanks. I pushed a variant of this patch, removing the register callback
procedure that I found too obscure. I also moved the inferior part to
Cuirass evaluation script.

Cuirass as well as the "build-aux/cuirass/evaluate.scm" script are now
evaluating each system in parallel. This decreases the amount of memory,
even though I don't have any figures and speeds up the evaluation.

Thanks,

Mathieu




^ permalink raw reply	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2021-03-26  9:53 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-02-17  8:42 [bug#46585] ci: Remove hydra support Mathieu Othacehe
2021-02-22  9:59 ` Ludovic Courtès
2021-03-26  9:52   ` bug#46585: " Mathieu Othacehe
2021-03-24  3:25 ` [bug#46585] " zimoun

Code repositories for project(s) associated with this external index

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

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.