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")) | |
49 | (define %default-store-mount-point (%store-prefix)) | |
50 | (define %default-multiboot-modules '()) | |
51 | (define %default-locale "es_ES.utf8") | |
52 | (define %root-path "/") | |
53 | ||
54 | (define %grub-boot-parameters | |
55 | (boot-parameters | |
56 | (bootloader-name 'grub) | |
57 | (bootloader-menu-entries '()) | |
58 | (root-device %default-root-device) | |
59 | (label %default-label) | |
60 | (kernel %default-kernel) | |
61 | (kernel-arguments %default-kernel-arguments) | |
62 | (initrd %default-initrd) | |
63 | (multiboot-modules %default-multiboot-modules) | |
64 | (locale %default-locale) | |
65 | (store-device %default-store-device) | |
66 | (store-mount-point %default-store-mount-point))) | |
67 | ||
68 | (define %default-operating-system | |
69 | (operating-system | |
70 | (host-name "host") | |
71 | (timezone "Europe/Berlin") | |
72 | (locale %default-locale) | |
73 | ||
74 | (bootloader (bootloader-configuration | |
75 | (bootloader grub-bootloader) | |
76 | (target "/dev/sda"))) | |
77 | (file-systems (cons* (file-system | |
78 | (device %default-root-device) | |
79 | (mount-point %root-path) | |
80 | (type "ext4")) | |
81 | (file-system | |
82 | (device %default-store-device) | |
83 | (mount-point %default-store-mount-point) | |
84 | (type "btrfs")) | |
85 | %base-file-systems)))) | |
86 | ||
87 | (define (quote-uuid uuid) | |
88 | (list 'uuid (uuid-type uuid) (uuid-bytevector uuid))) | |
89 | ||
90 | ;; Call read-boot-parameters with the desired string as input. | |
91 | (define* (test-read-boot-parameters | |
92 | #:key | |
93 | (version 0) | |
94 | (bootloader-name 'grub) | |
95 | (bootloader-menu-entries '()) | |
96 | (label %default-label) | |
97 | (root-device (quote-uuid %default-root-device)) | |
98 | (kernel %default-kernel) | |
99 | (kernel-arguments %default-kernel-arguments) | |
100 | (initrd %default-initrd) | |
101 | (multiboot-modules %default-multiboot-modules) | |
102 | (locale %default-locale) | |
103 | (with-store #t) | |
104 | (store-device | |
105 | (quote-uuid %default-store-device)) | |
106 | (store-mount-point %default-store-mount-point)) | |
107 | (define (generate-boot-parameters) | |
108 | (define (sexp-or-nothing fmt val) | |
109 | (cond ((eq? 'false val) (format #false fmt #false)) | |
110 | (val (format #false fmt val)) | |
111 | (else ""))) | |
112 | (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a~a)" | |
113 | (sexp-or-nothing " (version ~S)" version) | |
114 | (sexp-or-nothing " (label ~S)" label) | |
115 | (sexp-or-nothing " (root-device ~S)" root-device) | |
116 | (sexp-or-nothing " (kernel ~S)" kernel) | |
117 | (sexp-or-nothing " (kernel-arguments ~S)" kernel-arguments) | |
118 | (sexp-or-nothing " (initrd ~S)" initrd) | |
119 | (if with-store | |
120 | (format #false " (store~a~a)" | |
121 | (sexp-or-nothing " (device ~S)" store-device) | |
122 | (sexp-or-nothing " (mount-point ~S)" | |
123 | store-mount-point)) | |
124 | "") | |
125 | (sexp-or-nothing " (locale ~S)" locale) | |
126 | (sexp-or-nothing " (bootloader-name ~a)" bootloader-name) | |
127 | (sexp-or-nothing " (bootloader-menu-entries ~S)" | |
128 | bootloader-menu-entries))) | |
129 | (let ((str (generate-boot-parameters))) | |
130 | (call-with-input-string str read-boot-parameters))) | |
131 | ||
132 | (test-begin "boot-parameters") | |
133 | ||
134 | ;; XXX: <warning: unrecognized boot parameters at '#f'> | |
135 | (test-assert "read, construction, mandatory fields" | |
136 | (not (or (test-read-boot-parameters #:version #false) | |
137 | (test-read-boot-parameters #:version 'false) | |
138 | (test-read-boot-parameters #:version -1) | |
139 | (test-read-boot-parameters #:version "0") | |
140 | (test-read-boot-parameters #:root-device #false) | |
141 | (test-read-boot-parameters #:kernel #false) | |
142 | (test-read-boot-parameters #:label #false)))) | |
143 | ||
144 | (test-assert "read, construction, optional fields" | |
145 | (and (test-read-boot-parameters #:bootloader-name #false) | |
146 | (test-read-boot-parameters #:bootloader-menu-entries #false) | |
147 | (test-read-boot-parameters #:kernel-arguments #false) | |
148 | (test-read-boot-parameters #:with-store #false) | |
149 | (test-read-boot-parameters #:store-device #false) | |
150 | (test-read-boot-parameters #:store-device 'false) | |
151 | (test-read-boot-parameters #:store-mount-point #false) | |
152 | (test-read-boot-parameters #:multiboot-modules #false) | |
153 | (test-read-boot-parameters #:locale #false) | |
154 | (test-read-boot-parameters #:bootloader-name #false | |
155 | #:kernel-arguments #false | |
156 | #:with-store #false | |
157 | #:locale #false))) | |
158 | ||
159 | (test-equal "read, default equality" | |
160 | %grub-boot-parameters | |
161 | (test-read-boot-parameters)) | |
162 | ||
163 | (test-equal "read, root-device, label" | |
164 | (file-system-label "my-root") | |
165 | (boot-parameters-root-device | |
166 | (test-read-boot-parameters #:root-device '(file-system-label "my-root")))) | |
167 | ||
168 | (test-equal "read, root-device, /dev node" | |
169 | "/dev/sda2" | |
170 | (boot-parameters-root-device | |
171 | (test-read-boot-parameters #:root-device "/dev/sda2"))) | |
172 | ||
173 | (test-equal "read, kernel, only store path" | |
174 | %default-kernel | |
175 | (boot-parameters-kernel | |
176 | (test-read-boot-parameters #:kernel %default-kernel-path))) | |
177 | ||
178 | (test-equal "read, kernel, full-path" | |
179 | %default-kernel | |
180 | (boot-parameters-kernel | |
181 | (test-read-boot-parameters #:kernel %default-kernel))) | |
182 | ||
183 | (test-assert "read, construction, missing initrd" | |
184 | (not (boot-parameters-initrd (test-read-boot-parameters #:initrd #false)))) | |
185 | ||
186 | (test-equal "read, initrd, old format" | |
187 | "/a/b" | |
188 | (boot-parameters-initrd | |
189 | (test-read-boot-parameters #:initrd (list 'string-append "/a" "/b")))) | |
190 | ||
191 | ;; Compatibility reasons specified in gnu/system.scm. | |
192 | (test-eq "read, bootloader-name, default value" | |
193 | 'grub | |
194 | (boot-parameters-bootloader-name | |
195 | (test-read-boot-parameters #:bootloader-name #false))) | |
196 | ||
197 | (test-eq "read, bootloader-menu-entries, default value" | |
198 | '() | |
199 | (boot-parameters-bootloader-menu-entries | |
200 | (test-read-boot-parameters #:bootloader-menu-entries #false))) | |
201 | ||
202 | (test-eq "read, kernel-arguments, default value" | |
203 | '() | |
204 | (boot-parameters-kernel-arguments | |
205 | (test-read-boot-parameters #:kernel-arguments #false))) | |
206 | ||
207 | (test-assert "read, store-device, filter /dev" | |
208 | (not (boot-parameters-store-device | |
209 | (test-read-boot-parameters #:store-device "/dev/sda3")))) | |
210 | ||
211 | (test-assert "read, no-store, filter /dev from root" | |
212 | (not (boot-parameters-store-device | |
213 | (test-read-boot-parameters #:root-device "/dev/sda3" | |
214 | #:with-store #false)))) | |
215 | ||
216 | (test-assert "read, no store-device, filter /dev from root" | |
217 | (not (boot-parameters-store-device | |
218 | (test-read-boot-parameters #:root-device "/dev/sda3" | |
219 | #:store-device #false)))) | |
220 | ||
221 | (test-assert "read, store-device #false, filter /dev from root" | |
222 | (not (boot-parameters-store-device | |
223 | (test-read-boot-parameters #:root-device "/dev/sda3" | |
224 | #:store-device 'false)))) | |
225 | ||
226 | (test-equal "read, store-device, label (legacy)" | |
227 | (file-system-label "my-store") | |
228 | (boot-parameters-store-device | |
229 | (test-read-boot-parameters #:store-device "my-store"))) | |
230 | ||
231 | (test-equal "read, store-device, from root" | |
232 | %default-root-device | |
233 | (boot-parameters-store-device | |
234 | (test-read-boot-parameters #:with-store #false))) | |
235 | ||
236 | (test-equal "read, no store-mount-point, default" | |
237 | %root-path | |
238 | (boot-parameters-store-mount-point | |
239 | (test-read-boot-parameters #:store-mount-point #false))) | |
240 | ||
241 | (test-equal "read, no store, default store-mount-point" | |
242 | %root-path | |
243 | (boot-parameters-store-mount-point | |
244 | (test-read-boot-parameters #:with-store #false))) | |
245 | ||
246 | ;; For whitebox testing | |
247 | (define operating-system-boot-parameters | |
248 | (@@ (gnu system) operating-system-boot-parameters)) | |
249 | ||
250 | (test-equal "from os, locale" | |
251 | %default-locale | |
252 | (boot-parameters-locale | |
253 | (operating-system-boot-parameters %default-operating-system | |
254 | %default-root-device))) | |
255 | ||
256 | (test-end "boot-parameters") |