summary refs log tree commit diff
path: root/gnu/services
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-07-20 11:42:02 +0200
committerLudovic Courtès <ludo@gnu.org>2016-07-20 11:42:17 +0200
commit7575655212ecfbcd1f04e429c8a7a41f8720d027 (patch)
tree558982d3cf50ef6b19ef293850de1f485fde66a6 /gnu/services
parent5d4c90ae02f1e0b42d575bba2d828d63aaf79be5 (diff)
parent5f01078129f4eaa4760a14f22761cf357afb6738 (diff)
downloadguix-7575655212ecfbcd1f04e429c8a7a41f8720d027.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/avahi.scm12
-rw-r--r--gnu/services/base.scm264
-rw-r--r--gnu/services/dbus.scm44
-rw-r--r--gnu/services/desktop.scm67
-rw-r--r--gnu/services/networking.scm54
-rw-r--r--gnu/services/shepherd.scm45
-rw-r--r--gnu/services/ssh.scm97
-rw-r--r--gnu/services/web.scm3
-rw-r--r--gnu/services/xorg.scm42
9 files changed, 402 insertions, 226 deletions
diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm
index 8005b066ed..562005c22c 100644
--- a/gnu/services/avahi.scm
+++ b/gnu/services/avahi.scm
@@ -42,6 +42,8 @@
   avahi-configuration?
   (avahi             avahi-configuration-avahi    ;<package>
                      (default avahi))
+  (debug?            avahi-configuration-debug?   ;Boolean
+                     (default #f))
   (host-name         avahi-configuration-host-name) ;string
   (publish?          avahi-configuration-publish?)  ;Boolean
   (ipv4?             avahi-configuration-ipv4?)     ;Boolean
@@ -96,6 +98,7 @@
 (define (avahi-shepherd-service config)
   "Return a list of <shepherd-service> for CONFIG."
   (let ((config (configuration-file config))
+        (debug? (avahi-configuration-debug? config))
         (avahi  (avahi-configuration-avahi config)))
     (list (shepherd-service
            (documentation "Run the Avahi mDNS/DNS-SD responder.")
@@ -104,7 +107,10 @@
 
            (start #~(make-forkexec-constructor
                      (list (string-append #$avahi "/sbin/avahi-daemon")
-                           "--syslog" "-f" #$config)))
+                           "--daemonize"
+                           #$@(if debug? #~("--debug") #~())
+                           "-f" #$config)
+                     #:pid-file "/var/run/avahi-daemon/pid"))
            (stop #~(make-kill-destructor))))))
 
 (define avahi-service-type
@@ -127,7 +133,7 @@
                          (service-extension profile-service-type
                                             avahi-package))))))
 
-(define* (avahi-service #:key (avahi avahi)
+(define* (avahi-service #:key (avahi avahi) debug?
                         host-name
                         (publish? #t)
                         (ipv4? #t) (ipv6? #t)
@@ -155,7 +161,7 @@ Boolean values @var{ipv4?} and @var{ipv6?} determine whether to use IPv4/IPv6
 sockets."
   (service avahi-service-type
            (avahi-configuration
-            (avahi avahi) (host-name host-name)
+            (avahi avahi) (debug? debug?) (host-name host-name)
             (publish? publish?) (ipv4? ipv4?) (ipv6? ipv6?)
             (wide-area? wide-area?)
             (domains-to-browse domains-to-browse))))
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 2780d124c7..805ba7d12c 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -4,6 +4,8 @@
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2016 David Craven <david@craven.ch>
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,11 +33,11 @@
   #:use-module (gnu system mapped-devices)
   #:use-module (gnu packages admin)
   #:use-module ((gnu packages linux)
-                #:select (eudev kbd e2fsprogs lvm2 fuse alsa-utils crda gpm))
+                #: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 package-management)
-  #:use-module (gnu packages lsh)
+  #:use-module (gnu packages ssh)
   #:use-module (gnu packages lsof)
   #:use-module ((gnu build file-systems)
                 #:select (mount-flags->bit-mask))
@@ -81,6 +83,7 @@
             nscd-service-type
             nscd-service
             syslog-service
+            syslog-service-type
             %default-syslog.conf
 
             guix-configuration
@@ -94,7 +97,12 @@
             gpm-service-type
             gpm-service
 
+            urandom-seed-service-type
             urandom-seed-service
+            rngd-service-type
+            rngd-service
+            pam-limits-service-type
+            pam-limits-service
 
             %base-services))
 
@@ -224,59 +232,58 @@ FILE-SYSTEM."
         (create? (file-system-create-mount-point? file-system))
         (dependencies (file-system-dependencies file-system)))
     (if (file-system-mount? file-system)
-        (list
-         (shepherd-service
-          (provision (list (file-system->shepherd-service-name file-system)))
-          (requirement `(root-file-system
-                         ,@(map dependency->shepherd-service-name dependencies)))
-          (documentation "Check, mount, and unmount the given file system.")
-          (start #~(lambda args
-                     ;; FIXME: Use or factorize with 'mount-file-system'.
-                     (let ((device (canonicalize-device-spec #$device '#$title))
-                           (flags  #$(mount-flags->bit-mask
-                                      (file-system-flags file-system))))
-                       #$(if create?
-                             #~(mkdir-p #$target)
-                             #~#t)
-                       #$(if check?
-                             #~(begin
-                                 ;; Make sure fsck.ext2 & co. can be found.
-                                 (setenv "PATH"
-                                         (string-append
-                                          #$e2fsprogs "/sbin:"
-                                          "/run/current-system/profile/sbin:"
-                                          (getenv "PATH")))
-                                 (check-file-system device #$type))
-                             #~#t)
-
-                       (mount device #$target #$type flags
-                              #$(file-system-options file-system))
-
-                       ;; For read-only bind mounts, an extra remount is
-                       ;; needed, as per <http://lwn.net/Articles/281157/>,
-                       ;; which still applies to Linux 4.0.
-                       (when (and (= MS_BIND (logand flags MS_BIND))
-                                  (= MS_RDONLY (logand flags MS_RDONLY)))
-                         (mount device #$target #$type
-                                (logior MS_BIND MS_REMOUNT MS_RDONLY))))
-                     #t))
-          (stop #~(lambda args
-                    ;; Normally there are no processes left at this point, so
-                    ;; TARGET can be safely unmounted.
-
-                    ;; Make sure PID 1 doesn't keep TARGET busy.
-                    (chdir "/")
-
-                    (umount #$target)
-                    #f))
-
-          ;; We need an additional module.
-          (modules `(((gnu build file-systems)
-                      #:select (check-file-system canonicalize-device-spec))
-                     ,@%default-modules))
-          (imported-modules `((gnu build file-systems)
-                              (guix build bournish)
-                              ,@%default-imported-modules))))
+        (with-imported-modules '((gnu build file-systems)
+                                 (guix build bournish))
+          (list
+           (shepherd-service
+            (provision (list (file-system->shepherd-service-name file-system)))
+            (requirement `(root-file-system
+                           ,@(map dependency->shepherd-service-name dependencies)))
+            (documentation "Check, mount, and unmount the given file system.")
+            (start #~(lambda args
+                       ;; FIXME: Use or factorize with 'mount-file-system'.
+                       (let ((device (canonicalize-device-spec #$device '#$title))
+                             (flags  #$(mount-flags->bit-mask
+                                        (file-system-flags file-system))))
+                         #$(if create?
+                               #~(mkdir-p #$target)
+                               #~#t)
+                         #$(if check?
+                               #~(begin
+                                   ;; Make sure fsck.ext2 & co. can be found.
+                                   (setenv "PATH"
+                                           (string-append
+                                            #$e2fsprogs "/sbin:"
+                                            "/run/current-system/profile/sbin:"
+                                            (getenv "PATH")))
+                                   (check-file-system device #$type))
+                               #~#t)
+
+                         (mount device #$target #$type flags
+                                #$(file-system-options file-system))
+
+                         ;; For read-only bind mounts, an extra remount is
+                         ;; needed, as per <http://lwn.net/Articles/281157/>,
+                         ;; which still applies to Linux 4.0.
+                         (when (and (= MS_BIND (logand flags MS_BIND))
+                                    (= MS_RDONLY (logand flags MS_RDONLY)))
+                           (mount device #$target #$type
+                                  (logior MS_BIND MS_REMOUNT MS_RDONLY))))
+                       #t))
+            (stop #~(lambda args
+                      ;; Normally there are no processes left at this point, so
+                      ;; TARGET can be safely unmounted.
+
+                      ;; Make sure PID 1 doesn't keep TARGET busy.
+                      (chdir "/")
+
+                      (umount #$target)
+                      #f))
+
+            ;; We need an additional module.
+            (modules `(((gnu build file-systems)
+                        #:select (check-file-system canonicalize-device-spec))
+                       ,@%default-modules)))))
         '())))
 
 (define file-system-service-type
@@ -484,7 +491,47 @@ stopped before 'kill' is called."
 (define (urandom-seed-service)
   (service urandom-seed-service-type #f))
 
-
+
+;;;
+;;; Add hardware random number generator to entropy pool.
+;;;
+
+(define-record-type* <rngd-configuration>
+  rngd-configuration make-rngd-configuration
+  rngd-configuration?
+  (rng-tools rngd-configuration-rng-tools)        ;package
+  (device    rngd-configuration-device))          ;string
+
+(define rngd-service-type
+  (shepherd-service-type
+    'rngd
+    (lambda (config)
+      (define rng-tools (rngd-configuration-rng-tools config))
+      (define device (rngd-configuration-device config))
+
+      (define rngd-command
+        (list #~(string-append #$rng-tools "/sbin/rngd")
+              "-f" "-r" device))
+
+      (shepherd-service
+        (documentation "Add TRNG to entropy pool.")
+        (requirement '(udev))
+        (provision '(trng))
+        (start #~(make-forkexec-constructor #$@rngd-command))
+        (stop #~(make-kill-destructor))))))
+
+(define* (rngd-service #:key
+                       (rng-tools rng-tools)
+                       (device "/dev/hwrng"))
+  "Return a service that runs the @command{rngd} program from @var{rng-tools}
+to add @var{device} to the kernel's entropy pool.  The service will fail if
+@var{device} does not exist."
+  (service rngd-service-type
+           (rngd-configuration
+            (rng-tools rng-tools)
+            (device device))))
+
+
 ;;;
 ;;; System-wide environment variables.
 ;;;
@@ -790,6 +837,11 @@ the tty to run, among other things."
                                           "/sbin/nscd")
                            "-f" #$nscd.conf "--foreground")
 
+                     ;; Wait for the PID file.  However, the PID file is
+                     ;; written before nscd is actually listening on its
+                     ;; socket (XXX).
+                     #:pid-file "/var/run/nscd/nscd.pid"
+
                      #:environment-variables
                      (list (string-append "LD_LIBRARY_PATH="
                                           (string-join
@@ -875,6 +927,46 @@ settings.
 information on the configuration file syntax."
   (service syslog-service-type config-file))
 
+(define pam-limits-service-type
+  (let ((security-limits
+         ;; Create /etc/security containing the provided "limits.conf" file.
+         (lambda (limits-file)
+           `(("security"
+              ,(computed-file
+                "security"
+                #~(begin
+                    (mkdir #$output)
+                    (stat #$limits-file)
+                    (symlink #$limits-file
+                             (string-append #$output "/limits.conf"))))))))
+        (pam-extension
+         (lambda (pam)
+           (let ((pam-limits (pam-entry
+                              (control "required")
+                              (module "pam_limits.so")
+                              (arguments '("conf=/etc/security/limits.conf")))))
+             (if (member (pam-service-name pam)
+                         '("login" "su" "slim"))
+                 (pam-service
+                  (inherit pam)
+                  (session (cons pam-limits
+                                 (pam-service-session pam))))
+                 pam)))))
+    (service-type
+     (name 'limits)
+     (extensions
+      (list (service-extension etc-service-type security-limits)
+            (service-extension pam-root-service-type
+                               (lambda _ (list pam-extension))))))))
+
+(define* (pam-limits-service #:optional (limits '()))
+  "Return a service that makes selected programs respect the list of
+pam-limits-entry specified in LIMITS via pam_limits.so."
+  (service pam-limits-service-type
+           (plain-file "limits.conf"
+                       (string-join (map pam-limits-entry->string limits)
+                                    "\n"))))
+
 
 ;;;
 ;;; Guix services.
@@ -1088,44 +1180,44 @@ archive}).  If that is not the case, the service will fail to start."
   "Return the union of the @code{lib/udev/rules.d} directories found in each
 item of @var{packages}."
   (define build
-    #~(begin
-        (use-modules (guix build union)
-                     (guix build utils)
-                     (srfi srfi-1)
-                     (srfi srfi-26))
+    (with-imported-modules '((guix build union)
+                             (guix build utils))
+      #~(begin
+          (use-modules (guix build union)
+                       (guix build utils)
+                       (srfi srfi-1)
+                       (srfi srfi-26))
 
-        (define %standard-locations
-          '("/lib/udev/rules.d" "/libexec/udev/rules.d"))
+          (define %standard-locations
+            '("/lib/udev/rules.d" "/libexec/udev/rules.d"))
 
-        (define (rules-sub-directory directory)
-          ;; Return the sub-directory of DIRECTORY containing udev rules, or
-          ;; #f if none was found.
-          (find directory-exists?
-                (map (cut string-append directory <>) %standard-locations)))
+          (define (rules-sub-directory directory)
+            ;; Return the sub-directory of DIRECTORY containing udev rules, or
+            ;; #f if none was found.
+            (find directory-exists?
+                  (map (cut string-append directory <>) %standard-locations)))
 
-        (mkdir-p (string-append #$output "/lib/udev"))
-        (union-build (string-append #$output "/lib/udev/rules.d")
-                     (filter-map rules-sub-directory '#$packages))))
+          (mkdir-p (string-append #$output "/lib/udev"))
+          (union-build (string-append #$output "/lib/udev/rules.d")
+                       (filter-map rules-sub-directory '#$packages)))))
 
-  (computed-file "udev-rules" build
-                 #:modules '((guix build union)
-                             (guix build utils))))
+  (computed-file "udev-rules" build))
 
 (define (udev-rule file-name contents)
   "Return a directory with a udev rule file FILE-NAME containing CONTENTS."
   (computed-file file-name
-                 #~(begin
-                     (use-modules (guix build utils))
-
-                     (define rules.d
-                       (string-append #$output "/lib/udev/rules.d"))
-
-                     (mkdir-p rules.d)
-                     (call-with-output-file
-                         (string-append rules.d "/" #$file-name)
-                       (lambda (port)
-                         (display #$contents port))))
-                 #:modules '((guix build utils))))
+                 (with-imported-modules '((guix build utils))
+                   #~(begin
+                       (use-modules (guix build utils))
+
+                       (define rules.d
+                         (string-append #$output "/lib/udev/rules.d"))
+
+                       (mkdir-p rules.d)
+                       (call-with-output-file
+                           (string-append rules.d "/" #$file-name)
+                         (lambda (port)
+                           (display #$contents port)))))))
 
 (define kvm-udev-rule
   ;; Return a directory with a udev rule that changes the group of /dev/kvm to
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index 9a4a13d41d..6ef13568ef 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -46,26 +46,27 @@
   "Return the system service directory, containing @code{.service} files for
 all the services that may be activated by the daemon."
   (computed-file "dbus-system-services"
-                 #~(begin
-                     (use-modules (guix build utils)
-                                  (srfi srfi-1))
-
-                     (define files
-                       (append-map (lambda (service)
-                                     (find-files (string-append
-                                                  service
-                                                  "/share/dbus-1/system-services")
-                                                 "\\.service$"))
-                                   (list #$@services)))
-
-                     (mkdir #$output)
-                     (for-each (lambda (file)
-                                 (symlink file
-                                          (string-append #$output "/"
-                                                         (basename file))))
-                               files)
-                     #t)
-                 #:modules '((guix build utils))))
+                 (with-imported-modules '((guix build utils))
+                   #~(begin
+                       (use-modules (guix build utils)
+                                    (srfi srfi-1))
+
+                       (define files
+                         (append-map (lambda (service)
+                                       (find-files
+                                        (string-append
+                                         service
+                                         "/share/dbus-1/system-services")
+                                        "\\.service$"))
+                                     (list #$@services)))
+
+                       (mkdir #$output)
+                       (for-each (lambda (file)
+                                   (symlink file
+                                            (string-append #$output "/"
+                                                           (basename file))))
+                                 files)
+                       #t))))
 
 (define (dbus-configuration-directory services)
   "Return a directory contains the @code{system-local.conf} file for DBUS that
@@ -168,7 +169,8 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
             (requirement '(user-processes))
             (start #~(make-forkexec-constructor
                       (list (string-append #$dbus "/bin/dbus-daemon")
-                            "--nofork" "--system")))
+                            "--nofork" "--system")
+                      #:pid-file "/var/run/dbus/pid"))
             (stop #~(make-kill-destructor)))))))
 
 (define dbus-root-service-type
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 2fb08cd1b3..86214a73bf 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -91,30 +91,33 @@ is set to @var{value} when the bus daemon launches it."
                              (string-append #$service "/" #$program)
                              (cdr (command-line))))))
 
+  (define build
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils))
+
+          (define service-directory
+            "/share/dbus-1/system-services")
+
+          (mkdir-p (dirname (string-append #$output
+                                           service-directory)))
+          (copy-recursively (string-append #$service
+                                           service-directory)
+                            (string-append #$output
+                                           service-directory))
+          (symlink (string-append #$service "/etc") ;for etc/dbus-1
+                   (string-append #$output "/etc"))
+
+          (for-each (lambda (file)
+                      (substitute* file
+                        (("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$"
+                          _ original-program arguments)
+                         (string-append "Exec=" #$wrapper arguments
+                                        "\n"))))
+                    (find-files #$output "\\.service$")))))
+
   (computed-file (string-append (package-name service) "-wrapper")
-                 #~(begin
-                     (use-modules (guix build utils))
-
-                     (define service-directory
-                       "/share/dbus-1/system-services")
-
-                     (mkdir-p (dirname (string-append #$output
-                                                      service-directory)))
-                     (copy-recursively (string-append #$service
-                                                      service-directory)
-                                       (string-append #$output
-                                                      service-directory))
-                     (symlink (string-append #$service "/etc") ;for etc/dbus-1
-                              (string-append #$output "/etc"))
-
-                     (for-each (lambda (file)
-                                 (substitute* file
-                                   (("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$"
-                                     _ original-program arguments)
-                                    (string-append "Exec=" #$wrapper arguments
-                                                   "\n"))))
-                               (find-files #$output "\\.service$")))
-                 #:modules '((guix build utils))))
+                 build))
 
 
 ;;;
@@ -408,15 +411,15 @@ Users need to be in the @code{lp} group to access the D-Bus service.
 (define (polkit-directory packages)
   "Return a directory containing an @file{actions} and possibly a
 @file{rules.d} sub-directory, for use as @file{/etc/polkit-1}."
-  (computed-file "etc-polkit-1"
-                 #~(begin
-                     (use-modules (guix build union) (srfi srfi-26))
-
-                     (union-build #$output
-                                  (map (cut string-append <>
-                                            "/share/polkit-1")
-                                       (list #$@packages))))
-                 #:modules '((guix build union))))
+  (with-imported-modules '((guix build union))
+    (computed-file "etc-polkit-1"
+                   #~(begin
+                       (use-modules (guix build union) (srfi srfi-26))
+
+                       (union-build #$output
+                                    (map (cut string-append <>
+                                              "/share/polkit-1")
+                                         (list #$@packages)))))))
 
 (define polkit-etc-files
   (match-lambda
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index af2a60936b..a77ed3bb80 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
 ;;;
@@ -345,39 +345,39 @@ keep the system clock synchronized with that of @var{servers}."
     (($ <tor-configuration> tor config-file services)
      (computed-file
       "torrc"
-      #~(begin
-          (use-modules (guix build utils)
-                       (ice-9 match))
-
-          (call-with-output-file #$output
-            (lambda (port)
-              (display "\
+      (with-imported-modules '((guix build utils))
+        #~(begin
+            (use-modules (guix build utils)
+                         (ice-9 match))
+
+            (call-with-output-file #$output
+              (lambda (port)
+                (display "\
 # The beginning was automatically added.
 User tor
 DataDirectory /var/lib/tor
 Log notice syslog\n" port)
 
-              (for-each (match-lambda
-                          ((service (ports hosts) ...)
-                           (format port "\
+                (for-each (match-lambda
+                            ((service (ports hosts) ...)
+                             (format port "\
 HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
-                                   service)
-                           (for-each (lambda (tcp-port host)
-                                       (format port "\
+                                     service)
+                             (for-each (lambda (tcp-port host)
+                                         (format port "\
 HiddenServicePort ~a ~a~%"
-                                               tcp-port host))
-                                     ports hosts)))
-                        '#$(map (match-lambda
-                                  (($ <hidden-service> name mapping)
-                                   (cons name mapping)))
-                                services))
-
-              ;; Append the user's config file.
-              (call-with-input-file #$config-file
-                (lambda (input)
-                  (dump-port input port)))
-              #t)))
-      #:modules '((guix build utils))))))
+                                                 tcp-port host))
+                                       ports hosts)))
+                          '#$(map (match-lambda
+                                    (($ <hidden-service> name mapping)
+                                     (cons name mapping)))
+                                  services))
+
+                ;; Append the user's config file.
+                (call-with-input-file #$config-file
+                  (lambda (input)
+                    (dump-port input port)))
+                #t))))))))
 
 (define (tor-shepherd-service config)
   "Return a <shepherd-service> running TOR."
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 5d829e4c38..a14f51592a 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -47,9 +47,7 @@
             shepherd-service-stop
             shepherd-service-auto-start?
             shepherd-service-modules
-            shepherd-service-imported-modules
 
-            %default-imported-modules
             %default-modules
 
             shepherd-service-file
@@ -138,9 +136,7 @@ for a service that extends SHEPHERD-ROOT-SERVICE-TYPE and nothing else."
   (auto-start?   shepherd-service-auto-start?          ;Boolean
                  (default #t))
   (modules       shepherd-service-modules              ;list of module names
-                 (default %default-modules))
-  (imported-modules shepherd-service-imported-modules  ;list of module names
-                    (default %default-imported-modules)))
+                 (default %default-modules)))
 
 (define (shepherd-service-canonical-name service)
   "Return the 'canonical name' of SERVICE."
@@ -179,7 +175,7 @@ assertion failure."
                           (&message
                            (message
                             (format #f (_ "service '~a' requires '~a', \
-which is undefined")
+which is not provided by any service")
                                     (match (shepherd-service-provision service)
                                       ((head . _) head)
                                       (_          service))
@@ -203,37 +199,26 @@ stored."
 (define (shepherd-service-file service)
   "Return a file defining SERVICE."
   (gexp->file (shepherd-service-file-name service)
-              #~(begin
-                  (use-modules #$@(shepherd-service-modules service))
-
-                  (make <service>
-                    #:docstring '#$(shepherd-service-documentation service)
-                    #:provides '#$(shepherd-service-provision service)
-                    #:requires '#$(shepherd-service-requirement service)
-                    #:respawn? '#$(shepherd-service-respawn? service)
-                    #:start #$(shepherd-service-start service)
-                    #:stop #$(shepherd-service-stop service)))))
+              (with-imported-modules %default-imported-modules
+                #~(begin
+                    (use-modules #$@(shepherd-service-modules service))
+
+                    (make <service>
+                      #:docstring '#$(shepherd-service-documentation service)
+                      #:provides '#$(shepherd-service-provision service)
+                      #:requires '#$(shepherd-service-requirement service)
+                      #:respawn? '#$(shepherd-service-respawn? service)
+                      #:start #$(shepherd-service-start service)
+                      #:stop #$(shepherd-service-stop service))))))
 
 (define (shepherd-configuration-file services)
   "Return the shepherd configuration file for SERVICES."
-  (define modules
-    (delete-duplicates
-     (append-map shepherd-service-imported-modules services)))
-
   (assert-valid-graph services)
 
-  (mlet %store-monad ((modules  (imported-modules modules))
-                      (compiled (compiled-modules modules))
-                      (files    (mapm %store-monad
-                                      shepherd-service-file
-                                      services)))
+  (mlet %store-monad ((files (mapm %store-monad
+                                   shepherd-service-file services)))
     (define config
       #~(begin
-          (eval-when (expand load eval)
-            (set! %load-path (cons #$modules %load-path))
-            (set! %load-compiled-path
-              (cons #$compiled %load-compiled-path)))
-
           (use-modules (srfi srfi-34)
                        (system repl error-handling))
 
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index 33e1951a6e..743b5e3805 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,14 +18,19 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu services ssh)
-  #:use-module (guix gexp)
-  #:use-module (guix records)
+  #:use-module (gnu packages ssh)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system pam)
-  #:use-module (gnu packages lsh)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
   #:use-module (srfi srfi-26)
-  #:export (lsh-service))
+  #:export (lsh-service
+
+            dropbear-configuration
+            dropbear-configuration?
+            dropbear-service-type
+            dropbear-service))
 
 ;;; Commentary:
 ;;;
@@ -235,4 +241,85 @@ The other options should be self-descriptive."
                                public-key-authentication?)
                               (initialize? initialize?))))
 
+
+;;;
+;;; Dropbear.
+;;;
+
+(define-record-type* <dropbear-configuration>
+  dropbear-configuration make-dropbear-configuration
+  dropbear-configuration?
+  (dropbear               dropbear-configuration-dropbear
+                          (default dropbear))
+  (port-number            dropbear-configuration-port-number
+                          (default 22))
+  (syslog-output?         dropbear-configuration-syslog-output?
+                          (default #t))
+  (pid-file               dropbear-configuration-pid-file
+                          (default "/var/run/dropbear.pid"))
+  (root-login?            dropbear-configuration-root-login?
+                          (default #f))
+  (allow-empty-passwords? dropbear-configuration-allow-empty-passwords?
+                          (default #f))
+  (password-authentication? dropbear-configuration-password-authentication?
+                            (default #t)))
+
+(define (dropbear-activation config)
+  "Return the activation gexp for CONFIG."
+  #~(begin
+      (mkdir-p "/etc/dropbear")))
+
+(define (dropbear-shepherd-service config)
+  "Return a <shepherd-service> for dropbear with CONFIG."
+  (define dropbear
+    (dropbear-configuration-dropbear config))
+
+  (define pid-file
+    (dropbear-configuration-pid-file config))
+
+  (define dropbear-command
+    #~(list (string-append #$dropbear "/sbin/dropbear")
+
+            ;; '-R' allows host keys to be automatically generated upon first
+            ;; connection, at a time when /dev/urandom is more likely securely
+            ;; seeded.
+            "-F" "-R"
+
+            "-p" #$(number->string (dropbear-configuration-port-number config))
+            "-P" #$pid-file
+            #$@(if (dropbear-configuration-syslog-output? config) '() '("-E"))
+            #$@(if (dropbear-configuration-root-login? config) '() '("-w"))
+            #$@(if (dropbear-configuration-password-authentication? config)
+                   '()
+                   '("-s" "-g"))
+            #$@(if (dropbear-configuration-allow-empty-passwords? config)
+                   '("-B")
+                   '())))
+
+  (define requires
+    (if (dropbear-configuration-syslog-output? config)
+        '(networking syslogd) '(networking)))
+
+  (list (shepherd-service
+         (documentation "Dropbear SSH server.")
+         (requirement requires)
+         (provision '(ssh-daemon))
+         (start #~(make-forkexec-constructor #$dropbear-command
+                                             #:pid-file #$pid-file))
+         (stop #~(make-kill-destructor)))))
+
+(define dropbear-service-type
+  (service-type (name 'dropbear)
+                (extensions
+                 (list (service-extension shepherd-root-service-type
+                                          dropbear-shepherd-service)
+                       (service-extension activation-service-type
+                                          dropbear-activation)))))
+
+(define* (dropbear-service #:optional (config (dropbear-configuration)))
+  "Run the @uref{https://matt.ucc.asn.au/dropbear/dropbear.html,Dropbear SSH
+daemon} with the given @var{config}, a @code{<dropbear-configuration>}
+object."
+  (service dropbear-service-type config))
+
 ;;; ssh.scm ends here
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 0e17f6e5c6..72ef7d4050 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -114,7 +115,7 @@
                          (default-nginx-config log-directory run-directory)))
   "Return a service that runs NGINX, the nginx web server.
 
-The nginx daemon loads its runtime configuration from CONFIG-FIGLE, stores log
+The nginx daemon loads its runtime configuration from CONFIG-FILE, stores log
 files in LOG-DIRECTORY, and stores temporary runtime files in RUN-DIRECTORY."
   (service nginx-service-type
            (nginx-configuration
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 9908b9526b..44d12a7e77 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -158,27 +158,27 @@ EndSection
   "Return a directory that contains the @code{.conf} files for X.org that
 includes the @code{share/X11/xorg.conf.d} directories of each package listed
 in @var{modules}."
-  (computed-file "xorg.conf.d"
-                 #~(begin
-                     (use-modules (guix build utils)
-                                  (srfi srfi-1))
-
-                     (define files
-                       (append-map (lambda (module)
-                                     (find-files (string-append
-                                                  module
-                                                  "/share/X11/xorg.conf.d")
-                                                 "\\.conf$"))
-                                   (list #$@modules)))
-
-                     (mkdir #$output)
-                     (for-each (lambda (file)
-                                 (symlink file
-                                          (string-append #$output "/"
-                                                         (basename file))))
-                               files)
-                     #t)
-                 #:modules '((guix build utils))))
+  (with-imported-modules '((guix build utils))
+    (computed-file "xorg.conf.d"
+                   #~(begin
+                       (use-modules (guix build utils)
+                                    (srfi srfi-1))
+
+                       (define files
+                         (append-map (lambda (module)
+                                       (find-files (string-append
+                                                    module
+                                                    "/share/X11/xorg.conf.d")
+                                                   "\\.conf$"))
+                                     (list #$@modules)))
+
+                       (mkdir #$output)
+                       (for-each (lambda (file)
+                                   (symlink file
+                                            (string-append #$output "/"
+                                                           (basename file))))
+                                 files)
+                       #t))))
 
 (define* (xorg-start-command #:key
                              (guile (canonical-package guile-2.0))