projects/guix·blob ruby-team · refs

283 lines · 8.3 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2022 Mathieu Othacehe <[email protected]>
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(define-module (gnu tests image)
20 #:use-module (gnu)
21 #:use-module (gnu image)
22 #:use-module (gnu tests)
23 #:autoload (gnu system image) (system-image root-offset image-with-os efi-disk-image)
24 #:use-module (gnu system uuid)
25 #:use-module (gnu system vm)
26 #:use-module (gnu packages guile)
27 #:use-module (gnu packages guile-xyz)
28 #:use-module (guix gexp)
29 #:use-module (guix monads)
30 #:use-module (ice-9 format)
31 #:export (%test-images))
32
33;;; Commentary:
34;;;
35;;; This module provides tests for the image creation process that is
36;;; performed by "genimage" under the hood.
37;;;
38;;; The image partitionment is checked using Guile-Parted. The content of the
39;;; images is out of the scope of this module. Other test modules such as
40;;; (gnu tests installation) make sure that the produced images are viable.
41;;;
42;;; Code:
43
44;; A dummy initializer creating a simple file in the partition.
45(define dummy-initializer
46 #~(lambda* (root . rest)
47 (mkdir root)
48 (call-with-output-file
49 (string-append root "/test")
50 (lambda (port)
51 (format port "content")))))
52
53(define %simple-efi-os
54 (operating-system
55 (inherit %simple-os)
56 (bootloader (bootloader-configuration
57 (bootloader grub-efi-bootloader)
58 (targets '("/boot/efi"))))))
59
60;; An MBR disk image with a single ext4 partition.
61(define i1
62 (image
63 (format 'disk-image)
64 (operating-system %simple-os)
65 (partitions
66 (list
67 (partition
68 (size (* 1024 1024)) ;1MiB
69 (offset root-offset)
70 (label "test")
71 (file-system "ext4")
72 (flags '(boot))
73 (initializer dummy-initializer))))))
74
75;; A GPT disk image with a single ext4 partition.
76(define i2
77 (image
78 (format 'disk-image)
79 (operating-system %simple-efi-os)
80 (partition-table-type 'gpt)
81 (partitions
82 (list
83 (partition
84 (size (* 1024 1024)) ;1MiB
85 (offset root-offset)
86 (label "test")
87 (file-system "ext4")
88 (flags '(boot))
89 (initializer dummy-initializer))))))
90
91;; An MBR disk image with multiple ext4 partitions.
92(define i3
93 (image
94 (format 'disk-image)
95 (operating-system %simple-os)
96 (partitions
97 (list
98 (partition
99 (size (* 1024 1024)) ;1MiB
100 (offset root-offset)
101 (label "test")
102 (file-system "ext4")
103 (flags '(boot))
104 (initializer dummy-initializer))
105 (partition
106 (size (* 1024 1024)) ;1MiB
107 (label "test2")
108 (file-system "ext4")
109 (flags '())
110 (initializer dummy-initializer))))))
111
112;; A GPT disk image with multiple ext4 partitions.
113(define i4
114 (image
115 (format 'disk-image)
116 (operating-system %simple-efi-os)
117 (partition-table-type 'gpt)
118 (partitions
119 (list
120 (partition
121 (size (* 1024 1024)) ;1MiB
122 (offset root-offset)
123 (label "test")
124 (file-system "ext4")
125 (flags '(boot))
126 (initializer dummy-initializer))
127 (partition
128 (size (* 1024 1024)) ;1MiB
129 (label "test2")
130 (file-system "ext4")
131 (flags '())
132 (initializer dummy-initializer))))))
133
134;; A GPT disk image with fat32 and ext4 partitions.
135(define i5
136 (image
137 (format 'disk-image)
138 (operating-system %simple-efi-os)
139 (partition-table-type 'gpt)
140 (partitions
141 (list
142 (partition
143 (size (* 1024 1024 128)) ;128MiB
144 (offset root-offset)
145 (label "test")
146 (file-system "fat32")
147 (flags '(esp))
148 (initializer dummy-initializer))
149 (partition
150 (size (* 1024 1024 256)) ;256MiB
151 (label "test2")
152 (file-system "ext4")
153 (flags '(boot))
154 (initializer dummy-initializer))))))
155
156;; A efi disk image with default partitions
157(define i6
158 (image-with-os efi-disk-image %simple-efi-os))
159
160(define (run-images-test)
161 (define test
162 (with-imported-modules '((srfi srfi-64)
163 (gnu build marionette))
164 (with-extensions (list guile-parted guile-bytestructures)
165 #~(begin
166 (use-modules (gnu build marionette)
167 (srfi srfi-1)
168 (srfi srfi-26)
169 (srfi srfi-64)
170 (parted))
171
172 (define (image->disk img)
173 (disk-new (get-device img)))
174
175 (test-runner-current (system-test-runner #$output))
176 (test-begin "images")
177
178 ;; Image i1.
179 (define i1-image
180 #$(system-image i1))
181 (define d1-device
182 (get-device i1-image))
183
184 (test-equal "msdos"
185 (disk-type-name (disk-probe d1-device)))
186
187 (test-equal 1
188 (disk-get-primary-partition-count (disk-new d1-device)))
189
190 (test-assert
191 (let* ((disk (disk-new d1-device))
192 (partitions (disk-partitions disk))
193 (boot-partition (find normal-partition? partitions)))
194 (partition-get-flag boot-partition PARTITION-FLAG-BOOT)))
195
196 ;; Image i2.
197 (define i2-image
198 #$(system-image i2))
199 (define d2-device
200 (get-device i2-image))
201
202 (test-equal "gpt"
203 (disk-type-name (disk-probe d2-device)))
204
205 (test-equal 1
206 (disk-get-primary-partition-count (disk-new d2-device)))
207
208 (test-equal "test"
209 (let* ((disk (disk-new d2-device))
210 (partitions (disk-partitions disk))
211 (boot-partition (find normal-partition? partitions)))
212 (partition-get-name boot-partition)))
213
214 ;; Image i3.
215 (define i3-image
216 #$(system-image i3))
217 (define d3-device
218 (get-device i3-image))
219
220 (test-equal "msdos"
221 (disk-type-name (disk-probe d3-device)))
222
223 (test-equal 2
224 (disk-get-primary-partition-count (disk-new d3-device)))
225
226 ;; Image i4.
227 (define i4-image
228 #$(system-image i4))
229 (define d4-device
230 (get-device i4-image))
231
232 (test-equal "gpt"
233 (disk-type-name (disk-probe d4-device)))
234
235 (test-equal 2
236 (disk-get-primary-partition-count (disk-new d4-device)))
237
238 ;; Image i5.
239 (define i5-image
240 #$(system-image i5))
241 (define d5-device
242 (get-device i5-image))
243
244 (define (sector->byte sector)
245 (/ (* sector (device-sector-size d5-device))
246 MEBIBYTE-SIZE))
247
248 (test-equal "gpt"
249 (disk-type-name (disk-probe d5-device)))
250
251 (test-equal 2
252 (disk-get-primary-partition-count (disk-new d5-device)))
253
254 (test-equal '("fat32" "ext4")
255 (map (compose filesystem-type-name partition-fs-type)
256 (filter data-partition?
257 (disk-partitions (disk-new d5-device)))))
258
259 ;; The first partition has a 1MiB offset has a 128MiB size. The
260 ;; second partition should then start at 129MiB.
261 (test-equal '(1 129)
262 (map (compose sector->byte partition-start)
263 (filter data-partition?
264 (disk-partitions (disk-new d5-device)))))
265
266 ;; Image i6.
267 (define i6-image
268 #$(system-image i6))
269 (define d6-device
270 (get-device i6-image))
271
272 (test-equal "gpt"
273 (disk-type-name (disk-probe d6-device)))
274
275 (test-end)))))
276
277 (gexp->derivation "images-test" test))
278
279(define %test-images
280 (system-test
281 (name "images")
282 (description "Build and test basic system images.")
283 (value (run-images-test))))