summary refs log tree commit diff
path: root/gnu/services.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services.scm')
-rw-r--r--gnu/services.scm36
1 files changed, 32 insertions, 4 deletions
diff --git a/gnu/services.scm b/gnu/services.scm
index 03112f7515..6ac4f1322d 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -38,6 +38,8 @@
   #:use-module (ice-9 match)
   #:export (service-extension
             service-extension?
+            service-extension-target
+            service-extension-compute
 
             service-type
             service-type?
@@ -70,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
@@ -334,9 +338,14 @@ 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.
+                      (close-port (open-file "/var/run/utmpx" "a0"))
+
+                      ;; Same for 'wtmp', which is populated by mingetty et
+                      ;; al.
+                      (close-port (open-file "/var/log/wtmp" "a0"))
 
                       ;; Set up /run/current-system.  Among other things this
                       ;; sets up locales, which the activation snippets
@@ -402,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)))