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

[Liliana Marie Prikler <liliana.prikler@gmail.com>]

Am Montag, dem 02.10.2023 um 21:08 +0200 schrieb 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.
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.
This no longer holds, as far as I can see?
> 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.
Continuation of above.

> * 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 '())))
list of file-like for both

>  
>  (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))
> +                            '()))))))))
Do we need to keep hwdb.d with hwdb.bin or is that duplicated info?
>  
>  (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-