Subject: [PATCH v3 02/10] services: Add etc-profile-d-service-type.

From: Maxim Cournoyer <[email-masked]>
Date: Mon, 19 May 2025 09:29:00 +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 | 19 +++++++++++++-
 3 files changed, 96 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 8e73685a216..b236a358a1f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -47629,6 +47629,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 <[email-masked]>
 ;;; Copyright © 2023 Brian Cully <[email-masked]>
 ;;; Copyright © 2024 Nicolas Graves <[email-masked]>
+;;; Copyright © 2025 Maxim Cournoyer <[email-masked]>
 ;;;
 ;;; 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 f28c610ccb2..09fc91383df 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -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
@@ -576,7 +584,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