features: ssh: Rely on Guix ssh configuration. v1 PROPOSED

Nicolas Graves: 1
 features: ssh: Rely on Guix ssh configuration.

 5 files changed, 55 insertions(+), 367 deletions(-)
Export patchset (mbox)
How do I use this?

Copy & paste the following snippet into your terminal to import this patchset into git:

curl -s https://lists.sr.ht/~abcdw/rde-devel/patches/40004/mbox | git am -3
Learn more about email & git

[PATCH] features: ssh: Rely on Guix ssh configuration. Export this patch

 examples/src/abcdw/configs.scm              |  51 ++--
 src/gnu/home-services/ssh.scm               | 291 --------------------
 src/gnu/home/examples/home-environment.tmpl |   4 +-
 src/gnu/home/examples/minimal.tmpl          |  13 +-
 src/rde/features/ssh.scm                    |  63 ++---
 5 files changed, 55 insertions(+), 367 deletions(-)
 delete mode 100644 src/gnu/home-services/ssh.scm

diff --git a/examples/src/abcdw/configs.scm b/examples/src/abcdw/configs.scm
index 6c86b06e..f655344c 100644
--- a/examples/src/abcdw/configs.scm
+++ b/examples/src/abcdw/configs.scm
@@ -26,7 +26,7 @@
  #:use-module (rde home services emacs)
  #:use-module (rde home services wm)

  #:use-module (gnu home-services ssh)
  #:use-module (gnu home services ssh)

  #:use-module (gnu packages)
  #:use-module (rde packages)
@@ -179,36 +179,35 @@
(define ssh-extra-config-service
        (host-name "*")
        (host-key-algorithms "+ssh-rsa")
        (accepted-key-types "+ssh-rsa"))
        (host "pinky-ygg")
        (host-name "200:554d:3eb1:5bc5:6d7b:42f4:8792:efb8")
        (port 50621)
        (compression? #t)
         '((control-master . "auto")
           (control-path . "~/.ssh/master-%r@%h:%p"))))
        (host "pinky")
        (host-name "")
        (port 50621)
        (compression? #t)))
      ;; TODO: Move it feature-qemu?
      (map (lambda (id)
              (host (format #f "qemu~a" id))
               `((host-name . "localhost")
                 (port . ,(+ 10020 id))))))
           (iota 4))
        (host "pinky-ygg")
         '((host-name . "200:554d:3eb1:5bc5:6d7b:42f4:8792:efb8")
           (port . 50621)
           (control-master . "auto")
           (control-path . "~/.ssh/master-%r@%h:%p")
           (compression . #t))))
        (host "pinky")
         '((host-name . "")
           (port . 50621)
           (compression . #t)))))))
     '((host-key-algorithms . "+ssh-rsa")
       (pubkey-accepted-key-types . "+ssh-rsa"))))))
              (host-name "localhost")
              (port ,(+ 10020 id))))
           (iota 4))))))))

;;; User-specific features with personal preferences
diff --git a/src/gnu/home-services/ssh.scm b/src/gnu/home-services/ssh.scm
deleted file mode 100644
index 357a4c7f..00000000
--- a/src/gnu/home-services/ssh.scm
@@ -1,291 +0,0 @@
(define-module (gnu home-services ssh)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (ice-9 match)
  #:use-module (gnu home services)
  #:use-module (gnu home-services-utils)
  #:use-module (gnu services configuration)
  #:use-module (gnu packages ssh)
  #:use-module (guix packages)
  #:use-module (guix import utils)
  #:use-module (guix i18n)
  #:use-module (guix diagnostics)
  #:use-module (guix gexp)
  #:use-module (guix monads)
  #:use-module (guix records)

  #:export (home-ssh-service-type

;;; Commentary:
;;; Service to install and configure SSH.
;;; Code:

(define (uglify-field-name field-name)
  "Convert symbol FIELD-NAME to an upper camel case string.
@code{symbol-name} => \"@code{SymbolName}\"."
  (let ((str (symbol->string field-name)))
    (apply string-append (map string-capitalize (string-split str #\-)))))

(define* (serialize-field field-name val #:key (toplevel? #f))
   ((boolean? val) (serialize-boolean field-name val))
   ((list? val) (serialize-list field-name val #:toplevel? toplevel?))
    (let ((field-name (uglify-field-name field-name)))
       ((or (member field-name '("Host" "Match"))
        #~(format #f "\n~a ~a\n" #$field-name #$val))
        #~(format #f "  ~a ~a\n" #$field-name #$val)))))))

(define* (serialize-list field-name val #:key (toplevel? #f))
  (if (null? val)
         #$(if toplevel? "" "  ")
         #$(if field-name (uglify-field-name field-name) "")
         #$@(map (lambda (val)
                   #~(format #f " ~a" #$val))

(define* (serialize-alist field-name val #:key (toplevel? #f))
     #$@(map (match-lambda
            ((field-name . val)
             (serialize-field field-name val #:toplevel? toplevel?)))

(define (serialize-extra-config field-name val)
  (define serialize-extra-config-entry
      ((host name alist)
        (serialize-field host name)
        (serialize-alist #f alist)))))
  #~(string-append #$@(append-map serialize-extra-config-entry val)))

(define (serialize-boolean field-name val)
  (serialize-field field-name (boolean->yes-or-no val)))

(define serialize-string serialize-field)
(define (list-of-ssh-host-or-ssh-match? val)
  (list-of (lambda (val)
            (or (ssh-host? val)
                (ssh-match? val)))))

(define-enum ssh-match-keywords
  '(all canonical final exec host originalhost user localuser))

(define %ssh-standalone-keywords
  '(all canonical final))

(define match-block?
    ((keyword rest ...)
     (ssh-match-keywords? keyword))))

(define-configuration/no-serialization ssh-host
   "A pattern to match one or multiple hosts.")
   "An association list key and value pairs that contain the
configuration options for the host.  This has the same format as the
@code{default-options} field in @code{home-ssh-configuration}."))

(define-configuration/no-serialization ssh-match
   "A list where the first element is one of @code{ssh-match-keywords}
and the rest of the elements are arguments for the keyword.")
   "An association list key and value pairs that contain the
configuration options for the matched hosts.  This has the same format
as the @code{default-options} field in @code{home-ssh-configuration}."))

(define serialize-ssh-host
    (($ <ssh-host> host options _)
      #$(serialize-field 'host host)
      #$(serialize-alist #f options)))))

(define serialize-ssh-match
    (($ <ssh-match> match options _)
           (if (ssh-match-keywords? (car match))
               #~(format #f "~a~a"
                         '#$(car match)
                         #$(serialize-list #f (cdr match) #:toplevel? #t))
               (raise (formatted-message
                       (G_ "Match keyword must be one of the following ~a")
        #$(serialize-alist #f options)))))

(define (serialize-list-of-ssh-host-or-ssh-match field-name val)
         #$@(map (lambda (entry)
                (if (ssh-host? entry)
                    (serialize-ssh-host entry)
                    (serialize-ssh-match entry)))

(define-configuration home-ssh-configuration
    (package openssh)
    "The SSH package to use.")
   (string "*")
   "The name of the default host."
   (lambda (field-name val) (serialize-field 'host val)))
   (list-of-strings '("~/.ssh/known_hosts"))
   "One or more files to use for the user host key database."
   (boolean #f)
   "Whether the connection to the authentication agent will be forwarded
to the remote machine.")
  ;; TODO: Maybe we could add fields for some enums?
  ;; (AddressFamily, FingerprintHash)
    (alist '())
    "Configuration options for the default host.  This should be an
associative list representing a key-value pair.  A configuration like this:

  (host \"*\")
    '((add-keys-to-agent . #t)
      (address-family . \"inet\"))))
@end lisp

would turn into this:

Host *
  AddKeysToAgent yes
  AddressFamily inet
@end example")
   (alist '())
   "Association list of toplevel configuration options.  The configuration below:

    '((include . \"/some/path/to/file\"))))
@end lisp

would this:

Include /some/path/to/file
@end example"
   (lambda (field-name val)
     (serialize-alist field-name val #:toplevel? #t)))
   (list-of-ssh-host-or-ssh-match '())
   "List of configurations for other hosts.  Something like this:

  (list (ssh-host \"savannah\"
                  '((compression . #f)
                    (ciphers . (\"3des-cbc\" \"aes256-ctr\"))
                    (identity-file . \"~/.ssh/keys.d/id_rsa\")
                    (server-alive-count-max . 3)))
        (ssh-match '(exec \"grep key secret.txt\")
                   '((compression . #t))))))
@end lisp

will turn into this:

Host savannah
  Compression no
  Ciphers 3des-cbc aes256-ctr
  IdentityFile ~/.ssh/keys.d/id_rsa
  ServerAliveCountMax 3
Match exec \"grep key secret.txt\"
  Compression yes
@end example"))

(define-configuration home-ssh-extension
    (alist '()) "")
   (alist '())
   (lambda (field-name val)
     (serialize-alist field-name val #:toplevel? #t)))
   (list-of-ssh-host-or-ssh-match '())

(define (add-ssh-configuration config)
     ,(mixed-text-file "ssh-config"

(define (add-ssh-packages config)
  (list (home-ssh-configuration-package config)))

(define (home-ssh-extensions original-config extensions)
  (let ((extensions (reverse extensions)))
     (inherit original-config)
      (append (home-ssh-configuration-default-options original-config)
               home-ssh-extension-default-options extensions)))
      (append (home-ssh-configuration-toplevel-options original-config)
               home-ssh-extension-toplevel-options extensions)))
      (append (home-ssh-configuration-extra-config original-config)
               home-ssh-extension-extra-config extensions))))))

(define home-ssh-service-type
  (service-type (name 'home-ssh)
                 (list (service-extension
                (default-value (home-ssh-configuration))
                (compose identity)
                (extend home-ssh-extensions)
                (description "Install and configure SSH")))

(define (generate-home-ssh-documentation)
      (ssh-host ssh-host)
      (ssh-match ssh-match))
     (ssh-host ,ssh-host-fields)
     (ssh-match ,ssh-match-fields))
diff --git a/src/gnu/home/examples/home-environment.tmpl b/src/gnu/home/examples/home-environment.tmpl
index 2a9678ac..835ca60f 100644
--- a/src/gnu/home/examples/home-environment.tmpl
+++ b/src/gnu/home/examples/home-environment.tmpl
@@ -63,9 +63,9 @@
			  (string-append (getenv "HOME") "/tmp-mcron-test-file")
                        (lambda (port)
                          (display "Mcron service" port)))))))))
     (service home-ssh-service-type
     (service home-openssh-service-type
		 (ssh-host (host "savannah")
			   (options '((compression . #f))))))))
diff --git a/src/gnu/home/examples/minimal.tmpl b/src/gnu/home/examples/minimal.tmpl
index 91fca1c4..99707312 100644
--- a/src/gnu/home/examples/minimal.tmpl
+++ b/src/gnu/home/examples/minimal.tmpl
@@ -2,9 +2,9 @@
(use-modules (gnu home)
	     (gnu home services)
	     (gnu home-services gnupg)
	     (gnu home-services ssh)
	     (gnu home-services version-control)
	     (gnu home services shells)
	     (gnu home services ssh)
	     (gnu home services mcron)
	     (gnu services)
	     (gnu packages)
@@ -28,11 +28,12 @@
     (service home-bash-service-type
	       (guix-defaults? #f)))
     (service home-ssh-service-type
     (service home-openssh-service-type
                 (ssh-host (host "savannah")
			   (options '((compression . #f))))))))))))
                 (openssh-host (name "savannah")
                               (host-name "savannah")
			       (compression? #f))))))))))

diff --git a/src/rde/features/ssh.scm b/src/rde/features/ssh.scm
index 836b0ea2..74298902 100644
--- a/src/rde/features/ssh.scm
+++ b/src/rde/features/ssh.scm
@@ -21,7 +21,7 @@
(define-module (rde features ssh)
  #:use-module (rde features)
  #:use-module (rde features predicates)
  #:use-module (gnu home-services ssh)
  #:use-module (gnu home services ssh)
  #:use-module (gnu home services)
  #:use-module (gnu home services shepherd)
  #:use-module (gnu services)
@@ -31,59 +31,38 @@

  #:export (feature-ssh)

  #:re-export (home-ssh-configuration
  #:re-export (home-openssh-configuration

(define* (feature-ssh
          (ssh openssh)
          (ssh-configuration (home-ssh-configuration))
          (ssh-agent? #f))
          (openssh openssh-sans-x)
          (ssh-configuration (home-openssh-configuration))
          (ssh-agent? #f)
          (ssh-agent-configuration (home-ssh-agent-configuration)))
  "Setup and configure ssh and ssh-agent."
  (ensure-pred file-like? ssh)
  (ensure-pred home-ssh-configuration? ssh-configuration)
  (ensure-pred file-like? openssh)
  (ensure-pred home-openssh-configuration? ssh-configuration)
  (ensure-pred boolean? ssh-agent?)
  (ensure-pred home-ssh-agent-configuration? ssh-agent-configuration)

  (define (ssh-home-services config)
    "Returns home services related to SSH."
     (if ssh-agent?
         (let* ((sock "ssh-agent.sock"))
               (documentation "Run the ssh-agent at startup.")
               (provision '(ssh-agent))
               (requirement '())
                   (list (string-append
                          #$(get-value 'ssh config)
                         "-d" "-a"
                         (string-append (getenv "XDG_RUNTIME_DIR") "/" #$sock))
                   #:log-file (string-append
                               (or (getenv "XDG_LOG_HOME")
                                   (format #f "~a/.local/var/log"
                                           (getenv "HOME")))
               (stop #~(make-kill-destructor)))))
             `(("SSH_AUTH_SOCK" . ,(string-append "$XDG_RUNTIME_DIR/" sock))))))
     (list (service home-ssh-service-type
    (append (list
             (simple-service 'package
                             home-profile-service-type (list openssh))
             (service home-openssh-service-type
            (if ssh-agent?
                (list (service home-ssh-agent-service-type

   (name 'ssh)
   (values `((ssh . ,ssh)
   (values `((openssh . ,openssh)
             ,@(if ssh-agent?
                   '((ssh-agent? . #t))
Hi rde!

This patch tries to rely on the actual (gnu home services ssh) module
and delete the one from RDE. I've done this because I've seen that the
ssh-agent has been implemented here recently, and because I needed to
rework on the feature for my needs anyway. 

There are some patches related sent to Guix, so that this patch can work
here. The patch should not be merged before the ones in guix
upstream. These patches are there: https://issues.guix.gnu.org/62461
This patch introduces breaking changes, twofold :
- users will need to re-implement their call to feature-ssh. Hopefully,
it's not too difficult, you can see changes in this patch in configs.scm
of *.tmpl files (I've made the changes but not tested there
though). Another migration example can be seen here :

- not all ssh options which were possible with RDE are available with
  this implementation, although most configurations should be. 
  To me, it seems fine if all users have the configuration options they
  need (and we should quickly implement other options they need in
  Guix), because reimplementing all options properly (with proper
  configuration tests) might take quite a while.

(PS: A configuration migration tip: Default options and top-level
options regarding hosts can simply be implemented with a
openssh-host-configuration with the name "*".)