From b896b9102b83e6e29eec95c488ff73abe8c7ca3d Mon Sep 17 00:00:00 2001 From: Hilton Chain Date: Sat, 27 Jan 2024 16:01:13 +0800 Subject: services: kernel-module-lodaer: Add udev requirement. Otherwise, modules will be loaded before udev starts, and load events won't be handled. * gnu/services/linux.scm (kernel-module-loader-shepherd-service)[requirement]: Add 'udev. Change-Id: Ib65028978f96012604b54b27a56501d4388b0f34 --- gnu/services/linux.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm index 9ee0d93030..9955a11e64 100644 --- a/gnu/services/linux.scm +++ b/gnu/services/linux.scm @@ -291,7 +291,7 @@ more information)." (shepherd-service (documentation "Load kernel modules.") (provision '(kernel-module-loader)) - (requirement '()) + (requirement '(udev)) (one-shot? #t) (modules `((srfi srfi-1) (srfi srfi-34) -- cgit v1.2.3 From f331a667d3827c5c7603c87956c601d5e42ef82b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 20 Dec 2023 10:36:25 +0100 Subject: services: secret-service: Make the endpoint configurable. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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/services/virtualization.scm | 40 +++++++++++++++++++++++----------------- 1 file changed, 23 insertions(+), 17 deletions(-) (limited to 'gnu/services') 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 @@ specified, the QEMU default path is used.")) ;;; 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 @@ over TCP. Reboot upon failure." "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 @@ over TCP. Reboot upon failure." 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 @@ that will be listening to receive secret keys on port 1004, TCP." ;; 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 @@ is added to the OS specified in 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) -- cgit v1.2.3 From 9edbb2d7a40c9da7583a1046e39b87633459f656 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 20 Jan 2024 14:55:46 +0100 Subject: =?UTF-8?q?services:=20Add=20=E2=80=98virtual-build-machine?= =?UTF-8?q?=E2=80=99=20service.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/virtualization.scm (): 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 --- gnu/services/virtualization.scm | 602 +++++++++++++++++++++++++++++++--------- 1 file changed, 472 insertions(+), 130 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm index 5b8566f600..cc95dfdf22 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 -;;; Copyright © 2018, 2020-2023 Ludovic Courtès +;;; Copyright © 2018, 2020-2024 Ludovic Courtès ;;; Copyright © 2020, 2021, 2023 Janneke Nieuwenhuizen ;;; Copyright © 2021 Timotej Lazar ;;; Copyright © 2022 Oleg Pykhalov @@ -43,6 +43,8 @@ #: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 @@ #: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,461 @@ that will be listening to receive secret keys on ADDRESS." (inherit config) (generate-substitute-key? #f)))))))) + +;;; +;;; Offloading-as-a-service. +;;; + +(define-record-type* + 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 to a date "in the past" assuming a common use case + ;; is to rebuild old packages. + (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 + ;; . + ;; 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 + (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 , 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)))) + ;;; ;;; The Hurd in VM service: a Childhurd. @@ -1290,136 +1755,13 @@ is added to the OS specified in CONFIG." (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'." -- cgit v1.2.3 From 15fd5d6c3f6bb34d2250226889f9651440bd7c43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 12 Feb 2024 00:09:09 +0100 Subject: services: virtual-build-machine: Add base file systems to default OS. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This provides /dev/pts and other things that are important for builds (for example, Python 2.x has ‘openpty’ unit tests that can only succeed when /dev/pts is available.) * gnu/services/virtualization.scm (%virtual-build-machine-operating-system) [file-systems]: Add %BASE-FILE-SYSTEMS. Change-Id: I7d12a4cb491e957bf55e6c5f9dd09c013473ca42 --- gnu/services/virtualization.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm index cc95dfdf22..e1970e2b09 100644 --- a/gnu/services/virtualization.scm +++ b/gnu/services/virtualization.scm @@ -1192,10 +1192,11 @@ authpriv.*;auth.info /var/log/secure (bootloader (bootloader-configuration ;unused (bootloader grub-minimal-bootloader) (targets '("/dev/null")))) - (file-systems (list (file-system ;unused + (file-systems (cons (file-system ;unused (mount-point "/") (device "none") - (type "tmpfs")))) + (type "tmpfs")) + %base-file-systems)) (users (cons (user-account (name "offload") (group "users") -- cgit v1.2.3 From e0ade40c2b7f39dc109ef03d43241033e14c4d4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 12 Feb 2024 11:22:00 +0100 Subject: services: virtual-build-machine: Use a larger partition by default. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit So far the partition had too little free space. * gnu/services/virtualization.scm (%default-virtual-build-machine-image-size): New variable. (virtual-build-machine-default-image): Define ‘partitions’ field. Change-Id: Iffe0f316eecad8754d29f8c811cdc4836a818a3f --- gnu/services/virtualization.scm | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm index e1970e2b09..0fbd51de8d 100644 --- a/gnu/services/virtualization.scm +++ b/gnu/services/virtualization.scm @@ -57,7 +57,7 @@ #:autoload (guix self) (make-config.scm) #:autoload (guix platform) (platform-system) - #:use-module (srfi srfi-1) + #:use-module ((srfi srfi-1) #:hide (partition)) #:use-module (srfi srfi-9) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) @@ -1225,6 +1225,11 @@ authpriv.*;auth.info /var/log/secure (delete mingetty-service-type) (delete console-font-service-type)))))) +(define %default-virtual-build-machine-image-size + ;; Size of the default disk image of virtual build machines. It should be + ;; large enough to let users build a few things. + (* 20 (expt 2 30))) + (define (virtual-build-machine-default-image config) (let* ((type (lookup-image-type-by-name 'mbr-raw)) (base (os->image %virtual-build-machine-operating-system @@ -1235,7 +1240,15 @@ authpriv.*;auth.info /var/log/secure (format 'compressed-qcow2) (partition-table-type 'mbr) (shared-store? #f) - (size (* 10 (expt 2 30)))))) + (size %default-virtual-build-machine-image-size) + (partitions (match (image-partitions base) + ((root) + ;; Increase the size of the root partition to match + ;; that of the disk image. + (let ((root-size (- size (* 50 (expt 2 20))))) + (list (partition + (inherit root) + (size root-size)))))))))) (define (virtual-build-machine-account-name config) (string-append "build-vm-" -- cgit v1.2.3