[bug#66099] [PATCH gnome-team v8 4/6] gnu: udev-service-type: accept hardware description file extensions.

[Vivien Kraus]

The udev-configuration record now has a hardware field.

The contents of the /etc directory now includes hwdb.d and hwdb.bin, which is
computed immediately.

The documentation has been reworked so as to explain why creating udev rules
or hwdb needs helper functions for configuration or extension.

The hwdb.bin file is conditionally computed by a native version of eudev, that
may be configured in the udev-service-type configuration. The condition is
that both target and native eudev have the same version. If so, we can
reasonably expect that the hwdb.bin file created by native eudev can later be
read by target eudev.

* 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 | 62 ++++++++++++++++++++++++++++++++++++++-----
 2 files changed, 101 insertions(+), 18 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 46591b2f64..ec0bd688f0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -19322,9 +19322,23 @@ Base Services
 @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
@@ -19332,10 +19346,17 @@ Base Services
 
 @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
@@ -19358,6 +19379,11 @@ Base Services
 @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.
@@ -19377,6 +19403,11 @@ Base Services
 @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.
@@ -19401,12 +19432,16 @@ Base Services
 @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 0bf0568a4e..0ca7f2af4a 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -81,6 +81,7 @@ (define-module (gnu services base)
                 #: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)
@@ -150,11 +151,15 @@ (define-module (gnu services base)
             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?
@@ -2181,8 +2186,10 @@ (define-record-type* <udev-configuration>
   udev-configuration?
   (udev   udev-configuration-udev                 ;file-like
           (default eudev))
-  (rules  udev-configuration-rules                ;list of file-like
-          (default '())))
+  (rules  udev-configuration-rules                ;package-like file-like
+          (default '()))
+  (hardware  udev-configuration-hardware          ;package-like file-like
+             (default '())))
 
 (define (udev-configurations-union subdirectory packages)
   "Return the union of the lib/udev/SUBDIRECTORY.d directories found in each
@@ -2224,6 +2231,10 @@ (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))
 
+(define (udev-hardware file-name contents)
+  "Return a directory with a udev hardware file FILE-NAME containing CONTENTS."
+  (udev-configuration-file "hwdb" 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
  of FILE."
@@ -2248,6 +2259,10 @@ (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))
 
+(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" file-name file))
+
 (define kvm-udev-rule
   ;; Return a directory with a udev rule that changes the group of /dev/kvm to
   ;; "kvm" and makes it #o660.  Apparently QEMU-KVM used to ship this rule,
@@ -2355,13 +2370,30 @@ (define udev.conf
 
 (define (udev-etc config)
   (match-record config <udev-configuration>
-    (udev rules)
+    (udev rules hardware)
+    (let* ((hwdb.d
+            (udev-configurations-union "hwdb" (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" #$hwdb.d)
+                   (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.d" ,hwdb.d)
+                      ,@(if hwdb.bin
+                            `(("hwdb.bin" ,hwdb.bin))
+                            '()))))))))
 
 (define udev-service-type
   (service-type (name 'udev)
@@ -2370,12 +2402,15 @@ (define udev-service-type
                                           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}
@@ -2410,6 +2445,19 @@ (define* (udev-rules-service name rules #:key (groups 
'()))
                 (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-
-- 
2.41.0