diff options
| -rw-r--r-- | doc/guix.texi | 16 | ||||
| -rw-r--r-- | gnu/services.scm | 62 | ||||
| -rw-r--r-- | gnu/tests/base.scm | 19 |
3 files changed, 96 insertions, 1 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 0f4b2765f5..628cc007ce 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -47663,6 +47663,22 @@ In this example, the effect would be to add an @file{/etc/issue} file pointing to the given file. @end defvar +@defvar etc-profile-d-service-type +The type of the @file{/etc/profile.d} service. This service is used to +create files under @file{/etc/profile.d}. It takes as value a list of +file-like objects, as can be produced with @code{local-file}, +@code{plain-file}, etc. Note that provided files whose file names do +not end with @file{.sh} are @emph{not} added to @file{/etc/profile.d/} +and are silently dropped. Package objects can also be provided directly +to have their @file{etc/profile.d/*.sh} prefixed files added. A simple +usage may look like: + +@example +(simple-service 'my-important-profile-file etc-profile-d-service-type + (list (plain-file "youppi.sh" "HOW_IMPORTANT=very"))) +@end example +@end defvar + @defvar privileged-program-service-type Type for the ``privileged-program service''. This service collects lists of executable file names, passed as gexps, and adds them to the set of diff --git a/gnu/services.scm b/gnu/services.scm index af054339fd..8584b16ac5 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2023 Brian Cully <bjc@spork.org> ;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr> +;;; Copyright © 2025 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,6 +27,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu services) + #:use-module (guix derivations) #:use-module (guix gexp) #:use-module (guix monads) #:use-module (guix store) @@ -120,6 +122,7 @@ special-files-service-type extra-special-file etc-service-type + etc-profile-d-service-type etc-directory privileged-program-service-type setuid-program-service-type ; deprecated @@ -926,6 +929,65 @@ directory." FILES must be a list of name/file-like object pairs." (service etc-service-type files)) +(define (make-files->etc-directory name) + "Return a procedure that accept a list of FILES and compute a directory named NAME. +The returned procedure FILES argument can be packages containing +@file{etc/@var{name}.d/@var{x}.sh} scripts or single file-like objects of the +@file{.sh} file extension. The constructed procedure returns a list of +two-elements list suitable for extending `etc-service-type'." + (lambda (files) + `((,name + ,(computed-file name + ;; This is specialized variant of `file-union'. + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 ftw) + (ice-9 match) + (srfi srfi-1) + (srfi srfi-26)) + + (define sh-files + (append-map + (lambda (f) + (let* ((dir (format #f "~a/etc/~a" f #$name))) + `(,@(if (file-exists? dir) + (map (lambda (x) + (list x (string-append dir "/" x))) + (scandir dir + (cut string-suffix? ".sh" <>))) + (if (string-suffix? ".sh" f) + (list (list (basename + (strip-store-file-name f)) f)) + '()))))) + (list #$@files))) + + (mkdir #$output) + (chdir #$output) + + (map (match-lambda ;XXX: adapted from file-union + ((target source) + ;; Stat the source to abort early if it does not exist. + (stat source) + (mkdir-p (dirname target)) + (symlink source target))) + sh-files)))))))) + +(define files->profile-d-directory + (make-files->etc-directory "profile.d")) + +(define etc-profile-d-service-type + (service-type + (name 'etc-profile-d) + (extensions (list (service-extension etc-service-type + files->profile-d-directory))) + (compose concatenate) + (extend append) + (default-value '()) + (description "A service for populating @file{/etc/profile.d/} with POSIX +scripts having the @file{.sh} file extension, to be sourced when users +log in."))) + (define (privileged-program->activation-gexp programs) "Return an activation gexp for privileged-program from PROGRAMS." (let ((programs diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index f28c610ccb..09fc91383d 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -170,6 +170,14 @@ grep --version info --version") marionette))) + (test-assert "/etc/profile.d is sourced" + (zero? (marionette-eval '(system " +. /etc/profile +set -e -x +test -f /etc/profile.d/test_profile_d.sh +test \"$PROFILE_D_OK\" = yes") + marionette))) + (test-equal "special files" '#$special-files (marionette-eval @@ -576,7 +584,16 @@ functionality tests, using the given KERNEL.") (let* ((os (marionette-operating-system (operating-system (inherit %simple-os) - (kernel kernel)) + (kernel kernel) + (services (cons (service + etc-profile-d-service-type + (list (plain-file + "test_profile_d.sh" + "export PROFILE_D_OK=yes\n") + (plain-file + "invalid-name" + "not a POSIX script -- ignore me"))) + %base-services))) #:imported-modules '((gnu services herd) (guix combinators)))) (vm (virtual-machine os))) |