Package: guix-patches;
Reported by: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Date: Thu, 8 May 2025 05:49:01 UTC
Severity: normal
Tags: patch
Done: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Message #44 received at 78308 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: 78308 <at> debbugs.gnu.org Cc: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> Subject: [PATCH v2 2/9] services: Add etc-profile-d-service-type. Date: Tue, 13 May 2025 11:31:41 +0900
* gnu/services.scm (make-files->etc-directory)
(files->profile-d-entries): New procedures.
(etc-profile-d-service-type): New service type.
* doc/guix.texi (Service Reference): Document it.
* gnu/tests/base.scm (run-basic-test): Test it.
Change-Id: I45dde43a1b9603c3384b933ebd1d6e45dba146b9
---
doc/guix.texi | 16 ++++++++++++
gnu/services.scm | 62 ++++++++++++++++++++++++++++++++++++++++++++++
gnu/tests/base.scm | 21 ++++++++++++++--
3 files changed, 97 insertions(+), 2 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 34092a2f735..2f80b2a0296 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -47556,6 +47556,22 @@ Service Reference
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
+(service 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 af054339fd9..8584b16ac5c 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -9,6 +9,7 @@
;;; Copyright © 2022 Tobias Geerinckx-Rice <me <at> tobias.gr>
;;; Copyright © 2023 Brian Cully <bjc <at> spork.org>
;;; Copyright © 2024 Nicolas Graves <ngraves <at> ngraves.fr>
+;;; Copyright © 2025 Maxim Cournoyer <maxim.cournoyer <at> 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 @@ (define-module (gnu services)
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 @@ (define-deprecated (etc-service files)
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 20fc848e5ce..988212b4a7a 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016-2020, 2022, 2024-2025 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
-;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2022, 2025 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
;;; Copyright © 2022 Marius Bakke <marius <at> gnu.org>
;;; Copyright © 2024 Dariqq <dariqq <at> posteo.net>
;;;
@@ -170,6 +170,14 @@ (define* (run-basic-test os command #:optional (name "basic")
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
@@ -563,7 +571,16 @@ (define* (test-basic-os #:optional (kernel linux-libre))
(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)))
--
2.49.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.