(lambda (input)
(let ((bv (get-bytevector-n input size)))
(call-with-port
+ ;; Do not use "call-with-output-file" that would truncate the file.
(open-file-output-port device
- (file-options no-truncate no-create)
+ (file-options no-truncate no-fail)
(buffer-mode block)
- (native-transcoder))
+ ;; Use the binary-friendly ISO-8859-1
+ ;; encoding.
+ (make-transcoder (latin-1-codec)))
(lambda (output)
(seek output offset SEEK_SET)
(put-bytevector output bv)))))))
;; test suite, the bootloader installer script is omitted. 'grub-install'
;; would attempt to write directly to the virtual disk if the
;; installation script were run.
- (test (install-bootloader-program #f #f bootcfg bootcfg-file #f "/")))))
+ (test
+ (install-bootloader-program #f #f #f bootcfg bootcfg-file #f "/")))))
+
(define %test-switch-to-system
(system-test
;;; Bootloader configuration.
;;;
-(define (install-bootloader-program installer bootloader-package bootcfg
+(define (install-bootloader-program installer disk-installer
+ bootloader-package bootcfg
bootcfg-file device target)
"Return an executable store item that, upon being evaluated, will install
BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICE, a file system device,
;; a broken installation.
(switch-symlinks new-gc-root #$bootcfg)
(install-boot-config #$bootcfg #$bootcfg-file #$target)
- (when #$installer
+ (when (or #$installer #$disk-installer)
(catch #t
(lambda ()
- (#$installer #$bootloader-package #$device #$target))
+ ;; The bootloader might not support installation on a
+ ;; mounted directory using the BOOTLOADER-INSTALLER
+ ;; procedure. In that case, fallback to installing the
+ ;; bootloader directly on DEVICE using the
+ ;; BOOTLOADER-DISK-IMAGE-INSTALLER procedure.
+ (if #$installer
+ (#$installer #$bootloader-package #$device #$target)
+ (#$disk-installer #$bootloader-package 0 #$device)))
(lambda args
(delete-file new-gc-root)
(match args
(let* ((bootloader (bootloader-configuration-bootloader configuration))
(installer (and run-installer?
(bootloader-installer bootloader)))
+ (disk-installer (and run-installer?
+ (bootloader-disk-image-installer bootloader)))
(package (bootloader-package bootloader))
(device (bootloader-configuration-target configuration))
(bootcfg-file (bootloader-configuration-file bootloader)))
(eval #~(parameterize ((current-warning-port (%make-void-port "w")))
(primitive-load #$(install-bootloader-program installer
+ disk-installer
package
bootcfg
bootcfg-file