Message ID | fd12cd63dda9dfb81881bd33466bd4df629212f4.1707163201.git.vivien@planete-kraus.eu |
---|---|
State | New |
Headers | show |
Series | Modularization of the gnome desktop service with udev blocklist | expand |
Am Montag, dem 05.02.2024 um 19:30 +0100 schrieb Vivien Kraus: > The gnome-udev-configuration-files now lists every udev rule and > hardware > file, and remove files based on a user-supplied list of regular > expressions. > > * gnu/services/desktop.scm (gnome-desktop-configuration): Add the > udev-blocklist field. > (gnome-udev-configuration-files): Change behavior. > > Change-Id: I6df4b896652581c42a35ea3ba1e4849ad72d12ef > --- > gnu/services/desktop.scm | 63 ++++++++++++++++++++++++++++++-------- > -- > 1 file changed, 48 insertions(+), 15 deletions(-) > > diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm > index 263ae61698..8045406c10 100644 > --- a/gnu/services/desktop.scm > +++ b/gnu/services/desktop.scm > @@ -87,6 +87,7 @@ (define-module (gnu services desktop) > #:use-module (guix ui) > #:use-module (guix utils) > #:use-module (guix gexp) > + #:use-module (guix modules) > #:use-module (srfi srfi-1) > #:use-module (srfi srfi-26) > #:use-module (srfi srfi-35) > @@ -156,6 +157,7 @@ (define-module (gnu services desktop) > gnome-desktop-configuration-shell > gnome-desktop-configuration-utilities > gnome-desktop-configuration-extra-packages > + gnome-desktop-configuration-udev-blocklist > gnome-desktop-service > gnome-desktop-service-type > > @@ -1494,7 +1496,12 @@ (define-configuration/no-serialization gnome- > desktop-configuration > "A list of GNOME-adjacent packages to also include. This field > is intended > for users to add their own packages to their GNOME experience. > Note, that it > already includes some packages that are considered essential by some > (most?) > -GNOME users.")) > +GNOME users.") > + (udev-blocklist > + (list-of-strings '()) > + "A list of regular expressions denoting udev rules or hardware > file names > +provided by any package, that should not be installed. By default, > every udev > +rule and hardware file specified by all packages are installed.")) > > (define (gnome-package gnome name) > "Return the package NAME among the GNOME package inputs. NAME can > be a > @@ -1509,20 +1516,46 @@ (define (gnome-packages gnome names) > (define (gnome-udev-configuration-files config) > "Return the list of GNOME dependencies that provide udev rules and > hardware > files." > - (let* ((gnome (gnome-desktop-configuration-gnome config)) > - (shell (gnome-desktop-configuration-shell config))) > - (or (any (match-lambda > - ((and pkg (= package-name "gnome-settings-daemon")) > - (list pkg)) > - (_ #f)) > - shell) > - (and (maybe-value-set? gnome) > - (gnome-packages gnome '("gnome-settings-daemon"))) > - (raise > - (condition > - (&error-location > - (location (gnome-desktop-configuration-source-location > config))) > - (&message (message (G_ "Missing gnome-settings- > daemon")))))))) > + (let* ((all-packages > + (append > + (gnome-desktop-configuration-core-services config) > + (gnome-desktop-configuration-shell config) > + (gnome-desktop-configuration-utilities config) > + (let ((gnome-meta (gnome-desktop-configuration-gnome > config))) > + (if (maybe-value-set? gnome-meta) > + (begin > + (warning > + (gnome-desktop-configuration-source-location > config) > + (G_ "Using a meta-package for gnome-desktop is > discouraged.~%")) > + (list gnome-meta)) > + (list))) > + (gnome-desktop-configuration-extra-packages config)))) You could reuse the function that we have to implement for the profile service anyway, no? > + (list > + (computed-file > + "gnome-udev-configurations" > + (with-imported-modules > + (source-module-closure '((guix build utils))) > + #~(begin > + (use-modules (guix build utils)) > + (for-each > + (lambda (package) > + (with-directory-excursion > + package > + (for-each > + (lambda (filename) > + (mkdir-p (dirname (string-append #$output "/" > filename))) > + (copy-file filename (string-append #$output "/" > filename))) > + (find-files "." > + (lambda (name st) > + (or (string-prefix? "./lib/udev/" > name) > + (string-prefix? > "./libexec/udev/" name))))))) IIRC, string-prefix matching is not a great idea with find-files. search-path-as-list from (guix build utils) is probably preferable. > + (list #$@all-packages)) > + (for-each > + (lambda (pattern) > + (for-each > + delete-file-recursively > + (find-files #$output pattern))) > + (list #$@(gnome-desktop-configuration-udev-blocklist > config))))))))) > > (define (gnome-polkit-settings config) > "Return the list of GNOME dependencies that provide polkit actions > and Cheers
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 263ae61698..8045406c10 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -87,6 +87,7 @@ (define-module (gnu services desktop) #:use-module (guix ui) #:use-module (guix utils) #:use-module (guix gexp) + #:use-module (guix modules) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-35) @@ -156,6 +157,7 @@ (define-module (gnu services desktop) gnome-desktop-configuration-shell gnome-desktop-configuration-utilities gnome-desktop-configuration-extra-packages + gnome-desktop-configuration-udev-blocklist gnome-desktop-service gnome-desktop-service-type @@ -1494,7 +1496,12 @@ (define-configuration/no-serialization gnome-desktop-configuration "A list of GNOME-adjacent packages to also include. This field is intended for users to add their own packages to their GNOME experience. Note, that it already includes some packages that are considered essential by some (most?) -GNOME users.")) +GNOME users.") + (udev-blocklist + (list-of-strings '()) + "A list of regular expressions denoting udev rules or hardware file names +provided by any package, that should not be installed. By default, every udev +rule and hardware file specified by all packages are installed.")) (define (gnome-package gnome name) "Return the package NAME among the GNOME package inputs. NAME can be a @@ -1509,20 +1516,46 @@ (define (gnome-packages gnome names) (define (gnome-udev-configuration-files config) "Return the list of GNOME dependencies that provide udev rules and hardware files." - (let* ((gnome (gnome-desktop-configuration-gnome config)) - (shell (gnome-desktop-configuration-shell config))) - (or (any (match-lambda - ((and pkg (= package-name "gnome-settings-daemon")) - (list pkg)) - (_ #f)) - shell) - (and (maybe-value-set? gnome) - (gnome-packages gnome '("gnome-settings-daemon"))) - (raise - (condition - (&error-location - (location (gnome-desktop-configuration-source-location config))) - (&message (message (G_ "Missing gnome-settings-daemon")))))))) + (let* ((all-packages + (append + (gnome-desktop-configuration-core-services config) + (gnome-desktop-configuration-shell config) + (gnome-desktop-configuration-utilities config) + (let ((gnome-meta (gnome-desktop-configuration-gnome config))) + (if (maybe-value-set? gnome-meta) + (begin + (warning + (gnome-desktop-configuration-source-location config) + (G_ "Using a meta-package for gnome-desktop is discouraged.~%")) + (list gnome-meta)) + (list))) + (gnome-desktop-configuration-extra-packages config)))) + (list + (computed-file + "gnome-udev-configurations" + (with-imported-modules + (source-module-closure '((guix build utils))) + #~(begin + (use-modules (guix build utils)) + (for-each + (lambda (package) + (with-directory-excursion + package + (for-each + (lambda (filename) + (mkdir-p (dirname (string-append #$output "/" filename))) + (copy-file filename (string-append #$output "/" filename))) + (find-files "." + (lambda (name st) + (or (string-prefix? "./lib/udev/" name) + (string-prefix? "./libexec/udev/" name))))))) + (list #$@all-packages)) + (for-each + (lambda (pattern) + (for-each + delete-file-recursively + (find-files #$output pattern))) + (list #$@(gnome-desktop-configuration-udev-blocklist config))))))))) (define (gnome-polkit-settings config) "Return the list of GNOME dependencies that provide polkit actions and