01/01: services: lsh: Add graceful handling of daemonic option.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 5833bf33a277d12357858e07ba34c5b5e3e69d55
Author: nebuli <address@hidden>
Date:   Wed Dec 3 22:51:48 2014 +0100

    services: lsh: Add graceful handling of daemonic option.
    
    * gnu/services/ssh.scm (lsh-service): New #:keys (daemonic?, pid-file?,
      pid-file).  Build new lshd-command and expand service-requirement
      field.
    * doc/guix.texi (Networking Services): Update accordingly.
    
    Signed-off-by: Ludovic Courtès <address@hidden>
---
 doc/guix.texi        |    8 +++++-
 gnu/services/ssh.scm |   64 +++++++++++++++++++++++++++++++++++---------------
 2 files changed, 52 insertions(+), 20 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 9fa0bd8..0842c91 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4526,7 +4526,7 @@ configuration file.
 Furthermore, @code{(gnu services ssh)} provides the following service.
 
 @deffn {Monadic Procedure} lsh-service [#:host-key "/etc/lsh/host-key"] @
-       [#:interfaces '()] [#:port-number 22] @
+       [#:daemonic? #t] [#:interfaces '()] [#:port-number 22] @
        [#:allow-empty-passwords? #f] [#:root-login? #f] @
        [#:syslog-output? #t] [#:x11-forwarding? #t] @
        [#:tcp/ip-forwarding? #t] [#:password-authentication? #t] @
@@ -4535,6 +4535,12 @@ 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{daemonic?} is true, @command{lshd} will detach from the
+controlling terminal and log its output to syslogd, unless one sets
address@hidden to false.  Obviously, it also makes lsh-service
+depend on existence of syslogd service.  When @var{pid-file?} is true,
address@hidden writes its PID to the file called @var{pid-file}.
+
 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.
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index 8868e4f..9537958 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -73,12 +73,15 @@
 
 (define* (lsh-service #:key
                       (lsh lsh)
+                      (daemonic? #t)
                       (host-key "/etc/lsh/host-key")
                       (interfaces '())
                       (port-number 22)
                       (allow-empty-passwords? #f)
                       (root-login? #f)
                       (syslog-output? #t)
+                      (pid-file? #f)
+                      (pid-file "/var/run/lshd.pid")
                       (x11-forwarding? #t)
                       (tcp/ip-forwarding? #t)
                       (password-authentication? #t)
@@ -88,6 +91,12 @@
 @var{host-key} must designate a file containing the host key, and readable
 only by root.
 
+When @var{daemonic?} is true, @command{lshd} will detach from the
+controlling terminal and log its output to syslogd, unless one sets
address@hidden to false.  Obviously, it also makes lsh-service
+depend on existence of syslogd service.  When @var{pid-file?} is true,
address@hidden writes its PID to the file called @var{pid-file}.
+
 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.
@@ -107,30 +116,47 @@ 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 ","))))))
+    (append
+     (cons #~(string-append #$lsh "/sbin/lshd")
+           (if daemonic?
+               (let ((syslog (if syslog-output? '()
+                                 (list "--no-syslog"))))
+                 (cons "--daemonic"
+                       (if pid-file?
+                           (cons #~(string-append "--pid-file=" #$pid-file)
+                                 syslog)
+                           (cons "--no-pid-file" syslog))))
+               (if pid-file?
+                   (list #~(string-append "--pid-file=" #$pid-file))
+                   '())))
+     (cons* #~(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 ",")))))))
+
+  (define requires
+    (if (and daemonic? syslog-output?)
+        '(networking syslogd)
+        '(networking)))
 
   (with-monad %store-monad
     (return (service
              (documentation "GNU lsh SSH server")
              (provision '(ssh-daemon))
-             (requirement '(networking))
+             (requirement requires)
              (start #~(make-forkexec-constructor (list address@hidden)))
              (stop  #~(make-kill-destructor))
              (pam-services