05/08: home: services: ssh: Add 'add-keys-to-agent' field.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit f19e1b4f963564393bc6ccdb01e682d9cc889981
Author: Nicolas Graves <ngraves@ngraves.fr>
AuthorDate: Mon Jun 5 14:34:45 2023 +0200

    home: services: ssh: Add 'add-keys-to-agent' field.
    
    * gnu/home/services/ssh.scm 
(<home-openssh-configuration>)[add-keys-to-agent]:
    New field.
    (serialize-add-keys-to-agent): New procedure.
    (openssh-configuration->string): Use it.
    * doc/guix.texi (Secure Shell): Document it.
    
    Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 doc/guix.texi             | 14 ++++++++++++++
 gnu/home/services/ssh.scm | 49 ++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 54 insertions(+), 9 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index e6bff33a37..a71751142b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -43076,6 +43076,20 @@ Concretely, these files are concatenated and made 
available as
 running on this machine, then it @emph{may} take this file into account:
 this is what @command{sshd} does by default, but be aware that it can
 also be configured to ignore it.
+
+@item @code{add-keys-to-agent} (default: @code{``no''})
+This string specifies whether keys should be automatically added to a
+running ssh-agent.  If this option is set to @code{``yes''} and a key is
+loaded from a file, the key and its passphrase are added to the agent
+with the default lifetime, as if by @code{ssh-add}.  If this option is
+set to @code{``ask''}, @code{ssh} will require confirmation.  If this
+option is set to @code{``confirm''}, each use of the key must be
+confirmed.  If this option is set to @code{``no''}, no keys are added to
+the agent.  Alternately, this option may be specified as a time interval
+to specify the key's lifetime in @code{ssh-agent}, after which it will
+automatically be removed.  The argument must be @code{``no''},
+@code{``yes''}, @code{``confirm''} (optionally followed by a time
+interval), @code{``ask''} or a time interval.
 @end table
 @end deftp
 
diff --git a/gnu/home/services/ssh.scm b/gnu/home/services/ssh.scm
index 628dc743ae..c2c008f01c 100644
--- a/gnu/home/services/ssh.scm
+++ b/gnu/home/services/ssh.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2023 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,10 +39,12 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
+  #:autoload   (ice-9 regex) (string-match match:substring)
   #:export (home-openssh-configuration
             home-openssh-configuration-authorized-keys
             home-openssh-configuration-known-hosts
             home-openssh-configuration-hosts
+            home-openssh-configuration-add-keys-to-agent
             home-ssh-agent-configuration
 
             openssh-host
@@ -248,17 +251,45 @@ through before connecting to the server.")
 (define-record-type* <home-openssh-configuration>
   home-openssh-configuration make-home-openssh-configuration
   home-openssh-configuration?
-  (authorized-keys home-openssh-configuration-authorized-keys ;list of 
file-like
-                   (default #f))
-  (known-hosts     home-openssh-configuration-known-hosts ;unspec | list of 
file-like
-                   (default *unspecified*))
-  (hosts           home-openssh-configuration-hosts   ;list of <openssh-host>
-                   (default '())))
+  (authorized-keys   home-openssh-configuration-authorized-keys ;list of 
file-like
+                     (default #f))
+  (known-hosts       home-openssh-configuration-known-hosts ;unspec | list of 
file-like
+                     (default *unspecified*))
+  (hosts             home-openssh-configuration-hosts   ;list of <openssh-host>
+                     (default '()))
+  (add-keys-to-agent home-openssh-configuration-add-keys-to-agent ;string with 
limited values
+                     (default "no")))
+
+(define (serialize-add-keys-to-agent value)
+  (define (valid-time-string? str)
+    (and (> (string-length str) 0)
+         (equal?
+          str
+          (match:substring
+           (string-match "\
+[0-9]+|([0-9]+[Ww])?([0-9]+[Dd])?([0-9]+[Hh])?([0-9]+[Mm])?([0-9]+[Ss])?"
+                         str)))))
+
+  (string-append "AddKeysToAgent "
+                 (cond ((member value '("yes" "no" "confirm" "ask")) value)
+                       ((valid-time-string? value) value)
+                       ((and (string-prefix? "confirm" value)
+                             (valid-time-string?
+                              (cdr (string-split value #\ )))) value)
+                       ;; The 'else' branch is unreachable.
+                       (else
+                        (raise
+                         (formatted-message
+                          (G_ "~s: invalid 'add-keys-to-agent' value")
+                          value))))))
 
 (define (openssh-configuration->string config)
-  (string-join (map serialize-openssh-host
-                    (home-openssh-configuration-hosts config))
-               "\n"))
+  (string-join
+   (cons* (serialize-add-keys-to-agent
+           (home-openssh-configuration-add-keys-to-agent config))
+          (map serialize-openssh-host
+               (home-openssh-configuration-hosts config)))
+   "\n"))
 
 (define* (file-join name files #:optional (delimiter " "))
   "Return a file in the store called @var{name} that is the concatenation