02/02: services: Add 'dropbear-service'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 71b0601a97da9f12f76de0480c341e06acf8f2bc
Author: David Craven <address@hidden>
Date:   Wed Jul 13 18:13:12 2016 +0200

    services: Add 'dropbear-service'.
    
    * gnu/services/ssh.scm (<dropbear-configuration>): New record type.
    (dropbear-activation, dropbear-shepherd-service, dropbear-service): New
    procedures.
    (dropbear-service-type): New variable.
    * doc/guix.texi (Networking Services): Document it.
    
    Co-authored-by: Ludovic Courtès <address@hidden>
---
 doc/guix.texi        |   43 +++++++++++++++++++++-
 gnu/services/ssh.scm |   97 +++++++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 134 insertions(+), 6 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 4b55473..a2732de 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7754,7 +7754,7 @@ In addition, @var{extra-settings} specifies a string to 
append to the
 configuration file.
 @end deffn
 
-Furthermore, @code{(gnu services ssh)} provides the following service.
+Furthermore, @code{(gnu services ssh)} provides the following services.
 
 @deffn {Scheme Procedure} lsh-service [#:host-key "/etc/lsh/host-key"] @
        [#:daemonic? #t] [#:interfaces '()] [#:port-number 22] @
@@ -7792,6 +7792,47 @@ root.
 The other options should be self-descriptive.
 @end deffn
 
address@hidden {Scheme Procedure} dropbear-service address@hidden
+Run the @uref{https://matt.ucc.asn.au/dropbear/dropbear.html,Dropbear SSH
+daemon} with the given @var{config}, a @code{<dropbear-configuration>}
+object.
+
+For example, to specify a Dropbear service listening on port 1234, add
+this call to the operating system's @code{services} field:
+
address@hidden
+(dropbear-service (dropbear-configuration
+                    (port-number 1234)))
address@hidden example
address@hidden deffn
+
address@hidden {Data Type} dropbear-configuration
+This data type represents the configuration of a Dropbear SSH daemon.
+
address@hidden @asis
address@hidden @code{dropbear} (default: @var{dropbear})
+The Dropbear package to use.
+
address@hidden @code{port-number} (default: 22)
+The TCP port where the daemon waits for incoming connections.
+
address@hidden @code{syslog-output?} (default: @code{#t})
+Whether to enable syslog output.
+
address@hidden @code{pid-file} (default: @code{"/var/run/dropbear.pid"})
+File name of the daemon's PID file.
+
address@hidden @code{root-login?} (default: @code{#f})
+Whether to allow @code{root} logins.
+
address@hidden @code{allow-empty-passwords?} (default: @code{#f})
+Whether to allow empty passwords.
+
address@hidden @code{password-authentication?} (default: @code{#t})
+Whether to enable password-based authentication.
address@hidden table
address@hidden deftp
+
 @defvr {Scheme Variable} %facebook-host-aliases
 This variable contains a string for use in @file{/etc/hosts}
 (@pxref{Host Names,,, libc, The GNU C Library Reference Manual}).  Each
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index 1eb9382..743b5e3 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 <address@hidden>
+;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2016 David Craven <address@hidden>
 ;;;
 ;;; 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 ssh)
+  #: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