services: Add 'special-files-service-type'.

* gnu/build/activation.scm (activate-/bin/sh): Remove.
(activate-special-files): New procedure.
* gnu/services.scm (activation-script): Remove call to
'activate-/bin/sh'.
(special-files-service-type): New variable.
(extra-special-file): New procedure.
* gnu/services/base.scm (%base-services): Add SPECIAL-FILES-SERVICE-TYPE
instance.
* gnu/tests/base.scm (run-basic-test)[special-files]: New variables.
["special files"]: New test.

4 files changed, 62 insertions, 10 deletions

diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index e58304e83b..c4ed40e0de 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -28,7 +28,7 @@
             activate-user-home
             activate-etc
             activate-setuid-programs
-            activate-/bin/sh
+            activate-special-files
             activate-modprobe
             activate-firmware
             activate-ptrace-attach
@@ -383,10 +383,23 @@ copy SOURCE to TARGET."
 
   (for-each make-setuid-program programs))
 
-(define (activate-/bin/sh shell)
-  "Change /bin/sh to point to SHELL."
-  (symlink shell "/bin/sh.new")
-  (rename-file "/bin/sh.new" "/bin/sh"))
+(define (activate-special-files special-files)
+  "Install the files listed in SPECIAL-FILES.  Each element of SPECIAL-FILES
+is a pair where the first element is the name of the special file and the
+second element is the name it should appear at, such as:
+
+  ((\"/bin/sh\" \"/gnu/store/…-bash/bin/sh\")
+   (\"/usr/bin/env\" \"/gnu/store/…-coreutils/bin/env\"))
+"
+  (define install-special-file
+    (match-lambda
+      ((target file)
+       (let ((pivot (string-append target ".new")))
+         (mkdir-p (dirname target))
+         (symlink file pivot)
+         (rename-file pivot target)))))
+
+  (for-each install-special-file special-files))
 
 (define (activate-modprobe modprobe)
   "Tell the kernel to use MODPROBE to load modules."
diff --git a/gnu/services.scm b/gnu/services.scm
index e645889d30..6ac4f1322d 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -72,6 +72,8 @@
             activation-service-type
             activation-service->script
             %linux-bare-metal-service
+            special-files-service-type
+            extra-special-file
             etc-service-type
             etc-directory
             setuid-program-service-type
@@ -336,10 +338,6 @@ ACTIVATION-SCRIPT-TYPE."
                   #~(begin
                       (use-modules (gnu build activation))
 
-                      ;; Make sure /bin/sh is valid and current.
-                      (activate-/bin/sh
-                       (string-append #$(canonical-package bash) "/bin/sh"))
-
                       ;; Make sure the user accounting database exists.  If it
                       ;; does not exist, 'setutxent' does not create it and
                       ;; thus there is no accounting at all.
@@ -413,6 +411,25 @@ ACTIVATION-SCRIPT-TYPE."
   ;; necessary or impossible in a container.
   (service linux-bare-metal-service-type #f))
 
+(define special-files-service-type
+  ;; Service to install "special files" such as /bin/sh and /usr/bin/env.
+  (service-type
+   (name 'special-files)
+   (extensions
+    (list (service-extension activation-service-type
+                             (lambda (files)
+                               #~(activate-special-files '#$files)))))
+   (compose concatenate)
+   (extend append)))
+
+(define (extra-special-file file target)
+  "Use TARGET as the \"special file\" FILE.  For example, TARGET might be
+  (file-append coreutils \"/bin/env\")
+and FILE could be \"/usr/bin/env\"."
+  (simple-service (string->symbol (string-append "special-file-" file))
+                  special-files-service-type
+                  `((,file ,target))))
+
 (define (etc-directory service)
   "Return the directory for SERVICE, a service of type ETC-SERVICE-TYPE."
   (files->etc-directory (service-parameters service)))
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index d9f3a1445e..57601eab85 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -36,6 +36,7 @@
                 #:select (alsa-utils crda eudev e2fsprogs fuse gpm kbd lvm2 rng-tools))
   #:use-module ((gnu packages base)
                 #:select (canonical-package glibc))
+  #:use-module (gnu packages bash)
   #:use-module (gnu packages package-management)
   #:use-module (gnu packages lsof)
   #:use-module (gnu packages terminals)
@@ -1558,6 +1559,10 @@ This service is not part of @var{%base-services}."
         ;; The LVM2 rules are needed as soon as LVM2 or the device-mapper is
         ;; used, so enable them by default.  The FUSE and ALSA rules are
         ;; less critical, but handy.
-        (udev-service #:rules (list lvm2 fuse alsa-utils crda))))
+        (udev-service #:rules (list lvm2 fuse alsa-utils crda))
+
+        (service special-files-service-type
+                 `(("/bin/sh" ,(file-append (canonical-package bash)
+                                            "/bin/sh"))))))
 
 ;;; base.scm ends here
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 8a6a7a1568..000a4ddecb 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -77,6 +77,11 @@ When INITIALIZATION is true, it must be a one-argument procedure that is
 passed a gexp denoting the marionette, and it must return gexp that is
 inserted before the first test.  This is used to introduce an extra
 initialization step, such as entering a LUKS passphrase."
+  (define special-files
+    (service-parameters
+     (fold-services (operating-system-services os)
+                    #:target-type special-files-service-type)))
+
   (define test
     (with-imported-modules '((gnu build marionette)
                              (guix build syscalls))
@@ -120,6 +125,18 @@ grep --version
 info --version")
                                     marionette)))
 
+          (test-equal "special files"
+            '#$special-files
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 match))
+
+                (map (match-lambda
+                       ((file target)
+                        (list file (readlink file))))
+                     '#$special-files))
+             marionette))
+
           (test-assert "accounts"
             (let ((users (marionette-eval '(begin
                                              (use-modules (ice-9 match))