From 498db4de1f09414adf68a3a383f0178434035179 Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Mon, 2 Oct 2023 21:08:49 +0200 Subject: 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. (): 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. --- gnu/services/base.scm | 72 +++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 58 insertions(+), 14 deletions(-) (limited to 'gnu/services/base.scm') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 10e7383475..db22ac848e 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -82,6 +82,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) @@ -152,11 +153,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? @@ -2232,10 +2237,12 @@ (define-record-type* (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) @@ -2247,8 +2254,8 @@ (define build (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 @@ -2264,7 +2271,7 @@ (define (configuration-sub-directory directory) (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." @@ -2272,7 +2279,11 @@ (define (udev-configuration-file subdirectory file-name contents) (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 @@ -2285,8 +2296,7 @@ (define (file->udev-configuration-file subdirectory file-name file) (define configuration-directory (string-append #$output "/lib/udev/" - #$subdirectory - ".d")) + #$subdirectory)) (define file-copy-dest (string-append configuration-directory "/" #$file-name)) @@ -2296,7 +2306,11 @@ (define 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." - (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 @@ -2405,13 +2419,27 @@ (define udev.conf (define (udev-etc config) (match-record config - (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) @@ -2420,12 +2448,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} @@ -2460,6 +2491,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- -- cgit v1.2.3