diff options
Diffstat (limited to 'gnu/build/vm.scm')
| -rw-r--r-- | gnu/build/vm.scm | 44 |
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...") |