bootloader: extlinux: Stop using dd binary.
* gnu/bootloader/extlinux.scm (dd): Remove it, (install-extlinux): replace dd call by Guile I/O procedures. * gnu/system/vm.scm (qemu-image): Add (ice-9 binary-ports) to used-modules list to provide "get-bytevector-n" and "put-bytevector". * guix/scripts/system.scm (bootloader-installer-derivation): Ditto.
This commit is contained in:
parent
39b27f4eae
commit
4307397b5e
|
@ -85,14 +85,6 @@ TIMEOUT ~a~%"
|
|||
;;; Install procedures.
|
||||
;;;
|
||||
|
||||
(define dd
|
||||
#~(lambda (bs count if of)
|
||||
(zero? (system* "dd"
|
||||
(string-append "bs=" (number->string bs))
|
||||
(string-append "count=" (number->string count))
|
||||
(string-append "if=" if)
|
||||
(string-append "of=" of)))))
|
||||
|
||||
(define (install-extlinux mbr)
|
||||
#~(lambda (bootloader device mount-point)
|
||||
(let ((extlinux (string-append bootloader "/sbin/extlinux"))
|
||||
|
@ -101,9 +93,15 @@ TIMEOUT ~a~%"
|
|||
(for-each (lambda (file)
|
||||
(install-file file install-dir))
|
||||
(find-files syslinux-dir "\\.c32$"))
|
||||
|
||||
(unless (and (zero? (system* extlinux "--install" install-dir))
|
||||
(#$dd 440 1 (string-append syslinux-dir "/" #$mbr) device))
|
||||
(unless
|
||||
(and (zero? (system* extlinux "--install" install-dir))
|
||||
(call-with-input-file (string-append syslinux-dir "/" #$mbr)
|
||||
(lambda (input)
|
||||
(let ((bv (get-bytevector-n input 440)))
|
||||
(call-with-output-file device
|
||||
(lambda (output)
|
||||
(put-bytevector output bv))
|
||||
#:binary #t)))))
|
||||
(error "failed to install SYSLINUX")))))
|
||||
|
||||
(define install-extlinux-mbr
|
||||
|
|
|
@ -278,7 +278,8 @@ the image."
|
|||
#~(begin
|
||||
(use-modules (gnu build vm)
|
||||
(guix build utils)
|
||||
(srfi srfi-26))
|
||||
(srfi srfi-26)
|
||||
(ice-9 binary-ports))
|
||||
|
||||
(let ((inputs
|
||||
'#$(append (list qemu parted e2fsprogs dosfstools)
|
||||
|
|
|
@ -676,7 +676,8 @@ and TARGET arguments."
|
|||
(gexp->file "bootloader-installer"
|
||||
(with-imported-modules '((guix build utils))
|
||||
#~(begin
|
||||
(use-modules (guix build utils))
|
||||
(use-modules (guix build utils)
|
||||
(ice-9 binary-ports))
|
||||
(#$installer #$bootloader #$device #$target))))))
|
||||
|
||||
(define* (perform-action action os
|
||||
|
|
Loading…
Reference in New Issue