[bug#62461] [PATCH 2/3] gnu: openssh-host: Add option match-criteria.

[Nicolas Graves]

---
 gnu/home/services/ssh.scm | 49 ++++++++++++++++++++++++++++++++++-----
 1 file changed, 43 insertions(+), 6 deletions(-)

diff --git a/gnu/home/services/ssh.scm b/gnu/home/services/ssh.scm
index 4ab2adb292..0bd79e4322 100644
--- a/gnu/home/services/ssh.scm
+++ b/gnu/home/services/ssh.scm
@@ -45,6 +45,7 @@ (define-module (gnu home services ssh)
 
             openssh-host
             openssh-host-host-name
+            openssh-host-match-criteria
             openssh-host-identity-file
             openssh-host-name
             openssh-host-port
@@ -116,13 +117,39 @@ (define (serialize-string-list field lst)
 
 (define-maybe string-list)
 
+(define ssh-match-keywords
+  '("canonical" "final" "exec" "host" "originalhost" "user" "localuser"))
+
+(define (match-criteria? str)
+  ;; Rule out the case of "all" keyword.
+  (if (member str '("all"
+                    "canonical all"
+                    "final all"))
+      #t
+      (let* ((first (string-take str (string-index str #\ )))
+             (keyword (if (string-prefix? "!" first)
+                          (string-drop first 1)
+                          first)))
+        (member keyword ssh-match-keywords))))
+
+(define-maybe match-criteria)
+
 (define-configuration openssh-host
   (name
-   (string)
-   "Name of this host declaration.")
+   maybe-string
+   "Name of this host declaration.  A @code{openssh-host} must define only
+@code{name} or @code{match-criteria}.  Use host-name \"*\" for top-level
+options.")
   (host-name
    maybe-string
    "Host name---e.g., @code{\"foo.example.org\"} or @code{\"192.168.1.2\"}.")
+  (match-criteria ;TODO implement stricter match-criteria rules
+   maybe-match-criteria
+   "A string where the first element is all or one of
+@code{ssh-match-keywords}.  The rest of the elements are arguments for the
+keyword, or other criteria.  A @code{openssh-host} must define only
+@code{name} or @code{match-criteria}.  Other host configuration options will
+apply to all hosts matching @code{match-criteria}.")
   (address-family
    maybe-address-family
    "Address family to use when connecting to this host: one of
@@ -171,17 +198,27 @@ (define-configuration openssh-host
 @file{~/.ssh/config}."))
 
 (define (serialize-openssh-host config)
-  (define (openssh-host-name-field? field)
-    (eq? (configuration-field-name field) 'name))
+  (define (openssh-host-name-or-match-field? field)
+    (or (eq? (configuration-field-name field) 'name)
+        (eq? (configuration-field-name field) 'match-criteria)))
 
   (string-append
-   "Host " (openssh-host-name config) "\n"
+   (if (maybe-value-set? (openssh-host-name config))
+       (if (maybe-value-set? (openssh-host-match-criteria config))
+           (error
+            "You must either define name or match-criteria, not both.")
+           (string-append "Host " (openssh-host-name config) "\n"))
+       (if (maybe-value-set? (openssh-host-match-criteria config))
+           (string-append
+            "Match " (string-join (openssh-host-match-criteria config) " ") 
"\n")
+           (error
+            "You must either define name or match-criteria once.")))
    (string-concatenate
     (map (lambda (field)
            ((configuration-field-serializer field)
             (configuration-field-name field)
             ((configuration-field-getter field) config)))
-         (remove openssh-host-name-field?
+         (remove openssh-host-name-or-match-field?
                  openssh-host-fields)))))
 
 (define-record-type* <home-openssh-configuration>
-- 
2.39.2