blob: 49b3f2d475ddaa453ef1dfeb09abc1307a35ae9e (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
(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 '()))
(let* ((args (append args '(#:store-crypto-devices ())))
(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" (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)))
|
