2 files changed, 96 insertions(+), 19 deletions(-)

M doc/guix.texi
M gnu/services/ssh.scm

@@ 10203,7 10203,10 @@ shell daemon, @command{sshd}.  Its value must be an
 (service openssh-service-type
          (openssh-configuration
            (x11-forwarding? #t)
-           (permit-root-login 'without-password)))
+           (permit-root-login 'without-password)
+           (authorized-keys
+             `(("alice" ,(local-file "alice.pub"))
+               ("bob" ,(local-file "bob.pub"))))))
 @end example
 
 See below for details about @code{openssh-configuration}.


@@ 10278,8 10281,30 @@ server.  Alternately, one can specify the @command{sftp-server} command:
 (service openssh-service-type
          (openssh-configuration
           (subsystems
-           '(("sftp" ,(file-append openssh "/libexec/sftp-server"))))))
+           `(("sftp" ,(file-append openssh "/libexec/sftp-server"))))))
 @end example
+
+@item @code{authorized-keys} (default: @code{'()})
+@cindex authorized keys, SSH
+@cindex SSH authorized keys
+This is the list of authorized keys.  Each element of the list is a user
+name followed by one or more file-like objects that represent SSH public
+keys.  For example:
+
+@example
+(openssh-configuration
+  (authorized-keys
+    `(("rekado" ,(local-file "rekado.pub"))
+      ("chris" ,(local-file "chris.pub"))
+      ("root" ,(local-file "rekado.pub") ,(local-file "chris.pub")))))
+@end example
+
+@noindent
+registers the specified public keys for user accounts @code{rekado},
+@code{chris}, and @code{root}.
+
+Note that this does @emph{not} interfere with the use of
+@file{~/.ssh/authorized_keys}.
 @end table
 @end deftp
 

@@ 28,6 28,7 @@
   #:use-module (gnu system shadow)
   #:use-module (guix gexp)
   #:use-module (guix records)
+  #:use-module (guix modules)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (lsh-configuration


@@ 295,7 296,11 @@ The other options should be self-descriptive."
                          (default #t))
   ;; list of two-element lists
   (subsystems            openssh-configuration-subsystems
-                         (default '(("sftp" "internal-sftp")))))
+                         (default '(("sftp" "internal-sftp"))))
+
+  ;; list of user-name/file-like tuples
+  (authorized-keys       openssh-authorized-keys
+                         (default '())))
 
 (define %openssh-accounts
   (list (user-group (name "sshd") (system? #t))


@@ 309,22 314,64 @@ The other options should be self-descriptive."
 
 (define (openssh-activation config)
   "Return the activation GEXP for CONFIG."
-  #~(begin
-      (use-modules (guix build utils))
-      (mkdir-p "/etc/ssh")
-      (mkdir-p (dirname #$(openssh-configuration-pid-file config)))
-
-      (define (touch file-name)
-        (call-with-output-file file-name (const #t)))
-
-      (let ((lastlog "/var/log/lastlog"))
-        (when #$(openssh-configuration-print-last-log? config)
-          (unless (file-exists? lastlog)
-            (touch lastlog))))
-
-      ;; Generate missing host keys.
-      (system* (string-append #$(openssh-configuration-openssh config)
-                              "/bin/ssh-keygen") "-A")))
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+
+        (define (touch file-name)
+          (call-with-output-file file-name (const #t)))
+
+        ;; Make sure /etc/ssh can be read by the 'sshd' user.
+        (mkdir-p "/etc/ssh")
+        (chmod "/etc/ssh" #o755)
+        (mkdir-p (dirname #$(openssh-configuration-pid-file config)))
+
+        ;; 'sshd' complains if the authorized-key directory and its parents
+        ;; are group-writable, which rules out /gnu/store.  Thus we copy the
+        ;; authorized-key directory to /etc.
+        (catch 'system-error
+          (lambda ()
+            (delete-file-recursively "/etc/authorized_keys.d"))
+          (lambda args
+            (unless (= ENOENT (system-error-errno args))
+              (apply throw args))))
+        (copy-recursively #$(authorized-key-directory
+                             (openssh-authorized-keys config))
+                          "/etc/ssh/authorized_keys.d")
+
+        (chmod "/etc/ssh/authorized_keys.d" #o555)
+
+        (let ((lastlog "/var/log/lastlog"))
+          (when #$(openssh-configuration-print-last-log? config)
+            (unless (file-exists? lastlog)
+              (touch lastlog))))
+
+        ;; 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
+of user-name/file-like tuples."
+  (define build
+    (with-imported-modules (source-module-closure '((guix build utils)))
+      #~(begin
+          (use-modules (ice-9 match) (srfi srfi-26)
+                       (guix build utils))
+
+          (mkdir #$output)
+          (for-each (match-lambda
+                      ((user keys ...)
+                       (let ((file (string-append #$output "/" user)))
+                         (call-with-output-file file
+                           (lambda (port)
+                             (for-each (lambda (key)
+                                         (call-with-input-file key
+                                           (cut dump-port <> port)))
+                                       keys))))))
+                    '#$keys))))
+
+  (computed-file "openssh-authorized-keys" build))
 
 (define (openssh-config-file config)
   "Return the sshd configuration file corresponding to CONFIG."


@@ 367,6 414,11 @@ The other options should be self-descriptive."
            (format port "PrintLastLog ~a\n"
                    #$(if (openssh-configuration-print-last-log? config)
                          "yes" "no"))
+
+           ;; Add '/etc/authorized_keys.d/%u', which we populate.
+           (format port "AuthorizedKeysFile \
+ .ssh/authorized_keys .ssh/authorized_keys2 /etc/ssh/authorized_keys.d/%u\n")
+
            (for-each
             (match-lambda
               ((name command) (format port "Subsystem\t~a\t~a\n" name command)))