From 7d8b59139a5adeaed3f72b4e5e4749a13a77300b Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 15 Jan 2017 09:00:59 +0000 Subject: services: Export 'service-extension' procedures. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services.scm: Export service-extension-target and service-extension-compute. This allows for greater extensiblity of services by enabling service extensions to be wrapped. For example, the parameters passed to the compute function can be modified, or the return value of the compute function can be modified. Signed-off-by: Ludovic Courtès --- gnu/services.scm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'gnu/services.scm') diff --git a/gnu/services.scm b/gnu/services.scm index 03112f7515..4020fd37e0 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -38,6 +38,8 @@ (define-module (gnu services) #:use-module (ice-9 match) #:export (service-extension service-extension? + service-extension-target + service-extension-compute service-type service-type? -- cgit v1.2.3 From caa7816673ba110d2192c2f4a8b985a475aa08a2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 19 Jan 2017 23:42:20 +0100 Subject: services: Create /var/run/utmpx upon activation. This fixes a bug whereby /var/run/utmpx would never be created, and thus accounting information would be missing. * gnu/services.scm (activation-script): Create /var/run/utmpx. * gnu/tests/base.scm (run-basic-test)["utmpx entry"]: New test. --- gnu/services.scm | 7 ++++++- gnu/tests/base.scm | 22 ++++++++++++++++++++-- 2 files changed, 26 insertions(+), 3 deletions(-) (limited to 'gnu/services.scm') diff --git a/gnu/services.scm b/gnu/services.scm index 4020fd37e0..f72d4d5785 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 +;;; Copyright © 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2016 Chris Marusich ;;; ;;; This file is part of GNU Guix. @@ -340,6 +340,11 @@ (define (service-activations) (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")) + ;; Set up /run/current-system. Among other things this ;; sets up locales, which the activation snippets ;; executed below may expect. diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 6370d6951b..2687a6cdb8 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 Ludovic Courtès +;;; Copyright © 2016, 2017 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -78,9 +78,11 @@ (define* (run-basic-test os command #:optional (name "basic") inserted before the first test. This is used to introduce an extra initialization step, such as entering a LUKS passphrase." (define test - (with-imported-modules '((gnu build marionette)) + (with-imported-modules '((gnu build marionette) + (guix build syscalls)) #~(begin (use-modules (gnu build marionette) + (guix build syscalls) (srfi srfi-1) (srfi srfi-26) (srfi srfi-64) @@ -176,6 +178,22 @@ (define marionette (apply throw args))))) marionette))) + ;; There should be one utmpx entry for the user logged in on tty1. + (test-equal "utmpx entry" + '(("root" "tty1" #f)) + (marionette-eval + '(begin + (use-modules (guix build syscalls) + (srfi srfi-1)) + + (filter-map (lambda (entry) + (and (equal? (login-type USER_PROCESS) + (utmpx-login-type entry)) + (list (utmpx-user entry) (utmpx-line entry) + (utmpx-host entry)))) + (utmpx-entries))) + marionette)) + (test-assert "host name resolution" (match (marionette-eval '(begin -- cgit v1.2.3 From 2986995b85e76f12741fcdda8dd0e1a636620dec Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 24 Jan 2017 00:45:11 +0100 Subject: services: Create /var/log/wtmp upon activation. This fixes a bug whereby /var/log/wtmp would never be created, and thus accounting information would be lost. * gnu/services.scm (activation-script): Create /var/log/wtmp. * gnu/tests/base.scm (run-basic-test)["wtmp entry"]: New test. --- gnu/services.scm | 4 ++++ gnu/tests/base.scm | 23 +++++++++++++++++++++++ 2 files changed, 27 insertions(+) (limited to 'gnu/services.scm') diff --git a/gnu/services.scm b/gnu/services.scm index f72d4d5785..e645889d30 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -345,6 +345,10 @@ (define (service-activations) ;; 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 ;; executed below may expect. diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 2687a6cdb8..a725ca90f3 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -194,6 +194,29 @@ (define marionette (utmpx-entries))) marionette)) + ;; Likewise for /var/log/wtmp (used by 'last'). + (test-assert "wtmp entry" + (match (marionette-eval + '(begin + (use-modules (guix build syscalls) + (srfi srfi-1)) + + (define (entry->list entry) + (list (utmpx-user entry) (utmpx-line entry) + (utmpx-host entry) (utmpx-login-type entry))) + + (call-with-input-file "/var/log/wtmp" + (lambda (port) + (let loop ((result '())) + (if (eof-object? (peek-char port)) + (map entry->list (reverse result)) + (loop (cons (read-utmpx port) result))))))) + marionette) + (((users lines hosts types) ..1) + (every (lambda (type) + (eqv? type (login-type LOGIN_PROCESS))) + types)))) + (test-assert "host name resolution" (match (marionette-eval '(begin -- cgit v1.2.3 From 387e175492f960d7d86f34f3b2e43938fa72dbf3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 8 Feb 2017 15:32:28 +0100 Subject: 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. --- doc/guix.texi | 44 ++++++++++++++++++++++++++++++++++++++++++++ gnu/build/activation.scm | 23 ++++++++++++++++++----- gnu/services.scm | 25 +++++++++++++++++++++---- gnu/services/base.scm | 7 ++++++- gnu/tests/base.scm | 17 +++++++++++++++++ 5 files changed, 106 insertions(+), 10 deletions(-) (limited to 'gnu/services.scm') diff --git a/doc/guix.texi b/doc/guix.texi index 6acde6621b..21082aece4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8272,6 +8272,50 @@ this: @end example @end defvr +@defvr {Scheme Variable} special-files-service-type +This is the service that sets up ``special files'' such as +@file{/bin/sh}; an instance of it is part of @code{%base-services}. + +The value associated with @code{special-files-service-type} services +must be a list of tuples where the first element is the ``special file'' +and the second element is its target. By default it is: + +@cindex @file{/bin/sh} +@cindex @file{sh}, in @file{/bin} +@example +`(("/bin/sh" ,(file-append @var{bash} "/bin/sh"))) +@end example + +@cindex @file{/usr/bin/env} +@cindex @file{env}, in @file{/usr/bin} +If you want to add, say, @code{/usr/bin/env} to your system, you can +change it to: + +@example +`(("/bin/sh" ,(file-append @var{bash} "/bin/sh")) + ("/usr/bin/env" ,(file-append @var{coreutils} "/bin/env"))) +@end example + +Since this is part of @code{%base-services}, you can use +@code{modify-services} to customize the set of special files +(@pxref{Service Reference, @code{modify-services}}). But the simple way +to add a special file is @i{via} the @code{extra-special-file} procedure +(see below.) +@end defvr + +@deffn {Scheme Procedure} extra-special-file @var{file} @var{target} +Use @var{target} as the ``special file'' @var{file}. + +For example, adding the following lines to the @code{services} field of +your operating system declaration leads to a @file{/usr/bin/env} +symlink: + +@example +(extra-special-file "/usr/bin/env" + (file-append coreutils "/bin/env")) +@end example +@end deffn + @deffn {Scheme Procedure} host-name-service @var{name} Return a service that sets the host name to @var{name}. @end deffn 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 @@ (define-module (gnu build activation) 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 @@ (define (make-setuid-program prog) (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 @@ (define-module (gnu services) 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 @@ (define (service-activations) #~(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 @@ (define %linux-bare-metal-service ;; 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 @@ (define-module (gnu services base) #: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 @@ (define %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 @@ (define* (run-basic-test os command #:optional (name "basic") 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 @@ (define marionette 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)) -- cgit v1.2.3