diff options
| -rw-r--r-- | sigils/bootloader/grub.scm | 124 |
1 files changed, 124 insertions, 0 deletions
diff --git a/sigils/bootloader/grub.scm b/sigils/bootloader/grub.scm new file mode 100644 index 0000000..e1f1b76 --- /dev/null +++ b/sigils/bootloader/grub.scm @@ -0,0 +1,124 @@ +(define-module (sigils bootloader grub) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (guix utils) + #:use-module (gnu bootloader) + #:use-module (gnu bootloader grub) + #:use-module (gnu packages bootloaders) + #:use-module (srfi srfi-1) + #:use-module (ice-9 optargs) + #:export (grub-copy-bootloader + grub-efi-copy-bootloader)) + +;; The current grub-bootloader implementation demonstrates a remarkable +;; hostility to disk encryption, LVM, and PyGrub. + +;; Thanks to Rutherther (https://github.com/Rutherther/guix-config/blob/main/modules/ruther/bootloader/grub.scm) +;; for most of the implementation. + +(define (grub-copy-configuration-file config entries . args) + (let-keywords + args #t ((locale #f) + (system (%current-system)) + (old-entries '()) (store-crypto-devices '())) + + (let* ((grub (bootloader-package (bootloader-configuration-bootloader config))) + (image ((@@ (gnu bootloader grub) grub-background-image) config)) + (layout (bootloader-configuration-keyboard-layout config)) + (locales (and locale ((@@ (gnu bootloader grub) grub-locale-directory) grub))) + (keymap* (and layout ((@@ (gnu bootloader grub) keyboard-layout-file) layout #:grub grub))) + + (menu-entry-needed-files + (lambda (menu-entry) + #~(list + #$(menu-entry-linux menu-entry) + #$(menu-entry-initrd menu-entry)))) + + (needed-files-gexps + #~(delete-duplicates + (cons* + #$image + #$locales + #$keymap* + (apply append (list #$@(map menu-entry-needed-files (append entries old-entries))))))) + + (original-grub-cfg + (apply (@@ (gnu bootloader grub) grub-configuration-file) config entries args)) + + (builder + #~(call-with-output-file #$output + (lambda (port) + (use-modules (ice-9 textual-ports) + ;; delete-duplicates in needed gexps + (srfi srfi-1)) + + ;; This will probably never happen in the history of Guix. + (display "insmod lvm\n" port) + + (display + (string-join + (filter + ;; Let's get straight to the point. + (lambda (line) + (not (string-prefix? "search --label --set" (string-trim line)))) + (string-split + (call-with-input-file #$original-grub-cfg get-string-all) #\newline)) + "\n") port) + + (display "\n\n" port) + + (for-each + (lambda (file) + (display (string-append "# NEEDED FILE: " file "\n") port)) + #$needed-files-gexps))))) + + (computed-file "grub.cfg" builder + #:options '(#:local-build? #t + #:substitutable? #f))))) + +(define (install-grub-copy grub-installer) + #~(lambda (bootloader device mount-point) + (use-modules (guix build utils) + (ice-9 textual-ports) + (srfi srfi-1)) + + (let ((install-dir (string-append mount-point "/boot")) + (grub-cfg-lines (string-split + (call-with-input-file + (string-append mount-point #$(@@ (gnu bootloader grub) grub-cfg)) + get-string-all) #\newline))) + + (if (directory-exists? (string-append install-dir "/gnu")) + (delete-file-recursively (string-append install-dir "/gnu"))) + + (for-each + (lambda (file-line) + (let* ((source-file (string-trim-both (substring file-line (string-length "# NEEDED FILE: ")))) + (dest-file (string-append install-dir source-file))) + (mkdir-p (dirname dest-file)) + (copy-recursively source-file dest-file))) + (delete-duplicates (filter + (lambda (line) (string-prefix? "# NEEDED FILE: " line)) + grub-cfg-lines)))) + (#$grub-installer bootloader device mount-point))) + + +;; Maybe we could abstract grub-copy ? + +(define grub-copy-bootloader + (bootloader + (inherit grub-bootloader) + (name 'grub-copy) + (installer + (install-grub-copy (@@ (gnu bootloader grub) install-grub))) + (configuration-file-generator + grub-copy-configuration-file))) + +(define grub-efi-copy-bootloader + (bootloader + (inherit grub-efi-bootloader) + (name 'grub-efi-copy) + (installer + (install-grub-copy (@@ (gnu bootloader grub) install-grub-efi))) + (configuration-file-generator + grub-copy-configuration-file))) |