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, 2021 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   (run-loadable-kernel-modules-test-base
 116     (operating-system
 117       (inherit (simple-operating-system))
 118       (services (cons* (simple-service 'installing-module
 119                                        linux-loadable-module-service-type
 120                                        module-packages)
 121                        (service kernel-module-loader-service-type module-names)
 122                        (operating-system-user-services
 123                         (simple-operating-system)))))
 124     module-names))
 125
 126 (define %test-loadable-kernel-modules-0
 127   (system-test
 128    (name "loadable-kernel-modules-0")
 129    (description "Tests loadable kernel modules facility of <operating-system>
 130 with no extra modules.")
 131    (value (run-loadable-kernel-modules-test '() '()))))
 132
 133 (define %test-loadable-kernel-modules-1
 134   (system-test
 135    (name "loadable-kernel-modules-1")
 136    (description "Tests loadable kernel modules facility of <operating-system>
 137 with one extra module.")
 138    (value (run-loadable-kernel-modules-test
 139            (list ddcci-driver-linux)
 140            '("ddcci")))))
 141
 142 (define %test-loadable-kernel-modules-2
 143   (system-test
 144    (name "loadable-kernel-modules-2")
 145    (description "Tests loadable kernel modules facility of <operating-system>
 146 with two extra modules.")
 147    (value (run-loadable-kernel-modules-test
 148            (list acpi-call-linux-module
 149                  (package
 150                    (inherit ddcci-driver-linux)
 151                    (arguments
 152                     `(#:linux #f
 153                       ,@(strip-keyword-arguments '(#:linux)
 154                                                  (package-arguments
 155                                                   ddcci-driver-linux))))))
 156            '("acpi_call" "ddcci")))))
 157
 158 (define %test-loadable-kernel-modules-service-0
 159   (system-test
 160    (name "loadable-kernel-modules-service-0")
 161    (description "Tests loadable kernel modules extensible service with no
 162 extra modules.")
 163    (value (run-loadable-kernel-modules-service-test '() '()))))
 164
 165 (define %test-loadable-kernel-modules-service-1
 166   (system-test
 167    (name "loadable-kernel-modules-service-1")
 168    (description "Tests loadable kernel modules extensible service with one
 169 extra module.")
 170    (value (run-loadable-kernel-modules-service-test
 171            (list ddcci-driver-linux)
 172            '("ddcci")))))
 173
 174 (define %test-loadable-kernel-modules-service-2
 175   (system-test
 176    (name "loadable-kernel-modules-service-2")
 177    (description "Tests loadable kernel modules extensible service with two
 178 extra modules.")
 179    (value (run-loadable-kernel-modules-service-test
 180            (list acpi-call-linux-module
 181                  (package
 182                    (inherit ddcci-driver-linux)
 183                    (arguments
 184                     `(#:linux #f
 185                       ,@(strip-keyword-arguments '(#:linux)
 186                                                  (package-arguments
 187                                                   ddcci-driver-linux))))))
 188            '("acpi_call" "ddcci")))))