aboutsummaryrefslogtreecommitdiff
path: root/gnu/build/vm.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/build/vm.scm')
-rw-r--r--gnu/build/vm.scm44
1 files changed, 36 insertions, 8 deletions
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 2d41c5756b..727494ad93 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -76,11 +76,14 @@
(qemu (qemu-command)) (memory-size 512)
linux initrd
make-disk-image?
+ single-file-output?
(disk-image-size (* 100 (expt 2 20)))
(disk-image-format "qcow2")
(references-graphs '()))
"Run BUILDER, a Scheme file, into a VM running LINUX with INITRD, and copy
-the result to OUTPUT.
+the result to OUTPUT. If SINGLE-FILE-OUTPUT? is true, copy a single file from
+/xchg to OUTPUT. Otherwise, copy the contents of /xchg to a new directory
+OUTPUT.
When MAKE-DISK-IMAGE? is true, OUTPUT will contain a VM image of
DISK-IMAGE-SIZE bytes resulting from the execution of BUILDER, which may
@@ -137,8 +140,17 @@ the #:references-graphs parameter of 'derivation'."
;; When MAKE-DISK-IMAGE? is true, the image is in OUTPUT already.
(unless make-disk-image?
- (mkdir output)
- (copy-recursively "xchg" output)))
+ (if single-file-output?
+ (let ((graph? (lambda (name stat)
+ (member (basename name) references-graphs))))
+ (match (find-files "xchg" (negate graph?))
+ ((result)
+ (copy-file result output))
+ (x
+ (error "did not find a single result file" x))))
+ (begin
+ (mkdir output)
+ (copy-recursively "xchg" output)))))
;;;
@@ -157,8 +169,8 @@ the #:references-graphs parameter of 'derivation'."
(define (estimated-partition-size graphs)
"Return the estimated size of a partition that can store the store items
given by GRAPHS, a list of file names produced by #:references-graphs."
- ;; Simply add a 20% overhead.
- (round (* 1.2 (closure-size graphs))))
+ ;; Simply add a 25% overhead.
+ (round (* 1.25 (closure-size graphs))))
(define* (initialize-partition-table device partitions
#:key
@@ -354,9 +366,9 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
(error "failed to create GRUB EFI image"))))
(define* (make-iso9660-image grub config-file os-drv target
- #:key (volume-id "GuixSD") (volume-uuid #f))
+ #:key (volume-id "GuixSD_image") (volume-uuid #f))
"Given a GRUB package, creates an iso image as TARGET, using CONFIG-FILE as
-Grub configuration and OS-DRV as the stuff in it."
+GRUB configuration and OS-DRV as the stuff in it."
(let ((grub-mkrescue (string-append grub "/bin/grub-mkrescue")))
(mkdir-p "/tmp/root/var/run")
(mkdir-p "/tmp/root/run")
@@ -367,6 +379,19 @@ Grub configuration and OS-DRV as the stuff in it."
"var=/tmp/root/var"
"run=/tmp/root/run"
"--"
+ ;; Store two copies of the headers.
+ ;; The resulting ISO-9660 image has a DOS MBR and
+ ;; one protective partition (with type 0xCD).
+ ;; Because GuixSD only uses actual partitions
+ ;; rather than what /proc/partitions returns, work
+ ;; around it by storing the primary volume
+ ;; descriptor twice, once where it should be and
+ ;; once in the partition.
+ ;; Allegedly, otherwise, many other GNU tools
+ ;; (automounters etc) would also be confused by
+ ;; the extra partition so it makes sense to
+ ;; store two copies in any case.
+ "-boot_image" "any" "partition_offset=16"
"-volid" ,(string-upcase volume-id)
,@(if volume-uuid
`("-volume_date" "uuid"
@@ -427,11 +452,14 @@ passing it a directory name where it is mounted."
;; Create a tiny configuration file telling the embedded grub
;; where to load the real thing.
+ ;; XXX This is quite fragile, and can prevent the image from booting
+ ;; when there's more than one volume with this label present.
+ ;; Reproducible almost-UUIDs could reduce the risk (not eliminate it).
(call-with-output-file grub-config
(lambda (port)
(format port
"insmod part_msdos~@
- search --set=root --label GuixSD~@
+ search --set=root --label GuixSD_image~@
configfile /boot/grub/grub.cfg~%")))
(display "creating EFI firmware image...")