[bug#66099] [PATCH gnome-team v5 2/4] gnu: udev-service-type: accept hwdb file extensions.

[Liliana Marie Prikler]

Am Montag, dem 02.10.2023 um 21:08 +0200 schrieb Vivien Kraus:
> The "rules" field in the udev-configuration record can now hold both
> rules and hwdb files.
> 
> The udev-rules-union has been made generic, so that it works with
> either rules or hwdb files.
Maybe we should rename this to udev-configuration-union and deprecate
the former in favor of the latter (if it can be used outside of the
module)?

> Some udev-related auxiliary functions in (gnu services base) had non-
> texinfo variable references in their docstrings ("FILE-NAME" instead
> of "@var{file-name}").
> 
> udev-rule and file->udev-rule have very similar effects. file->udev-
> rule operates on a file-like, and udev-rule on plain string contents.
> Now udev-rule calls file->udev-rule with a plain-file file-like
> object.
I think the patch would be a little easier to read if you did this
refactoring in a separate one.  The commit log would read something
like:

"services: udev: unify udev-rule and fine->udev-rule.

* gnu/services/base.scm (udev-rule): Implement in terms of 
file->udev-rule.  Use texinfo in docstring."

> 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-things-union): Make udev-rules-union
> generic.
> (udev-rules-union): Use udev-things-union.
> (udev-hwdb-union): New function.
> (udev-rule): Fix docstring and call file->udev-rule.
> (udev-hwdb): New function.
> (file->udev-rule): Fix docstring.
> (file->udev-hwdb): New function.
> (udev-rules-service): Fix docstring.
> (udev-hwdb-service): New function.
> (udev-etc): Add hwdb.d and hwdb.bin.
> (module): Export udev-hwdb, file->udev-hwdb, and udev-hwdb-service.
> (<udev-configuration>): Add the native-udev field.
> * doc/guix.texi (Base Services)[udev-service-type]: Explain
> configuration and
> extension values.
> * doc/guix.texi (Base Services)[udev-hwdb]: Document it.
> [udev-hwdb-service]: Same.
> * doc/guix.texi (Base Services)[udev-configuration]: Document the
> native-udev field.
> ---
>  doc/guix.texi         |  52 +++++++++++++++++----
>  gnu/services/base.scm | 103 +++++++++++++++++++++++++++++++++-------
> --
>  2 files changed, 123 insertions(+), 32 deletions(-)
> 
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 46591b2f64..3310271ec8 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 hwdb files matters, the
> +configuration items for rules and hwdb 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 @code{lib/udev/rules.d} and optional hwdb files in
> +@code{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. However, to generate a
> +configuration or an extension, it is advised to use @code{udev-rule}
> and
> +@code{file->udev-rule} for rules, and @code{udev-hwdb} and
> +@code{file->udev-hwdb} for hwdb files.
> +
> +In an operating-system declaration, this service type can be
> +@emph{extended} using procedures @code{udev-rules-service} and
> +@code{udev-hwdb-service}.
>  @end defvar
>  
>  @deftp {Data Type} udev-configuration
> @@ -19334,8 +19348,18 @@ Base Services
>  @item @code{udev} (default: @code{eudev}) (type: file-like)
>  Package object of the udev service.
>  
> +@item @code{native-udev} (default: @code{eudev}) (type: file-like)
> +Native udev package to compile @code{hwdb.bin}. The trie format used
> for
> +@code{hwdb.bin} must be compatible with the @code{udev} and
> +@code{native-udev} fields of the udev configuration. To avoid
> generating
> +@code{hwdb.bin}, pass @code{#f} as the @code{native-udev} field.
> +
> +In any case, if the package version string differs between
> @code{udev}
> +and @code{native-udev}, @code{hwdb.bin} is @strong{not} created.
> +
>  @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 or udev-hwdb files
> under a
> +sub-directory.
>  
>  @end table
>  @end deftp
> @@ -19358,6 +19382,11 @@ Base Services
>  @end lisp
>  @end deffn
>  
> +@deffn {Procedure} udev-hwdb @var{file-name} @var{contents}
> +Return a udev-hwdb 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 +19406,11 @@ Base Services
>  @end lisp
>  @end deffn
>  
> +@deffn {Procedure} udev-hwdb-service @var{name} @var{hwdb}
> +Return a service that extends @code{udev-service-type} with
> +@var{hwdb}. The service name is @code{@var{name}-udev-hwdb}.
> +@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 +19435,10 @@ 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.
> +@deffn {Procedure} file->udev-hwdb @var{file-name} @var{file}
> +Return a udev-hwdb 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 b3f2d2e8b8..c813293697 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)
> @@ -153,8 +154,11 @@ (define-module (gnu services base)
>              udev-service-type
>              udev-service  ; deprecated
>              udev-rule
> +            udev-hwdb
>              file->udev-rule
> +            file->udev-hwdb
>              udev-rules-service
> +            udev-hwdb-service
>  
>              login-configuration
>              login-configuration?
> @@ -2181,11 +2185,14 @@ (define-record-type* <udev-configuration>
>    udev-configuration?
>    (udev   udev-configuration-udev                 ;file-like
>            (default eudev))
> -  (rules  udev-configuration-rules                ;list of file-like
> +  (native-udev udev-configuration-native-udev
> +               (default eudev))
> +  (rules  udev-configuration-rules                ;list of rule- and
> +                                                  ;hwdb-providing
> packages
>            (default '())))
>  
> -(define (udev-rules-union packages)
> -  "Return the union of the @code{lib/udev/rules.d} directories found
> in each
> +(define (udev-things-union what packages)
> +  "Return the union of the @code{lib/udev/@var{what}.d} directories
> found in each
>  item of @var{packages}."
>    (define build
>      (with-imported-modules '((guix build union)
> @@ -2197,7 +2204,8 @@ (define (udev-rules-union packages)
>                         (srfi srfi-26))
>  
>            (define %standard-locations
> -            '("/lib/udev/rules.d" "/libexec/udev/rules.d"))
> +            '(#$(string-append "/lib/udev/" what ".d")
> +                #$(string-append "/libexec/udev/" what ".d")))
>  
>            (define (rules-sub-directory directory)
>              ;; Return the sub-directory of DIRECTORY containing udev
> rules, or
> @@ -2208,10 +2216,27 @@ (define (udev-rules-union packages)
>            (union-build #$output
>                         (filter-map rules-sub-directory
> '#$packages)))))
>  
> -  (computed-file "udev-rules" build))
> +  (computed-file (string-append "udev-" what) build))
> +
> +(define (udev-rules-union packages)
> +  (udev-things-union "rules" packages))
> +
> +(define (udev-hwdb-union packages)
> +  (udev-things-union "hwdb" packages))
>  
>  (define (udev-rule file-name contents)
> -  "Return a directory with a udev rule file FILE-NAME containing
> CONTENTS."
> +  "Return a directory with a udev rule file @var{file-name}
> containing
> +@var{contents}."
> +  (file->udev-rule file-name (plain-file file-name contents)))
> +
> +(define (udev-hwdb file-name contents)
> +  "Return a directory with a udev hwdb file @var{file-name}
> containing
> +@var{contents}."
> +  (file->udev-hwdb file-name (plain-file file-name contents)))
> +
> +(define (file->udev-rule file-name file)
> +  "Return a directory with a udev rule file @var{file-name} which is
> a copy of
> +@var{file}."
>    (computed-file file-name
>                   (with-imported-modules '((guix build utils))
>                     #~(begin
> @@ -2220,26 +2245,27 @@ (define (udev-rule file-name contents)
>                         (define rules.d
>                           (string-append #$output
> "/lib/udev/rules.d"))
>  
> +                       (define file-copy-dest
> +                         (string-append rules.d "/" #$file-name))
> +
>                         (mkdir-p rules.d)
> -                       (call-with-output-file
> -                           (string-append rules.d "/" #$file-name)
> -                         (lambda (port)
> -                           (display #$contents port)))))))
> +                       (copy-file #$file file-copy-dest)))))
>  
> -(define (file->udev-rule file-name file)
> -  "Return a directory with a udev rule file FILE-NAME which is a
> copy of FILE."
> +(define (file->udev-hwdb file-name file)
> +  "Return a directory with a udev hwdb file @var{file-name} which is
> a copy of
> +@var{file}."
>    (computed-file file-name
>                   (with-imported-modules '((guix build utils))
>                     #~(begin
>                         (use-modules (guix build utils))
>  
> -                       (define rules.d
> -                         (string-append #$output
> "/lib/udev/rules.d"))
> +                       (define hwdb.d
> +                         (string-append #$output
> "/lib/udev/hwdb.d"))
>  
>                         (define file-copy-dest
> -                         (string-append rules.d "/" #$file-name))
> +                         (string-append hwdb.d "/" #$file-name))
>  
> -                       (mkdir-p rules.d)
> +                       (mkdir-p hwdb.d)
>                         (copy-file #$file file-copy-dest)))))
>  
>  (define kvm-udev-rule
> @@ -2349,13 +2375,33 @@ (define udev.conf
>  
>  (define (udev-etc config)
>    (match-record config <udev-configuration>
> -    (udev rules)
> +    (udev native-udev rules)
> +    (let* ((hwdb.d
> +            (udev-hwdb-union (cons* udev rules)))
> +           (hwdb.bin
> +            (and native-udev
> +                 (equal? (package-version udev)
> +                         (package-version native-udev))
> +                 (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 native-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)
> @@ -2384,10 +2430,10 @@ (define-deprecated (udev-service #:key (udev
> eudev) (rules '()))
>             (udev-configuration (udev udev) (rules rules))))
>  
>  (define* (udev-rules-service name rules #:key (groups '()))
> -  "Return a service that extends udev-service-type with RULES and
> -account-service-type with GROUPS as system groups.  This works by
> creating a
> -singleton service type NAME-udev-rules, of which the returned
> service is an
> -instance."
> +  "Return a service that extends udev-service-type with @var{rules}
> and
> +@code{account-service-type} with @var{groups} as system groups. 
> This works by
> +creating a singleton service type @code{@var{name}-udev-rules}, of
> which the
> +returned service is an instance."
>    (let* ((name (symbol-append name '-udev-rules))
>           (account-extension
>            (const (map (lambda (group)
> @@ -2404,6 +2450,19 @@ (define* (udev-rules-service name rules #:key
> (groups '()))
>                  (description "This service adds udev rules."))))
>      (service type #f)))
>  
> +(define (udev-hwdb-service name hwdb-files)
> +  "Return a service that extends udev-service-type with @var{hwdb-
> files}, named
> +@code{@var{name}-udev-hwdb}."
> +  (let* ((name (symbol-append name '-udev-hwdb))
> +         (udev-extension (const (list hwdb-files)))
> +         (type (service-type
> +                (name name)
> +                (extensions (list
> +                             (service-extension
> +                              udev-service-type udev-extension)))
> +                (description "This service adds udev hwdb
> files."))))
> +    (service type #f)))
> +
>  (define (swap-space->shepherd-service-name space)
>    (let ((target (swap-space-target space)))
>      (symbol-append 'swap-
Otherwise LGTM.

Cheers