Commit | Line | Data |
---|---|---|
94b4274d | 1 | ;;; GNU Guix --- Functional package management for GNU |
3adf320e | 2 | ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
4f51fdba | 3 | ;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr> |
1550db6f | 4 | ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> |
af7a8e71 | 5 | ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org> |
94b4274d LC |
6 | ;;; |
7 | ;;; This file is part of GNU Guix. | |
8 | ;;; | |
9 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
10 | ;;; under the terms of the GNU General Public License as published by | |
11 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
12 | ;;; your option) any later version. | |
13 | ;;; | |
14 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
15 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;;; GNU General Public License for more details. | |
18 | ;;; | |
19 | ;;; You should have received a copy of the GNU General Public License | |
20 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | (define-module (gnu tests install) | |
23 | #:use-module (gnu) | |
a48a20fb | 24 | #:use-module (gnu bootloader extlinux) |
f19cf27c | 25 | #:use-module (gnu image) |
94b4274d LC |
26 | #:use-module (gnu tests) |
27 | #:use-module (gnu tests base) | |
28 | #:use-module (gnu system) | |
f19cf27c | 29 | #:use-module (gnu system image) |
94b4274d LC |
30 | #:use-module (gnu system install) |
31 | #:use-module (gnu system vm) | |
32 | #:use-module ((gnu build vm) #:select (qemu-command)) | |
ccb1a8c4 | 33 | #:use-module (gnu packages admin) |
a48a20fb | 34 | #:use-module (gnu packages bootloaders) |
ccb1a8c4 LC |
35 | #:use-module (gnu packages cryptsetup) |
36 | #:use-module (gnu packages linux) | |
f7f292d3 | 37 | #:use-module (gnu packages ocr) |
b03ebdbc | 38 | #:use-module (gnu packages openbox) |
94b4274d | 39 | #:use-module (gnu packages package-management) |
b03ebdbc MO |
40 | #:use-module (gnu packages ratpoison) |
41 | #:use-module (gnu packages suckless) | |
59132b80 | 42 | #:use-module (gnu packages virtualization) |
b03ebdbc MO |
43 | #:use-module (gnu packages wm) |
44 | #:use-module (gnu packages xorg) | |
45 | #:use-module (gnu services desktop) | |
ccb1a8c4 | 46 | #:use-module (gnu services networking) |
b03ebdbc | 47 | #:use-module (gnu services xorg) |
94b4274d LC |
48 | #:use-module (guix store) |
49 | #:use-module (guix monads) | |
50 | #:use-module (guix packages) | |
51 | #:use-module (guix grafts) | |
52 | #:use-module (guix gexp) | |
53 | #:use-module (guix utils) | |
b03ebdbc | 54 | #:use-module (srfi srfi-1) |
b1bf155f | 55 | #:export (%test-installed-os |
a48a20fb | 56 | %test-installed-extlinux-os |
fbc7b1f1 | 57 | %test-iso-image-installer |
5479aa2b | 58 | %test-separate-store-os |
ae763b5b | 59 | %test-separate-home-os |
245cc5f5 | 60 | %test-raid-root-os |
4f83afd2 | 61 | %test-encrypted-root-os |
4f51fdba | 62 | %test-btrfs-root-os |
ccb1a8c4 | 63 | %test-jfs-root-os |
af7a8e71 | 64 | %test-f2fs-root-os |
ccb1a8c4 | 65 | |
e666a923 | 66 | %test-gui-installed-os |
b03ebdbc MO |
67 | %test-gui-installed-os-encrypted |
68 | %test-gui-installed-desktop-os-encrypted)) | |
94b4274d LC |
69 | |
70 | ;;; Commentary: | |
71 | ;;; | |
59e80445 | 72 | ;;; Test the installation of Guix using the documented approach at the |
94b4274d LC |
73 | ;;; command line. |
74 | ;;; | |
75 | ;;; Code: | |
76 | ||
77 | (define-os-with-source (%minimal-os %minimal-os-source) | |
78 | ;; The OS we want to install. | |
79 | (use-modules (gnu) (gnu tests) (srfi srfi-1)) | |
80 | ||
81 | (operating-system | |
82 | (host-name "liberigilo") | |
83 | (timezone "Europe/Paris") | |
84 | (locale "en_US.UTF-8") | |
85 | ||
fdfdecdb TGR |
86 | (bootloader (bootloader-configuration |
87 | (bootloader grub-bootloader) | |
88 | (target "/dev/vdb"))) | |
94b4274d LC |
89 | (kernel-arguments '("console=ttyS0")) |
90 | (file-systems (cons (file-system | |
9ceeca08 | 91 | (device (file-system-label "my-root")) |
94b4274d LC |
92 | (mount-point "/") |
93 | (type "ext4")) | |
94 | %base-file-systems)) | |
95 | (users (cons (user-account | |
96 | (name "alice") | |
97 | (comment "Bob's sister") | |
98 | (group "users") | |
cf848cc0 | 99 | (supplementary-groups '("wheel" "audio" "video"))) |
94b4274d LC |
100 | %base-user-accounts)) |
101 | (services (cons (service marionette-service-type | |
a4bbf41b LC |
102 | (marionette-configuration |
103 | (imported-modules '((gnu services herd) | |
f9d55c49 | 104 | (guix build utils) |
a4bbf41b | 105 | (guix combinators))))) |
94b4274d LC |
106 | %base-services)))) |
107 | ||
a48a20fb MO |
108 | (define (operating-system-add-packages os packages) |
109 | "Append PACKAGES to OS packages list." | |
110 | (operating-system | |
111 | (inherit os) | |
112 | (packages (append packages (operating-system-packages os))))) | |
113 | ||
114 | (define-os-with-source (%minimal-extlinux-os | |
115 | %minimal-extlinux-os-source) | |
116 | (use-modules (gnu) (gnu tests) (gnu bootloader extlinux) | |
117 | (srfi srfi-1)) | |
118 | ||
119 | (operating-system | |
120 | (host-name "liberigilo") | |
121 | (timezone "Europe/Paris") | |
122 | (locale "en_US.UTF-8") | |
123 | ||
124 | (bootloader (bootloader-configuration | |
125 | (bootloader extlinux-bootloader-gpt) | |
045ebb3e | 126 | (target "/dev/vdb"))) |
a48a20fb MO |
127 | (kernel-arguments '("console=ttyS0")) |
128 | (file-systems (cons (file-system | |
9ceeca08 | 129 | (device (file-system-label "my-root")) |
a48a20fb MO |
130 | (mount-point "/") |
131 | (type "ext4")) | |
132 | %base-file-systems)) | |
133 | (services (cons (service marionette-service-type | |
134 | (marionette-configuration | |
135 | (imported-modules '((gnu services herd) | |
136 | (guix combinators))))) | |
137 | %base-services)))) | |
138 | ||
94b4274d LC |
139 | (define (operating-system-with-current-guix os) |
140 | "Return a variant of OS that uses the current Guix." | |
141 | (operating-system | |
142 | (inherit os) | |
143 | (services (modify-services (operating-system-user-services os) | |
144 | (guix-service-type config => | |
145 | (guix-configuration | |
146 | (inherit config) | |
147 | (guix (current-guix)))))))) | |
148 | ||
94b4274d LC |
149 | \f |
150 | (define MiB (expt 2 20)) | |
151 | ||
b1bf155f LC |
152 | (define %simple-installation-script |
153 | ;; Shell script of a simple installation. | |
154 | "\ | |
155 | . /etc/profile | |
156 | set -e -x | |
157 | guix --version | |
158 | ||
159 | export GUIX_BUILD_OPTIONS=--no-grafts | |
160 | guix build isc-dhcp | |
161 | parted --script /dev/vdb mklabel gpt \\ | |
162 | mkpart primary ext2 1M 3M \\ | |
198a7ac0 | 163 | mkpart primary ext2 3M 1.4G \\ |
b1bf155f LC |
164 | set 1 boot on \\ |
165 | set 1 bios_grub on | |
166 | mkfs.ext4 -L my-root /dev/vdb2 | |
167 | mount /dev/vdb2 /mnt | |
168 | df -h /mnt | |
169 | herd start cow-store /mnt | |
170 | mkdir /mnt/etc | |
171 | cp /etc/target-config.scm /mnt/etc/config.scm | |
172 | guix system init /mnt/etc/config.scm /mnt --no-substitutes | |
173 | sync | |
174 | reboot\n") | |
175 | ||
a48a20fb MO |
176 | (define %extlinux-gpt-installation-script |
177 | ;; Shell script of a simple installation. | |
178 | ;; As syslinux 6.0.3 does not handle 64bits ext4 partitions, | |
179 | ;; we make sure to pass -O '^64bit' to mkfs. | |
180 | "\ | |
181 | . /etc/profile | |
182 | set -e -x | |
183 | guix --version | |
184 | ||
185 | export GUIX_BUILD_OPTIONS=--no-grafts | |
186 | guix build isc-dhcp | |
187 | parted --script /dev/vdb mklabel gpt \\ | |
198a7ac0 | 188 | mkpart ext2 1M 1.4G \\ |
a48a20fb MO |
189 | set 1 legacy_boot on |
190 | mkfs.ext4 -L my-root -O '^64bit' /dev/vdb1 | |
191 | mount /dev/vdb1 /mnt | |
192 | df -h /mnt | |
193 | herd start cow-store /mnt | |
194 | mkdir /mnt/etc | |
195 | cp /etc/target-config.scm /mnt/etc/config.scm | |
196 | guix system init /mnt/etc/config.scm /mnt --no-substitutes | |
197 | sync | |
198 | reboot\n") | |
199 | ||
b1bf155f LC |
200 | (define* (run-install target-os target-os-source |
201 | #:key | |
202 | (script %simple-installation-script) | |
ccb1a8c4 | 203 | (gui-test #f) |
a48a20fb | 204 | (packages '()) |
94b4274d | 205 | (os (marionette-operating-system |
94b4274d | 206 | (operating-system |
a48a20fb MO |
207 | ;; Since the image has no network access, use the |
208 | ;; current Guix so the store items we need are in | |
209 | ;; the image and add packages provided. | |
210 | (inherit (operating-system-add-packages | |
211 | (operating-system-with-current-guix | |
212 | installation-os) | |
213 | packages)) | |
94b4274d LC |
214 | (kernel-arguments '("console=ttyS0"))) |
215 | #:imported-modules '((gnu services herd) | |
ccb1a8c4 | 216 | (gnu installer tests) |
94b4274d | 217 | (guix combinators)))) |
fbc7b1f1 | 218 | (installation-disk-image-file-system-type "ext4") |
b03ebdbc | 219 | (install-size 'guess) |
5724a14e | 220 | (target-size (* 2200 MiB))) |
59e80445 | 221 | "Run SCRIPT (a shell script following the system installation procedure) in |
b1bf155f | 222 | OS to install TARGET-OS. Return a VM image of TARGET-SIZE bytes containing |
a48a20fb MO |
223 | the installed system. The packages specified in PACKAGES will be appended to |
224 | packages defined in installation-os." | |
94b4274d LC |
225 | |
226 | (mlet* %store-monad ((_ (set-grafting #f)) | |
227 | (system (current-system)) | |
b1bf155f | 228 | (target (operating-system-derivation target-os)) |
94b4274d LC |
229 | |
230 | ;; Since the installation system has no network access, | |
231 | ;; we cheat a little bit by adding TARGET to its GC | |
232 | ;; roots. This way, we know 'guix system init' will | |
233 | ;; succeed. | |
f19cf27c MO |
234 | (image |
235 | (system-image | |
236 | (image | |
237 | (inherit | |
238 | (find-image | |
239 | installation-disk-image-file-system-type)) | |
240 | (size install-size) | |
241 | (operating-system | |
242 | (operating-system-with-gc-roots | |
243 | os (list target))) | |
244 | ;; Don't provide substitutes; too big. | |
245 | (substitutable? #f))))) | |
94b4274d | 246 | (define install |
4ee96a79 LC |
247 | (with-imported-modules '((guix build utils) |
248 | (gnu build marionette)) | |
249 | #~(begin | |
250 | (use-modules (guix build utils) | |
251 | (gnu build marionette)) | |
252 | ||
253 | (set-path-environment-variable "PATH" '("bin") | |
254 | (list #$qemu-minimal)) | |
255 | ||
256 | (system* "qemu-img" "create" "-f" "qcow2" | |
257 | #$output #$(number->string target-size)) | |
258 | ||
259 | (define marionette | |
260 | (make-marionette | |
fbc7b1f1 CB |
261 | `(,(which #$(qemu-command system)) |
262 | "-no-reboot" | |
ae1a0f75 | 263 | "-m" "1200" |
fbc7b1f1 CB |
264 | #$@(cond |
265 | ((string=? "ext4" installation-disk-image-file-system-type) | |
4e396041 LC |
266 | #~("-drive" |
267 | ,(string-append "file=" #$image | |
268 | ",if=virtio,readonly"))) | |
fbc7b1f1 | 269 | ((string=? "iso9660" installation-disk-image-file-system-type) |
4e396041 | 270 | #~("-cdrom" #$image)) |
fbc7b1f1 CB |
271 | (else |
272 | (error | |
273 | "unsupported installation-disk-image-file-system-type:" | |
274 | installation-disk-image-file-system-type))) | |
275 | "-drive" | |
276 | ,(string-append "file=" #$output ",if=virtio") | |
277 | ,@(if (file-exists? "/dev/kvm") | |
278 | '("-enable-kvm") | |
279 | '())))) | |
4ee96a79 LC |
280 | |
281 | (pk 'uname (marionette-eval '(uname) marionette)) | |
282 | ||
283 | ;; Wait for tty1. | |
284 | (marionette-eval '(begin | |
285 | (use-modules (gnu services herd)) | |
286 | (start 'term-tty1)) | |
287 | marionette) | |
288 | ||
ccb1a8c4 LC |
289 | (when #$(->bool script) |
290 | (marionette-eval '(call-with-output-file "/etc/target-config.scm" | |
291 | (lambda (port) | |
292 | (write '#$target-os-source port))) | |
293 | marionette) | |
be0a672c LC |
294 | |
295 | ;; Run SCRIPT. It typically invokes 'reboot' as a last step and | |
296 | ;; thus normally gets killed with SIGTERM by PID 1. | |
297 | (let ((status (marionette-eval '(system #$script) marionette))) | |
298 | (exit (or (equal? (status:term-sig status) SIGTERM) | |
299 | (equal? (status:exit-val status) 0))))) | |
ccb1a8c4 LC |
300 | |
301 | (when #$(->bool gui-test) | |
302 | (wait-for-unix-socket "/var/guix/installer-socket" | |
303 | marionette) | |
304 | (format #t "installer socket ready~%") | |
305 | (force-output) | |
306 | (exit #$(and gui-test | |
307 | (gui-test #~marionette))))))) | |
b1bf155f | 308 | |
9cfd889f LC |
309 | (gexp->derivation "installation" install |
310 | #:substitutable? #f))) ;too big | |
b1bf155f | 311 | |
b800b8da | 312 | (define* (qemu-command/writable-image image #:key (memory-size 256)) |
b1bf155f | 313 | "Return as a monadic value the command to run QEMU on a writable copy of |
1a034f04 | 314 | IMAGE, a disk image. The QEMU VM has access to MEMORY-SIZE MiB of RAM." |
b1bf155f LC |
315 | (mlet %store-monad ((system (current-system))) |
316 | (return #~(let ((image #$image)) | |
317 | ;; First we need a writable copy of the image. | |
130079ae LC |
318 | (format #t "creating writable image from '~a'...~%" image) |
319 | (unless (zero? (system* #+(file-append qemu-minimal | |
320 | "/bin/qemu-img") | |
321 | "create" "-f" "qcow2" | |
322 | "-o" | |
323 | (string-append "backing_file=" image) | |
324 | "disk.img")) | |
325 | (error "failed to create writable QEMU image" image)) | |
326 | ||
b1bf155f LC |
327 | (chmod "disk.img" #o644) |
328 | `(,(string-append #$qemu-minimal "/bin/" | |
329 | #$(qemu-command system)) | |
330 | ,@(if (file-exists? "/dev/kvm") | |
331 | '("-enable-kvm") | |
332 | '()) | |
b800b8da | 333 | "-no-reboot" "-m" #$(number->string memory-size) |
b1bf155f LC |
334 | "-drive" "file=disk.img,if=virtio"))))) |
335 | ||
b1bf155f LC |
336 | (define %test-installed-os |
337 | (system-test | |
338 | (name "installed-os") | |
339 | (description | |
340 | "Test basic functionality of an OS installed like one would do by hand. | |
341 | This test is expensive in terms of CPU and storage usage since we need to | |
342 | build (current-guix) and then store a couple of full system images.") | |
343 | (value | |
344 | (mlet* %store-monad ((image (run-install %minimal-os %minimal-os-source)) | |
345 | (command (qemu-command/writable-image image))) | |
346 | (run-basic-test %minimal-os command | |
347 | "installed-os"))))) | |
348 | ||
a48a20fb MO |
349 | (define %test-installed-extlinux-os |
350 | (system-test | |
351 | (name "installed-extlinux-os") | |
352 | (description | |
353 | "Test basic functionality of an OS booted with an extlinux bootloader. As | |
354 | per %test-installed-os, this test is expensive in terms of CPU and storage.") | |
355 | (value | |
356 | (mlet* %store-monad ((image (run-install %minimal-extlinux-os | |
357 | %minimal-extlinux-os-source | |
358 | #:packages | |
359 | (list syslinux) | |
360 | #:script | |
361 | %extlinux-gpt-installation-script)) | |
362 | (command (qemu-command/writable-image image))) | |
363 | (run-basic-test %minimal-extlinux-os command | |
364 | "installed-extlinux-os"))))) | |
365 | ||
b1bf155f | 366 | \f |
fbc7b1f1 CB |
367 | ;;; |
368 | ;;; Installation through an ISO image. | |
369 | ;;; | |
370 | ||
371 | (define-os-with-source (%minimal-os-on-vda %minimal-os-on-vda-source) | |
372 | ;; The OS we want to install. | |
373 | (use-modules (gnu) (gnu tests) (srfi srfi-1)) | |
374 | ||
375 | (operating-system | |
376 | (host-name "liberigilo") | |
377 | (timezone "Europe/Paris") | |
378 | (locale "en_US.UTF-8") | |
379 | ||
fdfdecdb TGR |
380 | (bootloader (bootloader-configuration |
381 | (bootloader grub-bootloader) | |
382 | (target "/dev/vda"))) | |
fbc7b1f1 CB |
383 | (kernel-arguments '("console=ttyS0")) |
384 | (file-systems (cons (file-system | |
9ceeca08 | 385 | (device (file-system-label "my-root")) |
fbc7b1f1 CB |
386 | (mount-point "/") |
387 | (type "ext4")) | |
388 | %base-file-systems)) | |
389 | (users (cons (user-account | |
390 | (name "alice") | |
391 | (comment "Bob's sister") | |
392 | (group "users") | |
cf848cc0 | 393 | (supplementary-groups '("wheel" "audio" "video"))) |
fbc7b1f1 CB |
394 | %base-user-accounts)) |
395 | (services (cons (service marionette-service-type | |
396 | (marionette-configuration | |
397 | (imported-modules '((gnu services herd) | |
c537d2bc | 398 | (guix build utils) |
fbc7b1f1 CB |
399 | (guix combinators))))) |
400 | %base-services)))) | |
401 | ||
402 | (define %simple-installation-script-for-/dev/vda | |
403 | ;; Shell script of a simple installation. | |
404 | "\ | |
405 | . /etc/profile | |
406 | set -e -x | |
407 | guix --version | |
408 | ||
409 | export GUIX_BUILD_OPTIONS=--no-grafts | |
410 | guix build isc-dhcp | |
411 | parted --script /dev/vda mklabel gpt \\ | |
412 | mkpart primary ext2 1M 3M \\ | |
198a7ac0 | 413 | mkpart primary ext2 3M 1.4G \\ |
fbc7b1f1 CB |
414 | set 1 boot on \\ |
415 | set 1 bios_grub on | |
416 | mkfs.ext4 -L my-root /dev/vda2 | |
417 | mount /dev/vda2 /mnt | |
418 | df -h /mnt | |
419 | herd start cow-store /mnt | |
420 | mkdir /mnt/etc | |
421 | cp /etc/target-config.scm /mnt/etc/config.scm | |
422 | guix system init /mnt/etc/config.scm /mnt --no-substitutes | |
423 | sync | |
424 | reboot\n") | |
425 | ||
426 | (define %test-iso-image-installer | |
427 | (system-test | |
428 | (name "iso-image-installer") | |
429 | (description | |
430 | "") | |
431 | (value | |
432 | (mlet* %store-monad ((image (run-install | |
433 | %minimal-os-on-vda | |
434 | %minimal-os-on-vda-source | |
435 | #:script | |
436 | %simple-installation-script-for-/dev/vda | |
437 | #:installation-disk-image-file-system-type | |
438 | "iso9660")) | |
439 | (command (qemu-command/writable-image image))) | |
440 | (run-basic-test %minimal-os-on-vda command name))))) | |
441 | ||
442 | \f | |
ae763b5b LC |
443 | ;;; |
444 | ;;; Separate /home. | |
445 | ;;; | |
446 | ||
447 | (define-os-with-source (%separate-home-os %separate-home-os-source) | |
448 | ;; The OS we want to install. | |
449 | (use-modules (gnu) (gnu tests) (srfi srfi-1)) | |
450 | ||
451 | (operating-system | |
452 | (host-name "liberigilo") | |
453 | (timezone "Europe/Paris") | |
454 | (locale "en_US.utf8") | |
455 | ||
fdfdecdb TGR |
456 | (bootloader (bootloader-configuration |
457 | (bootloader grub-bootloader) | |
458 | (target "/dev/vdb"))) | |
ae763b5b LC |
459 | (kernel-arguments '("console=ttyS0")) |
460 | (file-systems (cons* (file-system | |
9ceeca08 | 461 | (device (file-system-label "my-root")) |
ae763b5b LC |
462 | (mount-point "/") |
463 | (type "ext4")) | |
464 | (file-system | |
465 | (device "none") | |
ae763b5b LC |
466 | (mount-point "/home") |
467 | (type "tmpfs")) | |
468 | %base-file-systems)) | |
469 | (users (cons* (user-account | |
470 | (name "alice") | |
cf848cc0 | 471 | (group "users")) |
ae763b5b LC |
472 | (user-account |
473 | (name "charlie") | |
cf848cc0 | 474 | (group "users")) |
ae763b5b LC |
475 | %base-user-accounts)) |
476 | (services (cons (service marionette-service-type | |
477 | (marionette-configuration | |
478 | (imported-modules '((gnu services herd) | |
479 | (guix combinators))))) | |
480 | %base-services)))) | |
481 | ||
482 | (define %test-separate-home-os | |
483 | (system-test | |
484 | (name "separate-home-os") | |
485 | (description | |
486 | "Test basic functionality of an installed OS with a separate /home | |
487 | partition. In particular, home directories must be correctly created (see | |
488 | <https://bugs.gnu.org/21108>).") | |
489 | (value | |
490 | (mlet* %store-monad ((image (run-install %separate-home-os | |
491 | %separate-home-os-source | |
492 | #:script | |
493 | %simple-installation-script)) | |
494 | (command (qemu-command/writable-image image))) | |
495 | (run-basic-test %separate-home-os command "separate-home-os"))))) | |
496 | ||
497 | \f | |
5479aa2b LC |
498 | ;;; |
499 | ;;; Separate /gnu/store partition. | |
500 | ;;; | |
501 | ||
502 | (define-os-with-source (%separate-store-os %separate-store-os-source) | |
503 | ;; The OS we want to install. | |
504 | (use-modules (gnu) (gnu tests) (srfi srfi-1)) | |
505 | ||
506 | (operating-system | |
507 | (host-name "liberigilo") | |
508 | (timezone "Europe/Paris") | |
509 | (locale "en_US.UTF-8") | |
510 | ||
fdfdecdb TGR |
511 | (bootloader (bootloader-configuration |
512 | (bootloader grub-bootloader) | |
513 | (target "/dev/vdb"))) | |
5479aa2b LC |
514 | (kernel-arguments '("console=ttyS0")) |
515 | (file-systems (cons* (file-system | |
9ceeca08 | 516 | (device (file-system-label "root-fs")) |
5479aa2b LC |
517 | (mount-point "/") |
518 | (type "ext4")) | |
519 | (file-system | |
9ceeca08 | 520 | (device (file-system-label "store-fs")) |
5479aa2b | 521 | (mount-point "/gnu") |
38434419 | 522 | (type "ext4")) |
5479aa2b LC |
523 | %base-file-systems)) |
524 | (users %base-user-accounts) | |
525 | (services (cons (service marionette-service-type | |
526 | (marionette-configuration | |
527 | (imported-modules '((gnu services herd) | |
528 | (guix combinators))))) | |
529 | %base-services)))) | |
530 | ||
531 | (define %separate-store-installation-script | |
532 | ;; Installation with a separate /gnu partition. | |
533 | "\ | |
534 | . /etc/profile | |
535 | set -e -x | |
536 | guix --version | |
537 | ||
538 | export GUIX_BUILD_OPTIONS=--no-grafts | |
539 | guix build isc-dhcp | |
540 | parted --script /dev/vdb mklabel gpt \\ | |
541 | mkpart primary ext2 1M 3M \\ | |
307ec732 LC |
542 | mkpart primary ext2 3M 400M \\ |
543 | mkpart primary ext2 400M 2.1G \\ | |
5479aa2b LC |
544 | set 1 boot on \\ |
545 | set 1 bios_grub on | |
546 | mkfs.ext4 -L root-fs /dev/vdb2 | |
547 | mkfs.ext4 -L store-fs /dev/vdb3 | |
548 | mount /dev/vdb2 /mnt | |
549 | mkdir /mnt/gnu | |
550 | mount /dev/vdb3 /mnt/gnu | |
551 | df -h /mnt | |
307ec732 | 552 | df -h /mnt/gnu |
5479aa2b LC |
553 | herd start cow-store /mnt |
554 | mkdir /mnt/etc | |
555 | cp /etc/target-config.scm /mnt/etc/config.scm | |
556 | guix system init /mnt/etc/config.scm /mnt --no-substitutes | |
557 | sync | |
558 | reboot\n") | |
559 | ||
560 | (define %test-separate-store-os | |
561 | (system-test | |
562 | (name "separate-store-os") | |
563 | (description | |
564 | "Test basic functionality of an OS installed like one would do by hand, | |
565 | where /gnu lives on a separate partition.") | |
566 | (value | |
567 | (mlet* %store-monad ((image (run-install %separate-store-os | |
568 | %separate-store-os-source | |
569 | #:script | |
570 | %separate-store-installation-script)) | |
571 | (command (qemu-command/writable-image image))) | |
572 | (run-basic-test %separate-store-os command "separate-store-os"))))) | |
573 | ||
574 | \f | |
245cc5f5 LC |
575 | ;;; |
576 | ;;; RAID root device. | |
577 | ;;; | |
578 | ||
579 | (define-os-with-source (%raid-root-os %raid-root-os-source) | |
580 | ;; An OS whose root partition is a RAID partition. | |
581 | (use-modules (gnu) (gnu tests)) | |
582 | ||
583 | (operating-system | |
584 | (host-name "raidified") | |
585 | (timezone "Europe/Paris") | |
586 | (locale "en_US.utf8") | |
587 | ||
fdfdecdb TGR |
588 | (bootloader (bootloader-configuration |
589 | (bootloader grub-bootloader) | |
590 | (target "/dev/vdb"))) | |
245cc5f5 | 591 | (kernel-arguments '("console=ttyS0")) |
bc499b11 | 592 | |
3adf320e LC |
593 | ;; Add a kernel module for RAID-1 (aka. "mirror"). |
594 | (initrd-modules (cons "raid1" %base-initrd-modules)) | |
bc499b11 | 595 | |
245cc5f5 LC |
596 | (mapped-devices (list (mapped-device |
597 | (source (list "/dev/vda2" "/dev/vda3")) | |
598 | (target "/dev/md0") | |
599 | (type raid-device-mapping)))) | |
600 | (file-systems (cons (file-system | |
9ceeca08 | 601 | (device (file-system-label "root-fs")) |
245cc5f5 LC |
602 | (mount-point "/") |
603 | (type "ext4") | |
604 | (dependencies mapped-devices)) | |
605 | %base-file-systems)) | |
606 | (users %base-user-accounts) | |
607 | (services (cons (service marionette-service-type | |
608 | (marionette-configuration | |
609 | (imported-modules '((gnu services herd) | |
610 | (guix combinators))))) | |
611 | %base-services)))) | |
612 | ||
613 | (define %raid-root-installation-script | |
614 | ;; Installation with a separate /gnu partition. See | |
615 | ;; <https://raid.wiki.kernel.org/index.php/RAID_setup> for more on RAID and | |
616 | ;; mdadm. | |
617 | "\ | |
618 | . /etc/profile | |
619 | set -e -x | |
620 | guix --version | |
621 | ||
622 | export GUIX_BUILD_OPTIONS=--no-grafts | |
623 | parted --script /dev/vdb mklabel gpt \\ | |
624 | mkpart primary ext2 1M 3M \\ | |
3adf320e LC |
625 | mkpart primary ext2 3M 1.4G \\ |
626 | mkpart primary ext2 1.4G 2.8G \\ | |
245cc5f5 LC |
627 | set 1 boot on \\ |
628 | set 1 bios_grub on | |
3adf320e | 629 | yes | mdadm --create /dev/md0 --verbose --level=mirror --raid-devices=2 \\ |
245cc5f5 LC |
630 | /dev/vdb2 /dev/vdb3 |
631 | mkfs.ext4 -L root-fs /dev/md0 | |
632 | mount /dev/md0 /mnt | |
633 | df -h /mnt | |
634 | herd start cow-store /mnt | |
635 | mkdir /mnt/etc | |
636 | cp /etc/target-config.scm /mnt/etc/config.scm | |
637 | guix system init /mnt/etc/config.scm /mnt --no-substitutes | |
638 | sync | |
639 | reboot\n") | |
640 | ||
641 | (define %test-raid-root-os | |
642 | (system-test | |
643 | (name "raid-root-os") | |
644 | (description | |
645 | "Test functionality of an OS installed with a RAID root partition managed | |
646 | by 'mdadm'.") | |
647 | (value | |
648 | (mlet* %store-monad ((image (run-install %raid-root-os | |
649 | %raid-root-os-source | |
650 | #:script | |
651 | %raid-root-installation-script | |
3adf320e | 652 | #:target-size (* 2800 MiB))) |
245cc5f5 LC |
653 | (command (qemu-command/writable-image image))) |
654 | (run-basic-test %raid-root-os | |
655 | `(,@command) "raid-root-os"))))) | |
656 | ||
657 | \f | |
5479aa2b LC |
658 | ;;; |
659 | ;;; LUKS-encrypted root file system. | |
660 | ;;; | |
661 | ||
b1bf155f LC |
662 | (define-os-with-source (%encrypted-root-os %encrypted-root-os-source) |
663 | ;; The OS we want to install. | |
664 | (use-modules (gnu) (gnu tests) (srfi srfi-1)) | |
665 | ||
666 | (operating-system | |
667 | (host-name "liberigilo") | |
668 | (timezone "Europe/Paris") | |
669 | (locale "en_US.UTF-8") | |
670 | ||
fdfdecdb TGR |
671 | (bootloader (bootloader-configuration |
672 | (bootloader grub-bootloader) | |
673 | (target "/dev/vdb"))) | |
f7f292d3 LC |
674 | |
675 | ;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt | |
676 | ;; detection logic in 'enter-luks-passphrase'. | |
677 | ||
678 | (mapped-devices (list (mapped-device | |
679 | (source (uuid "12345678-1234-1234-1234-123456789abc")) | |
680 | (target "the-root-device") | |
681 | (type luks-device-mapping)))) | |
b1bf155f LC |
682 | (file-systems (cons (file-system |
683 | (device "/dev/mapper/the-root-device") | |
b1bf155f LC |
684 | (mount-point "/") |
685 | (type "ext4")) | |
686 | %base-file-systems)) | |
b1bf155f LC |
687 | (users (cons (user-account |
688 | (name "charlie") | |
689 | (group "users") | |
b1bf155f LC |
690 | (supplementary-groups '("wheel" "audio" "video"))) |
691 | %base-user-accounts)) | |
692 | (services (cons (service marionette-service-type | |
693 | (marionette-configuration | |
694 | (imported-modules '((gnu services herd) | |
695 | (guix combinators))))) | |
696 | %base-services)))) | |
697 | ||
43e282ac LC |
698 | (define %luks-passphrase |
699 | ;; LUKS encryption passphrase used in tests. | |
700 | "thepassphrase") | |
701 | ||
b1bf155f LC |
702 | (define %encrypted-root-installation-script |
703 | ;; Shell script of a simple installation. | |
43e282ac | 704 | (string-append "\ |
94b4274d | 705 | . /etc/profile |
b1bf155f | 706 | set -e -x |
94b4274d | 707 | guix --version |
94b4274d LC |
708 | |
709 | export GUIX_BUILD_OPTIONS=--no-grafts | |
b1bf155f | 710 | ls -l /run/current-system/gc-roots |
94b4274d LC |
711 | parted --script /dev/vdb mklabel gpt \\ |
712 | mkpart primary ext2 1M 3M \\ | |
8dfb0c96 | 713 | mkpart primary ext2 3M 1.4G \\ |
94b4274d LC |
714 | set 1 boot on \\ |
715 | set 1 bios_grub on | |
43e282ac | 716 | echo -n " %luks-passphrase " | \\ |
f7f292d3 | 717 | cryptsetup luksFormat --uuid=12345678-1234-1234-1234-123456789abc -q /dev/vdb2 - |
43e282ac | 718 | echo -n " %luks-passphrase " | \\ |
b1bf155f LC |
719 | cryptsetup open --type luks --key-file - /dev/vdb2 the-root-device |
720 | mkfs.ext4 -L my-root /dev/mapper/the-root-device | |
721 | mount LABEL=my-root /mnt | |
94b4274d LC |
722 | herd start cow-store /mnt |
723 | mkdir /mnt/etc | |
b1bf155f | 724 | cp /etc/target-config.scm /mnt/etc/config.scm |
b1bf155f | 725 | guix system build /mnt/etc/config.scm |
94b4274d LC |
726 | guix system init /mnt/etc/config.scm /mnt --no-substitutes |
727 | sync | |
43e282ac | 728 | reboot\n")) |
94b4274d | 729 | |
f7f292d3 LC |
730 | (define (enter-luks-passphrase marionette) |
731 | "Return a gexp to be inserted in the basic system test running on MARIONETTE | |
732 | to enter the LUKS passphrase." | |
733 | (let ((ocrad (file-append ocrad "/bin/ocrad"))) | |
734 | #~(begin | |
735 | (define (passphrase-prompt? text) | |
736 | (string-contains (pk 'screen-text text) "Enter pass")) | |
737 | ||
738 | (define (bios-boot-screen? text) | |
739 | ;; Return true if TEXT corresponds to the boot screen, before GRUB's | |
740 | ;; menu. | |
741 | (string-prefix? "SeaBIOS" text)) | |
742 | ||
743 | (test-assert "enter LUKS passphrase for GRUB" | |
744 | (begin | |
745 | ;; At this point we have no choice but to use OCR to determine | |
746 | ;; when the passphrase should be entered. | |
747 | (wait-for-screen-text #$marionette passphrase-prompt? | |
748 | #:ocrad #$ocrad) | |
43e282ac LC |
749 | (marionette-type #$(string-append %luks-passphrase "\n") |
750 | #$marionette) | |
f7f292d3 LC |
751 | |
752 | ;; Now wait until we leave the boot screen. This is necessary so | |
753 | ;; we can then be sure we match the "Enter passphrase" prompt from | |
754 | ;; 'cryptsetup', in the initrd. | |
755 | (wait-for-screen-text #$marionette (negate bios-boot-screen?) | |
756 | #:ocrad #$ocrad | |
757 | #:timeout 20))) | |
758 | ||
759 | (test-assert "enter LUKS passphrase for the initrd" | |
760 | (begin | |
761 | ;; XXX: Here we use OCR as well but we could instead use QEMU | |
762 | ;; '-serial stdio' and run it in an input pipe, | |
763 | (wait-for-screen-text #$marionette passphrase-prompt? | |
764 | #:ocrad #$ocrad | |
765 | #:timeout 60) | |
43e282ac LC |
766 | (marionette-type #$(string-append %luks-passphrase "\n") |
767 | #$marionette) | |
f7f292d3 LC |
768 | |
769 | ;; Take a screenshot for debugging purposes. | |
770 | (marionette-control (string-append "screendump " #$output | |
771 | "/post-initrd-passphrase.ppm") | |
772 | #$marionette)))))) | |
773 | ||
4f83afd2 | 774 | (define %test-encrypted-root-os |
98b65b5f | 775 | (system-test |
b1bf155f | 776 | (name "encrypted-root-os") |
98b65b5f LC |
777 | (description |
778 | "Test basic functionality of an OS installed like one would do by hand. | |
779 | This test is expensive in terms of CPU and storage usage since we need to | |
780 | build (current-guix) and then store a couple of full system images.") | |
781 | (value | |
b1bf155f LC |
782 | (mlet* %store-monad ((image (run-install %encrypted-root-os |
783 | %encrypted-root-os-source | |
784 | #:script | |
785 | %encrypted-root-installation-script)) | |
786 | (command (qemu-command/writable-image image))) | |
f7f292d3 LC |
787 | (run-basic-test %encrypted-root-os command "encrypted-root-os" |
788 | #:initialization enter-luks-passphrase))))) | |
94b4274d | 789 | |
b1a505ba DC |
790 | \f |
791 | ;;; | |
792 | ;;; Btrfs root file system. | |
793 | ;;; | |
794 | ||
795 | (define-os-with-source (%btrfs-root-os %btrfs-root-os-source) | |
796 | ;; The OS we want to install. | |
797 | (use-modules (gnu) (gnu tests) (srfi srfi-1)) | |
798 | ||
799 | (operating-system | |
800 | (host-name "liberigilo") | |
801 | (timezone "Europe/Paris") | |
802 | (locale "en_US.UTF-8") | |
803 | ||
fdfdecdb TGR |
804 | (bootloader (bootloader-configuration |
805 | (bootloader grub-bootloader) | |
806 | (target "/dev/vdb"))) | |
b1a505ba DC |
807 | (kernel-arguments '("console=ttyS0")) |
808 | (file-systems (cons (file-system | |
9ceeca08 | 809 | (device (file-system-label "my-root")) |
b1a505ba DC |
810 | (mount-point "/") |
811 | (type "btrfs")) | |
812 | %base-file-systems)) | |
813 | (users (cons (user-account | |
814 | (name "charlie") | |
815 | (group "users") | |
b1a505ba DC |
816 | (supplementary-groups '("wheel" "audio" "video"))) |
817 | %base-user-accounts)) | |
818 | (services (cons (service marionette-service-type | |
819 | (marionette-configuration | |
820 | (imported-modules '((gnu services herd) | |
821 | (guix combinators))))) | |
822 | %base-services)))) | |
823 | ||
824 | (define %btrfs-root-installation-script | |
825 | ;; Shell script of a simple installation. | |
826 | "\ | |
827 | . /etc/profile | |
828 | set -e -x | |
829 | guix --version | |
830 | ||
831 | export GUIX_BUILD_OPTIONS=--no-grafts | |
832 | ls -l /run/current-system/gc-roots | |
833 | parted --script /dev/vdb mklabel gpt \\ | |
834 | mkpart primary ext2 1M 3M \\ | |
5724a14e | 835 | mkpart primary ext2 3M 2G \\ |
b1a505ba DC |
836 | set 1 boot on \\ |
837 | set 1 bios_grub on | |
838 | mkfs.btrfs -L my-root /dev/vdb2 | |
839 | mount /dev/vdb2 /mnt | |
840 | btrfs subvolume create /mnt/home | |
841 | herd start cow-store /mnt | |
842 | mkdir /mnt/etc | |
843 | cp /etc/target-config.scm /mnt/etc/config.scm | |
844 | guix system build /mnt/etc/config.scm | |
845 | guix system init /mnt/etc/config.scm /mnt --no-substitutes | |
846 | sync | |
847 | reboot\n") | |
848 | ||
849 | (define %test-btrfs-root-os | |
850 | (system-test | |
851 | (name "btrfs-root-os") | |
852 | (description | |
853 | "Test basic functionality of an OS installed like one would do by hand. | |
854 | This test is expensive in terms of CPU and storage usage since we need to | |
855 | build (current-guix) and then store a couple of full system images.") | |
856 | (value | |
857 | (mlet* %store-monad ((image (run-install %btrfs-root-os | |
858 | %btrfs-root-os-source | |
859 | #:script | |
860 | %btrfs-root-installation-script)) | |
861 | (command (qemu-command/writable-image image))) | |
862 | (run-basic-test %btrfs-root-os command "btrfs-root-os"))))) | |
863 | ||
4f51fdba TGR |
864 | \f |
865 | ;;; | |
866 | ;;; JFS root file system. | |
867 | ;;; | |
868 | ||
869 | (define-os-with-source (%jfs-root-os %jfs-root-os-source) | |
870 | ;; The OS we want to install. | |
871 | (use-modules (gnu) (gnu tests) (srfi srfi-1)) | |
872 | ||
873 | (operating-system | |
874 | (host-name "liberigilo") | |
875 | (timezone "Europe/Paris") | |
876 | (locale "en_US.UTF-8") | |
877 | ||
878 | (bootloader (bootloader-configuration | |
879 | (bootloader grub-bootloader) | |
880 | (target "/dev/vdb"))) | |
881 | (kernel-arguments '("console=ttyS0")) | |
882 | (file-systems (cons (file-system | |
883 | (device (file-system-label "my-root")) | |
884 | (mount-point "/") | |
885 | (type "jfs")) | |
886 | %base-file-systems)) | |
887 | (users (cons (user-account | |
888 | (name "charlie") | |
889 | (group "users") | |
890 | (supplementary-groups '("wheel" "audio" "video"))) | |
891 | %base-user-accounts)) | |
892 | (services (cons (service marionette-service-type | |
893 | (marionette-configuration | |
894 | (imported-modules '((gnu services herd) | |
895 | (guix combinators))))) | |
896 | %base-services)))) | |
897 | ||
898 | (define %jfs-root-installation-script | |
899 | ;; Shell script of a simple installation. | |
900 | "\ | |
901 | . /etc/profile | |
902 | set -e -x | |
903 | guix --version | |
904 | ||
905 | export GUIX_BUILD_OPTIONS=--no-grafts | |
906 | ls -l /run/current-system/gc-roots | |
907 | parted --script /dev/vdb mklabel gpt \\ | |
908 | mkpart primary ext2 1M 3M \\ | |
909 | mkpart primary ext2 3M 2G \\ | |
910 | set 1 boot on \\ | |
911 | set 1 bios_grub on | |
912 | jfs_mkfs -L my-root -q /dev/vdb2 | |
913 | mount /dev/vdb2 /mnt | |
914 | herd start cow-store /mnt | |
915 | mkdir /mnt/etc | |
916 | cp /etc/target-config.scm /mnt/etc/config.scm | |
917 | guix system build /mnt/etc/config.scm | |
918 | guix system init /mnt/etc/config.scm /mnt --no-substitutes | |
919 | sync | |
920 | reboot\n") | |
921 | ||
922 | (define %test-jfs-root-os | |
923 | (system-test | |
924 | (name "jfs-root-os") | |
925 | (description | |
926 | "Test basic functionality of an OS installed like one would do by hand. | |
927 | This test is expensive in terms of CPU and storage usage since we need to | |
928 | build (current-guix) and then store a couple of full system images.") | |
929 | (value | |
930 | (mlet* %store-monad ((image (run-install %jfs-root-os | |
931 | %jfs-root-os-source | |
932 | #:script | |
933 | %jfs-root-installation-script)) | |
934 | (command (qemu-command/writable-image image))) | |
935 | (run-basic-test %jfs-root-os command "jfs-root-os"))))) | |
936 | ||
ccb1a8c4 | 937 | \f |
af7a8e71 DM |
938 | ;;; |
939 | ;;; F2FS root file system. | |
940 | ;;; | |
941 | ||
942 | (define-os-with-source (%f2fs-root-os %f2fs-root-os-source) | |
943 | ;; The OS we want to install. | |
944 | (use-modules (gnu) (gnu tests) (srfi srfi-1)) | |
945 | ||
946 | (operating-system | |
947 | (host-name "liberigilo") | |
948 | (timezone "Europe/Paris") | |
949 | (locale "en_US.UTF-8") | |
950 | ||
951 | (bootloader (bootloader-configuration | |
952 | (bootloader grub-bootloader) | |
953 | (target "/dev/vdb"))) | |
954 | (kernel-arguments '("console=ttyS0")) | |
955 | (file-systems (cons (file-system | |
956 | (device (file-system-label "my-root")) | |
957 | (mount-point "/") | |
958 | (type "f2fs")) | |
959 | %base-file-systems)) | |
960 | (users (cons (user-account | |
961 | (name "charlie") | |
962 | (group "users") | |
963 | (supplementary-groups '("wheel" "audio" "video"))) | |
964 | %base-user-accounts)) | |
965 | (services (cons (service marionette-service-type | |
966 | (marionette-configuration | |
967 | (imported-modules '((gnu services herd) | |
968 | (guix combinators))))) | |
969 | %base-services)))) | |
970 | ||
971 | (define %f2fs-root-installation-script | |
972 | ;; Shell script of a simple installation. | |
973 | "\ | |
974 | . /etc/profile | |
975 | set -e -x | |
976 | guix --version | |
977 | ||
978 | export GUIX_BUILD_OPTIONS=--no-grafts | |
979 | ls -l /run/current-system/gc-roots | |
980 | parted --script /dev/vdb mklabel gpt \\ | |
981 | mkpart primary ext2 1M 3M \\ | |
982 | mkpart primary ext2 3M 2G \\ | |
983 | set 1 boot on \\ | |
984 | set 1 bios_grub on | |
985 | mkfs.f2fs -l my-root -q /dev/vdb2 | |
986 | mount /dev/vdb2 /mnt | |
987 | herd start cow-store /mnt | |
988 | mkdir /mnt/etc | |
989 | cp /etc/target-config.scm /mnt/etc/config.scm | |
990 | guix system build /mnt/etc/config.scm | |
991 | guix system init /mnt/etc/config.scm /mnt --no-substitutes | |
992 | sync | |
993 | reboot\n") | |
994 | ||
995 | (define %test-f2fs-root-os | |
996 | (system-test | |
997 | (name "f2fs-root-os") | |
998 | (description | |
999 | "Test basic functionality of an OS installed like one would do by hand. | |
1000 | This test is expensive in terms of CPU and storage usage since we need to | |
1001 | build (current-guix) and then store a couple of full system images.") | |
1002 | (value | |
1003 | (mlet* %store-monad ((image (run-install %f2fs-root-os | |
1004 | %f2fs-root-os-source | |
1005 | #:script | |
1006 | %f2fs-root-installation-script)) | |
1007 | (command (qemu-command/writable-image image))) | |
1008 | (run-basic-test %f2fs-root-os command "f2fs-root-os"))))) | |
1009 | ||
1010 | \f | |
ccb1a8c4 LC |
1011 | ;;; |
1012 | ;;; Installation through the graphical interface. | |
1013 | ;;; | |
1014 | ||
1015 | (define %syslog-conf | |
1016 | ;; Syslog configuration that dumps to /dev/console, so we can see the | |
1017 | ;; installer's messages during the test. | |
1018 | (computed-file "syslog.conf" | |
1019 | #~(begin | |
1020 | (copy-file #$%default-syslog.conf #$output) | |
1021 | (chmod #$output #o644) | |
1022 | (let ((port (open-file #$output "a"))) | |
1023 | (display "\n*.info /dev/console\n" port) | |
1024 | #t)))) | |
1025 | ||
1026 | (define (operating-system-with-console-syslog os) | |
1027 | "Return OS with a syslog service that writes to /dev/console." | |
1028 | (operating-system | |
1029 | (inherit os) | |
1030 | (services (modify-services (operating-system-user-services os) | |
1031 | (syslog-service-type config | |
1032 | => | |
1033 | (syslog-configuration | |
1034 | (inherit config) | |
1035 | (config-file %syslog-conf))))))) | |
1036 | ||
1037 | (define %root-password "foo") | |
1038 | ||
b03ebdbc MO |
1039 | (define* (gui-test-program marionette |
1040 | #:key | |
1041 | (desktop? #f) | |
1042 | (encrypted? #f)) | |
ccb1a8c4 LC |
1043 | #~(let () |
1044 | (define (screenshot file) | |
1045 | (marionette-control (string-append "screendump " file) | |
1046 | #$marionette)) | |
1047 | ||
1550db6f MO |
1048 | (define-syntax-rule (marionette-eval* exp marionette) |
1049 | (or (marionette-eval exp marionette) | |
1050 | (throw 'marionette-eval-failure 'exp))) | |
1051 | ||
ccb1a8c4 LC |
1052 | (setvbuf (current-output-port) 'none) |
1053 | (setvbuf (current-error-port) 'none) | |
1054 | ||
1550db6f MO |
1055 | (marionette-eval* '(use-modules (gnu installer tests)) |
1056 | #$marionette) | |
ccb1a8c4 LC |
1057 | |
1058 | ;; Arrange so that 'converse' prints debugging output to the console. | |
1550db6f MO |
1059 | (marionette-eval* '(let ((console (open-output-file "/dev/console"))) |
1060 | (setvbuf console 'none) | |
1061 | (conversation-log-port console)) | |
1062 | #$marionette) | |
ccb1a8c4 LC |
1063 | |
1064 | ;; Tell the installer to not wait for the Connman "online" status. | |
1550db6f MO |
1065 | (marionette-eval* '(call-with-output-file "/tmp/installer-assume-online" |
1066 | (const #t)) | |
1067 | #$marionette) | |
ccb1a8c4 LC |
1068 | |
1069 | ;; Run 'guix system init' with '--no-grafts', to cope with the lack of | |
1070 | ;; network access. | |
1550db6f MO |
1071 | (marionette-eval* '(call-with-output-file |
1072 | "/tmp/installer-system-init-options" | |
1073 | (lambda (port) | |
1074 | (write '("--no-grafts" "--no-substitutes") | |
1075 | port))) | |
1076 | #$marionette) | |
1077 | ||
1078 | (marionette-eval* '(define installer-socket | |
1079 | (open-installer-socket)) | |
1080 | #$marionette) | |
ccb1a8c4 LC |
1081 | (screenshot "installer-start.ppm") |
1082 | ||
1550db6f MO |
1083 | (marionette-eval* '(choose-locale+keyboard installer-socket) |
1084 | #$marionette) | |
ccb1a8c4 LC |
1085 | (screenshot "installer-locale.ppm") |
1086 | ||
1087 | ;; Choose the host name that the "basic" test expects. | |
1550db6f MO |
1088 | (marionette-eval* '(enter-host-name+passwords installer-socket |
1089 | #:host-name "liberigilo" | |
1090 | #:root-password | |
1091 | #$%root-password | |
1092 | #:users | |
1093 | '(("alice" "pass1") | |
1094 | ("bob" "pass2"))) | |
1095 | #$marionette) | |
ccb1a8c4 LC |
1096 | (screenshot "installer-services.ppm") |
1097 | ||
1550db6f | 1098 | (marionette-eval* '(choose-services installer-socket |
b03ebdbc MO |
1099 | #:choose-desktop-environment? |
1100 | (const #$desktop?) | |
1550db6f MO |
1101 | #:choose-network-service? |
1102 | (const #f)) | |
1103 | #$marionette) | |
ccb1a8c4 LC |
1104 | (screenshot "installer-partitioning.ppm") |
1105 | ||
1550db6f MO |
1106 | (marionette-eval* '(choose-partitioning installer-socket |
1107 | #:encrypted? #$encrypted? | |
1108 | #:passphrase #$%luks-passphrase) | |
1109 | #$marionette) | |
ccb1a8c4 LC |
1110 | (screenshot "installer-run.ppm") |
1111 | ||
1550db6f MO |
1112 | (marionette-eval* '(conclude-installation installer-socket) |
1113 | #$marionette) | |
ccb1a8c4 LC |
1114 | |
1115 | (sync) | |
1116 | #t)) | |
1117 | ||
1118 | (define %extra-packages | |
1119 | ;; Packages needed when installing with an encrypted root. | |
1120 | (list isc-dhcp | |
1121 | lvm2-static cryptsetup-static e2fsck/static | |
1122 | loadkeys-static)) | |
1123 | ||
1124 | (define installation-os-for-gui-tests | |
1125 | ;; Operating system that contains all of %EXTRA-PACKAGES, needed for the | |
1126 | ;; target OS, as well as syslog output redirected to the console so we can | |
1127 | ;; see what the installer is up to. | |
1128 | (marionette-operating-system | |
1129 | (operating-system | |
1130 | (inherit (operating-system-with-console-syslog | |
1131 | (operating-system-add-packages | |
1132 | (operating-system-with-current-guix | |
1133 | installation-os) | |
1134 | %extra-packages))) | |
1135 | (kernel-arguments '("console=ttyS0"))) | |
1136 | #:imported-modules '((gnu services herd) | |
1137 | (gnu installer tests) | |
1138 | (guix combinators)))) | |
1139 | ||
b03ebdbc MO |
1140 | (define* (installation-target-os-for-gui-tests |
1141 | #:key (encrypted? #f)) | |
1142 | (operating-system | |
c537d2bc | 1143 | (inherit %minimal-os-on-vda) |
b03ebdbc MO |
1144 | (users (append (list (user-account |
1145 | (name "alice") | |
1146 | (comment "Bob's sister") | |
1147 | (group "users") | |
1148 | (supplementary-groups | |
1149 | '("wheel" "audio" "video"))) | |
1150 | (user-account | |
1151 | (name "bob") | |
1152 | (comment "Alice's brother") | |
1153 | (group "users") | |
1154 | (supplementary-groups | |
1155 | '("wheel" "audio" "video")))) | |
1156 | %base-user-accounts)) | |
1157 | ;; The installer does not create a swap device in guided mode with | |
1158 | ;; encryption support. | |
be3abf28 | 1159 | (swap-devices (if encrypted? '() '("/dev/vda2"))) |
b03ebdbc | 1160 | (services (cons (service dhcp-client-service-type) |
c537d2bc | 1161 | (operating-system-user-services %minimal-os-on-vda))))) |
b03ebdbc MO |
1162 | |
1163 | (define* (installation-target-desktop-os-for-gui-tests | |
1164 | #:key (encrypted? #f)) | |
1165 | (operating-system | |
1166 | (inherit (installation-target-os-for-gui-tests | |
1167 | #:encrypted? encrypted?)) | |
1168 | (keyboard-layout (keyboard-layout "us" "altgr-intl")) | |
1169 | ||
1170 | ;; Make sure that all the packages and services that may be used by the | |
1171 | ;; graphical installer are available. | |
1172 | (packages (append | |
1173 | (list openbox awesome i3-wm i3status | |
1174 | dmenu st ratpoison xterm) | |
1175 | %base-packages)) | |
1176 | (services | |
1177 | (append | |
1178 | (list (service gnome-desktop-service-type) | |
1179 | (service xfce-desktop-service-type) | |
1180 | (service mate-desktop-service-type) | |
1181 | (service enlightenment-desktop-service-type) | |
1182 | (set-xorg-configuration | |
1183 | (xorg-configuration | |
1184 | (keyboard-layout keyboard-layout))) | |
1185 | (service marionette-service-type | |
1186 | (marionette-configuration | |
1187 | (imported-modules '((gnu services herd) | |
1188 | (guix build utils) | |
1189 | (guix combinators)))))) | |
1190 | %desktop-services)))) | |
1191 | ||
1192 | (define* (guided-installation-test name | |
1193 | #:key | |
1194 | (desktop? #f) | |
1195 | (encrypted? #f) | |
1196 | target-os | |
1197 | (install-size 'guess) | |
1198 | (target-size (* 2200 MiB))) | |
ccb1a8c4 LC |
1199 | (system-test |
1200 | (name name) | |
1201 | (description | |
1202 | "Install an OS using the graphical installer and test it.") | |
1203 | (value | |
b03ebdbc MO |
1204 | (mlet* %store-monad |
1205 | ((image (run-install target-os '(this is unused) | |
1206 | #:script #f | |
1207 | #:os installation-os-for-gui-tests | |
1208 | #:install-size install-size | |
1209 | #:target-size target-size | |
a860eddb LC |
1210 | #:installation-disk-image-file-system-type |
1211 | "iso9660" | |
b03ebdbc MO |
1212 | #:gui-test |
1213 | (lambda (marionette) | |
1214 | (gui-test-program | |
1215 | marionette | |
1216 | #:desktop? desktop? | |
1217 | #:encrypted? encrypted?)))) | |
1218 | (command (qemu-command/writable-image image))) | |
1219 | (run-basic-test target-os command name | |
ccb1a8c4 LC |
1220 | #:initialization (and encrypted? enter-luks-passphrase) |
1221 | #:root-password %root-password))))) | |
1222 | ||
1223 | (define %test-gui-installed-os | |
b03ebdbc MO |
1224 | (guided-installation-test |
1225 | "gui-installed-os" | |
1226 | #:target-os (installation-target-os-for-gui-tests))) | |
ccb1a8c4 | 1227 | |
e666a923 | 1228 | (define %test-gui-installed-os-encrypted |
b03ebdbc MO |
1229 | (guided-installation-test |
1230 | "gui-installed-os-encrypted" | |
1231 | #:encrypted? #t | |
1232 | #:target-os (installation-target-os-for-gui-tests | |
1233 | #:encrypted? #t))) | |
1234 | ||
1235 | ;; Building a desktop image is very time and space consuming. Install all | |
1236 | ;; desktop environments in a single test to reduce the overhead. | |
1237 | (define %test-gui-installed-desktop-os-encrypted | |
1238 | (guided-installation-test "gui-installed-desktop-os-encrypted" | |
1239 | #:desktop? #t | |
1240 | #:encrypted? #t | |
1241 | #:target-os | |
1242 | (installation-target-desktop-os-for-gui-tests | |
1243 | #:encrypted? #t) | |
1244 | ;; XXX: The disk-image size guess is too low. Use | |
1245 | ;; a constant value until this is fixed. | |
1246 | #:install-size (* 8000 MiB) | |
1247 | #:target-size (* 9000 MiB))) | |
ccb1a8c4 | 1248 | |
94b4274d | 1249 | ;;; install.scm ends here |