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:
parent
c2c29eb1b4
commit
95400e5c15
1 changed files with 34 additions and 16 deletions
|
@ -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,
|
||||||
|
|
Reference in a new issue