Commit | Line | Data |
---|---|---|
9d449b94 MÁAV |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | ;;; Commentary: | |
20 | ;;; | |
21 | ;;; Test boot parameters value storage and compatibility. | |
22 | ;;; | |
23 | ;;; Code: | |
24 | ||
25 | (define-module (test-boot-parameters) | |
26 | #:use-module (gnu bootloader) | |
27 | #:use-module (gnu bootloader grub) | |
28 | #:use-module (gnu system) | |
29 | #:use-module (gnu system file-systems) | |
30 | #:use-module (gnu system uuid) | |
31 | #:use-module (guix gexp) | |
32 | #:use-module (guix store) | |
33 | #:use-module (guix tests) | |
34 | #:use-module (srfi srfi-64) | |
35 | #:use-module (rnrs bytevectors)) | |
36 | ||
37 | (define %default-label "GNU with Linux-libre 99.1.2") | |
38 | (define %default-kernel-path | |
39 | (string-append (%store-prefix) | |
40 | "/zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz-linux-libre-99.1.2")) | |
41 | (define %default-kernel | |
42 | (string-append %default-kernel-path "/" (system-linux-image-file-name))) | |
43 | (define %default-kernel-arguments '()) | |
44 | (define %default-initrd-path | |
45 | (string-append (%store-prefix) "/wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww-initrd")) | |
46 | (define %default-initrd (string-append %default-initrd-path "/initrd.cpio.gz")) | |
47 | (define %default-root-device (uuid "abcdef12-3456-7890-abcd-ef1234567890")) | |
48 | (define %default-store-device (uuid "01234567-89ab-cdef-0123-456789abcdef")) | |
582cf925 MÁAV |
49 | (define %default-btrfs-subvolume "testfs") |
50 | (define %default-store-directory-prefix | |
51 | (string-append "/" %default-btrfs-subvolume)) | |
9d449b94 MÁAV |
52 | (define %default-store-mount-point (%store-prefix)) |
53 | (define %default-multiboot-modules '()) | |
54 | (define %default-locale "es_ES.utf8") | |
55 | (define %root-path "/") | |
56 | ||
57 | (define %grub-boot-parameters | |
58 | (boot-parameters | |
59 | (bootloader-name 'grub) | |
60 | (bootloader-menu-entries '()) | |
61 | (root-device %default-root-device) | |
62 | (label %default-label) | |
63 | (kernel %default-kernel) | |
64 | (kernel-arguments %default-kernel-arguments) | |
65 | (initrd %default-initrd) | |
66 | (multiboot-modules %default-multiboot-modules) | |
67 | (locale %default-locale) | |
68 | (store-device %default-store-device) | |
582cf925 | 69 | (store-directory-prefix %default-store-directory-prefix) |
9d449b94 MÁAV |
70 | (store-mount-point %default-store-mount-point))) |
71 | ||
72 | (define %default-operating-system | |
73 | (operating-system | |
74 | (host-name "host") | |
75 | (timezone "Europe/Berlin") | |
76 | (locale %default-locale) | |
77 | ||
78 | (bootloader (bootloader-configuration | |
79 | (bootloader grub-bootloader) | |
80 | (target "/dev/sda"))) | |
81 | (file-systems (cons* (file-system | |
82 | (device %default-root-device) | |
83 | (mount-point %root-path) | |
84 | (type "ext4")) | |
85 | (file-system | |
86 | (device %default-store-device) | |
87 | (mount-point %default-store-mount-point) | |
582cf925 MÁAV |
88 | (type "btrfs") |
89 | (options | |
90 | (string-append "subvol=" | |
91 | %default-btrfs-subvolume))) | |
9d449b94 MÁAV |
92 | %base-file-systems)))) |
93 | ||
94 | (define (quote-uuid uuid) | |
95 | (list 'uuid (uuid-type uuid) (uuid-bytevector uuid))) | |
96 | ||
97 | ;; Call read-boot-parameters with the desired string as input. | |
98 | (define* (test-read-boot-parameters | |
99 | #:key | |
100 | (version 0) | |
101 | (bootloader-name 'grub) | |
102 | (bootloader-menu-entries '()) | |
103 | (label %default-label) | |
104 | (root-device (quote-uuid %default-root-device)) | |
105 | (kernel %default-kernel) | |
106 | (kernel-arguments %default-kernel-arguments) | |
107 | (initrd %default-initrd) | |
108 | (multiboot-modules %default-multiboot-modules) | |
109 | (locale %default-locale) | |
110 | (with-store #t) | |
111 | (store-device | |
112 | (quote-uuid %default-store-device)) | |
582cf925 | 113 | (store-directory-prefix %default-store-directory-prefix) |
9d449b94 MÁAV |
114 | (store-mount-point %default-store-mount-point)) |
115 | (define (generate-boot-parameters) | |
116 | (define (sexp-or-nothing fmt val) | |
117 | (cond ((eq? 'false val) (format #false fmt #false)) | |
118 | (val (format #false fmt val)) | |
119 | (else ""))) | |
120 | (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a~a)" | |
121 | (sexp-or-nothing " (version ~S)" version) | |
122 | (sexp-or-nothing " (label ~S)" label) | |
123 | (sexp-or-nothing " (root-device ~S)" root-device) | |
124 | (sexp-or-nothing " (kernel ~S)" kernel) | |
125 | (sexp-or-nothing " (kernel-arguments ~S)" kernel-arguments) | |
126 | (sexp-or-nothing " (initrd ~S)" initrd) | |
127 | (if with-store | |
582cf925 | 128 | (format #false " (store~a~a~a)" |
9d449b94 MÁAV |
129 | (sexp-or-nothing " (device ~S)" store-device) |
130 | (sexp-or-nothing " (mount-point ~S)" | |
582cf925 MÁAV |
131 | store-mount-point) |
132 | (sexp-or-nothing " (directory-prefix ~S)" | |
133 | store-directory-prefix)) | |
9d449b94 MÁAV |
134 | "") |
135 | (sexp-or-nothing " (locale ~S)" locale) | |
136 | (sexp-or-nothing " (bootloader-name ~a)" bootloader-name) | |
137 | (sexp-or-nothing " (bootloader-menu-entries ~S)" | |
138 | bootloader-menu-entries))) | |
139 | (let ((str (generate-boot-parameters))) | |
140 | (call-with-input-string str read-boot-parameters))) | |
141 | ||
142 | (test-begin "boot-parameters") | |
143 | ||
144 | ;; XXX: <warning: unrecognized boot parameters at '#f'> | |
145 | (test-assert "read, construction, mandatory fields" | |
146 | (not (or (test-read-boot-parameters #:version #false) | |
147 | (test-read-boot-parameters #:version 'false) | |
148 | (test-read-boot-parameters #:version -1) | |
149 | (test-read-boot-parameters #:version "0") | |
150 | (test-read-boot-parameters #:root-device #false) | |
151 | (test-read-boot-parameters #:kernel #false) | |
152 | (test-read-boot-parameters #:label #false)))) | |
153 | ||
154 | (test-assert "read, construction, optional fields" | |
155 | (and (test-read-boot-parameters #:bootloader-name #false) | |
156 | (test-read-boot-parameters #:bootloader-menu-entries #false) | |
157 | (test-read-boot-parameters #:kernel-arguments #false) | |
158 | (test-read-boot-parameters #:with-store #false) | |
159 | (test-read-boot-parameters #:store-device #false) | |
160 | (test-read-boot-parameters #:store-device 'false) | |
161 | (test-read-boot-parameters #:store-mount-point #false) | |
582cf925 | 162 | (test-read-boot-parameters #:store-directory-prefix #false) |
9d449b94 MÁAV |
163 | (test-read-boot-parameters #:multiboot-modules #false) |
164 | (test-read-boot-parameters #:locale #false) | |
165 | (test-read-boot-parameters #:bootloader-name #false | |
166 | #:kernel-arguments #false | |
167 | #:with-store #false | |
168 | #:locale #false))) | |
169 | ||
170 | (test-equal "read, default equality" | |
171 | %grub-boot-parameters | |
172 | (test-read-boot-parameters)) | |
173 | ||
174 | (test-equal "read, root-device, label" | |
175 | (file-system-label "my-root") | |
176 | (boot-parameters-root-device | |
177 | (test-read-boot-parameters #:root-device '(file-system-label "my-root")))) | |
178 | ||
179 | (test-equal "read, root-device, /dev node" | |
180 | "/dev/sda2" | |
181 | (boot-parameters-root-device | |
182 | (test-read-boot-parameters #:root-device "/dev/sda2"))) | |
183 | ||
184 | (test-equal "read, kernel, only store path" | |
185 | %default-kernel | |
186 | (boot-parameters-kernel | |
187 | (test-read-boot-parameters #:kernel %default-kernel-path))) | |
188 | ||
189 | (test-equal "read, kernel, full-path" | |
190 | %default-kernel | |
191 | (boot-parameters-kernel | |
192 | (test-read-boot-parameters #:kernel %default-kernel))) | |
193 | ||
194 | (test-assert "read, construction, missing initrd" | |
195 | (not (boot-parameters-initrd (test-read-boot-parameters #:initrd #false)))) | |
196 | ||
197 | (test-equal "read, initrd, old format" | |
198 | "/a/b" | |
199 | (boot-parameters-initrd | |
200 | (test-read-boot-parameters #:initrd (list 'string-append "/a" "/b")))) | |
201 | ||
202 | ;; Compatibility reasons specified in gnu/system.scm. | |
203 | (test-eq "read, bootloader-name, default value" | |
204 | 'grub | |
205 | (boot-parameters-bootloader-name | |
206 | (test-read-boot-parameters #:bootloader-name #false))) | |
207 | ||
208 | (test-eq "read, bootloader-menu-entries, default value" | |
209 | '() | |
210 | (boot-parameters-bootloader-menu-entries | |
211 | (test-read-boot-parameters #:bootloader-menu-entries #false))) | |
212 | ||
213 | (test-eq "read, kernel-arguments, default value" | |
214 | '() | |
215 | (boot-parameters-kernel-arguments | |
216 | (test-read-boot-parameters #:kernel-arguments #false))) | |
217 | ||
218 | (test-assert "read, store-device, filter /dev" | |
219 | (not (boot-parameters-store-device | |
220 | (test-read-boot-parameters #:store-device "/dev/sda3")))) | |
221 | ||
222 | (test-assert "read, no-store, filter /dev from root" | |
223 | (not (boot-parameters-store-device | |
224 | (test-read-boot-parameters #:root-device "/dev/sda3" | |
225 | #:with-store #false)))) | |
226 | ||
227 | (test-assert "read, no store-device, filter /dev from root" | |
228 | (not (boot-parameters-store-device | |
229 | (test-read-boot-parameters #:root-device "/dev/sda3" | |
230 | #:store-device #false)))) | |
231 | ||
232 | (test-assert "read, store-device #false, filter /dev from root" | |
233 | (not (boot-parameters-store-device | |
234 | (test-read-boot-parameters #:root-device "/dev/sda3" | |
235 | #:store-device 'false)))) | |
236 | ||
237 | (test-equal "read, store-device, label (legacy)" | |
238 | (file-system-label "my-store") | |
239 | (boot-parameters-store-device | |
240 | (test-read-boot-parameters #:store-device "my-store"))) | |
241 | ||
242 | (test-equal "read, store-device, from root" | |
243 | %default-root-device | |
244 | (boot-parameters-store-device | |
245 | (test-read-boot-parameters #:with-store #false))) | |
246 | ||
247 | (test-equal "read, no store-mount-point, default" | |
248 | %root-path | |
249 | (boot-parameters-store-mount-point | |
250 | (test-read-boot-parameters #:store-mount-point #false))) | |
251 | ||
252 | (test-equal "read, no store, default store-mount-point" | |
253 | %root-path | |
254 | (boot-parameters-store-mount-point | |
255 | (test-read-boot-parameters #:with-store #false))) | |
256 | ||
257 | ;; For whitebox testing | |
258 | (define operating-system-boot-parameters | |
259 | (@@ (gnu system) operating-system-boot-parameters)) | |
260 | ||
261 | (test-equal "from os, locale" | |
262 | %default-locale | |
263 | (boot-parameters-locale | |
264 | (operating-system-boot-parameters %default-operating-system | |
265 | %default-root-device))) | |
266 | ||
582cf925 MÁAV |
267 | (test-equal "from os, store-directory-prefix" |
268 | %default-store-directory-prefix | |
269 | (boot-parameters-store-directory-prefix | |
270 | (operating-system-boot-parameters %default-operating-system | |
271 | %default-root-device))) | |
272 | ||
9d449b94 | 273 | (test-end "boot-parameters") |