gnu: libnma: Depend on GTK 4.x only on supported platforms.

[jackhill/guix/guix.git] / gnu / services / ssh.scm

diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index 97f74a0..72e7183 100644 (file)
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2019, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
@@ -292,6 +292,9 @@ The other options should be self-descriptive."
   ;; integer
   (port-number           openssh-configuration-port-number
                          (default 22))
+  ;; integer
+  (max-connections       openssh-configuration-max-connections
+                         (default 200))
   ;; Boolean | 'prohibit-password
   (permit-root-login     openssh-configuration-permit-root-login
                          (default #f))
@@ -348,9 +351,13 @@ The other options should be self-descriptive."
                          (default ""))
 
   ;; list of user-name/file-like tuples
-  (authorized-keys       openssh-authorized-keys
+  (authorized-keys       openssh-configuration-authorized-keys
                          (default '()))
 
+  ;; Boolean
+  (generate-host-keys?   openssh-configuration-generate-host-keys?
+                         (default #t))
+
   ;; Boolean
   ;; XXX: This should really be handled in an orthogonal way, for instance as
   ;; proposed in <https://bugs.gnu.org/27155>.  Keep it internal/undocumented
@@ -387,12 +394,12 @@ The other options should be self-descriptive."
         ;; authorized-key directory to /etc.
         (catch 'system-error
           (lambda ()
-            (delete-file-recursively "/etc/authorized_keys.d"))
+            (delete-file-recursively "/etc/ssh/authorized_keys.d"))
           (lambda args
             (unless (= ENOENT (system-error-errno args))
               (apply throw args))))
         (copy-recursively #$(authorized-key-directory
-                             (openssh-authorized-keys config))
+                             (openssh-configuration-authorized-keys config))
                           "/etc/ssh/authorized_keys.d")
 
         (chmod "/etc/ssh/authorized_keys.d" #o555)
@@ -402,9 +409,10 @@ The other options should be self-descriptive."
             (unless (file-exists? lastlog)
               (touch lastlog))))
 
-        ;; Generate missing host keys.
-        (system* (string-append #$(openssh-configuration-openssh config)
-                                "/bin/ssh-keygen") "-A"))))
+        (when #$(openssh-configuration-generate-host-keys? config)
+          ;; Generate missing host keys.
+          (system* (string-append #$(openssh-configuration-openssh config)
+                                  "/bin/ssh-keygen") "-A")))))
 
 (define (authorized-key-directory keys)
   "Return a directory containing the authorized keys specified in KEYS, a list
@@ -510,17 +518,56 @@ of user-name/file-like tuples."
   (define pid-file
     (openssh-configuration-pid-file config))
 
+  (define port-number
+    (openssh-configuration-port-number config))
+
+  (define max-connections
+    (openssh-configuration-max-connections config))
+
   (define openssh-command
     #~(list (string-append #$(openssh-configuration-openssh config) "/sbin/sshd")
             "-D" "-f" #$(openssh-config-file config)))
 
+  (define inetd-style?
+    ;; Whether to use 'make-inetd-constructor'.  That procedure appeared in
+    ;; Shepherd 0.9.0, but in 0.9.0, 'make-inetd-constructor' wouldn't let us
+    ;; pass a list of endpoints, and it wouldn't let us define a service
+    ;; listening on both IPv4 and IPv6, hence the conditional below.
+    #~(and (defined? 'make-inetd-constructor)
+           (not (string=? (@ (shepherd config) Version) "0.9.0"))))
+
+  (define ipv6-support?
+    ;; Expression that returns true if IPv6 support is available.
+    #~(catch 'system-error
+        (lambda ()
+          (let ((sock (socket AF_INET6 SOCK_STREAM 0)))
+            (close-port sock)
+            #t))
+        (const #f)))
+
   (list (shepherd-service
          (documentation "OpenSSH server.")
          (requirement '(syslogd loopback))
          (provision '(ssh-daemon ssh sshd))
-         (start #~(make-forkexec-constructor #$openssh-command
-                                             #:pid-file #$pid-file))
-         (stop #~(make-kill-destructor))
+
+         (start #~(if #$inetd-style?
+                      (make-inetd-constructor
+                       (append #$openssh-command '("-i"))
+                       (cons (endpoint
+                              (make-socket-address AF_INET INADDR_ANY
+                                                   #$port-number))
+                             (if #$ipv6-support?
+                                 (list
+                                  (endpoint
+                                   (make-socket-address AF_INET6 IN6ADDR_ANY
+                                                        #$port-number)))
+                                 '()))
+                       #:max-connections #$max-connections)
+                      (make-forkexec-constructor #$openssh-command
+                                                 #:pid-file #$pid-file)))
+         (stop #~(if #$inetd-style?
+                     (make-inetd-destructor)
+                     (make-kill-destructor)))
          (auto-start? (openssh-auto-start? config)))))
 
 (define (openssh-pam-services config)
@@ -536,10 +583,10 @@ of user-name/file-like tuples."
   (openssh-configuration
    (inherit config)
    (authorized-keys
-    (match (openssh-authorized-keys config)
-      (((users _ ...) ...)
+    (match (append (openssh-configuration-authorized-keys config) keys)
+      ((and alist ((users _ ...) ...))
        ;; Build a user/key-list mapping.
-       (let ((user-keys (alist->vhash (openssh-authorized-keys config))))
+       (let ((user-keys (alist->vhash alist)))
          ;; Coalesce the key lists associated with each user.
          (map (lambda (user)
                 `(,user