From c82c060d9167217aeede9d0e0c7129cc7944df70 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Apr 2016 16:23:18 +0200 Subject: install: Use 'beta' instead of 'alpha'. Suggested by Jelle Licht . * gnu/system/install.scm (installation-services): Say 'beta' instead of 'alpha' and make the warning less scary. --- gnu/system/install.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/system') diff --git a/gnu/system/install.scm b/gnu/system/install.scm index a94e3ab2d5..07ad3cbcb2 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -255,7 +255,7 @@ Welcome to the installation of the Guix System Distribution! There is NO WARRANTY, to the extent permitted by law. In particular, you may LOSE ALL YOUR DATA as a side effect of the installation process. Furthermore, -it is alpha software, so it may BREAK IN UNEXPECTED WAYS. +it is 'beta' software, so it may contain bugs. You have been warned. Thanks for being so brave. "))) -- cgit 1.4.1 From 060d62a740fc1932a3be505534feff099b59ac9f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Apr 2016 17:53:20 +0200 Subject: system: Add (gnu system mapped-devices). * gnu/system/file-systems.scm (, ): Move to... * gnu/system/mapped-devices.scm: ... here. New file. * gnu/system.scm, gnu/services/base.scm, gnu/system/linux-initrd.scm: Use it. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. * gnu.scm (%public-modules): Add it. --- gnu-system.am | 1 + gnu.scm | 3 ++- gnu/services/base.scm | 1 + gnu/system.scm | 1 + gnu/system/file-systems.scm | 31 ------------------------- gnu/system/linux-initrd.scm | 1 + gnu/system/mapped-devices.scm | 53 +++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 59 insertions(+), 32 deletions(-) create mode 100644 gnu/system/mapped-devices.scm (limited to 'gnu/system') diff --git a/gnu-system.am b/gnu-system.am index 2ec0000f2a..2b4c71d11f 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -383,6 +383,7 @@ GNU_SYSTEM_MODULES = \ gnu/system/linux-container.scm \ gnu/system/linux-initrd.scm \ gnu/system/locale.scm \ + gnu/system/mapped-devices.scm \ gnu/system/nss.scm \ gnu/system/pam.scm \ gnu/system/shadow.scm \ diff --git a/gnu.scm b/gnu.scm index f9a13246c3..932e4cdd58 100644 --- a/gnu.scm +++ b/gnu.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2015 Joshua S. Grant ;;; ;;; This file is part of GNU Guix. @@ -32,6 +32,7 @@ (begin (define %public-modules '((gnu system) + (gnu system mapped-devices) (gnu system file-systems) (gnu system grub) ; 'grub-configuration' (gnu system pam) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index a3585cc5a3..6884101fd7 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -27,6 +27,7 @@ #:use-module (gnu system pam) #:use-module (gnu system shadow) ; 'user-account', etc. #:use-module (gnu system file-systems) ; 'file-system', etc. + #:use-module (gnu system mapped-devices) #:use-module (gnu packages admin) #:use-module ((gnu packages linux) #:select (eudev kbd e2fsprogs lvm2 fuse alsa-utils crda gpm)) diff --git a/gnu/system.scm b/gnu/system.scm index a4259fb61b..a52881180d 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -54,6 +54,7 @@ #:use-module (gnu system pam) #:use-module (gnu system linux-initrd) #:use-module (gnu system file-systems) + #:use-module (gnu system mapped-devices) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index d0726d2b61..7e8c4489dd 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -54,17 +54,6 @@ %base-file-systems %container-file-systems - mapped-device - mapped-device? - mapped-device-source - mapped-device-target - mapped-device-type - - mapped-device-kind - mapped-device-kind? - mapped-device-kind-open - mapped-device-kind-close - file-system-mapping file-system-mapping? @@ -293,26 +282,6 @@ initrd code." (create-mount-point? #t) (check? #f)))) - - -;;; -;;; Mapped devices, for Linux's device-mapper. -;;; - -(define-record-type* mapped-device - make-mapped-device - mapped-device? - (source mapped-device-source) ;string - (target mapped-device-target) ;string - (type mapped-device-type)) ; - -(define-record-type* mapped-device-kind - make-mapped-device-kind - mapped-device-kind? - (open mapped-device-kind-open) ;source target -> gexp - (close mapped-device-kind-close ;source target -> gexp - (default (const #~(const #f))))) - ;;; ;;; Shared file systems, for VMs/containers. diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 8ca74104fb..aa9fbf6fe9 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -32,6 +32,7 @@ #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) #:use-module (gnu system file-systems) + #:use-module (gnu system mapped-devices) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm new file mode 100644 index 0000000000..81afb91f86 --- /dev/null +++ b/gnu/system/mapped-devices.scm @@ -0,0 +1,53 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014, 2015, 2016 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu system mapped-devices) + #:use-module (guix records) + #:export (mapped-device + mapped-device? + mapped-device-source + mapped-device-target + mapped-device-type + + mapped-device-kind + mapped-device-kind? + mapped-device-kind-open + mapped-device-kind-close)) + +;;; Commentary: +;;; +;;; This module supports "device mapping", a concept implemented by Linux's +;;; device-mapper. +;;; +;;; Code: + +(define-record-type* mapped-device + make-mapped-device + mapped-device? + (source mapped-device-source) ;string + (target mapped-device-target) ;string + (type mapped-device-type)) ; + +(define-record-type* mapped-device-kind + make-mapped-device-kind + mapped-device-kind? + (open mapped-device-kind-open) ;source target -> gexp + (close mapped-device-kind-close ;source target -> gexp + (default (const #~(const #f))))) + +;;; mapped-devices.scm ends here -- cgit 1.4.1 From 374f14c265224048b065f2c177f80718b905201b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Apr 2016 17:59:58 +0200 Subject: system: Move 'luks-device-mapping' to (gnu system mapped-devices). * gnu/system.scm (open-luks-device, close-luks-device) (luks-device-mapping): Move to... * gnu/system/mapped-devices.scm: ... here. New file. --- gnu/system.scm | 23 +---------------------- gnu/system/mapped-devices.scm | 29 ++++++++++++++++++++++++++++- 2 files changed, 29 insertions(+), 23 deletions(-) (limited to 'gnu/system') diff --git a/gnu/system.scm b/gnu/system.scm index a52881180d..b1454b262d 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -43,7 +43,6 @@ #:use-module (gnu packages texinfo) #:use-module (gnu packages compression) #:use-module (gnu packages firmware) - #:autoload (gnu packages cryptsetup) (cryptsetup) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu services base) @@ -102,9 +101,7 @@ local-host-aliases %setuid-programs %base-packages - %base-firmware - - luks-device-mapping)) + %base-firmware)) ;;; Commentary: ;;; @@ -177,24 +174,6 @@ ;;; Services. ;;; -(define (open-luks-device source target) - "Return a gexp that maps SOURCE to TARGET as a LUKS device, using -'cryptsetup'." - #~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") - "open" "--type" "luks" - #$source #$target))) - -(define (close-luks-device source target) - "Return a gexp that closes TARGET, a LUKS device." - #~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") - "close" #$target))) - -(define luks-device-mapping - ;; The type of LUKS mapped devices. - (mapped-device-kind - (open open-luks-device) - (close close-luks-device))) - (define (other-file-system-services os) "Return file system services for the file systems of OS that are not marked as 'needed-for-boot'." diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index 81afb91f86..dd8e432688 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -17,7 +17,9 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu system mapped-devices) + #:use-module (guix gexp) #:use-module (guix records) + #:autoload (gnu packages cryptsetup) (cryptsetup) #:export (mapped-device mapped-device? mapped-device-source @@ -27,7 +29,9 @@ mapped-device-kind mapped-device-kind? mapped-device-kind-open - mapped-device-kind-close)) + mapped-device-kind-close + + luks-device-mapping)) ;;; Commentary: ;;; @@ -50,4 +54,27 @@ (close mapped-device-kind-close ;source target -> gexp (default (const #~(const #f))))) + +;;; +;;; Common device mappings. +;;; + +(define (open-luks-device source target) + "Return a gexp that maps SOURCE to TARGET as a LUKS device, using +'cryptsetup'." + #~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") + "open" "--type" "luks" + #$source #$target))) + +(define (close-luks-device source target) + "Return a gexp that closes TARGET, a LUKS device." + #~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") + "close" #$target))) + +(define luks-device-mapping + ;; The type of LUKS mapped devices. + (mapped-device-kind + (open open-luks-device) + (close close-luks-device))) + ;;; mapped-devices.scm ends here -- cgit 1.4.1 From 1ea507bce294d12223c35c3f8c2ae3e54a4127fd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Apr 2016 18:09:11 +0200 Subject: services: Move 'device-mapping-service' to (gnu system mapped-devices). * gnu/services/base.scm (device-mapping-service-type) (device-mapping-service): Move to... * gnu/system/mapped-devices.scm (device-mapping-service-type): (device-mapping-service): ... here. New variables. --- gnu/services/base.scm | 21 --------------------- gnu/system/mapped-devices.scm | 31 +++++++++++++++++++++++++++++++ 2 files changed, 31 insertions(+), 21 deletions(-) (limited to 'gnu/system') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 6884101fd7..96bf8da02a 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -48,7 +48,6 @@ root-file-system-service file-system-service user-unmount-service - device-mapping-service swap-service user-processes-service session-environment-service @@ -1175,26 +1174,6 @@ extra rules from the packages listed in @var{rules}." (service udev-service-type (udev-configuration (udev udev) (rules rules)))) -(define device-mapping-service-type - (shepherd-service-type - 'device-mapping - (match-lambda - ((target open close) - (shepherd-service - (provision (list (symbol-append 'device-mapping- (string->symbol target)))) - (requirement '(udev)) - (documentation "Map a device node using Linux's device mapper.") - (start #~(lambda () #$open)) - (stop #~(lambda _ (not #$close))) - (respawn? #f)))))) - -(define (device-mapping-service target open close) - "Return a service that maps device @var{target}, a string such as -@code{\"home\"} (meaning @code{/dev/mapper/home}). Evaluate @var{open}, a -gexp, to open it, and evaluate @var{close} to close it." - (service device-mapping-service-type - (list target open close))) - (define swap-service-type (shepherd-service-type 'swap diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index dd8e432688..be2d6a4749 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -19,7 +19,10 @@ (define-module (gnu system mapped-devices) #:use-module (guix gexp) #:use-module (guix records) + #:use-module (gnu services) + #:use-module (gnu services shepherd) #:autoload (gnu packages cryptsetup) (cryptsetup) + #:use-module (ice-9 match) #:export (mapped-device mapped-device? mapped-device-source @@ -31,6 +34,9 @@ mapped-device-kind-open mapped-device-kind-close + device-mapping-service-type + device-mapping-service + luks-device-mapping)) ;;; Commentary: @@ -54,6 +60,31 @@ (close mapped-device-kind-close ;source target -> gexp (default (const #~(const #f))))) + +;;; +;;; Device mapping as a Shepherd service. +;;; + +(define device-mapping-service-type + (shepherd-service-type + 'device-mapping + (match-lambda + ((target open close) + (shepherd-service + (provision (list (symbol-append 'device-mapping- (string->symbol target)))) + (requirement '(udev)) + (documentation "Map a device node using Linux's device mapper.") + (start #~(lambda () #$open)) + (stop #~(lambda _ (not #$close))) + (respawn? #f)))))) + +(define (device-mapping-service target open close) + "Return a service that maps device @var{target}, a string such as +@code{\"home\"} (meaning @code{/dev/mapper/home}). Evaluate @var{open}, a +gexp, to open it, and evaluate @var{close} to close it." + (service device-mapping-service-type + (list target open close))) + ;;; ;;; Common device mappings. -- cgit 1.4.1 From 4da8c19e8337cbb908d5e77cd912791846070fb7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Apr 2016 18:26:50 +0200 Subject: mapped-devices: 'mapped-device-service' takes a . * gnu/system/mapped-devices.scm (device-mapping-service): Take a instead of 3 parameters. (device-mapping-service-type): Adjust accordingly. * gnu/system.scm (device-mapping-services): Adjust accordingly. --- gnu/system.scm | 10 +--------- gnu/system/mapped-devices.scm | 16 +++++++--------- 2 files changed, 8 insertions(+), 18 deletions(-) (limited to 'gnu/system') diff --git a/gnu/system.scm b/gnu/system.scm index b1454b262d..768ca9cab2 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -233,15 +233,7 @@ from the initrd." (define (device-mapping-services os) "Return the list of device-mapping services for OS as a list." - (map (lambda (md) - (let* ((source (mapped-device-source md)) - (target (mapped-device-target md)) - (type (mapped-device-type md)) - (open (mapped-device-kind-open type)) - (close (mapped-device-kind-close type))) - (device-mapping-service target - (open source target) - (close source target)))) + (map device-mapping-service (operating-system-user-mapped-devices os))) (define (swap-services os) diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index be2d6a4749..2706e255c5 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -69,21 +69,19 @@ (shepherd-service-type 'device-mapping (match-lambda - ((target open close) + (($ source target + ($ open close)) (shepherd-service (provision (list (symbol-append 'device-mapping- (string->symbol target)))) (requirement '(udev)) (documentation "Map a device node using Linux's device mapper.") - (start #~(lambda () #$open)) - (stop #~(lambda _ (not #$close))) + (start #~(lambda () #$(open source target))) + (stop #~(lambda _ (not #$(close source target)))) (respawn? #f)))))) -(define (device-mapping-service target open close) - "Return a service that maps device @var{target}, a string such as -@code{\"home\"} (meaning @code{/dev/mapper/home}). Evaluate @var{open}, a -gexp, to open it, and evaluate @var{close} to close it." - (service device-mapping-service-type - (list target open close))) +(define (device-mapping-service mapped-device) + "Return a service that sets up @var{mapped-device}." + (service device-mapping-service-type mapped-device)) ;;; -- cgit 1.4.1 From ffba7d498d36618ad21af3961a1a685ae91bae57 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 18 Apr 2016 00:23:16 +0200 Subject: mapped-devices: LUKS partitions can be designated by their UUID. * gnu/system/mapped-devices.scm (device-mapping-service-type): Add 'modules' and 'imported-modules' fields to 'shepherd-service'. (open-luks-device): Use 'find-partition-by-luks-uuid' to lookup the partition when SOURCE is a bytevector. * gnu/system/linux-initrd.scm (base-initrd): Augment 'use-modules' form. * doc/guix.texi (Mapped Devices): Give example with a UUID. --- doc/guix.texi | 20 ++++++++++++++++++-- gnu/system/linux-initrd.scm | 9 ++++++++- gnu/system/mapped-devices.scm | 29 +++++++++++++++++++++++++---- 3 files changed, 51 insertions(+), 7 deletions(-) (limited to 'gnu/system') diff --git a/doc/guix.texi b/doc/guix.texi index d5f7dcb30b..1b02ba0373 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6688,13 +6688,29 @@ Mapped devices are declared using the @code{mapped-device} form: (type luks-device-mapping)) @end example -@noindent +Or, better yet, like this: + +@example +(mapped-device + (source (uuid "cb67fc72-0d54-4c88-9d4b-b225f30b0f44")) + (target "home") + (type luks-device-mapping)) +@end example + @cindex disk encryption @cindex LUKS This example specifies a mapping from @file{/dev/sda3} to @file{/dev/mapper/home} using LUKS---the @url{http://code.google.com/p/cryptsetup,Linux Unified Key Setup}, a -standard mechanism for disk encryption. The @file{/dev/mapper/home} +standard mechanism for disk encryption. In the second example, the UUID +(unique identifier) is the LUKS UUID returned for the device by a +command like: + +@example +cryptsetup luksUUID /dev/sdx9 +@end example + +The @file{/dev/mapper/home} device can then be used as the @code{device} of a @code{file-system} declaration (@pxref{File Systems}). The @code{mapped-device} form is detailed below. diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index aa9fbf6fe9..484bce71c4 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -229,7 +229,14 @@ loaded at boot time in the order in which they appear." (use-modules (gnu build linux-boot) (guix build utils) (guix build bournish) ;add the 'bournish' meta-command - (srfi srfi-26)) + (srfi srfi-26) + + ;; FIXME: The following modules are for + ;; LUKS-DEVICE-MAPPING. We should instead propagate + ;; this info via gexps. + ((gnu build file-systems) + #:select (find-partition-by-luks-uuid)) + (rnrs bytevectors)) (with-output-to-port (%make-void-port "w") (lambda () diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm index 2706e255c5..450b4737ac 100644 --- a/gnu/system/mapped-devices.scm +++ b/gnu/system/mapped-devices.scm @@ -22,6 +22,7 @@ #:use-module (gnu services) #:use-module (gnu services shepherd) #:autoload (gnu packages cryptsetup) (cryptsetup) + #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:export (mapped-device mapped-device? @@ -77,7 +78,16 @@ (documentation "Map a device node using Linux's device mapper.") (start #~(lambda () #$(open source target))) (stop #~(lambda _ (not #$(close source target)))) - (respawn? #f)))))) + (respawn? #f) + + ;; Add the modules needed by LUKS-DEVICE-MAPPING. + ;; FIXME: This info should be propagated via gexps. + (modules `((rnrs bytevectors) ;bytevector? + ((gnu build file-systems) + #:select (find-partition-by-luks-uuid)) + ,@%default-modules)) + (imported-modules `((gnu build file-systems) + ,@%default-imported-modules))))))) (define (device-mapping-service mapped-device) "Return a service that sets up @var{mapped-device}." @@ -91,9 +101,20 @@ (define (open-luks-device source target) "Return a gexp that maps SOURCE to TARGET as a LUKS device, using 'cryptsetup'." - #~(zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") - "open" "--type" "luks" - #$source #$target))) + #~(let ((source #$source)) + (zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup") + "open" "--type" "luks" + + ;; Note: We cannot use the "UUID=source" syntax here + ;; because 'cryptsetup' implements it by searching the + ;; udev-populated /dev/disk/by-id directory but udev may + ;; be unavailable at the time we run this. + (if (bytevector? source) + (or (find-partition-by-luks-uuid source) + (error "LUKS partition not found" source)) + source) + + #$target)))) (define (close-luks-device source target) "Return a gexp that closes TARGET, a LUKS device." -- cgit 1.4.1 From 4c0416ae1709e08c311d32af4823fac9d73364ee Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 28 Apr 2016 23:04:52 +0200 Subject: guix system: Reduce size of image produced for 'vm' action. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This reduces the size of the image produced by 'guix system vm' from 26 MiB to 9 MiB. * gnu/system/vm.scm (system-qemu-image/shared-store): (system-qemu-image/shared-store-script): Change the default value of #:disk-image-size to 30 MiB when not FULL-BOOT?. * guix/scripts/system.scm (system-derivation-for-action): Likewise for the 'vm' action. --- gnu/system/vm.scm | 4 ++-- guix/scripts/system.scm | 5 ++++- 2 files changed, 6 insertions(+), 3 deletions(-) (limited to 'gnu/system') diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 58a476a468..2fbef6a3fc 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -425,7 +425,7 @@ environment with the store shared with the host. MAPPINGS is a list of os #:key full-boot? - (disk-image-size (* (if full-boot? 500 15) (expt 2 20)))) + (disk-image-size (* (if full-boot? 500 30) (expt 2 20)))) "Return a derivation that builds a QEMU image of OS that shares its store with the host. @@ -480,7 +480,7 @@ with '-virtfs' options for the host file systems listed in SHARED-FS." (mappings '()) full-boot? (disk-image-size - (* (if full-boot? 500 15) + (* (if full-boot? 500 30) (expt 2 20)))) "Return a derivation that builds a script to run a virtual machine image of OS that shares its store with the host. diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 566e7e8768..e5d754a6fa 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -477,7 +477,10 @@ PATTERN, a string. When PATTERN is #f, display all the system generations." ((vm) (system-qemu-image/shared-store-script os #:full-boot? full-boot? - #:disk-image-size image-size + #:disk-image-size + (if full-boot? + image-size + (* 30 (expt 2 20))) #:mappings mappings)) ((disk-image) (system-disk-image os #:disk-image-size image-size)))) -- cgit 1.4.1