You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

1091 lines
41 KiB

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