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.master
parent
39b27f4eae
commit
4307397b5e
|
@ -85,14 +85,6 @@ TIMEOUT ~a~%"
|
||||||
;;; Install procedures.
|
;;; 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)
|
(define (install-extlinux mbr)
|
||||||
#~(lambda (bootloader device mount-point)
|
#~(lambda (bootloader device mount-point)
|
||||||
(let ((extlinux (string-append bootloader "/sbin/extlinux"))
|
(let ((extlinux (string-append bootloader "/sbin/extlinux"))
|
||||||
|
@ -101,9 +93,15 @@ TIMEOUT ~a~%"
|
||||||
(for-each (lambda (file)
|
(for-each (lambda (file)
|
||||||
(install-file file install-dir))
|
(install-file file install-dir))
|
||||||
(find-files syslinux-dir "\\.c32$"))
|
(find-files syslinux-dir "\\.c32$"))
|
||||||
|
(unless
|
||||||
(unless (and (zero? (system* extlinux "--install" install-dir))
|
(and (zero? (system* extlinux "--install" install-dir))
|
||||||
(#$dd 440 1 (string-append syslinux-dir "/" #$mbr) device))
|
(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")))))
|
(error "failed to install SYSLINUX")))))
|
||||||
|
|
||||||
(define install-extlinux-mbr
|
(define install-extlinux-mbr
|
||||||
|
|
|
@ -278,7 +278,8 @@ the image."
|
||||||
#~(begin
|
#~(begin
|
||||||
(use-modules (gnu build vm)
|
(use-modules (gnu build vm)
|
||||||
(guix build utils)
|
(guix build utils)
|
||||||
(srfi srfi-26))
|
(srfi srfi-26)
|
||||||
|
(ice-9 binary-ports))
|
||||||
|
|
||||||
(let ((inputs
|
(let ((inputs
|
||||||
'#$(append (list qemu parted e2fsprogs dosfstools)
|
'#$(append (list qemu parted e2fsprogs dosfstools)
|
||||||
|
|
|
@ -676,7 +676,8 @@ and TARGET arguments."
|
||||||
(gexp->file "bootloader-installer"
|
(gexp->file "bootloader-installer"
|
||||||
(with-imported-modules '((guix build utils))
|
(with-imported-modules '((guix build utils))
|
||||||
#~(begin
|
#~(begin
|
||||||
(use-modules (guix build utils))
|
(use-modules (guix build utils)
|
||||||
|
(ice-9 binary-ports))
|
||||||
(#$installer #$bootloader #$device #$target))))))
|
(#$installer #$bootloader #$device #$target))))))
|
||||||
|
|
||||||
(define* (perform-action action os
|
(define* (perform-action action os
|
||||||
|
|
Reference in New Issue