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.
master
Ludovic Courtès 2017-02-08 15:32:28 +01:00
parent 618739b063
commit 387e175492
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
5 changed files with 106 additions and 10 deletions

View File

@ -8272,6 +8272,50 @@ this:
@end example @end example
@end defvr @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} @deffn {Scheme Procedure} host-name-service @var{name}
Return a service that sets the host name to @var{name}. Return a service that sets the host name to @var{name}.
@end deffn @end deffn

View File

@ -28,7 +28,7 @@
activate-user-home activate-user-home
activate-etc activate-etc
activate-setuid-programs activate-setuid-programs
activate-/bin/sh activate-special-files
activate-modprobe activate-modprobe
activate-firmware activate-firmware
activate-ptrace-attach activate-ptrace-attach
@ -383,10 +383,23 @@ copy SOURCE to TARGET."
(for-each make-setuid-program programs)) (for-each make-setuid-program programs))
(define (activate-/bin/sh shell) (define (activate-special-files special-files)
"Change /bin/sh to point to SHELL." "Install the files listed in SPECIAL-FILES. Each element of SPECIAL-FILES
(symlink shell "/bin/sh.new") is a pair where the first element is the name of the special file and the
(rename-file "/bin/sh.new" "/bin/sh")) 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) (define (activate-modprobe modprobe)
"Tell the kernel to use MODPROBE to load modules." "Tell the kernel to use MODPROBE to load modules."

View File

@ -72,6 +72,8 @@
activation-service-type activation-service-type
activation-service->script activation-service->script
%linux-bare-metal-service %linux-bare-metal-service
special-files-service-type
extra-special-file
etc-service-type etc-service-type
etc-directory etc-directory
setuid-program-service-type setuid-program-service-type
@ -336,10 +338,6 @@ ACTIVATION-SCRIPT-TYPE."
#~(begin #~(begin
(use-modules (gnu build activation)) (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 ;; Make sure the user accounting database exists. If it
;; does not exist, 'setutxent' does not create it and ;; does not exist, 'setutxent' does not create it and
;; thus there is no accounting at all. ;; thus there is no accounting at all.
@ -413,6 +411,25 @@ ACTIVATION-SCRIPT-TYPE."
;; necessary or impossible in a container. ;; necessary or impossible in a container.
(service linux-bare-metal-service-type #f)) (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) (define (etc-directory service)
"Return the directory for SERVICE, a service of type ETC-SERVICE-TYPE." "Return the directory for SERVICE, a service of type ETC-SERVICE-TYPE."
(files->etc-directory (service-parameters service))) (files->etc-directory (service-parameters service)))

View File

@ -36,6 +36,7 @@
#:select (alsa-utils crda eudev e2fsprogs fuse gpm kbd lvm2 rng-tools)) #:select (alsa-utils crda eudev e2fsprogs fuse gpm kbd lvm2 rng-tools))
#:use-module ((gnu packages base) #:use-module ((gnu packages base)
#:select (canonical-package glibc)) #:select (canonical-package glibc))
#:use-module (gnu packages bash)
#:use-module (gnu packages package-management) #:use-module (gnu packages package-management)
#:use-module (gnu packages lsof) #:use-module (gnu packages lsof)
#:use-module (gnu packages terminals) #: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 ;; 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 ;; used, so enable them by default. The FUSE and ALSA rules are
;; less critical, but handy. ;; 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 ;;; base.scm ends here

View File

@ -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 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 inserted before the first test. This is used to introduce an extra
initialization step, such as entering a LUKS passphrase." 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 (define test
(with-imported-modules '((gnu build marionette) (with-imported-modules '((gnu build marionette)
(guix build syscalls)) (guix build syscalls))
@ -120,6 +125,18 @@ grep --version
info --version") info --version")
marionette))) 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" (test-assert "accounts"
(let ((users (marionette-eval '(begin (let ((users (marionette-eval '(begin
(use-modules (ice-9 match)) (use-modules (ice-9 match))