aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-02-08 15:32:28 +0100
committerLudovic Courtès <ludo@gnu.org>2017-02-08 16:17:05 +0100
commit387e175492f960d7d86f34f3b2e43938fa72dbf3 (patch)
treea12082201befe64989049c1c417752195f0381be /gnu
parent618739b063dd0f8f33d0618cf64567aaaf86f4d7 (diff)
downloadguix-387e175492f960d7d86f34f3b2e43938fa72dbf3.tar
guix-387e175492f960d7d86f34f3b2e43938fa72dbf3.tar.gz
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.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/build/activation.scm23
-rw-r--r--gnu/services.scm25
-rw-r--r--gnu/services/base.scm7
-rw-r--r--gnu/tests/base.scm17
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))