diff mbox series

[bug#62461,1/3] gnu: home-openssh-configuration: Add field add-keys-to-agent.

Message ID 20230326140706.32412-1-ngraves@ngraves.fr
State New
Headers show
Series [bug#62461,1/3] gnu: home-openssh-configuration: Add field add-keys-to-agent. | expand

Commit Message

Nicolas Graves March 26, 2023, 2:07 p.m. UTC 
---
 gnu/home/services/ssh.scm | 44 +++++++++++++++++++++++++++++++--------
 1 file changed, 35 insertions(+), 9 deletions(-)

Comments

Ludovic Courtès April 1, 2023, 7:45 a.m. UTC | #1 
Hi Nicolas,

Nice work!

Nicolas Graves <ngraves@ngraves.fr> skribis:

> ---
>  gnu/home/services/ssh.scm | 44 +++++++++++++++++++++++++++++++--------
>  1 file changed, 35 insertions(+), 9 deletions(-)

Bonus point if you add a ChangeLog-style commit log.  :-)

> +(define (serialize-add-keys-to-agent value)
> +  (define (is-valid-time-string? str)
> +    (and (> (string-length str) 0)
> +         (eq?
> +          (cdr (vector-ref
> +                (string-match "\
> +[0-9]+|([0-9]+[Ww])?([0-9]+[Dd])?([0-9]+[Hh])?([0-9]+[Mm])?([0-9]+[Ss])?" str)
> +                1))
> +          (string-length str))))

In general please use ‘match’ instead of car/cdr/cadddr (info "(guix)
Data Types and Pattern Matching").

That said, the result of ‘string-match’ is meant to be accessed with
‘match:substring’, not with ‘vector-ref’ (info "(guile) Match
Structures").

Nitpick: you can remove ‘is-’ from the name.

> +  (string-append "AddKeysToAgent "
> +                 (cond ((member value '("yes" "no" "confirm" "ask")) value)
> +                       ((is-valid-time-string? value) value)
> +                       ((and (string-prefix? "confirm" value)
> +                             (is-valid-time-string?
> +                              (cdr (string-split value #\ )))) value)
> +                       ;; The 'else' branch is unreachable.
> +                       (else (raise (condition (&error)))))))

I guess the ‘else’ branch is reachable if one uses the wrong value?
Should it instead be:

  (raise (formatted-message (G_ "~s: invalid 'add-keys-to-agent' value")
                            value))

?

Ludo’.
diff mbox series

Patch

diff --git a/gnu/home/services/ssh.scm b/gnu/home/services/ssh.scm
index 01917a29cd..4ab2adb292 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.
 ;;;
@@ -39,6 +40,7 @@  (define-module (gnu home services ssh)
             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
@@ -185,17 +187,41 @@  (define (openssh-host-name-field? field)
 (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 '()))
-  (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 '()))
+  (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 (is-valid-time-string? str)
+    (and (> (string-length str) 0)
+         (eq?
+          (cdr (vector-ref
+                (string-match "\
+[0-9]+|([0-9]+[Ww])?([0-9]+[Dd])?([0-9]+[Hh])?([0-9]+[Mm])?([0-9]+[Ss])?" str)
+                1))
+          (string-length str))))
+
+  (string-append "AddKeysToAgent "
+                 (cond ((member value '("yes" "no" "confirm" "ask")) value)
+                       ((is-valid-time-string? value) value)
+                       ((and (string-prefix? "confirm" value)
+                             (is-valid-time-string?
+                              (cdr (string-split value #\ )))) value)
+                       ;; The 'else' branch is unreachable.
+                       (else (raise (condition (&error)))))))
 
 (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