gnu/tests/linux-modules.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
   3 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
   4 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
   5 ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
   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 linux-modules)
  23   #:use-module (gnu packages linux)
  24   #:use-module (gnu services)
  25   #:use-module (gnu services linux)
  26   #:use-module (gnu system)
  27   #:use-module (gnu system vm)
  28   #:use-module (gnu tests)
  29   #:use-module (guix derivations)
  30   #:use-module (guix gexp)
  31   #:use-module (guix modules)
  32   #:use-module (guix packages)
  33   #:use-module (guix monads)
  34   #:use-module (guix store)
  35   #:use-module (guix utils)
  36   #:export (%test-loadable-kernel-modules-0
  37             %test-loadable-kernel-modules-1
  38             %test-loadable-kernel-modules-2
  39             %test-loadable-kernel-modules-service-0
  40             %test-loadable-kernel-modules-service-1
  41             %test-loadable-kernel-modules-service-2))
  42
  43 ;;; Commentary:
  44 ;;;
  45 ;;; Test <operating-system> kernel-loadable-modules.
  46 ;;;
  47 ;;; Code:
  48
  49 (define* (modules-loaded?-program os modules)
  50   "Return an executable store item that, upon being evaluated, will verify
  51 that MODULES are actually loaded."
  52   (program-file
  53    "verify-kernel-modules-loaded.scm"
  54    #~(begin
  55      (use-modules (ice-9 rdelim)
  56                   (ice-9 popen)
  57                   (srfi srfi-1)
  58                   (srfi srfi-13))
  59      (let* ((port (open-input-pipe (string-append #$kmod "/bin/lsmod")))
  60             (lines (string-split (read-string port) #\newline))
  61             (separators (char-set #\space #\tab))
  62             (modules (map (lambda (line)
  63                             (string-take line
  64                                          (or (string-index line separators)
  65                                              0)))
  66                           lines))
  67             (status (close-pipe port)))
  68        (and (= status 0)
  69             (and-map (lambda (module)
  70                        (member module modules string=?))
  71                      '#$modules))))))
  72
  73 (define* (run-loadable-kernel-modules-test-base base-os module-names)
  74   "Run a test of BASE-OS, verifying that MODULE-NAMES are loaded in memory."
  75   (define os
  76     (marionette-operating-system
  77      base-os
  78      #:imported-modules '((guix combinators))))
  79   (define vm (virtual-machine os))
  80   (define (test script)
  81     (with-imported-modules '((gnu build marionette))
  82       #~(begin
  83           (use-modules (gnu build marionette)
  84                        (srfi srfi-64))
  85           (define marionette
  86             (make-marionette (list #$vm)))
  87           (mkdir #$output)
  88           (chdir #$output)
  89           (test-begin "loadable-kernel-modules")
  90           (test-assert "script successfully evaluated"
  91             (marionette-eval
  92              '(primitive-load #$script)
  93              marionette))
  94           (test-end)
  95           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
  96   (gexp->derivation "loadable-kernel-modules"
  97                     (test (modules-loaded?-program os module-names))))
  98
  99 (define* (run-loadable-kernel-modules-test module-packages module-names)
 100   "Run a test of an OS having MODULE-PACKAGES, and verify that MODULE-NAMES
 101 are loaded in memory."
 102   (run-loadable-kernel-modules-test-base
 103     (operating-system
 104       (inherit (simple-operating-system))
 105       (services (cons (service kernel-module-loader-service-type module-names)
 106                       (operating-system-user-services
 107                        (simple-operating-system))))
 108       (kernel-loadable-modules module-packages))
 109     module-names))
 110
 111 (define* (run-loadable-kernel-modules-service-test module-packages module-names)
 112   "Run a test of an OS having MODULE-PACKAGES, which are loaded by creating a
 113 service that extends LINUXL-LOADABLE-MODULE-SERVICE-TYPE. Then verify that
 114 MODULE-NAMES are loaded in memory."
 115   (define module-installing-service-type
 116     (service-type
 117       (name 'module-installing-service)
 118       (extensions (list (service-extension linux-loadable-module-service-type
 119                                            (const module-packages))))
 120       (default-value #f)))
 121   (run-loadable-kernel-modules-test-base
 122     (operating-system
 123       (inherit (simple-operating-system))
 124       (services (cons* (service module-installing-service-type)
 125                        (operating-system-user-services
 126                         (simple-operating-system)))))
 127     module-names))
 128
 129 (define %test-loadable-kernel-modules-0
 130   (system-test
 131    (name "loadable-kernel-modules-0")
 132    (description "Tests loadable kernel modules facility of <operating-system>
 133 with no extra modules.")
 134    (value (run-loadable-kernel-modules-test '() '()))))
 135
 136 (define %test-loadable-kernel-modules-1
 137   (system-test
 138    (name "loadable-kernel-modules-1")
 139    (description "Tests loadable kernel modules facility of <operating-system>
 140 with one extra module.")
 141    (value (run-loadable-kernel-modules-test
 142            (list ddcci-driver-linux)
 143            '("ddcci")))))
 144
 145 (define %test-loadable-kernel-modules-2
 146   (system-test
 147    (name "loadable-kernel-modules-2")
 148    (description "Tests loadable kernel modules facility of <operating-system>
 149 with two extra modules.")
 150    (value (run-loadable-kernel-modules-test
 151            (list acpi-call-linux-module
 152                  (package
 153                    (inherit ddcci-driver-linux)
 154                    (arguments
 155                     `(#:linux #f
 156                       ,@(strip-keyword-arguments '(#:linux)
 157                                                  (package-arguments
 158                                                   ddcci-driver-linux))))))
 159            '("acpi_call" "ddcci")))))
 160
 161 (define %test-loadable-kernel-modules-service-0
 162   (system-test
 163    (name "loadable-kernel-modules-service-0")
 164    (description "Tests loadable kernel modules extensible service with no
 165 extra modules.")
 166    (value (run-loadable-kernel-modules-service-test '() '()))))
 167
 168 (define %test-loadable-kernel-modules-service-1
 169   (system-test
 170    (name "loadable-kernel-modules-service-1")
 171    (description "Tests loadable kernel modules extensible service with one
 172 extra module.")
 173    (value (run-loadable-kernel-modules-service-test
 174            (list ddcci-driver-linux)
 175            '("ddcci")))))
 176
 177 (define %test-loadable-kernel-modules-service-2
 178   (system-test
 179    (name "loadable-kernel-modules-service-2")
 180    (description "Tests loadable kernel modules extensible service with two
 181 extra modules.")
 182    (value (run-loadable-kernel-modules-service-test
 183            (list acpi-call-linux-module
 184                  (package
 185                    (inherit ddcci-driver-linux)
 186                    (arguments
 187                     `(#:linux #f
 188                       ,@(strip-keyword-arguments '(#:linux)
 189                                                  (package-arguments
 190                                                   ddcci-driver-linux))))))
 191            '("acpi_call" "ddcci")))))