22/36: gnu: udev-service-type: accept hardware description file extensions.

[guix-commits]

jpoiret pushed a commit to branch core-updates-glibc-2.39
in repository guix.

commit 5e594be86afd9103b25670358d54fd2ac8ba7dc0
Author: Vivien Kraus <vivien@planete-kraus.eu>
AuthorDate: Mon Oct 2 21:08:49 2023 +0200

    gnu: udev-service-type: accept hardware description file extensions.
    
    The udev-configuration record now has a hardware field.
    
    The contents of the /etc/udev directory now includes hwdb.bin, which is
    computed when the system is instanciated (prior to system activation).  The
    hardware description files used to generate hwdb.bin are not installed in
    /etc, because they are not required at run-time.
    
    The documentation has been reworked so as to explain why creating udev rules
    or hardware needs helper functions for configuration or extension.
    
    * gnu/services/base.scm (udev-hardware): New function.
    (file->udev-hardware): New function.
    (udev-hardware-service): New function.
    (udev-etc): Add hwdb.d and hwdb.bin.
    (module): Export udev-hardware, file->udev-hardware, and 
udev-hardware-service.
    (<udev-configuration>): Add the native-udev field.
    (udev-service-type) [extend]: Populate the hardware field.
    * doc/guix.texi (Base Services)[udev-service-type]: Explain configuration 
and
    extension values.
    * doc/guix.texi (Base Services)[udev-hardware]: Document it.
    [udev-hardware-service]: Same.
    * doc/guix.texi (Base Services)[udev-configuration]: Document the 
native-udev
    field.
---
 doc/guix.texi         | 57 ++++++++++++++++++++++++++++++++--------
 gnu/services/base.scm | 72 +++++++++++++++++++++++++++++++++++++++++----------
 2 files changed, 104 insertions(+), 25 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index fd98199978..b5b9191aa9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -19687,9 +19687,23 @@ Type of the service that runs udev, a service which 
populates the
 @file{/dev} directory dynamically, whose value is a
 @code{<udev-configuration>} object.
 
-This service type can be @emph{extended} using procedures
-@code{udev-rules-service} along with @code{file->udev-rule} or
-@code{udev-rule} which simplify the process of writing udev rules.
+Since the file names for udev rules and hardware description files
+matter, the configuration items for rules and hardware cannot simply be
+plain file-like objects with the rules content, because the name would
+be ignored.  Instead, they are directory file-like objects that contain
+optional rules in @file{lib/udev/rules.d} and optional hardware files in
+@file{lib/udev/hwdb.d}.  This way, the service can be configured with
+whole packages from which to take rules and hwdb files.
+
+The @code{udev-service-type} can be @emph{extended} with file-like
+directories that respect this hierarchy.  For convenience, the
+@code{udev-rule} and @code{file->udev-rule} can be used to construct
+udev rules, while @code{udev-hardware} and @code{file->udev-hardware}
+can be used to construct hardware description files.
+
+In an @code{operating-system} declaration, this service type can be
+@emph{extended} using procedures @code{udev-rules-service} and
+@code{udev-hardware-service}.
 @end defvar
 
 @deftp {Data Type} udev-configuration
@@ -19697,10 +19711,17 @@ Data type representing the configuration of udev.
 
 @table @asis
 @item @code{udev} (default: @code{eudev}) (type: file-like)
-Package object of the udev service.
+Package object of the udev service.  This package is used at run-time,
+when compiled for the target system.  In order to generate the
+@file{hwdb.bin} hardware index, it is also used when generating the
+system definition, compiled for the current system.
 
 @item @code{rules} (default: @var{'()}) (type: list-of-file-like)
-List of file-like objects denoting udev-rule files.
+List of file-like objects denoting udev rule files under a sub-directory.
+
+@item @code{hardware} (default: @var{'()}) (type: list-of-file-like)
+List of file-like objects denoting udev hardware description files under
+a sub-directory.
 
 @end table
 @end deftp
@@ -19723,6 +19744,11 @@ upon detecting a USB device with a given product 
identifier.
 @end lisp
 @end deffn
 
+@deffn {Procedure} udev-hardware @var{file-name} @var{contents}
+Return a udev hardware description file named @var{file-name} containing
+the hardware information @var{contents}.
+@end deffn
+
 @deffn {Procedure} udev-rules-service @var{name} @var{rules} [#:groups '()]
 Return a service that extends @code{udev-service-type} with @var{rules}
 and @code{account-service-type} with @var{groups} as system groups.
@@ -19742,6 +19768,11 @@ with the previously defined rule 
@code{%example-udev-rule}.
 @end lisp
 @end deffn
 
+@deffn {Procedure} udev-hardware-service @var{name} @var{hardware}
+Return a service that extends @code{udev-service-type} with
+@var{hardware}.  The service name is @code{@var{name}-udev-hardware}.
+@end deffn
+
 @deffn {Procedure} file->udev-rule @var{file-name} @var{file}
 Return a udev-rule file named @var{file-name} containing the rules
 defined within @var{file}, a file-like object.
@@ -19766,12 +19797,16 @@ The following example showcases how we can use an 
existing rule file.
 @end lisp
 @end deffn
 
-Additionally, Guix package definitions can be included in @var{rules} in
-order to extend the udev rules with the definitions found under their
-@file{lib/udev/rules.d} sub-directory.  In lieu of the previous
-@var{file->udev-rule} example, we could have used the
-@var{android-udev-rules} package which exists in Guix in the @code{(gnu
-packages android)} module.
+Since guix package definitions can be included in @var{rules} in order
+to use all their rules under the @file{lib/udev/rules.d} sub-directory,
+then in lieu of the previous @var{file->udev-rule} example, we could
+have used the @var{android-udev-rules} package which exists in Guix in
+the @code{(gnu packages android)} module.
+
+@deffn {Procedure} file->udev-hardware @var{file-name} @var{file}
+Return a udev hardware description file named @var{file-name} containing
+the rules defined within @var{file}, a file-like object.
+@end deffn
 
 The following example shows how to use the @var{android-udev-rules}
 package so that the Android tool @command{adb} can detect devices
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 9d88cc6db4..2340cf1696 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -84,6 +84,7 @@
                 #:select (mount-flags->bit-mask
                           swap-space->flags-bit-mask))
   #:use-module (guix gexp)
+  #:use-module ((guix packages) #:select (package-version))
   #:use-module (guix records)
   #:use-module (guix modules)
   #:use-module (guix pki)
@@ -154,11 +155,15 @@
             udev-configuration
             udev-configuration?
             udev-configuration-rules
+            udev-configuration-hardware
             udev-service-type
             udev-service  ; deprecated
             udev-rule
+            udev-hardware
             file->udev-rule
+            file->udev-hardware
             udev-rules-service
+            udev-hardware-service
 
             login-configuration
             login-configuration?
@@ -2241,10 +2246,12 @@ command that allows you to share pre-built binaries 
with others over HTTP.")))
   (udev   udev-configuration-udev                 ;file-like
           (default eudev))
   (rules  udev-configuration-rules                ;list of file-like
-          (default '())))
+          (default '()))
+  (hardware  udev-configuration-hardware          ;list of file-like
+             (default '())))
 
 (define (udev-configurations-union subdirectory packages)
-  "Return the union of the lib/udev/SUBDIRECTORY.d directories found in each
+  "Return the union of the lib/udev/SUBDIRECTORY directories found in each
 item of PACKAGES."
   (define build
     (with-imported-modules '((guix build union)
@@ -2256,8 +2263,8 @@ item of PACKAGES."
                        (srfi srfi-26))
 
           (define %standard-locations
-            '(#$(string-append "/lib/udev/" subdirectory ".d")
-                #$(string-append "/libexec/udev/" subdirectory ".d")))
+            '(#$(string-append "/lib/udev/" subdirectory)
+                #$(string-append "/libexec/udev/" subdirectory)))
 
           (define (configuration-sub-directory directory)
             ;; Return the sub-directory of DIRECTORY containing udev
@@ -2273,7 +2280,7 @@ item of PACKAGES."
 (define (udev-rules-union packages)
   "Return the union of the lib/udev/rules.d directories found in each
 item of PACKAGES."
-  (udev-configurations-union "rules" packages))
+  (udev-configurations-union "rules.d" packages))
 
 (define (udev-configuration-file subdirectory file-name contents)
   "Return a directory with a udev configuration file FILE-NAME containing 
CONTENTS."
@@ -2281,7 +2288,11 @@ item of PACKAGES."
 
 (define (udev-rule file-name contents)
   "Return a directory with a udev rule file FILE-NAME containing CONTENTS."
-  (udev-configuration-file "rules" file-name contents))
+  (udev-configuration-file "rules.d" file-name contents))
+
+(define (udev-hardware file-name contents)
+  "Return a directory with a udev hardware file FILE-NAME containing CONTENTS."
+  (udev-configuration-file "hwdb.d" file-name contents))
 
 (define (file->udev-configuration-file subdirectory file-name file)
   "Return a directory with a udev configuration file FILE-NAME which is a copy
@@ -2294,8 +2305,7 @@ item of PACKAGES."
                        (define configuration-directory
                          (string-append #$output
                                         "/lib/udev/"
-                                        #$subdirectory
-                                        ".d"))
+                                        #$subdirectory))
 
                        (define file-copy-dest
                          (string-append configuration-directory "/" 
#$file-name))
@@ -2305,7 +2315,11 @@ item of PACKAGES."
 
 (define (file->udev-rule file-name file)
   "Return a directory with a udev rule file FILE-NAME which is a copy of FILE."
-  (file->udev-configuration-file "rules" file-name file))
+  (file->udev-configuration-file "rules.d" file-name file))
+
+(define (file->udev-hardware file-name file)
+  "Return a directory with a udev hardware file FILE-NAME which is a copy of 
FILE."
+  (file->udev-configuration-file "hwdb.d" file-name file))
 
 (define kvm-udev-rule
   ;; Return a directory with a udev rule that changes the group of /dev/kvm to
@@ -2414,13 +2428,27 @@ item of PACKAGES."
 
 (define (udev-etc config)
   (match-record config <udev-configuration>
-    (udev rules)
+    (udev rules hardware)
+    (let* ((hardware
+            (udev-configurations-union "hwdb.d" (cons* udev hardware)))
+           (hwdb.bin
+            (computed-file
+             "hwdb.bin"
+             (with-imported-modules '((guix build utils))
+               #~(begin
+                   (use-modules (guix build utils))
+                   (setenv "UDEV_HWDB_PATH" #$hardware)
+                   (invoke #+(file-append udev "/bin/udevadm")
+                           "hwdb"
+                           "--update"
+                           "-o" #$output))))))
     `(("udev"
        ,(file-union "udev"
                     `(("udev.conf" ,udev.conf)
                       ("rules.d"
                        ,(udev-rules-union (cons* udev kvm-udev-rule
-                                                 rules)))))))))
+                                                 rules)))
+                      ("hwdb.bin" ,hwdb.bin))))))))
 
 (define udev-service-type
   (service-type (name 'udev)
@@ -2429,12 +2457,15 @@ item of PACKAGES."
                                           udev-shepherd-service)
                        (service-extension etc-service-type udev-etc)))
                 (compose concatenate)           ;concatenate the list of rules
-                (extend (lambda (config rules)
+                (extend (lambda (config extensions)
                           (let ((initial-rules
-                                 (udev-configuration-rules config)))
+                                 (udev-configuration-rules config))
+                                (initial-hardware
+                                 (udev-configuration-hardware config)))
                             (udev-configuration
                              (inherit config)
-                             (rules (append initial-rules rules))))))
+                             (rules (append initial-rules extensions))
+                             (hardware (append initial-hardware 
extensions))))))
                 (default-value (udev-configuration))
                 (description
                  "Run @command{udev}, which populates the @file{/dev}
@@ -2469,6 +2500,19 @@ instance."
                 (description "This service adds udev rules."))))
     (service type #f)))
 
+(define (udev-hardware-service name hardware-files)
+  "Return a service that extends udev-service-type with HARDWARE-FILES, named
+NAME-udev-hardware."
+  (let* ((name (symbol-append name '-udev-hardware))
+         (udev-extension (const (list hardware-files)))
+         (type (service-type
+                (name name)
+                (extensions (list
+                             (service-extension
+                              udev-service-type udev-extension)))
+                (description "This service adds udev hardware files."))))
+    (service type #f)))
+
 (define (swap-space->shepherd-service-name space)
   (let ((target (swap-space-target space)))
     (symbol-append 'swap-