diff options
| -rw-r--r-- | gnu/image.scm | 3 | ||||
| -rw-r--r-- | gnu/system/image.scm | 66 |
2 files changed, 43 insertions, 26 deletions
diff --git a/gnu/image.scm b/gnu/image.scm index 0a92d168e9..19b466527b 100644 --- a/gnu/image.scm +++ b/gnu/image.scm @@ -33,6 +33,7 @@ image image-name image-format + image-target image-size image-operating-system image-partitions @@ -67,6 +68,8 @@ image make-image image? (format image-format) ;symbol + (target image-target + (default #f)) (size image-size ;size in bytes as integer (default 'guess)) (operating-system image-operating-system ;<operating-system> diff --git a/gnu/system/image.scm b/gnu/system/image.scm index be8b6e67f7..97e4bb0e3c 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -104,6 +104,7 @@ (define hurd-disk-image (image (format 'disk-image) + (target "i586-pc-gnu") (partitions (list (partition (size 'guess) @@ -519,6 +520,14 @@ it can be used for bootloading." (type root-file-system-type)) file-systems-to-keep))))) +(define-syntax-rule (maybe-with-target image exp ...) + (let ((target (image-target image))) + (if target + (with-parameters ((%current-target-system target)) + exp ...) + (begin + exp ...)))) + (define* (system-image image) "Return the derivation of IMAGE. It can be a raw disk-image or an ISO9660 image, depending on IMAGE format." @@ -530,32 +539,33 @@ image, depending on IMAGE format." (bootcfg (operating-system-bootcfg os)) (bootloader (bootloader-configuration-bootloader (operating-system-bootloader os)))) - (case (image-format image) - ((disk-image) - (system-disk-image image* - #:bootcfg bootcfg - #:bootloader bootloader - #:register-closures? register-closures? - #:inputs `(("system" ,os) - ("bootcfg" ,bootcfg)))) - ((iso9660) - (system-iso9660-image - image* - #:bootcfg bootcfg - #:bootloader bootloader - #:register-closures? register-closures? - #:inputs `(("system" ,os) - ("bootcfg" ,bootcfg)) - ;; Make sure to use a mode that does no imply - ;; HFS+ tree creation that may fail with: - ;; - ;; "libisofs: FAILURE : Too much files to mangle, - ;; cannot guarantee unique file names" - ;; - ;; This happens if some limits are exceeded, see: - ;; https://lists.gnu.org/archive/html/grub-devel/2020-06/msg00048.html - #:grub-mkrescue-environment - '(("MKRESCUE_SED_MODE" . "mbr_only"))))))) + (maybe-with-target image + (case (image-format image) + ((disk-image) + (system-disk-image image* + #:bootcfg bootcfg + #:bootloader bootloader + #:register-closures? register-closures? + #:inputs `(("system" ,os) + ("bootcfg" ,bootcfg)))) + ((iso9660) + (system-iso9660-image + image* + #:bootcfg bootcfg + #:bootloader bootloader + #:register-closures? register-closures? + #:inputs `(("system" ,os) + ("bootcfg" ,bootcfg)) + ;; Make sure to use a mode that does no imply + ;; HFS+ tree creation that may fail with: + ;; + ;; "libisofs: FAILURE : Too much files to mangle, + ;; cannot guarantee unique file names" + ;; + ;; This happens if some limits are exceeded, see: + ;; https://lists.gnu.org/archive/html/grub-devel/2020-06/msg00048.html + #:grub-mkrescue-environment + '(("MKRESCUE_SED_MODE" . "mbr_only")))))))) (define (find-image file-system-type target) "Find and return an image built that could match the given FILE-SYSTEM-TYPE, @@ -570,4 +580,8 @@ addition of the <image> record." (else efi-disk-image))))) +;;; Local Variables: +;;; eval: (put 'maybe-with-target 'scheme-indent-function 1) +;;; End: + ;;; image.scm ends here |