diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/avahi.scm | 4 | ||||
| -rw-r--r-- | gnu/services/base.scm | 104 | ||||
| -rw-r--r-- | gnu/services/dbus.scm | 6 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 54 | ||||
| -rw-r--r-- | gnu/services/ssh.scm | 140 | ||||
| -rw-r--r-- | gnu/services/xorg.scm | 56 |
6 files changed, 273 insertions, 91 deletions
diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm index 4ba1a513ab..e8da6be5f5 100644 --- a/gnu/services/avahi.scm +++ b/gnu/services/avahi.scm @@ -88,8 +88,8 @@ sockets." (requirement '(dbus-system networking)) (start #~(make-forkexec-constructor - (string-append #$avahi "/sbin/avahi-daemon") - "--syslog" "-f" #$config)) + (list (string-append #$avahi "/sbin/avahi-daemon") + "--syslog" "-f" #$config))) (stop #~(make-kill-destructor)) (activate #~(begin (use-modules (guix build utils)) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index bab07aa4b7..eb7c9dce04 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -20,6 +20,7 @@ #:use-module ((guix store) #:select (%store-prefix)) #:use-module (gnu services) + #:use-module (gnu services networking) #:use-module (gnu system shadow) ; 'user-account', etc. #:use-module (gnu system linux) ; 'pam-service', etc. #:use-module (gnu packages admin) @@ -189,7 +190,7 @@ stopped before 'kill' is called." (respawn? #f))))) (define (host-name-service name) - "Return a service that sets the host name to NAME." + "Return a service that sets the host name to @var{name}." (with-monad %store-monad (return (service (documentation "Initialize the machine's host name.") @@ -204,6 +205,10 @@ stopped before 'kill' is called." auto-login login-program login-pause? + + ;; Allow empty passwords by default so that + ;; first-time users can log in when the 'root' + ;; account has just been created. (allow-empty-passwords? #t)) "Return a service to run mingetty on @var{tty}. @@ -218,7 +223,7 @@ of the log-in program (the default is the @code{login} program from the Shadow tool suite.) @var{motd} is a monadic value containing a text file to use as -the \"message of the day\"." +the ``message of the day''." (mlet %store-monad ((motd motd) (login-program (cond ((gexp? login-program) (return login-program)) @@ -236,17 +241,17 @@ the \"message of the day\"." (requirement '(user-processes host-name)) (start #~(make-forkexec-constructor - (string-append #$mingetty "/sbin/mingetty") - "--noclear" #$tty - #$@(if auto-login - #~("--autologin" #$auto-login) - #~()) - #$@(if login-program - #~("--loginprog" #$login-program) - #~()) - #$@(if login-pause? - #~("--loginpause") - #~()))) + (list (string-append #$mingetty "/sbin/mingetty") + "--noclear" #$tty + #$@(if auto-login + #~("--autologin" #$auto-login) + #~()) + #$@(if login-program + #~("--loginprog" #$login-program) + #~()) + #$@(if login-pause? + #~("--loginpause") + #~())))) (stop #~(make-kill-destructor)) (pam-services @@ -269,16 +274,15 @@ the \"message of the day\"." (use-modules (guix build utils)) (mkdir-p "/var/run/nscd"))) - (start - #~(make-forkexec-constructor (string-append #$glibc "/sbin/nscd") - "-f" "/dev/null" - "--foreground")) + (start #~(make-forkexec-constructor + (list (string-append #$glibc "/sbin/nscd") + "-f" "/dev/null" "--foreground"))) (stop #~(make-kill-destructor)) (respawn? #f))))) (define (syslog-service) - "Return a service that runs 'syslogd' with reasonable default settings." + "Return a service that runs @code{syslogd} with reasonable default settings." ;; Snippet adapted from the GNU inetutils manual. (define contents " @@ -310,10 +314,9 @@ the \"message of the day\"." (provision '(syslogd)) (requirement '(user-processes)) (start - #~(make-forkexec-constructor (string-append #$inetutils - "/libexec/syslogd") - "--no-detach" - "--rcfile" #$syslog.conf)) + #~(make-forkexec-constructor + (list (string-append #$inetutils "/libexec/syslogd") + "--no-detach" "--rcfile" #$syslog.conf))) (stop #~(make-kill-destructor)))))) (define* (guix-build-accounts count #:key @@ -366,12 +369,12 @@ failed to register hydra.gnu.org public key: ~a~%" status)))))))) (define* (guix-service #:key (guix guix) (builder-group "guixbuild") (build-accounts 10) authorize-hydra-key?) - "Return a service that runs the build daemon from GUIX, and has -BUILD-ACCOUNTS user accounts available under BUILD-USER-GID. + "Return a service that runs the build daemon from @var{guix}, and has +@var{build-accounts} user accounts available under @var{builder-group}. -When AUTHORIZE-HYDRA-KEY? is true, the hydra.gnu.org public key provided by -GUIX is authorized upon activation, meaning that substitutes from -hydra.gnu.org are used by default." +When @var{authorize-hydra-key?} is true, the @code{hydra.gnu.org} public key +provided by @var{guix} is authorized upon activation, meaning that substitutes +from @code{hydra.gnu.org} are used by default." (define activate ;; Assume that the store has BUILDER-GROUP as its group. We could ;; otherwise call 'chown' here, but the problem is that on a COW unionfs, @@ -387,10 +390,9 @@ hydra.gnu.org are used by default." (provision '(guix-daemon)) (requirement '(user-processes)) (start - #~(make-forkexec-constructor (string-append #$guix - "/bin/guix-daemon") - "--build-users-group" - #$builder-group)) + #~(make-forkexec-constructor + (list (string-append #$guix "/bin/guix-daemon") + "--build-users-group" #$builder-group))) (stop #~(make-kill-destructor)) (user-accounts accounts) (user-groups (list (user-group @@ -409,6 +411,23 @@ hydra.gnu.org are used by default." (requirement '(root-file-system)) (documentation "Populate the /dev directory.") (start #~(lambda () + (define udevd + (string-append #$udev "/libexec/udev/udevd")) + + (define (wait-for-udevd) + ;; Wait until someone's listening on udevd's control + ;; socket. + (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0))) + (let try () + (catch 'system-error + (lambda () + (connect sock PF_UNIX "/run/udev/control") + (close-port sock)) + (lambda args + (format #t "waiting for udevd...~%") + (usleep 500000) + (try)))))) + ;; Allow udev to find the modules. (setenv "LINUX_MODULE_DIRECTORY" "/run/booted-system/kernel/lib/modules") @@ -416,21 +435,20 @@ hydra.gnu.org are used by default." (let ((pid (primitive-fork))) (case pid ((0) - ;; In dmd 0.1, file descriptor 0 is closed, thus - ;; is gets reused when open(2) is called, and it - ;; turns out that EPOLL_CTL_ADD of 0 returns - ;; EPERM for some reason. So make sure 0 is - ;; open. - ;; FIXME: Close the other descriptors. - (execl (string-append #$udev "/libexec/udev/udevd") - "udevd")) + (exec-command (list udevd))) (else + ;; Wait until udevd is up and running. This + ;; appears to be needed so that the events + ;; triggered below are actually handled. + (wait-for-udevd) + + ;; Trigger device node creation. + (system* (string-append #$udev "/bin/udevadm") + "trigger" "--action=add") + ;; Wait for things to settle down. (system* (string-append #$udev "/bin/udevadm") "settle") - ;; Create a bunch of devices. - (system* (string-append #$udev "/bin/udevadm") - "trigger") pid))))) (stop #~(make-kill-destructor)))))) @@ -444,6 +462,8 @@ This is the GNU operating system, welcome!\n\n"))) (mingetty-service "tty4" #:motd motd) (mingetty-service "tty5" #:motd motd) (mingetty-service "tty6" #:motd motd) + (static-networking-service "lo" "127.0.0.1" + #:provision '(loopback)) (syslog-service) (guix-service) (nscd-service) diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index 2f67e26a1e..6076317ee5 100644 --- a/gnu/services/dbus.scm +++ b/gnu/services/dbus.scm @@ -81,9 +81,9 @@ and policy files. For example, to allow avahi-daemon to use the system bus, (provision '(dbus-system)) (requirement '(user-processes)) (start #~(make-forkexec-constructor - (string-append #$dbus "/bin/dbus-daemon") - "--nofork" - (string-append "--config-file=" #$conf "/system.conf"))) + (list (string-append #$dbus "/bin/dbus-daemon") + "--nofork" + (string-append "--config-file=" #$conf "/system.conf")))) (stop #~(make-kill-destructor)) (user-groups (list (user-group (name "messagebus")))) diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 8bb05850e3..502b0d85f1 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -18,11 +18,14 @@ (define-module (gnu services networking) #:use-module (gnu services) + #:use-module (gnu system shadow) #:use-module (gnu packages admin) #:use-module (gnu packages linux) + #:use-module (gnu packages tor) #:use-module (guix gexp) #:use-module (guix monads) - #:export (static-networking-service)) + #:export (static-networking-service + tor-service)) ;;; Commentary: ;;; @@ -33,11 +36,13 @@ (define* (static-networking-service interface ip #:key gateway + (provision '(networking)) (name-servers '()) (inetutils inetutils) (net-tools net-tools)) - "Return a service that starts INTERFACE with address IP. If GATEWAY is -true, it must be a string specifying the default network gateway." + "Return a service that starts @var{interface} with address @var{ip}. If +@var{gateway} is true, it must be a string specifying the default network +gateway." ;; TODO: Eventually we should do this using Guile's networking procedures, ;; like 'configure-qemu-networking' does, but the patch that does this is @@ -48,12 +53,13 @@ true, it must be a string specifying the default network gateway." (documentation (string-append "Set up networking on the '" interface "' interface using a static IP address.")) - (provision '(networking)) + (provision provision) (start #~(lambda _ ;; Return #t if successfully started. (and (zero? (system* (string-append #$inetutils "/bin/ifconfig") - #$interface #$ip "up")) + "-i" #$interface "-A" #$ip + "-i" #$interface "--up")) #$(if gateway #~(zero? (system* (string-append #$net-tools "/sbin/route") @@ -75,8 +81,42 @@ true, it must be a string specifying the default network gateway." ;; Return #f is successfully stopped. (not (and (system* (string-append #$inetutils "/bin/ifconfig") #$interface "down") - (system* (string-append #$net-tools "/sbin/route") - "del" "-net" "default"))))) + #$(if gateway + #~(system* (string-append #$net-tools + "/sbin/route") + "del" "-net" "default") + #t))))) (respawn? #f))))) +(define* (tor-service #:key (tor tor)) + "Return a service to run the @uref{https://torproject.org,Tor} daemon. + +The daemon runs with the default settings (in particular the default exit +policy) as the @code{tor} unprivileged user." + (mlet %store-monad ((torrc (text-file "torrc" "User tor\n"))) + (return + (service + (provision '(tor)) + + ;; Tor needs at least one network interface to be up, hence the + ;; dependency on 'loopback'. + (requirement '(user-processes loopback)) + + (start #~(make-forkexec-constructor + (list (string-append #$tor "/bin/tor") "-f" #$torrc))) + (stop #~(make-kill-destructor)) + + (user-groups (list (user-group + (name "tor")))) + (user-accounts (list (user-account + (name "tor") + (group "tor") + (system? #t) + (comment "Tor daemon user") + (home-directory "/var/empty") + (shell + "/run/current-system/profile/sbin/nologin")))) + + (documentation "Run the Tor anonymous network overlay."))))) + ;;; networking.scm ends here diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm new file mode 100644 index 0000000000..fc46c345de --- /dev/null +++ b/gnu/services/ssh.scm @@ -0,0 +1,140 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gnu services ssh) + #:use-module (guix gexp) + #:use-module (gnu services) + #:use-module (gnu system linux) ; 'pam-service' + #:use-module (gnu packages lsh) + #:use-module (guix monads) + #:export (lsh-service)) + +;;; Commentary: +;;; +;;; This module implements secure shell (SSH) services. +;;; +;;; Code: + +(define %yarrow-seed + "/var/spool/lsh/yarrow-seed-file") + +(define (activation lsh host-key) + "Return the gexp to activate the LSH service for HOST-KEY." + #~(begin + (unless (file-exists? #$%yarrow-seed) + (system* (string-append #$lsh "/bin/lsh-make-seed") + "--sloppy" "-o" #$%yarrow-seed)) + + (unless (file-exists? #$host-key) + (mkdir-p (dirname #$host-key)) + (format #t "creating SSH host key '~a'...~%" #$host-key) + + ;; FIXME: We're just doing a simple pipeline, but 'system' cannot be + ;; used yet because /bin/sh might be dangling; factorize this somehow. + (let* ((in+out (pipe)) + (keygen (primitive-fork))) + (case keygen + ((0) + (close-port (car in+out)) + (close-fdes 1) + (dup2 (fileno (cdr in+out)) 1) + (execl (string-append #$lsh "/bin/lsh-keygen") + "lsh-keygen" "--server")) + (else + (let ((write-key (primitive-fork))) + (case write-key + ((0) + (close-port (cdr in+out)) + (close-fdes 0) + (dup2 (fileno (car in+out)) 0) + (execl (string-append #$lsh "/bin/lsh-writekey") + "lsh-writekey" "--server" "-o" #$host-key)) + (else + (close-port (car in+out)) + (close-port (cdr in+out)) + (waitpid keygen) + (waitpid write-key)))))))))) + +(define* (lsh-service #:key + (lsh lsh) + (host-key "/etc/lsh/host-key") + (interfaces '()) + (port-number 22) + (allow-empty-passwords? #f) + (root-login? #f) + (syslog-output? #t) + (x11-forwarding? #t) + (tcp/ip-forwarding? #t) + (password-authentication? #t) + (public-key-authentication? #t) + initialize?) + "Run the @command{lshd} program from @var{lsh} to listen on port @var{port-number}. +@var{host-key} must designate a file containing the host key, and readable +only by root. + +When @var{initialize?} is true, automatically create the seed and host key +upon service activation if they do not exist yet. This may take long and +require interaction. + +When @var{interfaces} is empty, lshd listens for connections on all the +network interfaces; otherwise, @var{interfaces} must be a list of host names +or addresses. + +@var{allow-empty-passwords?} specifies whether to accepts log-ins with empty +passwords, and @var{root-login?} specifies whether to accepts log-ins as +root. + +The other options should be self-descriptive." + (define lsh-command + (cons* #~(string-append #$lsh "/sbin/lshd") + #~(string-append "--host-key=" #$host-key) + #~(string-append "--password-helper=" #$lsh "/sbin/lsh-pam-checkpw") + #~(string-append "--subsystems=sftp=" #$lsh "/sbin/sftp-server") + "-p" (number->string port-number) + (if password-authentication? "--password" "--no-password") + (if public-key-authentication? + "--publickey" "--no-publickey") + (if root-login? + "--root-login" "--no-root-login") + (if x11-forwarding? + "--x11-forward" "--no-x11-forward") + (if tcp/ip-forwarding? + "--tcpip-forward" "--no-tcpip-forward") + (if (null? interfaces) + '() + (list (string-append "--interfaces=" + (string-join interfaces ",")))))) + + (with-monad %store-monad + (return (service + (documentation "GNU lsh SSH server") + (provision '(ssh-daemon)) + (requirement '(networking)) + (start #~(make-forkexec-constructor (list #$@lsh-command))) + (stop #~(make-kill-destructor)) + (pam-services + (list (unix-pam-service + "lshd" + #:allow-empty-passwords? allow-empty-passwords?))) + (activate #~(begin + (mkdir-p "/var/spool/lsh") + #$(if initialize? + (activation lsh host-key) + #t))))))) + +;;; ssh.scm ends here diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index 7215297f69..7ca0d3f7db 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -48,10 +48,17 @@ XORG-SERVER. Usually the X server is started by a login manager." (define (xserver.conf) (text-file* "xserver.conf" " Section \"Files\" - FontPath \"" font-adobe75dpi "/share/font/X11/75dpi\" + FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\" ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" - ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\" + ModulePath \"" xf86-video-fbdev "/lib/xorg/modules/drivers\" + ModulePath \"" xf86-video-cirrus "/lib/xorg/modules/drivers\" + ModulePath \"" xf86-video-intel "/lib/xorg/modules/drivers\" + ModulePath \"" xf86-video-mach64 "/lib/xorg/modules/drivers\" + ModulePath \"" xf86-video-nv "/lib/xorg/modules/drivers\" ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\" + ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\" + ModulePath \"" xf86-input-synaptics "/lib/xorg/modules/input\" + ModulePath \"" xf86-input-vmmouse "/lib/xorg/modules/input\" ModulePath \"" xorg-server "/lib/xorg/modules\" ModulePath \"" xorg-server "/lib/xorg/modules/extensions\" ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\" @@ -60,32 +67,7 @@ EndSection Section \"ServerFlags\" Option \"AllowMouseOpenFail\" \"on"" EndSection - -Section \"Monitor\" - Identifier \"Monitor[0]\" -EndSection - -Section \"InputClass\" - Identifier \"Generic keyboard\" - MatchIsKeyboard \"on\" - Option \"XkbRules\" \"base\" - Option \"XkbModel\" \"pc104\" -EndSection - -Section \"ServerLayout\" - Identifier \"Layout\" - Screen \"Screen-vesa\" -EndSection - -Section \"Device\" - Identifier \"Device-vesa\" - Driver \"vesa\" -EndSection - -Section \"Screen\" - Identifier \"Screen-vesa\" - Device \"Device-vesa\" -EndSection")) +")) (mlet %store-monad ((config (xserver.conf))) (define script @@ -130,11 +112,12 @@ EndSection")) (xauth xauth) (dmd dmd) (bash bash) startx) "Return a service that spawns the SLiM graphical login manager, which in -turn start the X display server with STARTX, a command as returned by -'xorg-start-command'. +turn starts the X display server with @var{startx}, a command as returned by +@code{xorg-start-command}. -When ALLOW-EMPTY-PASSWORDS? is true, allow logins with an empty password. -When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER." +When @var{allow-empty-passwords?} is true, allow logins with an empty +password. When @var{auto-login?} is true, log in automatically as +@var{default-user}." (define (slim.cfg) (mlet %store-monad ((startx (or startx (xorg-start-command))) (xinitrc (xinitrc))) @@ -161,13 +144,12 @@ reboot_cmd " dmd "/sbin/reboot (service (documentation "Xorg display server") (provision '(xorg-server)) - (requirement '(user-processes host-name)) + (requirement '(user-processes host-name udev)) (start - ;; XXX: Work around the inability to specify env. vars. directly. #~(make-forkexec-constructor - (string-append #$bash "/bin/sh") "-c" - (string-append "SLIM_CFGFILE=" #$slim.cfg - " " #$slim "/bin/slim" " -nodaemon"))) + (list (string-append #$slim "/bin/slim") "-nodaemon") + #:environment-variables + (list (string-append "SLIM_CFGFILE=" #$slim.cfg)))) (stop #~(make-kill-destructor)) (respawn? #t) (pam-services |