diff options
Diffstat (limited to 'gnu/build')
-rw-r--r-- | gnu/build/file-systems.scm | 3 | ||||
-rw-r--r-- | gnu/build/svg.scm | 4 | ||||
-rw-r--r-- | gnu/build/vm.scm | 30 |
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...") |