From patchwork Fri Jun 12 21:42:13 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Janneke Nieuwenhuizen X-Patchwork-Id: 22690 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id E433427BBE3; Fri, 12 Jun 2020 22:43:08 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 831B927BBE1 for ; Fri, 12 Jun 2020 22:43:08 +0100 (BST) Received: from localhost ([::1]:43482 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jjrS8-0006gm-1r for patchwork@mira.cbaines.net; Fri, 12 Jun 2020 17:43:08 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:58964) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jjrS2-0006gY-NY for guix-patches@gnu.org; Fri, 12 Jun 2020 17:43:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:57335) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jjrS2-0007tb-El for guix-patches@gnu.org; Fri, 12 Jun 2020 17:43:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jjrS2-0000ju-De for guix-patches@gnu.org; Fri, 12 Jun 2020 17:43:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41785] [PATCH v3 1/2] image: Make 'find-image' non-monadic. References: <20200610085441.890-1-janneke@gnu.org> In-Reply-To: <20200610085441.890-1-janneke@gnu.org> Resent-From: "Jan (janneke) Nieuwenhuizen" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 12 Jun 2020 21:43:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41785 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 41785@debbugs.gnu.org, Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe Received: via spool by 41785-submit@debbugs.gnu.org id=B41785.15919981542801 (code B ref 41785); Fri, 12 Jun 2020 21:43:02 +0000 Received: (at 41785) by debbugs.gnu.org; 12 Jun 2020 21:42:34 +0000 Received: from localhost ([127.0.0.1]:40646 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jjrRS-0000iy-Py for submit@debbugs.gnu.org; Fri, 12 Jun 2020 17:42:33 -0400 Received: from eggs.gnu.org ([209.51.188.92]:50710) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jjrRR-0000ic-85 for 41785@debbugs.gnu.org; Fri, 12 Jun 2020 17:42:25 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:45597) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jjrRJ-0007ap-H5; Fri, 12 Jun 2020 17:42:17 -0400 Received: from [2001:980:1b4f:1:42d2:832d:bb59:862] (port=33506 helo=dundal.fritz.box) by fencepost.gnu.org with esmtpa (Exim 4.82) (envelope-from ) id 1jjrRH-00040W-QZ; Fri, 12 Jun 2020 17:42:16 -0400 From: "Jan (janneke) Nieuwenhuizen" Date: Fri, 12 Jun 2020 23:42:13 +0200 Message-Id: <20200612214214.14112-1-janneke@gnu.org> X-Mailer: git-send-email 2.26.2 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/system/image.scm (find-image): Make non-monadic. Add 'target' parameter. * gnu/tests/install.scm (run-install): Update caller, passing (%current-target-system). * guix/scripts/system.scm (perform-action): Likewise. --- gnu/system/image.scm | 22 ++++++++++------------ gnu/tests/install.scm | 6 ++++-- guix/scripts/system.scm | 3 ++- 3 files changed, 16 insertions(+), 15 deletions(-) diff --git a/gnu/system/image.scm b/gnu/system/image.scm index a0e6bf31f1..ac55301a60 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020 Mathieu Othacehe +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -547,20 +548,17 @@ image, depending on IMAGE format." #:grub-mkrescue-environment '(("MKRESCUE_SED_MODE" . "mbr_hfs"))))))) -(define (find-image file-system-type) +(define (find-image file-system-type target) "Find and return an image that could match the given FILE-SYSTEM-TYPE. This is useful to adapt to interfaces written before the addition of the record." - (mlet %store-monad ((target (current-target-system))) - (mbegin %store-monad - (return - (match file-system-type - ("iso9660" iso9660-image) - (_ (cond - ((and target - (hurd-triplet? target)) - hurd-disk-image) - (else - efi-disk-image)))))))) + (match file-system-type + ("iso9660" iso9660-image) + (_ (cond + ((and target + (hurd-triplet? target)) + hurd-disk-image) + (else + efi-disk-image))))) ;;; image.scm ends here diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 6bd8c7d3d2..82098290f7 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice ;;; Copyright © 2020 Mathieu Othacehe ;;; Copyright © 2020 Danny Milosavljevic +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -228,8 +229,9 @@ packages defined in installation-os." (mlet* %store-monad ((_ (set-grafting #f)) (system (current-system)) (target (operating-system-derivation target-os)) - (base-image (find-image - installation-disk-image-file-system-type)) + (base-image -> (find-image + installation-disk-image-file-system-type + (%current-target-system))) ;; Since the installation system has no network access, ;; we cheat a little bit by adding TARGET to its GC diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 3d7aa77cb7..6f3880cc34 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2017, 2019 Mathieu Othacehe ;;; Copyright © 2018 Ricardo Wurmus ;;; Copyright © 2019 Christopher Baines +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -801,7 +802,7 @@ static checks." (check-initrd-modules os))) (mlet* %store-monad - ((image (find-image file-system-type)) + ((image -> (find-image file-system-type (%current-target-system))) (sys (system-derivation-for-action os image action #:file-system-type file-system-type #:image-size image-size From patchwork Fri Jun 12 21:42:14 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Janneke Nieuwenhuizen X-Patchwork-Id: 22691 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 000FD27BBE3; Fri, 12 Jun 2020 22:43:13 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 695F127BBE1 for ; Fri, 12 Jun 2020 22:43:13 +0100 (BST) Received: from localhost ([::1]:43694 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jjrSD-0006mT-0K for patchwork@mira.cbaines.net; Fri, 12 Jun 2020 17:43:13 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:58968) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jjrS3-0006ge-4b for guix-patches@gnu.org; Fri, 12 Jun 2020 17:43:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:57336) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jjrS2-0007tn-Rd for guix-patches@gnu.org; Fri, 12 Jun 2020 17:43:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jjrS2-0000k1-Q8 for guix-patches@gnu.org; Fri, 12 Jun 2020 17:43:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41785] [PATCH v3 2/2] services: Add 'hurd-vm service-type'. Resent-From: "Jan (janneke) Nieuwenhuizen" Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 12 Jun 2020 21:43:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41785 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 41785@debbugs.gnu.org, Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe Received: via spool by 41785-submit@debbugs.gnu.org id=B41785.15919981542807 (code B ref 41785); Fri, 12 Jun 2020 21:43:02 +0000 Received: (at 41785) by debbugs.gnu.org; 12 Jun 2020 21:42:34 +0000 Received: from localhost ([127.0.0.1]:40648 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jjrRa-0000j7-0L for submit@debbugs.gnu.org; Fri, 12 Jun 2020 17:42:34 -0400 Received: from eggs.gnu.org ([209.51.188.92]:50716) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jjrRR-0000id-H8 for 41785@debbugs.gnu.org; Fri, 12 Jun 2020 17:42:26 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:45599) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jjrRK-0007aw-JM; Fri, 12 Jun 2020 17:42:18 -0400 Received: from [2001:980:1b4f:1:42d2:832d:bb59:862] (port=33506 helo=dundal.fritz.box) by fencepost.gnu.org with esmtpa (Exim 4.82) (envelope-from ) id 1jjrRJ-00040W-8j; Fri, 12 Jun 2020 17:42:17 -0400 From: "Jan (janneke) Nieuwenhuizen" Date: Fri, 12 Jun 2020 23:42:14 +0200 Message-Id: <20200612214214.14112-2-janneke@gnu.org> X-Mailer: git-send-email 2.26.2 In-Reply-To: <20200612214214.14112-1-janneke@gnu.org> References: <20200612214214.14112-1-janneke@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/services/virtualization.scm (hurd-vm-shepherd-service, hurd-vm-disk-image): New procedures. (%hurd-vm-operating-system, hurd-vm-service-type): New variable. (): New record type. * doc/guix.texi (Virtualization Services): Document it. --- doc/guix.texi | 83 +++++++++++++++++++++ gnu/services/virtualization.scm | 126 ++++++++++++++++++++++++++++++-- 2 files changed, 202 insertions(+), 7 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 15e077a41c..ed36d5014b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -24583,6 +24583,89 @@ Return true if @var{obj} is a platform object. Return the name of @var{platform}---a string such as @code{"arm"}. @end deffn + +@subsubheading The Hurd in a Virtual Machine + +@cindex @code{hurd} +@cindex the Hurd + +Service @code{hurd-vm} provides support for running GNU/Hurd in a +virtual machine (VM), a so-called ``Childhurd''. The virtual machine is +a Shepherd service that can be controlled with commands such as: + +@example +herd start hurd-vm +herd stop childhurd +@end example + +The given GNU/Hurd operating system configuration is cross-compiled. + +@defvr {Scheme Variable} hurd-vm-service-type +This is the type of the Hurd in a Virtual Machine service. Its value +must be a @code{hurd-vm-configuration} object, which specifies the +operating system (@pxref{operating-system Reference}) and the disk size +for the Hurd Virtual Machine, the QEMU package to use as well as the +options for running it. + +For example: + +@lisp +(service hurd-vm-service-type + (hurd-vm-configuration + (disk-size (* 5000 (expt 2 20))) ;5G + (memory-size 1024))) ;1024MiB +@end lisp + +would create a disk image big enough to build GNU@tie{}Hello, with some +extra memory. +@end defvr + +@deftp {Data Type} hurd-vm-configuration +The data type representing the configuration for +@code{hurd-vm-service-type}. + +@table @asis +@item @code{os} (default: @var{%hurd-vm-operating-system}) +The operating system to instantiate. This default is bare-bones with a +permissive OpenSSH secure shell daemon listening on port 2222 +(@pxref{Networking Services, @code{openssh-service-type}}). + +@item @code{qemu} (default: @code{qemu-minimal}) +The QEMU package to use. + +@item @code{image} (default: @var{hurd-vm-disk-image}) +The procedure used to build the disk-image built from this +configuration. + +@item @code{disk-size} (default: @code{'guess}) +The size of the disk image. + +@item @code{memory-size} (default: @code{512}) +The memory size of the Virtual Machine in mebibytes. + +@item @code{options} (default: @code{'("--device"} @code{"rtl8139,netdev=net0"} @ + @code{"--netdev"} @ + @code{"user,id=net0,hostfwd=tcp:127.0.0.1:20022-:2222,hostfwd=tcp:127.0.0.1:25900-:5900"} @ + @code{"--snapshot"} @ + @code{"--hda")}) +The extra options for running QEMU. +@end table +@end deftp + +Note that by default the VM image is volatile, i.e., once stopped the +contents are lost. If you want a stateful image instead, override the +configuration's @code{image} and @code{options} without +the @code{--snapshot} flag using something along these lines: + +@lisp +(service hurd-vm-service-type + (hurd-vm-configuration + (image (const "/out/of/store/writable/hurd.img")) + (options '("--device" "rtl8139,netdev=net0" + "--netdev" + "user,id=net0,hostfwd=tcp:127.0.0.1:20022-:2222")))) +@end lisp + @node Version Control Services @subsection Version Control Services diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm index 989e439d5d..dc1e91b0bd 100644 --- a/gnu/services/virtualization.scm +++ b/gnu/services/virtualization.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Ryan Moe ;;; Copyright © 2018 Ludovic Courtès +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,24 +19,41 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu services virtualization) - #:use-module (gnu services) - #:use-module (gnu services configuration) + #:use-module (gnu bootloader) + #:use-module (gnu bootloader grub) + #:use-module (gnu image) + #:use-module (gnu packages admin) + #:use-module (gnu packages ssh) + #:use-module (gnu packages virtualization) #:use-module (gnu services base) + #:use-module (gnu services configuration) #:use-module (gnu services dbus) #:use-module (gnu services shepherd) - #:use-module (gnu system shadow) + #:use-module (gnu services ssh) + #:use-module (gnu services) #:use-module (gnu system file-systems) - #:use-module (gnu packages admin) - #:use-module (gnu packages virtualization) - #:use-module (guix records) + #:use-module (gnu system hurd) + #:use-module (gnu system image) + #:use-module (gnu system shadow) + #:use-module (gnu system) + #:use-module (guix derivations) #:use-module (guix gexp) + #:use-module (guix monads) #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) - #:export (libvirt-configuration + #:export (%hurd-vm-operating-system + hurd-vm-configuration + hurd-vm-service-type + + libvirt-configuration libvirt-service-type virtlog-configuration virtlog-service-type @@ -773,3 +791,97 @@ given QEMU package." "This service supports transparent emulation of binaries compiled for other architectures using QEMU and the @code{binfmt_misc} functionality of the kernel Linux."))) + + +;;; +;;; The Hurd in VM service. +;;; + +(define %hurd-vm-operating-system + (operating-system + (inherit %hurd-default-operating-system) + (host-name "guixydevel") + (timezone "Europe/Amsterdam") + (bootloader (bootloader-configuration + (bootloader grub-minimal-bootloader) + (target "/dev/vda") + (timeout 0))) + (services (cons* + (service openssh-service-type + (openssh-configuration + (openssh openssh-sans-x) + (use-pam? #f) + (port-number 2222) + (permit-root-login #t) + (allow-empty-passwords? #t) + (password-authentication? #t))) + %base-services/hurd)))) + +(define-record-type* + hurd-vm-configuration make-hurd-vm-configuration + hurd-vm-configuration? + (os hurd-vm-configuration-os ; + (default %hurd-vm-operating-system)) + (qemu hurd-vm-configuration-qemu ; + (default qemu-minimal)) + (image hurd-vm-configuration-image ;string + (thunked) + (default (hurd-vm-disk-image this-record))) + (disk-size hurd-vm-configuration-disk-size ;number or 'guess + (default 'guess)) + (memory-size hurd-vm-configuration-memory-size ;number + (default 512)) + (options hurd-vm-configuration-options ;list of string + (default + `("--device" "rtl8139,netdev=net0" + "--netdev" ,(string-append + "user,id=net0" + ",hostfwd=tcp:127.0.0.1:20022-:2222" + ",hostfwd=tcp:127.0.0.1:25900-:5900") + "--snapshot" + "--hda")))) + +(define (hurd-vm-disk-image config) + "Return a disk-image for the Hurd according to CONFIG." + (let ((os (hurd-vm-configuration-os config)) + (disk-size (hurd-vm-configuration-disk-size config)) + (target (and (not (%current-target-system)) "i586-pc-gnu")) + (base-image (find-image "ext2" (%current-target-system)))) + (with-parameters ((%current-target-system target)) + (system-image + (image (inherit base-image) + (size disk-size) + (operating-system os)))))) + +(define (hurd-vm-shepherd-service config) + "Return a for a Hurd in a Virtual Machine with CONFIG." + + (let ((image (hurd-vm-configuration-image config)) + (qemu (hurd-vm-configuration-qemu config)) + (memory-size (hurd-vm-configuration-memory-size config)) + (options (hurd-vm-configuration-options config))) + + (define vm-command + #~(list + (string-append #$qemu "/bin/qemu-system-i386") + #$@(if (file-exists? "/dev/kvm") '("-enable-kvm") '()) + "-m" (number->string #$memory-size) + #$@options + #+image)) + + (list + (shepherd-service + (documentation "Run the Hurd in a Virtual Machine: a Childhurd.") + (provision '(hurd-vm childhurd)) + (requirement '(networking)) + (start #~(make-forkexec-constructor #$vm-command)) + (stop #~(make-kill-destructor)))))) + +(define hurd-vm-service-type + (service-type + (name 'hurd-vm) + (extensions (list (service-extension shepherd-root-service-type + hurd-vm-shepherd-service))) + (default-value (hurd-vm-configuration)) + (description + "Provide a Virtual Machine running the GNU/Hurd.")))