Archived
1
0
Fork 0

services: udev: Make udev-rule helper functions generic.

* gnu/services/base.scm (udev-configurations-union): New function.
(udev-configuration-file): New function, use file->udev-configuration-file.
(file->udev-configuration-file): New function.
(udev-rules-union): Use udev-configurations-union.
(udev-rule): Use udev-configuration-file.
(file->udev-rule): Use file->udev-configuration-file.
This commit is contained in:
Vivien Kraus 2023-10-05 19:24:56 +02:00 committed by Liliana Marie Prikler
parent c2c29eb1b4
commit 95400e5c15
No known key found for this signature in database
GPG key ID: 442A84B8C70E2F87

View file

@ -2234,9 +2234,9 @@ command that allows you to share pre-built binaries with others over HTTP.")))
(rules udev-configuration-rules ;list of file-like (rules udev-configuration-rules ;list of file-like
(default '()))) (default '())))
(define (udev-rules-union packages) (define (udev-configurations-union subdirectory packages)
"Return the union of the @code{lib/udev/rules.d} directories found in each "Return the union of the lib/udev/SUBDIRECTORY.d directories found in each
item of @var{packages}." item of PACKAGES."
(define build (define build
(with-imported-modules '((guix build union) (with-imported-modules '((guix build union)
(guix build utils)) (guix build utils))
@ -2247,39 +2247,57 @@ item of @var{packages}."
(srfi srfi-26)) (srfi srfi-26))
(define %standard-locations (define %standard-locations
'("/lib/udev/rules.d" "/libexec/udev/rules.d")) '(#$(string-append "/lib/udev/" subdirectory ".d")
#$(string-append "/libexec/udev/" subdirectory ".d")))
(define (rules-sub-directory directory) (define (configuration-sub-directory directory)
;; Return the sub-directory of DIRECTORY containing udev rules, or ;; Return the sub-directory of DIRECTORY containing udev
;; #f if none was found. ;; configurations, or #f if none was found.
(find directory-exists? (find directory-exists?
(map (cut string-append directory <>) %standard-locations))) (map (cut string-append directory <>) %standard-locations)))
(union-build #$output (union-build #$output
(filter-map rules-sub-directory '#$packages))))) (filter-map configuration-sub-directory '#$packages)))))
(computed-file "udev-rules" build)) (computed-file (string-append "udev-" subdirectory) build))
(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))
(define (udev-configuration-file subdirectory file-name contents)
"Return a directory with a udev configuration file FILE-NAME containing CONTENTS."
(file->udev-configuration-file subdirectory file-name (plain-file file-name contents)))
(define (udev-rule file-name contents) (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 FILE-NAME containing CONTENTS."
(file->udev-rule file-name (plain-file file-name contents))) (udev-configuration-file "rules" file-name contents))
(define (file->udev-rule file-name file) (define (file->udev-configuration-file subdirectory file-name file)
"Return a directory with a udev rule file FILE-NAME which is a copy of FILE." "Return a directory with a udev configuration file FILE-NAME which is a copy
of FILE."
(computed-file file-name (computed-file file-name
(with-imported-modules '((guix build utils)) (with-imported-modules '((guix build utils))
#~(begin #~(begin
(use-modules (guix build utils)) (use-modules (guix build utils))
(define rules.d (define configuration-directory
(string-append #$output "/lib/udev/rules.d")) (string-append #$output
"/lib/udev/"
#$subdirectory
".d"))
(define file-copy-dest (define file-copy-dest
(string-append rules.d "/" #$file-name)) (string-append configuration-directory "/" #$file-name))
(mkdir-p rules.d) (mkdir-p configuration-directory)
(copy-file #$file file-copy-dest))))) (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."
(file->udev-configuration-file "rules" file-name file))
(define kvm-udev-rule (define kvm-udev-rule
;; Return a directory with a udev rule that changes the group of /dev/kvm to ;; 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, ;; "kvm" and makes it #o660. Apparently QEMU-KVM used to ship this rule,