aboutsummaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2020-06-13 14:01:18 +0200
committerMathieu Othacehe <othacehe@gnu.org>2020-06-13 15:20:52 +0200
commitf292d4719dead6a615187f325fbc0bb0e99d10b4 (patch)
tree1c24c9dabcf98907d64979ba070832679253d814 /gnu/system
parent7ca533c7237622d70b423033c4506217d9ce4014 (diff)
downloadguix-f292d4719dead6a615187f325fbc0bb0e99d10b4.tar
guix-f292d4719dead6a615187f325fbc0bb0e99d10b4.tar.gz
image: Add 'target' support.
* gnu/image.scm (<image>)[target]: New field, (image-target): new public method. * gnu/system/image.scm (hurd-disk-image): Set "i586-pc-gnu" as image 'target' field, (maybe-with-target): new procedure, (system-image): honor image 'target' field using the above procedure.
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/image.scm66
1 files changed, 40 insertions, 26 deletions
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