;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
+;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (gnu system)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
+ #:use-module ((guix diagnostics) #:select (formatted-message?))
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix tests)
+ #:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors))
(define %default-initrd (string-append %default-initrd-path "/initrd.cpio.gz"))
(define %default-root-device (uuid "abcdef12-3456-7890-abcd-ef1234567890"))
(define %default-store-device (uuid "01234567-89ab-cdef-0123-456789abcdef"))
+(define %default-btrfs-subvolume "testfs")
+(define %default-store-directory-prefix
+ (string-append "/" %default-btrfs-subvolume))
(define %default-store-mount-point (%store-prefix))
+(define %default-store-crypto-devices
+ (list (uuid "00000000-1111-2222-3333-444444444444")
+ (uuid "55555555-6666-7777-8888-999999999999")))
(define %default-multiboot-modules '())
(define %default-locale "es_ES.utf8")
(define %root-path "/")
(multiboot-modules %default-multiboot-modules)
(locale %default-locale)
(store-device %default-store-device)
+ (store-directory-prefix %default-store-directory-prefix)
+ (store-crypto-devices %default-store-crypto-devices)
(store-mount-point %default-store-mount-point)))
(define %default-operating-system
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (target "/dev/sda")))
+ (targets '("/dev/sda"))))
(file-systems (cons* (file-system
(device %default-root-device)
(mount-point %root-path)
(file-system
(device %default-store-device)
(mount-point %default-store-mount-point)
- (type "btrfs"))
+ (type "btrfs")
+ (options
+ (string-append "subvol="
+ %default-btrfs-subvolume)))
%base-file-systems))))
(define (quote-uuid uuid)
;; Call read-boot-parameters with the desired string as input.
(define* (test-read-boot-parameters
#:key
- (version 0)
+ (version %boot-parameters-version)
(bootloader-name 'grub)
(bootloader-menu-entries '())
(label %default-label)
(with-store #t)
(store-device
(quote-uuid %default-store-device))
+ (store-crypto-devices
+ (map quote-uuid %default-store-crypto-devices))
+ (store-directory-prefix %default-store-directory-prefix)
(store-mount-point %default-store-mount-point))
(define (generate-boot-parameters)
(define (sexp-or-nothing fmt val)
(sexp-or-nothing " (kernel-arguments ~S)" kernel-arguments)
(sexp-or-nothing " (initrd ~S)" initrd)
(if with-store
- (format #false " (store~a~a)"
+ (format #false " (store~a~a~a~a)"
(sexp-or-nothing " (device ~S)" store-device)
(sexp-or-nothing " (mount-point ~S)"
- store-mount-point))
+ store-mount-point)
+ (sexp-or-nothing " (directory-prefix ~S)"
+ store-directory-prefix)
+ (sexp-or-nothing " (crypto-devices ~S)"
+ store-crypto-devices))
"")
(sexp-or-nothing " (locale ~S)" locale)
(sexp-or-nothing " (bootloader-name ~a)" bootloader-name)
;; XXX: <warning: unrecognized boot parameters at '#f'>
(test-assert "read, construction, mandatory fields"
- (not (or (test-read-boot-parameters #:version #false)
- (test-read-boot-parameters #:version 'false)
- (test-read-boot-parameters #:version -1)
- (test-read-boot-parameters #:version "0")
- (test-read-boot-parameters #:root-device #false)
- (test-read-boot-parameters #:kernel #false)
- (test-read-boot-parameters #:label #false))))
+ (let-syntax ((test-read-boot-parameters
+ (syntax-rules ()
+ ((_ args ...)
+ (guard (c ((formatted-message? c) #f))
+ (test-read-boot-parameters args ...))))))
+ (not (or (test-read-boot-parameters #:version #false)
+ (test-read-boot-parameters #:version 'false)
+ (test-read-boot-parameters #:version -1)
+ (test-read-boot-parameters #:version "0")
+ (test-read-boot-parameters #:root-device #false)
+ (test-read-boot-parameters #:kernel #false)
+ (test-read-boot-parameters #:label #false)))))
(test-assert "read, construction, optional fields"
(and (test-read-boot-parameters #:bootloader-name #false)
(test-read-boot-parameters #:with-store #false)
(test-read-boot-parameters #:store-device #false)
(test-read-boot-parameters #:store-device 'false)
+ (test-read-boot-parameters #:store-crypto-devices #false)
(test-read-boot-parameters #:store-mount-point #false)
+ (test-read-boot-parameters #:store-directory-prefix #false)
(test-read-boot-parameters #:multiboot-modules #false)
(test-read-boot-parameters #:locale #false)
(test-read-boot-parameters #:bootloader-name #false
(boot-parameters-store-mount-point
(test-read-boot-parameters #:with-store #false)))
+(test-equal "read, store-crypto-devices, default"
+ '()
+ (boot-parameters-store-crypto-devices
+ (test-read-boot-parameters #:store-crypto-devices #false)))
+
+;; XXX: <warning: unrecognized crypto-devices #f at '#f'>
+(test-equal "read, store-crypto-devices, false"
+ '()
+ (boot-parameters-store-crypto-devices
+ (test-read-boot-parameters #:store-crypto-devices 'false)))
+
+;; XXX: <warning: unrecognized crypto-device "bad" at '#f'>
+(test-equal "read, store-crypto-devices, string"
+ '()
+ (boot-parameters-store-crypto-devices
+ (test-read-boot-parameters #:store-crypto-devices "bad")))
+
;; For whitebox testing
(define operating-system-boot-parameters
(@@ (gnu system) operating-system-boot-parameters))
(operating-system-boot-parameters %default-operating-system
%default-root-device)))
+(test-equal "from os, store-directory-prefix"
+ %default-store-directory-prefix
+ (boot-parameters-store-directory-prefix
+ (operating-system-boot-parameters %default-operating-system
+ %default-root-device)))
+
+(define %uuid-menu-entry
+ (menu-entry
+ (label "test")
+ (device (uuid "6d5b13d4-6092-46d0-8be4-073dc07413cc"))
+ (linux "/boot/bzImage")
+ (initrd "/boot/initrd.cpio.gz")))
+
+(define %file-system-label-menu-entry
+ (menu-entry
+ (label "test")
+ (device (file-system-label "test-label"))
+ (linux "/boot/bzImage")
+ (initrd "/boot/initrd.cpio.gz")))
+
+(test-equal "menu-entry roundtrip, uuid"
+ %uuid-menu-entry
+ (sexp->menu-entry (menu-entry->sexp %uuid-menu-entry)))
+
+(test-equal "menu-entry roundtrip, file-system-label"
+ %file-system-label-menu-entry
+ (sexp->menu-entry (menu-entry->sexp %file-system-label-menu-entry)))
+
(test-end "boot-parameters")