From 12723370e5a780b18eae4c44ab9634adaff927ea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Lassieur?= <clement@lassieur.org>
Date: Tue, 21 Feb 2017 00:53:55 +0100
Subject: [PATCH] services: openssh: Add 'subsystems' option.

* gnu/services/ssh.scm (openssh-config-file): Add it.
(<openssh-configuration>)[subsystems]: Add it.
* doc/guix.texi (Networking Services): Document it.
---
 doc/guix.texi        | 16 +++++++++
 gnu/services/ssh.scm | 81 +++++++++++++++++++++++++-------------------
 2 files changed, 62 insertions(+), 35 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 297141288c..8d27dd2031 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9511,6 +9511,22 @@ equivalent role to password authentication, you should disable either
 @item @code{print-last-log?} (default: @code{#t})
 Specifies whether @command{sshd} should print the date and time of the
 last user login when a user logs in interactively.
+
+@item @code{subsystems} (default: @code{'(("sftp" "internal-sftp"))})
+Configures external subsystems (e.g. file transfer daemon).
+
+This is a list of two-element lists, each of which containing the
+subsystem name and a command (with optional arguments) to execute upon
+subsystem request.
+
+The command @command{internal-sftp} implements an in-process SFTP
+server.  Alternately, one can specify the @command{sftp-server} command:
+@example
+(service openssh-service-type
+         (openssh-configuration
+          (subsystems
+           '(("sftp" ,(file-append openssh "/libexec/sftp-server"))))))
+@end example
 @end table
 @end deftp
 
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index 6272d53fc8..b7f9887b30 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -292,7 +292,10 @@ The other options should be self-descriptive."
                          (default #t))
   ;; Boolean
   (print-last-log?       openssh-configuration-print-last-log?
-                         (default #t)))
+                         (default #t))
+  ;; list of two-element lists
+  (subsystems            openssh-configuration-subsystems
+                         (default '(("sftp" "internal-sftp")))))
 
 (define %openssh-accounts
   (list (user-group (name "sshd") (system? #t))
@@ -327,40 +330,48 @@ The other options should be self-descriptive."
   "Return the sshd configuration file corresponding to CONFIG."
   (computed-file
    "sshd_config"
-   #~(call-with-output-file #$output
-       (lambda (port)
-         (display "# Generated by 'openssh-service'.\n" port)
-         (format port "Port ~a\n"
-                 #$(number->string (openssh-configuration-port-number config)))
-         (format port "PermitRootLogin ~a\n"
-                 #$(match (openssh-configuration-permit-root-login config)
-                     (#t "yes")
-                     (#f "no")
-                     ('without-password "without-password")))
-         (format port "PermitEmptyPasswords ~a\n"
-                 #$(if (openssh-configuration-allow-empty-passwords? config)
-                       "yes" "no"))
-         (format port "PasswordAuthentication ~a\n"
-                 #$(if (openssh-configuration-password-authentication? config)
-                       "yes" "no"))
-         (format port "PubkeyAuthentication ~a\n"
-                 #$(if (openssh-configuration-public-key-authentication? config)
-                       "yes" "no"))
-         (format port "X11Forwarding ~a\n"
-                 #$(if (openssh-configuration-x11-forwarding? config)
-                       "yes" "no"))
-         (format port "PidFile ~a\n"
-                 #$(openssh-configuration-pid-file config))
-         (format port "ChallengeResponseAuthentication ~a\n"
-                 #$(if (openssh-challenge-response-authentication? config)
-                       "yes" "no"))
-         (format port "UsePAM ~a\n"
-                 #$(if (openssh-configuration-use-pam? config)
-                       "yes" "no"))
-         (format port "PrintLastLog ~a\n"
-                 #$(if (openssh-configuration-print-last-log? config)
-                       "yes" "no"))
-         #t))))
+   #~(begin
+       (use-modules (ice-9 match))
+       (call-with-output-file #$output
+         (lambda (port)
+           (display "# Generated by 'openssh-service'.\n" port)
+           (format port "Port ~a\n"
+                   #$(number->string
+                      (openssh-configuration-port-number config)))
+           (format port "PermitRootLogin ~a\n"
+                   #$(match (openssh-configuration-permit-root-login config)
+                       (#t "yes")
+                       (#f "no")
+                       ('without-password "without-password")))
+           (format port "PermitEmptyPasswords ~a\n"
+                   #$(if (openssh-configuration-allow-empty-passwords? config)
+                         "yes" "no"))
+           (format port "PasswordAuthentication ~a\n"
+                   #$(if (openssh-configuration-password-authentication? config)
+                         "yes" "no"))
+           (format port "PubkeyAuthentication ~a\n"
+                   #$(if (openssh-configuration-public-key-authentication?
+                          config)
+                         "yes" "no"))
+           (format port "X11Forwarding ~a\n"
+                   #$(if (openssh-configuration-x11-forwarding? config)
+                         "yes" "no"))
+           (format port "PidFile ~a\n"
+                   #$(openssh-configuration-pid-file config))
+           (format port "ChallengeResponseAuthentication ~a\n"
+                   #$(if (openssh-challenge-response-authentication? config)
+                         "yes" "no"))
+           (format port "UsePAM ~a\n"
+                   #$(if (openssh-configuration-use-pam? config)
+                         "yes" "no"))
+           (format port "PrintLastLog ~a\n"
+                   #$(if (openssh-configuration-print-last-log? config)
+                         "yes" "no"))
+           (for-each
+            (match-lambda
+              ((name command) (format port "Subsystem\t~a\t~a\n" name command)))
+            '#$(openssh-configuration-subsystems config))
+           #t)))))
 
 (define (openssh-shepherd-service config)
   "Return a <shepherd-service> for openssh with CONFIG."