06/13: services: guix: Support declarative offloading setup.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit aa40b085dc36721c00eb7fcde69c70c5d9284c1c
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Sep 15 15:16:04 2023 +0200

    services: guix: Support declarative offloading setup.
    
    * gnu/services/base.scm (guix-machines-files-installation): New
    procedure.
    (<guix-configuration>)[build-machines]: New field.
    (guix-activation): Call ‘ guix-machines-files-installation’.
    (<guix-extension>)[build-machines]: New field.
    (guix-extension-merge): Handle it.
    (guix-service-type)[extend]: Likewise.
    * doc/guix.texi (Daemon Offload Setup): Add note linking to
    ‘guix-configuration’.
    (Base Services): Document ‘build-machines’ field of <guix-configuration>
    and of <guix-extension>.
    (Virtualization Services): Add ‘hurd-vm’ anchor.
---
 doc/guix.texi         | 42 +++++++++++++++++++++++++++++++++++++++++-
 gnu/services/base.scm | 43 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 84 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index f49ed894a7..103f6b4c64 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1485,6 +1485,14 @@ name, and they will be scheduled on matching build 
machines.
 @end table
 @end deftp
 
+@quotation Note
+On Guix System, instead of managing @file{/etc/guix/machines.scm}
+independently, you can choose to specify build machines directly in the
+@code{operating-system} declaration, in the @code{build-machines} field
+of @code{guix-configuration}.  @xref{guix-configuration-build-machines,
+@code{build-machines} field of @code{guix-configuration}}.
+@end quotation
+
 The @command{guix} command must be in the search path on the build
 machines.  You can check whether this is the case by running:
 
@@ -19263,6 +19271,28 @@ The type of compression used for build logs---one of 
@code{gzip},
 Whether to discover substitute servers on the local network using mDNS
 and DNS-SD.
 
+@anchor{guix-configuration-build-machines}
+@item @code{build-machines} (default: @code{#f})
+This field must be either @code{#f} or a list of gexps evaluating to a
+@code{build-machine} record (@pxref{Daemon Offload Setup}).
+
+When it is @code{#f}, the @file{/etc/guix/machines.scm} file is left
+untouched.  Otherwise, the list of of gexps is written to
+@file{/etc/guix/machines.scm}; if a previously-existing file is found,
+it is backed up as @file{/etc/guix/machines.scm.bak}.  This allows you
+to declare build machines for offloading directly in the operating
+system declaration, like so:
+
+@lisp
+(guix-configuration
+  (build-machines
+    (list #~(build-machine (name "foo.example.org") @dots{})
+          #~(build-machine (name "bar.example.org") @dots{}))))
+@end lisp
+
+Additional build machines may be added @i{via} the @code{guix-extension}
+mechanism (see below).
+
 @item @code{extra-options} (default: @code{'()})
 List of extra command-line options for @command{guix-daemon}.
 
@@ -19300,7 +19330,6 @@ Environment variables to be set before starting the 
daemon, as a list of
 @end deftp
 
 @deftp {Data Type} guix-extension
-
 This data type represents the parameters of the Guix build daemon that
 are extendable. This is the type of the object that must be used within
 a guix service extension.
@@ -19313,6 +19342,16 @@ A list of file-like objects where each element 
contains a public key.
 @item @code{substitute-urls} (default: @code{'()})
 A list of strings where each element is a substitute URL.
 
+@item @code{build-machines} (default: @code{'()})
+A list of gexps that evaluate to @code{build-machine} records
+(@pxref{Daemon Offload Setup}).
+
+Using this field, a service may add new build machines to receive builds
+offloaded by the daemon.  This is useful for a service such as
+@code{hurd-vm-service-type}, which can make a GNU/Hurd virtual machine
+directly usable for offloading (@pxref{hurd-vm,
+@code{hurd-vm-service-type}}).
+
 @item @code{chroot-directories} (default: @code{'()})
 A list of file-like objects or strings pointing to additional directories the 
build daemon can use.
 @end table
@@ -35654,6 +35693,7 @@ host.  If empty, QEMU uses a default file name.
 @end deftp
 
 
+@anchor{hurd-vm}
 @subsubheading The Hurd in a Virtual Machine
 
 @cindex @code{hurd}
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 10e0d4cf9d..98d59fd36d 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1743,6 +1743,31 @@ archive' public keys, with GUIX."
   (list (file-append guix "/share/guix/berlin.guix.gnu.org.pub")
         (file-append guix "/share/guix/bordeaux.guix.gnu.org.pub")))
 
+(define (guix-machines-files-installation machines)
+  "Return a gexp to install MACHINES, a list of gexps, as
+/etc/guix/machines.scm, which is used for offloading."
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+
+        (define machines-file
+          "/etc/guix/machines.scm")
+
+        ;; If MACHINES-FILE already exists, move it out of the way.
+        ;; Create a backup if it's a regular file: it's likely that the
+        ;; user manually updated it.
+        (if (file-exists? machines-file)
+            (if (and (symbolic-link? machines-file)
+                     (store-file-name? (readlink machines-file)))
+                (delete-file machines-file)
+                (rename-file machines-file
+                             (string-append machines-file ".bak")))
+            (mkdir-p (dirname machines-file)))
+
+        ;; Installed the declared machines file.
+        (symlink #+(scheme-file "machines.scm" machines)
+                 machines-file))))
+
 (define-record-type* <guix-configuration>
   guix-configuration make-guix-configuration
   guix-configuration?
@@ -1780,6 +1805,8 @@ archive' public keys, with GUIX."
                     (default #f))
   (tmpdir           guix-tmpdir                   ;string | #f
                     (default #f))
+  (build-machines   guix-build-machines           ;list of gexps | #f
+                    (default #f))
   (environment      guix-configuration-environment  ;list of strings
                     (default '())))
 
@@ -1965,8 +1992,15 @@ proxy of 'guix-daemon'...~%")
           (system* #$(file-append guix "/bin/guix") "archive"
                    "--generate-key"))
 
+        ;; Optionally install /etc/guix/acl...
         #$(if authorize-key?
               (substitute-key-authorization authorized-keys guix)
+              #~#f)
+
+        ;; ... and /etc/guix/machines.scm.
+        #$(if (guix-build-machines config)
+              (guix-machines-files-installation
+               #~(list #$@(guix-build-machines config)))
               #~#f))))
 
 (define-record-type* <guix-extension>
@@ -1976,6 +2010,8 @@ proxy of 'guix-daemon'...~%")
                     (default '()))
   (substitute-urls guix-extension-substitute-urls ;list of strings
                     (default '()))
+  (build-machines  guix-extension-build-machines  ;list of gexps
+                   (default '()))
   (chroot-directories guix-extension-chroot-directories ;list of 
file-like/strings
                       (default '())))
 
@@ -1985,6 +2021,8 @@ proxy of 'guix-daemon'...~%")
                             (guix-extension-authorized-keys b)))
    (substitute-urls (append (guix-extension-substitute-urls a)
                             (guix-extension-substitute-urls b)))
+   (build-machines (append (guix-extension-build-machines a)
+                           (guix-extension-build-machines b)))
    (chroot-directories (append (guix-extension-chroot-directories a)
                                (guix-extension-chroot-directories b)))))
 
@@ -2008,6 +2046,11 @@ proxy of 'guix-daemon'...~%")
                                        (guix-configuration-authorized-keys 
config)))
               (substitute-urls (append (guix-extension-substitute-urls 
extension)
                                        (guix-configuration-substitute-urls 
config)))
+              (build-machines
+               (and (or (guix-build-machines config)
+                        (pair? (guix-extension-build-machines extension)))
+                    (append (or (guix-build-machines config) '())
+                            (guix-extension-build-machines extension))))
               (chroot-directories
                (append (guix-extension-chroot-directories extension)
                        (guix-configuration-chroot-directories config))))))