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.
This commit is contained in:
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 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

View File

@ -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."

View File

@ -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)))

View File

@ -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

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
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))