Merge branch 'master' into staging

3 files changed, 33 insertions, 16 deletions

diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index 299c0728cb..9c58370ec3 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -313,6 +313,7 @@ they already exist."
     (false-if-exception (delete-file file)))
 
   (format #t "populating /etc from ~a...~%" etc)
+  (mkdir-p "/etc")
 
   ;; Create the /etc/ssl -> /run/current-system/profile/etc/ssl symlink.  This
   ;; symlink, to a target outside of the store, probably doesn't belong in the
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index b6930497d6..203fbdfffb 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -373,15 +373,16 @@ not valid header was found."
 
 (define (disk-partitions)
   "Return the list of device names corresponding to valid disk partitions."
-  (define (last-character str)
-    (string-ref str (- (string-length str) 1)))
-
   (define (partition? name major minor)
-    ;; Select device names that end in a digit, like libblkid's 'probe_all'
-    ;; function does.  Checking for "/sys/dev/block/MAJOR:MINOR/partition"
-    ;; doesn't work for partitions coming from mapped devices.
-    (and (char-set-contains? char-set:digit (last-character name))
-         (> major 2)))                      ;ignore RAM disks and floppy disks
+    ;; grub-mkrescue does some funny things for EFI support which
+    ;; makes it a lot more difficult than one would expect to support
+    ;; booting an ISO-9660 image from an USB flash drive.
+    ;; For example there's a buggy (too small) hidden partition in it
+    ;; which Linux mounts and then proceeds to fail while trying to
+    ;; fall off the edge.
+    ;; In any case, partition tables are supposed to be optional so
+    ;; here we allow checking entire disks for file systems, too.
+    (> major 2))                      ;ignore RAM disks and floppy disks
 
   (call-with-input-file "/proc/partitions"
     (lambda (port)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index d8c53ef37f..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")
@@ -440,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...")