Merge branch 'master' into core-updates

3 files changed, 32 insertions, 5 deletions

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index f9cc4088bb..b6930497d6 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -48,6 +48,7 @@
             string->ext3-uuid
             string->ext4-uuid
             string->btrfs-uuid
+            iso9660-uuid->string
 
             bind-mount
 
@@ -319,7 +320,7 @@ SBLOCK as a bytevector.  If that's not set, returns the creation time."
          (second (sub-bytevector uuid 12 2))
          (hundredths (sub-bytevector uuid 14 2))
          (parts (list year month day hour minute second hundredths)))
-    (string-append (string-join (map digits->string parts)))))
+    (string-append (string-join (map digits->string parts) "-"))))
 
 (define (iso9660-superblock-volume-name sblock)
   "Return the volume name of SBLOCK as a string.  The volume name is an ASCII
diff --git a/gnu/build/svg.scm b/gnu/build/svg.scm
index f7e92a1a19..b5474ec4a0 100644
--- a/gnu/build/svg.scm
+++ b/gnu/build/svg.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -50,7 +50,7 @@ dimensions of IN-SVG."
   (define svg
     (rsvg-handle-new-from-file in-svg))
 
-  (let-values (((origin-width origin-height)
+  (let-values (((origin-width origin-height em ex)
                 (rsvg-handle-get-dimensions svg)))
     (let* ((surf (cairo-image-surface-create 'argb32
                                              origin-width origin-height))
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 8f7fc3c9c4..2d41c5756b 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -26,6 +26,7 @@
   #:use-module (guix build syscalls)
   #:use-module (gnu build linux-boot)
   #:use-module (gnu build install)
+  #:use-module (gnu build file-systems)
   #:use-module (guix records)
   #:use-module ((guix combinators) #:select (fold2))
   #:use-module (ice-9 format)
@@ -50,7 +51,8 @@
             estimated-partition-size
             root-partition-initializer
             initialize-partition-table
-            initialize-hard-disk))
+            initialize-hard-disk
+            make-iso9660-image))
 
 ;;; Commentary:
 ;;;
@@ -351,6 +353,30 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
                             (string-append "boot/grub/grub.cfg=" config-file)))
       (error "failed to create GRUB EFI image"))))
 
+(define* (make-iso9660-image grub config-file os-drv target
+                             #:key (volume-id "GuixSD") (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."
+  (let ((grub-mkrescue (string-append grub "/bin/grub-mkrescue")))
+    (mkdir-p "/tmp/root/var/run")
+    (mkdir-p "/tmp/root/run")
+    (unless (zero? (apply system*
+                          `(,grub-mkrescue "-o" ,target
+                            ,(string-append "boot/grub/grub.cfg=" config-file)
+                            ,(string-append "gnu/store=" os-drv "/..")
+                            "var=/tmp/root/var"
+                            "run=/tmp/root/run"
+                            "--"
+                            "-volid" ,(string-upcase volume-id)
+                            ,@(if volume-uuid
+                                  `("-volume_date" "uuid"
+                                    ,(string-filter (lambda (value)
+                                                      (not (char=? #\- value)))
+                                                    (iso9660-uuid->string
+                                                     volume-uuid)))
+                                  `()))))
+      (error "failed to create ISO9660 image"))))
+
 (define* (initialize-hard-disk device
                                #:key
                                bootloader-package
@@ -405,7 +431,7 @@ passing it a directory name where it is mounted."
           (lambda (port)
             (format port
                     "insmod part_msdos~@
-                    search --set=root --label gnu-disk-image~@
+                    search --set=root --label GuixSD~@
                     configfile /boot/grub/grub.cfg~%")))
 
         (display "creating EFI firmware image...")