Merge branch 'version-1.4.0'

3 files changed, 21 insertions, 72 deletions

diff --git a/gnu/system/examples/yggdrasil.tmpl b/gnu/system/examples/yggdrasil.tmpl
deleted file mode 100644
index 4d34f49b54..0000000000
--- a/gnu/system/examples/yggdrasil.tmpl
+++ /dev/null
@@ -1,60 +0,0 @@
-;; This is an operating system configuration template
-;; for a "bare bones" setup, with no X11 display server.
-
-(use-modules (gnu))
-(use-service-modules networking ssh)
-(use-package-modules admin curl networking screen)
-
-(operating-system
-  (host-name "ruby-guard-5545")
-  (timezone "Europe/Budapest")
-  (locale "en_US.utf8")
-
-  ;; Boot in "legacy" BIOS mode, assuming /dev/sdX is the
-  ;; target hard disk, and "my-root" is the label of the target
-  ;; root file system.
-  (bootloader (bootloader-configuration
-                (bootloader grub-bootloader)
-                (targets '("/dev/sdX"))))
-  (file-systems (cons (file-system
-                        (device (file-system-label "my-root"))
-                        (mount-point "/")
-                        (type "ext4"))
-                      %base-file-systems))
-  (users (cons (user-account
-                (name "alice")
-                (comment "Bob's sister")
-                (group "users")
-                ;; adding her to the yggdrasil group means she can use
-                ;; yggdrasilctl to modify the configuration
-                (supplementary-groups '("wheel" "yggdrasil")))
-               %base-user-accounts))
-
-  ;; Globally-installed packages.
-  (packages (cons* screen curl %base-packages))
-
-  ;; Add services to the baseline: a DHCP client and
-  ;; an SSH server.
-  ;; If you add an /etc/yggdrasil-private.conf, you can log in to ssh
-  ;; using your Yggdrasil IPv6 address from another machine running Yggdrasil.
-  ;; Alternatively, the client can sit behind a router that has Yggdrasil.
-  ;; That file is specifically _not_ handled by Guix, because we don't want its
-  ;; contents to sit in the world-readable /gnu/store.
-  (services
-   (append
-    (list
-     (service dhcp-client-service-type)
-     (service yggdrasil-service-type
-              (yggdrasil-configuration
-               (log-to 'stdout)
-               (log-level 'debug)
-               (autoconf? #f)
-               (json-config
-                ;; choose a few from
-                ;; https://github.com/yggdrasil-network/public-peers
-                '((peers . #("tcp://1.2.3.4:1337"))))
-               (config-file #f)))
-     (service openssh-service-type
-              (openssh-configuration
-               (port-number 2222))))
-    %base-services)))
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index f07a4a5217..d518a05a51 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -972,9 +972,9 @@ image, depending on IMAGE format."
                 (G_ "~a: unsupported image format") image-format)))))))
 
 
-;;
-;; Image detection.
-;;
+;;;
+;;; Image type discovery.
+;;;
 
 (define (image-modules)
   "Return the list of image modules."
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index c2f7efa966..b7bccd72a4 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2022 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>
@@ -234,8 +234,8 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
 
      #$@(map virtfs-option shared-fs)
      #$@(if rw-image?
-            #~((format #f "-drive file=~a,if=virtio" #$image))
-            #~((format #f "-drive file=~a,if=virtio,cache=writeback,werror=report,readonly=on"
+            #~((format #f "-drive file=~a,format=qcow2,if=virtio" #$image))
+            #~((format #f "-drive file=~a,format=raw,if=virtio,cache=writeback,werror=report,readonly=on"
                        #$image)))))
 
 (define* (system-qemu-image/shared-store-script os
@@ -303,17 +303,26 @@ useful when FULL-BOOT?  is true."
               "-m " (number->string #$memory-size)
               #$@options))
 
+    (define copy-image
+      ;; Script that "copies" BASE-IMAGE to /tmp.  Make a copy-on-write image,
+      ;; which is much cheaper than actually copying it.
+      (program-file "copy-image"
+                    (with-imported-modules '((guix build utils))
+                      #~(begin
+                          (use-modules (guix build utils))
+                          (unless (file-exists? #$rw-image)
+                            (invoke #+(file-append qemu "/bin/qemu-img")
+                                    "create" "-b" #$base-image
+                                    "-F" "raw" "-f" "qcow2" #$rw-image))))))
+
     (define builder
       #~(call-with-output-file #$output
           (lambda (port)
             (format port "#!~a~%"
                     #+(file-append bash "/bin/sh"))
-            (when (not #$volatile?)
-              (format port "~a~%"
-                      #$(program-file "copy-image"
-                                      #~(unless (file-exists? #$rw-image)
-                                          (copy-file #$base-image #$rw-image)
-                                          (chmod #$rw-image #o640)))))
+            #$@(if volatile?
+                   #~()
+                   #~((format port "~a~%" #+copy-image)))
             (format port "exec ~a \"$@\"~%"
                     (string-join #$qemu-exec " "))
             (chmod port #o555))))