unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#68677] [PATCH 0/6] Service for "virtual build machines"
@ 2024-01-23 16:46 Ludovic Courtès
  2024-01-23 16:48 ` [bug#68677] [PATCH 1/6] services: secret-service: Make the endpoint configurable Ludovic Courtès
                   ` (9 more replies)
  0 siblings, 10 replies; 14+ messages in thread
From: Ludovic Courtès @ 2024-01-23 16:46 UTC (permalink / raw)
  To: 68677; +Cc: Ludovic Courtès

Hello Guix!

Lots of talk about reproducibility and how wonderful Guix is, but
as soon as you try to build packages from v1.0.0, released less
than 5 years ago, you hit a “time trap” in Python, in OpenSSL, or
some other ugly build failure—assuming you managed to fetch source
code in the first place¹.

This patch series defines a long-overdue
‘virtual-build-machine-service-type’: a service to run a virtual
machine available for offloading.  My main goal here is to
allow users to build stuff at a past date without having to
change their system clock.  It can also be used to control other
aspects usually not under control: the CPU model, the Linux kernel.

The series includes changes to <virtual-machine> that are not
actually used but can be useful; they come from a previous iteration
that didn’t pan out.

One limitation I’d like to address is the fact that the SSH and
secrets ports are exposed locally, as is already the case with
childhurds (any local user could inject secrets into the VM if
they connect at the right moment when it boots).  Future work
includes switching to AF_VSOCK sockets—see vsock(7).

Some of the code is shared with childhurds.  I don’t know if
we could factorize things further.

Thoughts?

Ludo’.

¹ This blog post by Simon explains the kind of problem one hits
  when traveling to the not-so-distant past:
  https://simon.tournier.info/posts/2023-12-21-repro-paper.html

Ludovic Courtès (6):
  services: secret-service: Make the endpoint configurable.
  vm: Add ‘date’ field to <virtual-machine>.
  vm: Export <virtual-machine> accessors.
  vm: Add ‘cpu-count’ field to <virtual-machine>.
  marionette: Add #:peek? to ‘wait-for-tcp-port?’.
  services: Add ‘virtual-build-machine’ service.

 doc/guix.texi                   | 139 ++++++-
 gnu/build/marionette.scm        |  32 +-
 gnu/build/secret-service.scm    |  62 ++--
 gnu/services/virtualization.scm | 640 ++++++++++++++++++++++++--------
 gnu/system/image.scm            |   1 +
 gnu/system/vm.scm               | 115 +++++-
 gnu/tests/virtualization.scm    | 176 +++++++--
 7 files changed, 933 insertions(+), 232 deletions(-)


base-commit: 299ce524c9f725549ab5548197cc88b085bba2f4
-- 
2.41.0





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

* [bug#68677] [PATCH 1/6] services: secret-service: Make the endpoint configurable.
  2024-01-23 16:46 [bug#68677] [PATCH 0/6] Service for "virtual build machines" Ludovic Courtès
@ 2024-01-23 16:48 ` Ludovic Courtès
  2024-01-23 16:48 ` [bug#68677] [PATCH 2/6] vm: Add ‘date’ field to <virtual-machine> Ludovic Courtès
                   ` (8 subsequent siblings)
  9 siblings, 0 replies; 14+ messages in thread
From: Ludovic Courtès @ 2024-01-23 16:48 UTC (permalink / raw)
  To: 68677; +Cc: Ludovic Courtès

Until now, the secret service had a hard-coded TCP endpoint on port
1004.  This change lets users specify arbitrary socket addresses.

* gnu/build/secret-service.scm (socket-address->string): New procedure,
taken from Shepherd.
(secret-service-send-secrets): Replace ‘port’ by ‘address’ and adjust
accordingly.
(secret-service-receive-secrets): Likewise.
* gnu/services/virtualization.scm (secret-service-shepherd-services):
Likewise.
(secret-service-operating-system): Add optional ‘address’ parameter and
honor it.  Adjust ‘start’ method accordingly.

Change-Id: I87a9514f1c170dca756ce76083d7182c6ebf6578
---
 gnu/build/secret-service.scm    | 62 +++++++++++++++++++++------------
 gnu/services/virtualization.scm | 40 ++++++++++++---------
 2 files changed, 63 insertions(+), 39 deletions(-)

diff --git a/gnu/build/secret-service.scm b/gnu/build/secret-service.scm
index e13fd4eef3..0226c64032 100644
--- a/gnu/build/secret-service.scm
+++ b/gnu/build/secret-service.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -93,13 +93,28 @@ (define (wait-for-readable-fd port timeout)
            ('readable #t)
            ('timeout  #f)))))))
 
-(define* (secret-service-send-secrets port secret-root
+(define (socket-address->string address)
+  "Return a human-readable representation of ADDRESS, an object as returned by
+'make-socket-address'."
+  (let ((family (sockaddr:fam address)))
+    (cond ((= AF_INET family)
+           (string-append (inet-ntop AF_INET (sockaddr:addr address))
+                          ":" (number->string (sockaddr:port address))))
+          ((= AF_INET6 family)
+           (string-append "[" (inet-ntop AF_INET6 (sockaddr:addr address)) "]"
+                          ":" (number->string (sockaddr:port address))))
+          ((= AF_UNIX family)
+           (sockaddr:path address))
+          (else
+           (object->string address)))))
+
+(define* (secret-service-send-secrets address secret-root
                                       #:key (retry 60)
                                       (handshake-timeout 180))
-  "Copy all files under SECRET-ROOT using TCP to secret-service listening at
-local PORT.  If connect fails, sleep 1s and retry RETRY times; once connected,
-wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete.  Return
-#f on failure."
+  "Copy all files under SECRET-ROOT by connecting to secret-service listening
+at ADDRESS, an address as returned by 'make-socket-address'.  If connection
+fails, sleep 1s and retry RETRY times; once connected, wait for at most
+HANDSHAKE-TIMEOUT seconds for handshake to complete.  Return #f on failure."
   (define (file->file+size+mode file-name)
     (let ((stat (stat file-name))
           (target (substring file-name (string-length secret-root))))
@@ -118,9 +133,9 @@ (define* (secret-service-send-secrets port secret-root
                       (dump-port input sock))))
                 files)))
 
-  (log "sending secrets to ~a~%" port)
+  (log "sending secrets to ~a~%" (socket-address->string address))
+
   (let ((sock (socket AF_INET (logior SOCK_CLOEXEC SOCK_STREAM) 0))
-        (addr (make-socket-address AF_INET INADDR_LOOPBACK port))
         (sleep (if (resolve-module '(fibers) #f)
                    (module-ref (resolve-interface '(fibers)) 'sleep)
                    sleep)))
@@ -129,7 +144,7 @@ (define* (secret-service-send-secrets port secret-root
     ;; forward port inside the guest.
     (let loop ((retry retry))
       (catch 'system-error
-        (cute connect sock addr)
+        (cute connect sock address)
         (lambda (key . args)
           (when (zero? retry)
             (apply throw key args))
@@ -147,7 +162,8 @@ (define* (secret-service-send-secrets port secret-root
           (('secret-service-server ('version version ...))
            (log "sending files from ~s...~%" secret-root)
            (send-files sock)
-           (log "done sending files to port ~a~%" port)
+           (log "done sending files to ~a~%"
+                (socket-address->string address))
            (close-port sock)
            secret-root)
           (x
@@ -155,7 +171,8 @@ (define* (secret-service-send-secrets port secret-root
            (close-port sock)
            #f))
         (begin                                    ;timeout
-         (log "timeout while sending files to ~a~%" port)
+         (log "timeout while sending files to ~a~%"
+              (socket-address->string address))
          (close-port sock)
          #f))))
 
@@ -168,19 +185,20 @@ (define (delete-file* file)
       (unless (= ENOENT (system-error-errno args))
         (apply throw args)))))
 
-(define (secret-service-receive-secrets port)
-  "Listen to local PORT and wait for a secret service client to send secrets.
-Write them to the file system.  Return the list of files installed on success,
-and #f otherwise."
+(define (secret-service-receive-secrets address)
+  "Listen to ADDRESS, an address returned by 'make-socket-address', and wait
+for a secret service client to send secrets.  Write them to the file system.
+Return the list of files installed on success, and #f otherwise."
 
-  (define (wait-for-client port)
-    ;; Wait for a TCP connection on PORT.  Note: We cannot use the
-    ;; virtio-serial ports, which would be safer, because they are
-    ;; (presumably) unsupported on GNU/Hurd.
+  (define (wait-for-client address)
+    ;; Wait for a connection on ADDRESS.  Note: virtio-serial ports are safer
+    ;; than TCP connections but they are (presumably) unsupported on GNU/Hurd.
     (let ((sock (socket AF_INET (logior SOCK_CLOEXEC SOCK_STREAM) 0)))
-      (bind sock AF_INET INADDR_ANY port)
+      (bind sock address)
       (listen sock 1)
-      (log "waiting for secrets on port ~a...~%" port)
+      (log "waiting for secrets on ~a...~%"
+           (socket-address->string address))
+
       (match (select (list sock) '() '() 60)
         (((_) () ())
          (match (accept sock)
@@ -244,7 +262,7 @@ (define (secret-service-receive-secrets port)
        (log "invalid secrets received~%")
        #f)))
 
-  (let* ((port   (wait-for-client port))
+  (let* ((port   (wait-for-client address))
          (result (and=> port read-secrets)))
     (when port
       (close-port port))
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index f0f0ab3bf1..5b8566f600 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -996,7 +996,7 @@ (define qemu-guest-agent-service-type
 ;;; Secrets for guest VMs.
 ;;;
 
-(define (secret-service-shepherd-services port)
+(define (secret-service-shepherd-services address)
   "Return a Shepherd service that fetches sensitive material at local PORT,
 over TCP.  Reboot upon failure."
   ;; This is a Shepherd service, rather than an activation snippet, to make
@@ -1018,7 +1018,7 @@ (define (secret-service-shepherd-services port)
                          "receiving secrets from the host...~%")
                  (force-output (current-error-port))
 
-                 (let ((sent (secret-service-receive-secrets #$port)))
+                 (let ((sent (secret-service-receive-secrets #$address)))
                    (unless sent
                      (sleep 3)
                      (reboot))))))
@@ -1039,9 +1039,13 @@ (define secret-service-type
 boot time.  This service is meant to be used by virtual machines (VMs) that
 can only be accessed by their host.")))
 
-(define (secret-service-operating-system os)
+(define* (secret-service-operating-system os
+                                          #:optional
+                                          (address
+                                           #~(make-socket-address
+                                              AF_INET INADDR_ANY 1004)))
   "Return an operating system based on OS that includes the secret-service,
-that will be listening to receive secret keys on port 1004, TCP."
+that will be listening to receive secret keys on ADDRESS."
   (operating-system
     (inherit os)
     (services
@@ -1049,7 +1053,7 @@ (define (secret-service-operating-system os)
      ;; activation: that requires entropy and thus takes time during boot, and
      ;; those keys are going to be overwritten by secrets received from the
      ;; host anyway.
-     (cons (service secret-service-type 1004)
+     (cons (service secret-service-type address)
            (modify-services (operating-system-user-services os)
              (openssh-service-type
               config => (openssh-configuration
@@ -1243,24 +1247,26 @@ (define (hurd-vm-shepherd-service config)
            (source-module-closure '((gnu build secret-service)
                                     (guix build utils)))
          #~(lambda ()
-             (let ((pid  (fork+exec-command #$vm-command
-                                            #:user "childhurd"
-                                            ;; XXX TODO: use "childhurd" after
-                                            ;; updating Shepherd
-                                            #:group "kvm"
-                                            #:environment-variables
-                                            ;; QEMU tries to write to /var/tmp
-                                            ;; by default.
-                                            '("TMPDIR=/tmp")))
-                   (port #$(hurd-vm-port config %hurd-vm-secrets-port))
-                   (root #$(hurd-vm-configuration-secret-root config)))
+             (let* ((pid  (fork+exec-command #$vm-command
+                                             #:user "childhurd"
+                                             ;; XXX TODO: use "childhurd" after
+                                             ;; updating Shepherd
+                                             #:group "kvm"
+                                             #:environment-variables
+                                             ;; QEMU tries to write to /var/tmp
+                                             ;; by default.
+                                             '("TMPDIR=/tmp")))
+                    (port #$(hurd-vm-port config %hurd-vm-secrets-port))
+                    (root #$(hurd-vm-configuration-secret-root config))
+                    (address (make-socket-address AF_INET INADDR_LOOPBACK
+                                                  port)))
                (catch #t
                  (lambda _
                    ;; XXX: 'secret-service-send-secrets' won't complete until
                    ;; the guest has booted and its secret service server is
                    ;; running, which could take 20+ seconds during which PID 1
                    ;; is stuck waiting.
-                   (if (secret-service-send-secrets port root)
+                   (if (secret-service-send-secrets address root)
                        pid
                        (begin
                          (kill (- pid) SIGTERM)
-- 
2.41.0





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

* [bug#68677] [PATCH 2/6] vm: Add ‘date’ field to <virtual-machine>.
  2024-01-23 16:46 [bug#68677] [PATCH 0/6] Service for "virtual build machines" Ludovic Courtès
  2024-01-23 16:48 ` [bug#68677] [PATCH 1/6] services: secret-service: Make the endpoint configurable Ludovic Courtès
@ 2024-01-23 16:48 ` Ludovic Courtès
  2024-01-23 16:48 ` [bug#68677] [PATCH 3/6] vm: Export <virtual-machine> accessors Ludovic Courtès
                   ` (7 subsequent siblings)
  9 siblings, 0 replies; 14+ messages in thread
From: Ludovic Courtès @ 2024-01-23 16:48 UTC (permalink / raw)
  To: 68677; +Cc: Ludovic Courtès

* gnu/system/vm.scm (<virtual-machine>)[date]: New field.
(virtual-machine-compiler): Honor it.

Change-Id: Idab1c152466d57cbc6784c031a99fdfd37080bcb
---
 gnu/system/vm.scm | 34 +++++++++++++++++-----------------
 1 file changed, 17 insertions(+), 17 deletions(-)

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 8c27ff787d..33604d3229 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -63,6 +63,7 @@ (define-module (gnu system vm)
   #:use-module (gnu system uuid)
 
   #:use-module ((srfi srfi-1) #:hide (partition))
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
@@ -326,7 +327,9 @@ (define-record-type* <virtual-machine> %virtual-machine
   (disk-image-size  virtual-machine-disk-image-size   ;integer (bytes)
                     (default 'guess))
   (port-forwardings virtual-machine-port-forwardings ;list of integer pairs
-                    (default '())))
+                    (default '()))
+  (date             virtual-machine-date          ;SRFI-19 date | #f
+                    (default #f)))
 
 (define-syntax virtual-machine
   (syntax-rules ()
@@ -353,22 +356,19 @@ (define-gexp-compiler (virtual-machine-compiler (vm <virtual-machine>)
                                                 system target)
   (match vm
     (($ <virtual-machine> os qemu volatile? graphic? memory-size
-                          disk-image-size ())
-     (system-qemu-image/shared-store-script os
-                                            #:system system
-                                            #:target target
-                                            #:qemu qemu
-                                            #:graphic? graphic?
-                                            #:volatile? volatile?
-                                            #:memory-size memory-size
-                                            #:disk-image-size
-                                            disk-image-size))
-    (($ <virtual-machine> os qemu volatile? graphic? memory-size
-                          disk-image-size forwardings)
+                          disk-image-size forwardings date)
      (let ((options
-            `("-nic" ,(string-append
-                       "user,model=virtio-net-pci,"
-                       (port-forwardings->qemu-options forwardings)))))
+            (append (if (null? forwardings)
+                        '()
+                        `("-nic" ,(string-append
+                                   "user,model=virtio-net-pci,"
+                                   (port-forwardings->qemu-options
+                                    forwardings))))
+                    (if date
+                        `("-rtc"
+                          ,(string-append
+                            "base=" (date->string date "~5")))
+                        '()))))
        (system-qemu-image/shared-store-script os
                                               #:system system
                                               #:target target
-- 
2.41.0





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

* [bug#68677] [PATCH 3/6] vm: Export <virtual-machine> accessors.
  2024-01-23 16:46 [bug#68677] [PATCH 0/6] Service for "virtual build machines" Ludovic Courtès
  2024-01-23 16:48 ` [bug#68677] [PATCH 1/6] services: secret-service: Make the endpoint configurable Ludovic Courtès
  2024-01-23 16:48 ` [bug#68677] [PATCH 2/6] vm: Add ‘date’ field to <virtual-machine> Ludovic Courtès
@ 2024-01-23 16:48 ` Ludovic Courtès
  2024-01-23 16:48 ` [bug#68677] [PATCH 4/6] vm: Add ‘cpu-count’ field to <virtual-machine> Ludovic Courtès
                   ` (6 subsequent siblings)
  9 siblings, 0 replies; 14+ messages in thread
From: Ludovic Courtès @ 2024-01-23 16:48 UTC (permalink / raw)
  To: 68677; +Cc: Ludovic Courtès

* gnu/system/vm.scm: Export.

Change-Id: If65d96f4052d070af5baee26f3dd9b233b8480f4
---
 gnu/system/vm.scm | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 33604d3229..a95f615e6b 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -72,7 +72,15 @@ (define-module (gnu system vm)
             system-qemu-image/shared-store-script
 
             virtual-machine
-            virtual-machine?))
+            virtual-machine?
+            virtual-machine-operating-system
+            virtual-machine-qemu
+            virtual-machine-volatile?
+            virtual-machine-graphic?
+            virtual-machine-memory-size
+            virtual-machine-disk-image-size
+            virtual-machine-port-forwardings
+            virtual-machine-date))
 
 \f
 ;;; Commentary:
-- 
2.41.0





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

* [bug#68677] [PATCH 4/6] vm: Add ‘cpu-count’ field to <virtual-machine>.
  2024-01-23 16:46 [bug#68677] [PATCH 0/6] Service for "virtual build machines" Ludovic Courtès
                   ` (2 preceding siblings ...)
  2024-01-23 16:48 ` [bug#68677] [PATCH 3/6] vm: Export <virtual-machine> accessors Ludovic Courtès
@ 2024-01-23 16:48 ` Ludovic Courtès
  2024-01-23 16:48 ` [bug#68677] [PATCH 5/6] marionette: Add #:peek? to ‘wait-for-tcp-port?’ Ludovic Courtès
                   ` (5 subsequent siblings)
  9 siblings, 0 replies; 14+ messages in thread
From: Ludovic Courtès @ 2024-01-23 16:48 UTC (permalink / raw)
  To: 68677; +Cc: Ludovic Courtès

* gnu/system/vm.scm (<virtual-machine>)[cpu-count]: New field.
(virtual-machine-compiler): Honor it.

Change-Id: I907a89365f32ac7a9981c4ae5f59cf6eb199c3cc
---
 gnu/system/vm.scm | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index a95f615e6b..ef4c180058 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -75,6 +75,7 @@ (define-module (gnu system vm)
             virtual-machine?
             virtual-machine-operating-system
             virtual-machine-qemu
+            virtual-machine-cpu-count
             virtual-machine-volatile?
             virtual-machine-graphic?
             virtual-machine-memory-size
@@ -326,6 +327,8 @@ (define-record-type* <virtual-machine> %virtual-machine
   (operating-system virtual-machine-operating-system) ;<operating-system>
   (qemu             virtual-machine-qemu              ;<package>
                     (default qemu-minimal))
+  (cpu-count        virtual-machine-cpu-count     ;integer
+                    (default 1))
   (volatile?        virtual-machine-volatile?    ;Boolean
                     (default #t))
   (graphic?         virtual-machine-graphic?      ;Boolean
@@ -363,7 +366,7 @@ (define (port-forwardings->qemu-options forwardings)
 (define-gexp-compiler (virtual-machine-compiler (vm <virtual-machine>)
                                                 system target)
   (match vm
-    (($ <virtual-machine> os qemu volatile? graphic? memory-size
+    (($ <virtual-machine> os qemu cpus volatile? graphic? memory-size
                           disk-image-size forwardings date)
      (let ((options
             (append (if (null? forwardings)
@@ -372,6 +375,10 @@ (define-gexp-compiler (virtual-machine-compiler (vm <virtual-machine>)
                                    "user,model=virtio-net-pci,"
                                    (port-forwardings->qemu-options
                                     forwardings))))
+                    (if (> cpus 1)
+                        `("-smp" ,(string-append "cpus="
+                                                 (number->string cpus)))
+                        '())
                     (if date
                         `("-rtc"
                           ,(string-append
-- 
2.41.0





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

* [bug#68677] [PATCH 5/6] marionette: Add #:peek? to ‘wait-for-tcp-port?’.
  2024-01-23 16:46 [bug#68677] [PATCH 0/6] Service for "virtual build machines" Ludovic Courtès
                   ` (3 preceding siblings ...)
  2024-01-23 16:48 ` [bug#68677] [PATCH 4/6] vm: Add ‘cpu-count’ field to <virtual-machine> Ludovic Courtès
@ 2024-01-23 16:48 ` Ludovic Courtès
  2024-01-23 16:48 ` [bug#68677] [PATCH 6/6] services: Add ‘virtual-build-machine’ service Ludovic Courtès
                   ` (4 subsequent siblings)
  9 siblings, 0 replies; 14+ messages in thread
From: Ludovic Courtès @ 2024-01-23 16:48 UTC (permalink / raw)
  To: 68677; +Cc: Ludovic Courtès

* gnu/build/marionette.scm (wait-for-tcp-port): Add #:peek? parameter
and honor it.

Change-Id: Ie7515a5223299390ab8af6fe5aa3cf63ba5c8078
---
 gnu/build/marionette.scm | 32 ++++++++++++++++++++++++++------
 1 file changed, 26 insertions(+), 6 deletions(-)

diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 27c10e3dfe..0b0a8a70d8 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2022, 2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
@@ -223,29 +223,49 @@ (define* (wait-for-file file marionette
 (define* (wait-for-tcp-port port marionette
                             #:key
                             (timeout 20)
+                            (peek? #f)
                             (address `(make-socket-address AF_INET
                                                            INADDR_LOOPBACK
                                                            ,port)))
   "Wait for up to TIMEOUT seconds for PORT to accept connections in
 MARIONETTE.  ADDRESS must be an expression that returns a socket address,
-typically a call to 'make-socket-address'.  Raise an error on failure."
+typically a call to 'make-socket-address'.  When PEEK? is true, attempt to
+read a byte from the socket upon connection; retry if that gives the
+end-of-file object.
+
+Raise an error on failure."
   ;; Note: The 'connect' loop has to run within the guest because, when we
   ;; forward ports to the host, connecting to the host never raises
   ;; ECONNREFUSED.
   (match (marionette-eval
-          `(let* ((address ,address)
-                  (sock (socket (sockaddr:fam address) SOCK_STREAM 0)))
-             (let loop ((i 0))
+          `(let* ((address ,address))
+             (define (open-socket)
+               (socket (sockaddr:fam address) SOCK_STREAM 0))
+
+             (let loop ((sock (open-socket))
+                        (i 0))
                (catch 'system-error
                  (lambda ()
                    (connect sock address)
+                   (when ,peek?
+                     (let ((byte ((@ (ice-9 binary-ports) lookahead-u8)
+                                  sock)))
+                       (when (eof-object? byte)
+                         (close-port sock)
+                         (throw 'system-error
+                                "wait-for-tcp-port" "~A"
+                                (list (strerror ECONNRESET))
+                                (list ECONNRESET)))))
                    (close-port sock)
                    'success)
                  (lambda args
                    (if (< i ,timeout)
                        (begin
                          (sleep 1)
-                         (loop (+ 1 i)))
+                         (loop (if (port-closed? sock)
+                                   (open-socket)
+                                   sock)
+                               (+ 1 i)))
                        (list 'failure address))))))
           marionette)
     ('success #t)
-- 
2.41.0





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

* [bug#68677] [PATCH 6/6] services: Add ‘virtual-build-machine’ service.
  2024-01-23 16:46 [bug#68677] [PATCH 0/6] Service for "virtual build machines" Ludovic Courtès
                   ` (4 preceding siblings ...)
  2024-01-23 16:48 ` [bug#68677] [PATCH 5/6] marionette: Add #:peek? to ‘wait-for-tcp-port?’ Ludovic Courtès
@ 2024-01-23 16:48 ` Ludovic Courtès
  2024-01-25 14:18 ` [bug#68677] [PATCH 0/6] Service for "virtual build machines" Simon Tournier
                   ` (3 subsequent siblings)
  9 siblings, 0 replies; 14+ messages in thread
From: Ludovic Courtès @ 2024-01-23 16:48 UTC (permalink / raw)
  To: 68677; +Cc: Ludovic Courtès

* gnu/services/virtualization.scm (<virtual-build-machine>): New record type.
(%build-vm-ssh-port, %build-vm-secrets-port, %x86-64-intel-cpu-models):
New variables.
(qemu-cpu-model-for-date, virtual-build-machine-ssh-port)
(virtual-build-machine-secrets-port): New procedures.
(%minimal-vm-syslog-config, %virtual-build-machine-operating-system):
New variables.
(virtual-build-machine-default-image):
(virtual-build-machine-account-name)
(virtual-build-machine-accounts)
(build-vm-shepherd-services)
(initialize-build-vm-substitutes)
(build-vm-activation)
(virtual-build-machine-offloading-ssh-key)
(virtual-build-machine-activation)
(virtual-build-machine-secret-root)
(check-vm-availability)
(build-vm-guix-extension): New procedures.
(initialize-hurd-vm-substitutes): Remove.
(hurd-vm-activation): Rewrite in terms of ‘build-vm-activation’.
* gnu/system/vm.scm (linux-image-startup-command): New procedure.
(operating-system-for-image): Export.
* gnu/tests/virtualization.scm (run-command-over-ssh): New procedure,
extracted from…
(run-childhurd-test): … here.
[test]: Adjust accordingly.
(%build-vm-os): New variable.
(run-build-vm-test): New procedure.
(%test-build-vm): New variable.
* doc/guix.texi (Virtualization Services)[Virtual Build Machines]: New
section.
(Build Environment Setup): Add cross-reference.

Change-Id: I0a47652a583062314020325aedb654f11cb2499c
---
 doc/guix.texi                   | 139 +++++++-
 gnu/services/virtualization.scm | 600 +++++++++++++++++++++++++-------
 gnu/system/image.scm            |   1 +
 gnu/system/vm.scm               |  62 +++-
 gnu/tests/virtualization.scm    | 176 ++++++++--
 5 files changed, 810 insertions(+), 168 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ac17f91f7d..04a6bf2bcd 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -22,7 +22,7 @@
 @set SUBSTITUTE-URLS https://@value{SUBSTITUTE-SERVER-1} https://@value{SUBSTITUTE-SERVER-2}
 
 @copying
-Copyright @copyright{} 2012-2023 Ludovic Courtès@*
+Copyright @copyright{} 2012-2024 Ludovic Courtès@*
 Copyright @copyright{} 2013, 2014, 2016 Andreas Enge@*
 Copyright @copyright{} 2013 Nikita Karetnikov@*
 Copyright @copyright{} 2014, 2015, 2016 Alex Kost@*
@@ -1297,6 +1297,11 @@ Build Environment Setup
 @file{/homeless-shelter}.  This helps to highlight inappropriate uses of
 @env{HOME} in the build scripts of packages.
 
+All this usually enough to ensure details of the environment do not
+influence build processes.  In some exceptional cases where more control
+is needed---typically over the date, kernel, or CPU---you can resort to
+a virtual build machine (@pxref{build-vm, virtual build machines}).
+
 You can influence the directory where the daemon stores build trees
 @i{via} the @env{TMPDIR} environment variable.  However, the build tree
 within the chroot is always called @file{/tmp/guix-build-@var{name}.drv-0},
@@ -36081,6 +36086,138 @@ Virtualization Services
 @end deftp
 
 
+@anchor{build-vm}
+@subsubheading Virtual Build Machines
+
+@cindex virtual build machines
+@cindex build VMs
+@cindex VMs, for offloading
+@dfn{Virtual build machines} or ``build VMs'' let you offload builds to
+a fully controlled environment.  ``How can it be more controlled than
+regular builds?  And why would it be useful?'', you ask.  Good
+questions.
+
+Builds spawned by @code{guix-daemon} indeed run in a controlled
+environment; specifically the daemon spawns build processes in separate
+namespaces and in a chroot, such as that build processes only see their
+declared dependencies and a well-defined subset of the file system tree
+(@pxref{Build Environment Setup}, for details).  A few aspects of the
+environments are not controlled though: the operating system kernel, the
+CPU model, and the date.  Most of the time, these aspects have no impact
+on the build process: the level of isolation @code{guix-daemon} provides
+is ``good enough''.
+
+@cindex time traps
+However, there are occasionally cases where those aspects @emph{do}
+influence the build process.  A typical example is @dfn{time traps}:
+build processes that stop working after a certain date@footnote{The most
+widespread example of time traps is test suites that involve checking
+the expiration date of a certificate.  Such tests exists in TLS
+implementations such as OpenSSL and GnuTLS, but also in high-level
+software such as Python.}.  Another one is software that optimizes for
+the CPU microarchitecture it is built on or, worse, bugs that manifest
+only on specific CPUs.
+
+To address that, @code{virtual-build-machine-service-type} lets you add
+a virtual build machine on your system, as in this example:
+
+@lisp
+(use-modules (gnu services virtualization))
+
+(operating-system
+  ;; @dots{}
+  (services (append (list (service virtual-build-machine-service-type))
+                    %base-services)))
+@end lisp
+
+By default, you have to explicitly start the build machine when you need
+it, at which point builds may be offloaded to it (@pxref{Daemon Offload
+Setup}):
+
+@example
+herd start build-vm
+@end example
+
+With the default setting shown above, the build VM runs with its clock
+set to a date several years in the past, and on a CPU model that
+corresponds to that date---a model possibly older than that of your
+machine.  This lets you rebuild today software from the past that would
+otherwise fail to build due to a time trap or other issues in its build
+process.
+
+You can configure the build VM, as in this example:
+
+@lisp
+(service virtual-build-machine-service-type
+         (virtual-build-machine
+          (cpu "Westmere")
+          (cpu-count 8)
+          (memory-size (* 1 1024))
+          (auto-start? #t)))
+@end lisp
+
+The available options are shown below.
+
+@defvar virtual-build-machine-service-type
+This is the service type to run @dfn{virtual build machines}.  Virtual
+build machines are configured so that builds are offloaded to them when
+they are running.
+@end defvar
+
+@deftp {Data Type} virtual-build-machine
+This is the data type specifying the configuration of a build machine.
+It contains the fields below:
+
+@table @asis
+@item @code{name} (default: @code{'build-vm})
+The name of this build VM.  It is used to construct the name of its
+Shepherd service.
+
+@item @code{image}
+The image of the virtual machine (@pxref{System Images}).  This notably
+specifies the virtual disk size and the operating system running into it
+(@pxref{operating-system Reference}).  The default value is a minimal
+operating system image.
+
+@item @code{qemu} (default: @code{qemu-minimal})
+The QEMU package to run the image.
+
+@item @code{cpu}
+The CPU model being emulated as a string denoting a model known to QEMU.
+
+The default value is a model that matches @code{date} (see below).  To
+see what CPU models are available, run, for example:
+
+@example
+qemu-system-x86_64 -cpu help
+@end example
+
+@item @code{cpu-count} (default: @code{4})
+The number of CPUs emulated by the virtual machine.
+
+@item @code{memory-size} (default: @code{2048})
+Size in mebibytes (MiB) of the virtual machine's main memory (RAM).
+
+@item @code{date} (default: a few years ago)
+Date inside the virtual machine when it starts; this must be a SRFI-19
+date object (@pxref{SRFI-19 Date,,, guile, GNU Guile Reference Manual}).
+
+@item @code{port-forwardings} (default: 11022 and 11004)
+TCP ports of the virtual machine forwarded to the host.  By default, the
+SSH and secrets ports are forwarded into the host.
+
+@item @code{systems} (default: @code{(list (%current-system))})
+List of system types supported by the build VM---e.g.,
+@code{"x86_64-linux"}.
+
+@item @code{auto-start?} (default: @code{#f})
+Whether to start the virtual machine when the system boots.
+@end table
+@end deftp
+
+In the next section, you'll find a variant on this theme: GNU/Hurd
+virtual machines!
+
 @anchor{hurd-vm}
 @subsubheading The Hurd in a Virtual Machine
 
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 5b8566f600..907d641c6a 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>
-;;; Copyright © 2018, 2020-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020, 2021, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si>
 ;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
@@ -43,6 +43,8 @@ (define-module (gnu services virtualization)
   #:use-module (gnu system hurd)
   #:use-module (gnu system image)
   #:use-module (gnu system shadow)
+  #:autoload   (gnu system vm) (linux-image-startup-command
+                                virtualized-operating-system)
   #:use-module (gnu system)
   #:use-module (guix derivations)
   #:use-module (guix gexp)
@@ -55,12 +57,20 @@ (define-module (gnu services virtualization)
   #:autoload   (guix self) (make-config.scm)
   #:autoload   (guix platform) (platform-system)
 
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
 
-  #:export (%hurd-vm-operating-system
+  #:export (virtual-build-machine
+            virtual-build-machine-service-type
+
+            %virtual-build-machine-operating-system
+            %virtual-build-machine-default-vm
+
+            %hurd-vm-operating-system
             hurd-vm-configuration
             hurd-vm-configuration?
             hurd-vm-configuration-os
@@ -1064,6 +1074,459 @@ (define* (secret-service-operating-system os
                          (inherit config)
                          (generate-substitute-key? #f))))))))
 
+\f
+;;;
+;;; Offloading-as-a-service.
+;;;
+
+(define-record-type* <virtual-build-machine>
+  virtual-build-machine make-virtual-build-machine
+  virtual-build-machine?
+  this-virtual-build-machine
+  (name        virtual-build-machine-name
+               (default 'build-vm))
+  (image       virtual-build-machine-image
+               (thunked)
+               (default
+                 (virtual-build-machine-default-image
+                  this-virtual-build-machine)))
+  (qemu        virtual-build-machine-qemu
+               (default qemu-minimal))
+  (cpu         virtual-build-machine-cpu
+               (thunked)
+               (default
+                 (qemu-cpu-model-for-date
+                  (virtual-build-machine-systems this-virtual-build-machine)
+                  (virtual-build-machine-date this-virtual-build-machine))))
+  (cpu-count   virtual-build-machine-cpu-count
+               (default 4))
+  (memory-size virtual-build-machine-memory-size  ;integer (MiB)
+               (default 2048))
+  (date        virtual-build-machine-date
+               (default (make-date 0 0 00 00 01 01 2020 0)))
+  (port-forwardings virtual-build-machine-port-forwardings
+                    (default
+                      `((,%build-vm-ssh-port . 22)
+                        (,%build-vm-secrets-port . 1004))))
+  (systems     virtual-build-machine-systems
+               (default (list (%current-system))))
+  (auto-start? virtual-build-machine-auto-start?
+               (default #f)))
+
+(define %build-vm-ssh-port
+  ;; Default host port where the guest's SSH port is forwarded.
+  11022)
+
+(define %build-vm-secrets-port
+  ;; Host port to communicate secrets to the build VM.
+  ;; FIXME: Anyone on the host can talk to it; use virtio ports or AF_VSOCK
+  ;; instead.
+  11044)
+
+(define %x86-64-intel-cpu-models
+  ;; List of release date/CPU model pairs representing Intel's x86_64 models.
+  ;; The list is taken from
+  ;; <https://en.wikipedia.org/wiki/List_of_Intel_CPU_microarchitectures>.
+  ;; CPU model strings are those found in 'qemu-system-x86_64 -cpu help'.
+  (letrec-syntax ((cpu-models (syntax-rules ()
+                                ((_ (date model) rest ...)
+                                 (alist-cons (date->time-utc
+                                              (string->date date "~Y-~m-~d"))
+                                             model
+                                             (cpu-models rest ...)))
+                                ((_)
+                                 '()))))
+    (reverse
+     (cpu-models ("2006-01-01" "core2duo")
+                 ("2010-01-01" "Westmere")
+                 ("2008-01-01" "Nehalem")
+                 ("2011-01-01" "SandyBridge")
+                 ("2012-01-01" "IvyBridge")
+                 ("2013-01-01" "Haswell")
+                 ("2014-01-01" "Broadwell")
+                 ("2015-01-01" "Skylake-Client")))))
+
+(define (qemu-cpu-model-for-date systems date)
+  "Return the QEMU name of a CPU model for SYSTEMS that was current at DATE."
+  (if (any (cut string-prefix? "x86_64-" <>) systems)
+      (let ((time (date->time-utc date)))
+        (any (match-lambda
+               ((release-date . model)
+                (and (time<? release-date time)
+                     model)))
+             %x86-64-intel-cpu-models))
+      ;; TODO: Add models for other architectures.
+      "host"))
+
+(define (virtual-build-machine-ssh-port config)
+  "Return the host port where CONFIG has its VM's SSH port forwarded."
+  (any (match-lambda
+         ((host-port . 22) host-port)
+         (_ #f))
+       (virtual-build-machine-port-forwardings config)))
+
+(define (virtual-build-machine-secrets-port config)
+  "Return the host port where CONFIG has its VM's secrets port forwarded."
+  (any (match-lambda
+         ((host-port . 1004) host-port)
+         (_ #f))
+       (virtual-build-machine-port-forwardings config)))
+
+(define %minimal-vm-syslog-config
+  ;; Minimal syslog configuration for a VM.
+  (plain-file "vm-syslog.conf" "\
+# Log most messages to the console, which goes to the serial
+# output, allowing the host to log it.
+*.info;auth.notice;authpriv.none       -/dev/console
+
+# The rest.
+*.=debug                               -/var/log/debug
+authpriv.*;auth.info                    /var/log/secure
+"))
+
+(define %virtual-build-machine-operating-system
+  (operating-system
+    (host-name "build-machine")
+    (bootloader (bootloader-configuration         ;unused
+                 (bootloader grub-minimal-bootloader)
+                 (targets '("/dev/null"))))
+    (file-systems (list (file-system              ;unused
+                          (mount-point "/")
+                          (device "none")
+                          (type "tmpfs"))))
+    (users (cons (user-account
+                  (name "offload")
+                  (group "users")
+                  (supplementary-groups '("kvm"))
+                  (comment "Account used for offloading"))
+                 %base-user-accounts))
+    (services (cons* (service static-networking-service-type
+                              (list %qemu-static-networking))
+                     (service openssh-service-type
+                              (openssh-configuration
+                               (openssh openssh-sans-x)))
+
+                     (modify-services %base-services
+                       ;; By default, the secret service introduces a
+                       ;; pre-initialized /etc/guix/acl file in the VM.  Thus,
+                       ;; clear 'authorize-key?' so that it's not overridden
+                       ;; at activation time.
+                       (guix-service-type config =>
+                                          (guix-configuration
+                                           (inherit config)
+                                           (authorize-key? #f)))
+                       (syslog-service-type config =>
+                                            (syslog-configuration
+                                             (config-file
+                                              %minimal-vm-syslog-config)))
+                       (delete mingetty-service-type)
+                       (delete console-font-service-type))))))
+
+(define (virtual-build-machine-default-image config)
+  (let* ((type (lookup-image-type-by-name 'mbr-raw))
+         (base (os->image %virtual-build-machine-operating-system
+                          #:type type)))
+    (image (inherit base)
+           (name (symbol-append 'build-vm-
+                                (virtual-build-machine-name config)))
+           (format 'compressed-qcow2)
+           (partition-table-type 'mbr)
+           (shared-store? #f)
+           (size (* 10 (expt 2 30))))))
+
+(define (virtual-build-machine-account-name config)
+  (string-append "build-vm-"
+                 (symbol->string
+                  (virtual-build-machine-name config))))
+
+(define (virtual-build-machine-accounts config)
+  (let ((name (virtual-build-machine-account-name config)))
+    (list (user-group (name name) (system? #t))
+          (user-account
+           (name name)
+           (group name)
+           (supplementary-groups '("kvm"))
+           (comment "Privilege separation user for the virtual build machine")
+           (home-directory "/var/empty")
+           (shell (file-append shadow "/sbin/nologin"))
+           (system? #t)))))
+
+(define (build-vm-shepherd-services config)
+  (define transform
+    (compose secret-service-operating-system
+             operating-system-with-locked-root-account
+             operating-system-with-offloading-account
+             (lambda (os)
+               (virtualized-operating-system os #:full-boot? #t))))
+
+  (define transformed-image
+    (let ((base (virtual-build-machine-image config)))
+      (image
+       (inherit base)
+       (operating-system
+         (transform (image-operating-system base))))))
+
+  (define command
+    (linux-image-startup-command transformed-image
+                                 #:qemu
+                                 (virtual-build-machine-qemu config)
+                                 #:cpu
+                                 (virtual-build-machine-cpu config)
+                                 #:cpu-count
+                                 (virtual-build-machine-cpu-count config)
+                                 #:memory-size
+                                 (virtual-build-machine-memory-size config)
+                                 #:port-forwardings
+                                 (virtual-build-machine-port-forwardings
+                                  config)
+                                 #:date
+                                 (virtual-build-machine-date config)))
+
+  (define user
+    (virtual-build-machine-account-name config))
+
+  (list (shepherd-service
+         (documentation "Run the build virtual machine service.")
+         (provision (list (virtual-build-machine-name config)))
+         (requirement '(user-processes))
+         (modules `((gnu build secret-service)
+                    (guix build utils)
+                    ,@%default-modules))
+         (start
+          (with-imported-modules (source-module-closure
+                                  '((gnu build secret-service)
+                                    (guix build utils)))
+            #~(lambda arguments
+                (let* ((pid  (fork+exec-command (append #$command arguments)
+                                                #:user #$user
+                                                #:group "kvm"
+                                                #:environment-variables
+                                                ;; QEMU tries to write to /var/tmp
+                                                ;; by default.
+                                                '("TMPDIR=/tmp")))
+                       (port #$(virtual-build-machine-secrets-port config))
+                       (root #$(virtual-build-machine-secret-root config))
+                       (address (make-socket-address AF_INET INADDR_LOOPBACK
+                                                     port)))
+                  (catch #t
+                    (lambda _
+                      (if (secret-service-send-secrets address root)
+                          pid
+                          (begin
+                            (kill (- pid) SIGTERM)
+                            #f)))
+                    (lambda (key . args)
+                      (kill (- pid) SIGTERM)
+                      (apply throw key args)))))))
+         (stop #~(make-kill-destructor))
+         (auto-start? (virtual-build-machine-auto-start? config)))))
+
+(define (authorize-guest-substitutes-on-host)
+  "Return a program that authorizes the guest's archive signing key (passed as
+an argument) on the host."
+  (define not-config?
+    (match-lambda
+      ('(guix config) #f)
+      (('guix _ ...) #t)
+      (('gnu _ ...) #t)
+      (_ #f)))
+
+  (define run
+    (with-extensions (list guile-gcrypt)
+      (with-imported-modules `(((guix config) => ,(make-config.scm))
+                               ,@(source-module-closure
+                                  '((guix pki)
+                                    (guix build utils))
+                                  #:select? not-config?))
+        #~(begin
+            (use-modules (ice-9 match)
+                         (ice-9 textual-ports)
+                         (gcrypt pk-crypto)
+                         (guix pki)
+                         (guix build utils))
+
+            (match (command-line)
+              ((_ guest-config-directory)
+               (let ((guest-key (string-append guest-config-directory
+                                               "/signing-key.pub")))
+                 (if (file-exists? guest-key)
+                     ;; Add guest key to the host's ACL.
+                     (let* ((key (string->canonical-sexp
+                                  (call-with-input-file guest-key
+                                    get-string-all)))
+                            (acl (public-keys->acl
+                                  (cons key (acl->public-keys (current-acl))))))
+                       (with-atomic-file-replacement %acl-file
+                         (lambda (_ port)
+                           (write-acl acl port))))
+                     (format (current-error-port)
+                             "warning: guest key missing from '~a'~%"
+                             guest-key)))))))))
+
+  (program-file "authorize-guest-substitutes-on-host" run))
+
+(define (initialize-build-vm-substitutes)
+  "Initialize the Hurd VM's key pair and ACL and store it on the host."
+  (define run
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils)
+                       (ice-9 match))
+
+          (define host-key
+            "/etc/guix/signing-key.pub")
+
+          (define host-acl
+            "/etc/guix/acl")
+
+          (match (command-line)
+            ((_ guest-config-directory)
+             (setenv "GUIX_CONFIGURATION_DIRECTORY"
+                     guest-config-directory)
+             (invoke #+(file-append guix "/bin/guix") "archive"
+                     "--generate-key")
+
+             (when (file-exists? host-acl)
+               ;; Copy the host ACL.
+               (copy-file host-acl
+                          (string-append guest-config-directory
+                                         "/acl")))
+
+             (when (file-exists? host-key)
+               ;; Add the host key to the childhurd's ACL.
+               (let ((key (open-fdes host-key O_RDONLY)))
+                 (close-fdes 0)
+                 (dup2 key 0)
+                 (execl #+(file-append guix "/bin/guix")
+                        "guix" "archive" "--authorize"))))))))
+
+  (program-file "initialize-build-vm-substitutes" run))
+
+(define* (build-vm-activation secret-directory
+                              #:key
+                              offloading-ssh-key
+                              (offloading? #t))
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+
+        (define secret-directory
+          #$secret-directory)
+
+        (define ssh-directory
+          (string-append secret-directory "/etc/ssh"))
+
+        (define guix-directory
+          (string-append secret-directory "/etc/guix"))
+
+        (define offloading-ssh-key
+          #$offloading-ssh-key)
+
+        (unless (file-exists? ssh-directory)
+          ;; Generate SSH host keys under SSH-DIRECTORY.
+          (mkdir-p ssh-directory)
+          (invoke #$(file-append openssh "/bin/ssh-keygen")
+                  "-A" "-f" secret-directory))
+
+        (unless (or (not #$offloading?)
+                    (file-exists? offloading-ssh-key))
+          ;; Generate a user SSH key pair for the host to use when offloading
+          ;; to the guest.
+          (mkdir-p (dirname offloading-ssh-key))
+          (invoke #$(file-append openssh "/bin/ssh-keygen")
+                  "-t" "ed25519" "-N" ""
+                  "-f" offloading-ssh-key)
+
+          ;; Authorize it in the guest for user 'offloading'.
+          (let ((authorizations
+                 (string-append ssh-directory
+                                "/authorized_keys.d/offloading")))
+            (mkdir-p (dirname authorizations))
+            (copy-file (string-append offloading-ssh-key ".pub")
+                       authorizations)
+            (chmod (dirname authorizations) #o555)))
+
+        (unless (file-exists? guix-directory)
+          (invoke #$(initialize-build-vm-substitutes)
+                  guix-directory))
+
+        (when #$offloading?
+          ;; Authorize the archive signing key from GUIX-DIRECTORY in the host.
+          (invoke #$(authorize-guest-substitutes-on-host) guix-directory)))))
+
+(define (virtual-build-machine-offloading-ssh-key config)
+  "Return the name of the file containing the SSH key of user 'offloading'."
+  (string-append "/etc/guix/offload/ssh/virtual-build-machine/"
+                 (symbol->string
+                  (virtual-build-machine-name config))))
+
+(define (virtual-build-machine-activation config)
+  "Return a gexp to activate the build VM according to CONFIG."
+  (build-vm-activation (virtual-build-machine-secret-root config)
+                       #:offloading? #t
+                       #:offloading-ssh-key
+                       (virtual-build-machine-offloading-ssh-key config)))
+
+(define (virtual-build-machine-secret-root config)
+  (string-append "/etc/guix/virtual-build-machines/"
+                 (symbol->string
+                  (virtual-build-machine-name config))))
+
+(define (check-vm-availability config)
+  "Return a Scheme file that evaluates to true if the service corresponding to
+CONFIG, a <virtual-build-machine>, is up and running."
+  (define service-name
+    (virtual-build-machine-name config))
+
+  (scheme-file "check-build-vm-availability.scm"
+               #~(begin
+                   (use-modules (gnu services herd)
+                                (srfi srfi-34))
+
+                   (guard (c ((service-not-found-error? c) #f))
+                     (->bool (current-service '#$service-name))))))
+
+(define (build-vm-guix-extension config)
+  (define vm-ssh-key
+    (string-append
+     (virtual-build-machine-secret-root config)
+     "/etc/ssh/ssh_host_ed25519_key.pub"))
+
+  (define host-ssh-key
+    (virtual-build-machine-offloading-ssh-key config))
+
+  (guix-extension
+   (build-machines
+    (list #~(if (primitive-load #$(check-vm-availability config))
+                (list (build-machine
+                       (name "localhost")
+                       (port #$(virtual-build-machine-ssh-port config))
+                       (systems
+                        '#$(virtual-build-machine-systems config))
+                       (user "offloading")
+                       (host-key (call-with-input-file #$vm-ssh-key
+                                   (@ (ice-9 textual-ports)
+                                      get-string-all)))
+                       (private-key #$host-ssh-key)))
+                '())))))
+
+(define virtual-build-machine-service-type
+  (service-type
+   (name 'build-vm)
+   (extensions (list (service-extension shepherd-root-service-type
+                                        build-vm-shepherd-services)
+                     (service-extension guix-service-type
+                                        build-vm-guix-extension)
+                     (service-extension account-service-type
+                                        virtual-build-machine-accounts)
+                     (service-extension activation-service-type
+                                        virtual-build-machine-activation)))
+   (description
+    "Create a @dfn{virtual build machine}: a virtual machine (VM) that builds
+can be offloaded to.  By default, the virtual machine starts with a clock
+running at some point in the past.")
+   (default-value (virtual-build-machine))))
+
 \f
 ;;;
 ;;; The Hurd in VM service: a Childhurd.
@@ -1290,136 +1753,13 @@ (define %hurd-vm-accounts
          (shell (file-append shadow "/sbin/nologin"))
          (system? #t))))
 
-(define (initialize-hurd-vm-substitutes)
-  "Initialize the Hurd VM's key pair and ACL and store it on the host."
-  (define run
-    (with-imported-modules '((guix build utils))
-      #~(begin
-          (use-modules (guix build utils)
-                       (ice-9 match))
-
-          (define host-key
-            "/etc/guix/signing-key.pub")
-
-          (define host-acl
-            "/etc/guix/acl")
-
-          (match (command-line)
-            ((_ guest-config-directory)
-             (setenv "GUIX_CONFIGURATION_DIRECTORY"
-                     guest-config-directory)
-             (invoke #+(file-append guix "/bin/guix") "archive"
-                     "--generate-key")
-
-             (when (file-exists? host-acl)
-               ;; Copy the host ACL.
-               (copy-file host-acl
-                          (string-append guest-config-directory
-                                         "/acl")))
-
-             (when (file-exists? host-key)
-               ;; Add the host key to the childhurd's ACL.
-               (let ((key (open-fdes host-key O_RDONLY)))
-                 (close-fdes 0)
-                 (dup2 key 0)
-                 (execl #+(file-append guix "/bin/guix")
-                        "guix" "archive" "--authorize"))))))))
-
-  (program-file "initialize-hurd-vm-substitutes" run))
-
-(define (authorize-guest-substitutes-on-host)
-  "Return a program that authorizes the guest's archive signing key (passed as
-an argument) on the host."
-  (define not-config?
-    (match-lambda
-      ('(guix config) #f)
-      (('guix _ ...) #t)
-      (('gnu _ ...) #t)
-      (_ #f)))
-
-  (define run
-    (with-extensions (list guile-gcrypt)
-      (with-imported-modules `(((guix config) => ,(make-config.scm))
-                               ,@(source-module-closure
-                                  '((guix pki)
-                                    (guix build utils))
-                                  #:select? not-config?))
-        #~(begin
-            (use-modules (ice-9 match)
-                         (ice-9 textual-ports)
-                         (gcrypt pk-crypto)
-                         (guix pki)
-                         (guix build utils))
-
-            (match (command-line)
-              ((_ guest-config-directory)
-               (let ((guest-key (string-append guest-config-directory
-                                               "/signing-key.pub")))
-                 (if (file-exists? guest-key)
-                     ;; Add guest key to the host's ACL.
-                     (let* ((key (string->canonical-sexp
-                                  (call-with-input-file guest-key
-                                    get-string-all)))
-                            (acl (public-keys->acl
-                                  (cons key (acl->public-keys (current-acl))))))
-                       (with-atomic-file-replacement %acl-file
-                         (lambda (_ port)
-                           (write-acl acl port))))
-                     (format (current-error-port)
-                             "warning: guest key missing from '~a'~%"
-                             guest-key)))))))))
-
-  (program-file "authorize-guest-substitutes-on-host" run))
-
 (define (hurd-vm-activation config)
   "Return a gexp to activate the Hurd VM according to CONFIG."
-  (with-imported-modules '((guix build utils))
-    #~(begin
-        (use-modules (guix build utils))
-
-        (define secret-directory
-          #$(hurd-vm-configuration-secret-root config))
-
-        (define ssh-directory
-          (string-append secret-directory "/etc/ssh"))
-
-        (define guix-directory
-          (string-append secret-directory "/etc/guix"))
-
-        (define offloading-ssh-key
-          #$(hurd-vm-configuration-offloading-ssh-key config))
-
-        (unless (file-exists? ssh-directory)
-          ;; Generate SSH host keys under SSH-DIRECTORY.
-          (mkdir-p ssh-directory)
-          (invoke #$(file-append openssh "/bin/ssh-keygen")
-                  "-A" "-f" secret-directory))
-
-        (unless (or (not #$(hurd-vm-configuration-offloading? config))
-                    (file-exists? offloading-ssh-key))
-          ;; Generate a user SSH key pair for the host to use when offloading
-          ;; to the guest.
-          (mkdir-p (dirname offloading-ssh-key))
-          (invoke #$(file-append openssh "/bin/ssh-keygen")
-                  "-t" "ed25519" "-N" ""
-                  "-f" offloading-ssh-key)
-
-          ;; Authorize it in the guest for user 'offloading'.
-          (let ((authorizations
-                 (string-append ssh-directory
-                                "/authorized_keys.d/offloading")))
-            (mkdir-p (dirname authorizations))
-            (copy-file (string-append offloading-ssh-key ".pub")
-                       authorizations)
-            (chmod (dirname authorizations) #o555)))
-
-        (unless (file-exists? guix-directory)
-          (invoke #$(initialize-hurd-vm-substitutes)
-                  guix-directory))
-
-        (when #$(hurd-vm-configuration-offloading? config)
-          ;; Authorize the archive signing key from GUIX-DIRECTORY in the host.
-          (invoke #$(authorize-guest-substitutes-on-host) guix-directory)))))
+  (build-vm-activation (hurd-vm-configuration-secret-root config)
+                       #:offloading?
+                       (hurd-vm-configuration-offloading? config)
+                       #:offloading-ssh-key
+                       (hurd-vm-configuration-offloading-ssh-key config)))
 
 (define (hurd-vm-configuration-offloading-ssh-key config)
   "Return the name of the file containing the SSH key of user 'offloading'."
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 2cc1012893..87df2fa088 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -72,6 +72,7 @@ (define-module (gnu system image)
   #:export (root-offset
             root-label
             image-without-os
+            operating-system-for-image
 
             esp-partition
             esp32-partition
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index ef4c180058..fcfd1cdb48 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -71,6 +71,8 @@ (define-module (gnu system vm)
   #:export (virtualized-operating-system
             system-qemu-image/shared-store-script
 
+            linux-image-startup-command
+
             virtual-machine
             virtual-machine?
             virtual-machine-operating-system
@@ -132,7 +134,8 @@ (define (mapping->file-system mapping)
        (check? #f)
        (create-mount-point? #t)))))
 
-(define* (virtualized-operating-system os mappings
+(define* (virtualized-operating-system os
+                                       #:optional (mappings '())
                                        #:key (full-boot? #f) volatile?)
   "Return an operating system based on OS suitable for use in a virtualized
 environment with the store shared with the host.  MAPPINGS is a list of
@@ -316,6 +319,63 @@ (define* (system-qemu-image/shared-store-script os
 
     (gexp->derivation "run-vm.sh" builder)))
 
+(define* (linux-image-startup-command image
+                                      #:key
+                                      (system (%current-system))
+                                      (target #f)
+                                      (qemu qemu-minimal)
+                                      (graphic? #f)
+                                      (cpu "max")
+                                      (cpu-count 1)
+                                      (memory-size 1024)
+                                      (port-forwardings '())
+                                      (date #f))
+  "Return a list-valued gexp representing the command to start QEMU to run
+IMAGE, assuming it uses the Linux kernel, and not sharing the store with the
+host."
+  (define os
+    ;; Note: 'image-operating-system' would return the wrong OS, before
+    ;; its root partition has been assigned a UUID.
+    (operating-system-for-image image))
+
+  (define kernel-arguments
+    #~(list #$@(if graphic? #~() #~("console=ttyS0"))
+            #+@(operating-system-kernel-arguments os "/dev/vda1")))
+
+  #~`(#+(file-append qemu "/bin/"
+                     (qemu-command (or target system)))
+      ,@(if (access? "/dev/kvm" (logior R_OK W_OK))
+            '("-enable-kvm")
+            '())
+
+      "-cpu" #$cpu
+      #$@(if (> cpu-count 1)
+             #~("-smp" #$(string-append "cpus=" (number->string cpu-count)))
+             #~())
+      "-m" #$(number->string memory-size)
+      "-nic" #$(string-append
+                "user,model=virtio-net-pci,"
+                (port-forwardings->qemu-options port-forwardings))
+      "-kernel" #$(operating-system-kernel-file os)
+      "-initrd" #$(file-append os "/initrd")
+      "-append" ,(string-join #$kernel-arguments)
+      "-serial" "stdio"
+
+      #$@(if date
+             #~("-rtc"
+                #$(string-append "base=" (date->string date "~5")))
+             #~())
+
+      "-object" "rng-random,filename=/dev/urandom,id=guix-vm-rng"
+      "-device" "virtio-rng-pci,rng=guix-vm-rng"
+
+      "-drive"
+      ,(string-append "file=" #$(system-image image)
+                      ",format=qcow2,if=virtio,"
+                      "cache=writeback,werror=report,readonly=off")
+      "-snapshot"
+      "-no-reboot"))
+
 \f
 ;;;
 ;;; High-level abstraction.
diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm
index 6ca88cbacd..c8b42eb1db 100644
--- a/gnu/tests/virtualization.scm
+++ b/gnu/tests/virtualization.scm
@@ -33,6 +33,7 @@ (define-module (gnu tests virtualization)
   #:use-module (gnu services)
   #:use-module (gnu services dbus)
   #:use-module (gnu services networking)
+  #:use-module (gnu services ssh)
   #:use-module (gnu services virtualization)
   #:use-module (gnu packages ssh)
   #:use-module (gnu packages virtualization)
@@ -42,7 +43,8 @@ (define-module (gnu tests virtualization)
   #:use-module (guix modules)
   #:export (%test-libvirt
             %test-qemu-guest-agent
-            %test-childhurd))
+            %test-childhurd
+            %test-build-vm))
 
 \f
 ;;;
@@ -241,6 +243,36 @@ (define %childhurd-os
                                  (password ""))   ;empty password
                                 %base-user-accounts))))))))
 
+(define* (run-command-over-ssh command
+                               #:key (port 10022) (user "test"))
+  "Return a program that runs COMMAND over SSH and prints the result on standard
+output."
+  (define run
+    (with-extensions (list guile-ssh)
+      #~(begin
+          (use-modules (ssh session)
+                       (ssh auth)
+                       (ssh popen)
+                       (ice-9 match)
+                       (ice-9 textual-ports))
+
+          (let ((session (make-session #:user #$user
+                                       #:port #$port
+                                       #:host "localhost"
+                                       #:timeout 120
+                                       #:log-verbosity 'rare)))
+            (match (connect! session)
+              ('ok
+               (userauth-password! session "")
+               (display
+                (get-string-all
+                 (open-remote-input-pipe* session #$@command))))
+              (status
+               (error "could not connect to guest over SSH"
+                      session status)))))))
+
+  (program-file "run-command-over-ssh" run))
+
 (define (run-childhurd-test)
   (define (import-module? module)
     ;; This module is optional and depends on Guile-Gcrypt, do skip it.
@@ -261,36 +293,6 @@ (define (run-childhurd-test)
      (operating-system os)
      (memory-size (* 1024 3))))
 
-  (define (run-command-over-ssh . command)
-    ;; Program that runs COMMAND over SSH and prints the result on standard
-    ;; output.
-    (let ()
-      (define run
-        (with-extensions (list guile-ssh)
-          #~(begin
-              (use-modules (ssh session)
-                           (ssh auth)
-                           (ssh popen)
-                           (ice-9 match)
-                           (ice-9 textual-ports))
-
-              (let ((session (make-session #:user "test"
-                                           #:port 10022
-                                           #:host "localhost"
-                                           #:timeout 120
-                                           #:log-verbosity 'rare)))
-                (match (connect! session)
-                  ('ok
-                   (userauth-password! session "")
-                   (display
-                    (get-string-all
-                     (open-remote-input-pipe* session #$@command))))
-                  (status
-                   (error "could not connect to childhurd over SSH"
-                          session status)))))))
-
-      (program-file "run-command-over-ssh" run)))
-
   (define test
     (with-imported-modules '((gnu build marionette))
       #~(begin
@@ -356,21 +358,24 @@ (define (run-childhurd-test)
             ;; 'uname' command.
             (marionette-eval
              '(begin
-                (use-modules (ice-9 popen))
+                (use-modules (ice-9 popen)
+                             (ice-9 textual-ports))
 
                 (get-string-all
-                 (open-input-pipe #$(run-command-over-ssh "uname" "-on"))))
+                 (open-input-pipe #$(run-command-over-ssh '("uname" "-on")))))
              marionette))
 
           (test-assert "guix-daemon up and running"
             (let ((drv (marionette-eval
                         '(begin
-                           (use-modules (ice-9 popen))
+                           (use-modules (ice-9 popen)
+                                        (ice-9 textual-ports))
 
                            (get-string-all
                             (open-input-pipe
-                             #$(run-command-over-ssh "guix" "build" "coreutils"
-                                                     "--no-grafts" "-d"))))
+                             #$(run-command-over-ssh
+                                '("guix" "build" "coreutils"
+                                  "--no-grafts" "-d")))))
                         marionette)))
               ;; We cannot compare the .drv with (raw-derivation-file
               ;; coreutils) on the host: they may differ due to fixed-output
@@ -416,3 +421,102 @@ (define %test-childhurd
     "Connect to the GNU/Hurd virtual machine service, aka. a childhurd, making
 sure that the childhurd boots and runs its SSH server.")
    (value (run-childhurd-test))))
+
+\f
+;;;
+;;; Virtual build machine.
+;;;
+
+(define %build-vm-os
+  (simple-operating-system
+   (service virtual-build-machine-service-type
+            (virtual-build-machine
+             (cpu-count 1)
+             (memory-size (* 1 1024))))))
+
+(define (run-build-vm-test)
+  (define (import-module? module)
+    ;; This module is optional and depends on Guile-Gcrypt, do skip it.
+    (and (guix-module-name? module)
+         (not (equal? module '(guix store deduplication)))))
+
+  (define os
+    (marionette-operating-system
+     %build-vm-os
+     #:imported-modules (source-module-closure
+                         '((gnu services herd)
+                           (gnu build install))
+                         #:select? import-module?)))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (memory-size (* 1024 3))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64)
+                       (ice-9 match))
+
+          (define marionette
+            ;; Emulate as much as the host CPU supports so that, possibly, KVM
+            ;; is available inside as well ("nested KVM"), provided
+            ;; /sys/module/kvm_intel/parameters/nested (or similar) allows it.
+            (make-marionette (list #$vm "-cpu" "max")))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "build-vm")
+
+          (test-assert "service running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd)
+                             (ice-9 match))
+
+                (start-service 'build-vm))
+             marionette))
+
+          (test-assert "guest SSH up and running"
+            ;; Note: Pass #:peek? #t because due to the way QEMU port
+            ;; forwarding works, connecting to 11022 always works even if the
+            ;; 'sshd' service hasn't been started yet in the guest.
+            (wait-for-tcp-port 11022 marionette
+                               #:peek? #t))
+
+          (test-assert "copy-on-write store"
+            ;; Set up a writable store.  The root partition is already an
+            ;; overlayfs, which is not suitable as the bottom part of this
+            ;; additional overlayfs; thus, create a tmpfs for the backing
+            ;; store.
+            ;; TODO: Remove this when <virtual-machine> creates a writable
+            ;; store.
+            (marionette-eval
+             '(begin
+                (use-modules (gnu build install)
+                             (guix build syscalls))
+
+                (mkdir "/run/writable-store")
+                (mount "none" "/run/writable-store" "tmpfs")
+                (mount-cow-store "/run/writable-store" "/backing-store")
+                (system* "df" "-hT"))
+             marionette))
+
+          (test-equal "offloading"
+            0
+            (marionette-eval
+             '(and (file-exists? "/etc/guix/machines.scm")
+                   (system* "guix" "offload" "test"))
+             marionette))
+
+          (test-end))))
+
+  (gexp->derivation "build-vm-test" test))
+
+(define %test-build-vm
+  (system-test
+   (name "build-vm")
+   (description
+    "Offload to a virtual build machine over SSH.")
+   (value (run-build-vm-test))))
-- 
2.41.0





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

* [bug#68677] [PATCH 0/6] Service for "virtual build machines"
  2024-01-23 16:46 [bug#68677] [PATCH 0/6] Service for "virtual build machines" Ludovic Courtès
                   ` (5 preceding siblings ...)
  2024-01-23 16:48 ` [bug#68677] [PATCH 6/6] services: Add ‘virtual-build-machine’ service Ludovic Courtès
@ 2024-01-25 14:18 ` Simon Tournier
  2024-01-29 11:25   ` Ludovic Courtès
  2024-02-05 13:37 ` Ludovic Courtès
                   ` (2 subsequent siblings)
  9 siblings, 1 reply; 14+ messages in thread
From: Simon Tournier @ 2024-01-25 14:18 UTC (permalink / raw)
  To: Ludovic Courtès, 68677; +Cc: Ludovic Courtès

Hi Ludo,

On mar., 23 janv. 2024 at 17:46, Ludovic Courtès <ludo@gnu.org> wrote:

> Lots of talk about reproducibility and how wonderful Guix is, but
> as soon as you try to build packages from v1.0.0, released less
> than 5 years ago, you hit a “time trap” in Python, in OpenSSL, or
> some other ugly build failure—assuming you managed to fetch source
> code in the first place¹.

Cool!  Workarounds for “time trap” of the current past.

Note that today is the past of the future. ;-) Other said, the same
workarounds will help to detect today thus fix the “time trap” that
would arise in the future.

Without mentioning the bug of 2038 year. :-)



> This patch series defines a long-overdue
> ‘virtual-build-machine-service-type’: a service to run a virtual
> machine available for offloading.  My main goal here is to
> allow users to build stuff at a past date without having to
> change their system clock.  It can also be used to control other
> aspects usually not under control: the CPU model, the Linux kernel.

Yes, controlling CPU model and Linux kernel are worth:

 + CPU model because we already have examples of failures (Python 3.7
   packaged in Guix v1.0.0, some BLAS libraries, etc.);

 + Linux kernel because its stability is one of the strong assumption we
   are making for reproducibility.


Cheers,
simon





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

* [bug#68677] [PATCH 0/6] Service for "virtual build machines"
  2024-01-25 14:18 ` [bug#68677] [PATCH 0/6] Service for "virtual build machines" Simon Tournier
@ 2024-01-29 11:25   ` Ludovic Courtès
  0 siblings, 0 replies; 14+ messages in thread
From: Ludovic Courtès @ 2024-01-29 11:25 UTC (permalink / raw)
  To: Simon Tournier; +Cc: 68677

Simon Tournier <zimon.toutoune@gmail.com> skribis:

> Yes, controlling CPU model and Linux kernel are worth:
>
>  + CPU model because we already have examples of failures (Python 3.7
>    packaged in Guix v1.0.0, some BLAS libraries, etc.);

Yes!  And I think we should maintain a catalog of these problems (build
processes influenced by date, hardware, or kernel version).

Our horizon should be to somehow ensure such packages are always built
in the right environment, automatically, whether or not it involves
using a VM.

Ludo’.




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

* [bug#68677] [PATCH 0/6] Service for "virtual build machines"
  2024-01-23 16:46 [bug#68677] [PATCH 0/6] Service for "virtual build machines" Ludovic Courtès
                   ` (6 preceding siblings ...)
  2024-01-25 14:18 ` [bug#68677] [PATCH 0/6] Service for "virtual build machines" Simon Tournier
@ 2024-02-05 13:37 ` Ludovic Courtès
  2024-02-05 15:45 ` Suhail via Guix-patches via
  2024-02-10 22:35 ` bug#68677: " Ludovic Courtès
  9 siblings, 0 replies; 14+ messages in thread
From: Ludovic Courtès @ 2024-02-05 13:37 UTC (permalink / raw)
  To: 68677

Hello there!

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

> This patch series defines a long-overdue
> ‘virtual-build-machine-service-type’: a service to run a virtual
> machine available for offloading.  My main goal here is to
> allow users to build stuff at a past date without having to
> change their system clock.  It can also be used to control other
> aspects usually not under control: the CPU model, the Linux kernel.

Any comments on this patch series?

  https://issues.guix.gnu.org/68677

I’d like to go ahead and apply it by the end of the week if there are no
objections.

(I realize all the files being touched here are in a limbo in terms of
team coverage.  We should fix that!)

Ludo’.




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

* [bug#68677] [PATCH 0/6] Service for "virtual build machines"
  2024-01-23 16:46 [bug#68677] [PATCH 0/6] Service for "virtual build machines" Ludovic Courtès
                   ` (7 preceding siblings ...)
  2024-02-05 13:37 ` Ludovic Courtès
@ 2024-02-05 15:45 ` Suhail via Guix-patches via
  2024-02-07 17:33   ` Ludovic Courtès
  2024-02-14 15:15   ` Simon Tournier
  2024-02-10 22:35 ` bug#68677: " Ludovic Courtès
  9 siblings, 2 replies; 14+ messages in thread
From: Suhail via Guix-patches via @ 2024-02-05 15:45 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 68677

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

> Any comments on this patch series?

I don't have comments regarding the code, but I do have a couple of
questions and a comment.  Please excuse my limited understanding of GNU
Shepherd and Guix System.  None of the questions/comments below are
deal-breakers in my opinion.

1. The documentation references GNU Shepherd.  Is GNU Shepherd a hard
   requirement in order to use the facilities provided by the patch
   series?  Would it be possible to use, say, Systemd on a foreign
   distribution?  If so, could examples of those be documented in the
   appropriate place as well?

2. The code sets the default date to be 2020-01-01; does this date have
   any significance?  It might help for the code to have a comment
   explaining whether this value is completely arbitrary or whether it
   has some significance.  On a related note, it might help for the
   documentation to note dates that are less likely to work (in case
   values before a certain time aren't expected to be well supported).

Additionally, I'm not sure if this belongs in the manual or in the
cookbook (or elsewhere), but it would be helpful to have some small, but
complete, examples.  The documentation in the patch series mentions two
situations (time traps, and CPU microarchitecture optimizations) and for
each it would be helpful to have a self-contained full working example
referenced.  For the "time trap" use-case, perhaps one of the
submissions from the Ten Years Reproducibility Challenge could be used.

-- 
Suhail





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

* [bug#68677] [PATCH 0/6] Service for "virtual build machines"
  2024-02-05 15:45 ` Suhail via Guix-patches via
@ 2024-02-07 17:33   ` Ludovic Courtès
  2024-02-14 15:15   ` Simon Tournier
  1 sibling, 0 replies; 14+ messages in thread
From: Ludovic Courtès @ 2024-02-07 17:33 UTC (permalink / raw)
  To: Suhail; +Cc: 68677

Hi Suhail,

Suhail <suhail@bayesians.ca> skribis:

> 1. The documentation references GNU Shepherd.  Is GNU Shepherd a hard
>    requirement in order to use the facilities provided by the patch
>    series?  Would it be possible to use, say, Systemd on a foreign
>    distribution?  If so, could examples of those be documented in the
>    appropriate place as well?

What this patch adds is a service one can use on Guix System.  Someone
who adds this service to their Guix System config can then run ‘herd
start build-vm’ to enable offloading to the virtual build machine.

It’s possible to do something similar on a distro other than Guix System
but this patch series won’t help with that.  On another distro, one
would need to create a VM image and then manually start QEMU with the
right flags and set up offloading to that VM.  Nothing insurmountable,
but it’s quite tedious.

> 2. The code sets the default date to be 2020-01-01; does this date have
>    any significance?  It might help for the code to have a comment
>    explaining whether this value is completely arbitrary or whether it
>    has some significance.  On a related note, it might help for the
>    documentation to note dates that are less likely to work (in case
>    values before a certain time aren't expected to be well supported).

I picked a date in the past because I figured this would be the most
common use case at first: being able to rebuild things “in the past”
(the manual says that the default date is “in the past”).  Apart from
that, it has no significance.  I’ll add a comment as you suggest.

The manual cannot really say which date “won’t work” because (1) it
depends on what one is building, and (2) we simply don’t know in most
cases.

> Additionally, I'm not sure if this belongs in the manual or in the
> cookbook (or elsewhere), but it would be helpful to have some small, but
> complete, examples.  The documentation in the patch series mentions two
> situations (time traps, and CPU microarchitecture optimizations) and for
> each it would be helpful to have a self-contained full working example
> referenced.  For the "time trap" use-case, perhaps one of the
> submissions from the Ten Years Reproducibility Challenge could be used.

Yes, I agree we need complete examples (maybe not in the manual, rather
as blog posts and/or Cookbook entries I’d say).

Thanks for chiming in!

Ludo’.




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

* bug#68677: [PATCH 0/6] Service for "virtual build machines"
  2024-01-23 16:46 [bug#68677] [PATCH 0/6] Service for "virtual build machines" Ludovic Courtès
                   ` (8 preceding siblings ...)
  2024-02-05 15:45 ` Suhail via Guix-patches via
@ 2024-02-10 22:35 ` Ludovic Courtès
  9 siblings, 0 replies; 14+ messages in thread
From: Ludovic Courtès @ 2024-02-10 22:35 UTC (permalink / raw)
  To: 68677-done

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

>   services: secret-service: Make the endpoint configurable.
>   vm: Add ‘date’ field to <virtual-machine>.
>   vm: Export <virtual-machine> accessors.
>   vm: Add ‘cpu-count’ field to <virtual-machine>.
>   marionette: Add #:peek? to ‘wait-for-tcp-port?’.
>   services: Add ‘virtual-build-machine’ service.

Pushed as 9edbb2d7a40c9da7583a1046e39b87633459f656 with an extra comment
explaining how the default date was chosen.

Ludo’.




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

* [bug#68677] [PATCH 0/6] Service for "virtual build machines"
  2024-02-05 15:45 ` Suhail via Guix-patches via
  2024-02-07 17:33   ` Ludovic Courtès
@ 2024-02-14 15:15   ` Simon Tournier
  1 sibling, 0 replies; 14+ messages in thread
From: Simon Tournier @ 2024-02-14 15:15 UTC (permalink / raw)
  To: Suhail, Ludovic Courtès; +Cc: 68677

Hi,

Thanks for your feedback.

On lun., 05 févr. 2024 at 15:45, Suhail via Guix-patches via <guix-patches@gnu.org> wrote:

> 1. The documentation references GNU Shepherd.  Is GNU Shepherd a hard
>    requirement in order to use the facilities provided by the patch
>    series?  Would it be possible to use, say, Systemd on a foreign
>    distribution?  If so, could examples of those be documented in the
>    appropriate place as well?

From my understanding, for now, it is for Guix System, so using
Shepherd.  It might be possible to use the ’vm’ on foreign distros but
some details must be configured by hand, when it is automatically done
by the “extended service”.  More or less. :-)


> 2. The code sets the default date to be 2020-01-01; does this date have
>    any significance?  It might help for the code to have a comment
>    explaining whether this value is completely arbitrary or whether it
>    has some significance.  On a related note, it might help for the
>    documentation to note dates that are less likely to work (in case
>    values before a certain time aren't expected to be well supported).

For this date, nothing specific I guess.  The oldest commit that one can
reaches using “guix time-machine” is May 2019.

Aside, it is hard to maintain a list of dates that “work”.  Because
nothing is written in stone and the passing of time cannot be frozen.

For instance, 6 months ago, a jump of ~4 years was just working [1].
And now, it is broken [2].  Somehow, Guix provides features that demo a
real-world experience which was simply impossible.  Therefore, things
are fluctuating toward more robustness.

That’s said, based on my experience playing with “guix time-machine”, my
rule of thumb is: 2-3 years old is most of the time ok.  Older than 3
years is… cross-finger.


1: https://simon.tournier.info/posts/2023-06-23-hackathon-repro.html
2: https://issues.guix.gnu.org/69058


> Additionally, I'm not sure if this belongs in the manual or in the
> cookbook (or elsewhere), but it would be helpful to have some small, but
> complete, examples.  The documentation in the patch series mentions two
> situations (time traps, and CPU microarchitecture optimizations) and for
> each it would be helpful to have a self-contained full working example
> referenced.  For the "time trap" use-case, perhaps one of the
> submissions from the Ten Years Reproducibility Challenge could be used.

The issue with time-trap is documented in the manual, see:

           Due to ‘guix time-machine’ relying on the “inferiors” mechanism
        (*note Inferiors::), the oldest commit it can travel to is commit
        ‘6298c3ff’ (“v1.0.0”), dated May 1^{st}, 2019, which is the first
        release that included the inferiors mechanism.  An error is returned
        when attempting to navigate to older commits.

             Note: Although it should technically be possible to travel to such
             an old commit, the ease to do so will largely depend on the
             availability of binary substitutes.  When traveling to a distant
             past, some packages may not easily build from source anymore.  One
             such example are old versions of Python 2 which had time bombs in
             its test suite, in the form of expiring SSL certificates.  This
             particular problem can be worked around by setting the hardware
             clock to a value in the past before attempting the build.

        https://guix.gnu.org/manual/devel/en/guix.html#Invoking-guix-time_002dmachine


However, it appears to me hard to maintain a list of all the known
time-trap.  For now, we are not re-building the past, therefore most of
the time-trap get unnoticed.

About CPU microarchitecture, I know only two: Python [3] and OpenBLAS
[4].

All in all we are at the infancy of this work and any help is
welcome. :-)

Cheers,
simon


3: Try “guix time-machine --commit=v1.0.0 -- describe”

4: Investigating a reproducibility failure
Konrad Hinsen <konrad.hinsen@fastmail.net>
Tue, 01 Feb 2022 15:05:40 +0100
id:m1a6fahebv.fsf@fastmail.net
https://lists.gnu.org/archive/html/guix-devel/2022-02
https://yhetil.org/guix/m1a6fahebv.fsf@fastmail.net

Follow-up:
Re: Investigating a reproducibility failure
zimoun <zimon.toutoune@gmail.com>
Wed, 02 Feb 2022 21:35:06 +0100
id:871r0l9fd1.fsf@gmail.com
https://lists.gnu.org/archive/html/guix-devel/2022-02
https://yhetil.org/guix/871r0l9fd1.fsf@gmail.com





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

end of thread, other threads:[~2024-02-15  9:54 UTC | newest]

Thread overview: 14+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-01-23 16:46 [bug#68677] [PATCH 0/6] Service for "virtual build machines" Ludovic Courtès
2024-01-23 16:48 ` [bug#68677] [PATCH 1/6] services: secret-service: Make the endpoint configurable Ludovic Courtès
2024-01-23 16:48 ` [bug#68677] [PATCH 2/6] vm: Add ‘date’ field to <virtual-machine> Ludovic Courtès
2024-01-23 16:48 ` [bug#68677] [PATCH 3/6] vm: Export <virtual-machine> accessors Ludovic Courtès
2024-01-23 16:48 ` [bug#68677] [PATCH 4/6] vm: Add ‘cpu-count’ field to <virtual-machine> Ludovic Courtès
2024-01-23 16:48 ` [bug#68677] [PATCH 5/6] marionette: Add #:peek? to ‘wait-for-tcp-port?’ Ludovic Courtès
2024-01-23 16:48 ` [bug#68677] [PATCH 6/6] services: Add ‘virtual-build-machine’ service Ludovic Courtès
2024-01-25 14:18 ` [bug#68677] [PATCH 0/6] Service for "virtual build machines" Simon Tournier
2024-01-29 11:25   ` Ludovic Courtès
2024-02-05 13:37 ` Ludovic Courtès
2024-02-05 15:45 ` Suhail via Guix-patches via
2024-02-07 17:33   ` Ludovic Courtès
2024-02-14 15:15   ` Simon Tournier
2024-02-10 22:35 ` bug#68677: " Ludovic Courtès

Code repositories for project(s) associated with this public inbox

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

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