~abcdw/rde-devel

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

Nicolas Graves: 3
 features: ssh: Rely on Guix ssh configuration.
 ssh: Rely on Guix ssh configuration.
 rde: ssh: Rely on Guix ssh configuration

 14 files changed, 148 insertions(+), 1081 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
  (simple-service
   'ssh-extra-config
   home-ssh-service-type
   home-openssh-service-type
   (home-ssh-extension
    (extra-config
    (hosts
     (append
      (list
       (openssh-host
        (host-name "*")
        (host-key-algorithms "+ssh-rsa")
        (accepted-key-types "+ssh-rsa"))
       (openssh-host
        (host "pinky-ygg")
        (host-name "200:554d:3eb1:5bc5:6d7b:42f4:8792:efb8")
        (port 50621)
        (compression? #t)
        (options
         '((control-master . "auto")
           (control-path . "~/.ssh/master-%r@%h:%p"))))
       (openssh-host
        (host "pinky")
        (host-name "23.137.249.202")
        (port 50621)
        (compression? #t)))
      ;; TODO: Move it feature-qemu?
      (map (lambda (id)
             (ssh-host
             (openssh-host
              (host (format #f "qemu~a" id))
              (options
               `((host-name . "localhost")
                 (port . ,(+ 10020 id))))))
           (iota 4))
      (list
       (ssh-host
        (host "pinky-ygg")
        (options
         '((host-name . "200:554d:3eb1:5bc5:6d7b:42f4:8792:efb8")
           (port . 50621)
           (control-master . "auto")
           (control-path . "~/.ssh/master-%r@%h:%p")
           (compression . #t))))
       (ssh-host
        (host "pinky")
        (options
         '((host-name . "23.137.249.202")
           (port . 50621)
           (compression . #t)))))))
    (toplevel-options
     '((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
            home-ssh-configuration
            home-ssh-extension
	    home-ssh-configuration?
            ssh-host
            ssh-match))

;;; 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))
  (cond
   ((boolean? val) (serialize-boolean field-name val))
   ((list? val) (serialize-list field-name val #:toplevel? toplevel?))
   (else
    (let ((field-name (uglify-field-name field-name)))
      (cond
       ((or (member field-name '("Host" "Match"))
            toplevel?)
        #~(format #f "\n~a ~a\n" #$field-name #$val))
       (else
        #~(format #f "  ~a ~a\n" #$field-name #$val)))))))

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

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

(define (serialize-extra-config field-name val)
  (define serialize-extra-config-entry
    (match-lambda
      ((host name alist)
       (list
        (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?
  (match-lambda
    ((keyword rest ...)
     (ssh-match-keywords? keyword))))

(define-configuration/no-serialization ssh-host
  (host
   (string)
   "A pattern to match one or multiple hosts.")
  (options
   (alist)
   "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
  (match
   (match-block)
   "A list where the first element is one of @code{ssh-match-keywords}
and the rest of the elements are arguments for the keyword.")
  (options
   (alist)
   "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
  (match-lambda
    (($ <ssh-host> host options _)
     #~(string-append
      #$(serialize-field 'host host)
      #$(serialize-alist #f options)))))

(define serialize-ssh-match
  (match-lambda
    (($ <ssh-match> match options _)
     #~(string-append
        #$(serialize-field
           'match
           (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")
                       ssh-match-keywords))))
        #$(serialize-alist #f options)))))

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

(define-configuration home-ssh-configuration
  (package
    (package openssh)
    "The SSH package to use.")
  (default-host
   (string "*")
   "The name of the default host."
   (lambda (field-name val) (serialize-field 'host val)))
  (user-known-hosts-file
   (list-of-strings '("~/.ssh/known_hosts"))
   "One or more files to use for the user host key database."
   serialize-list)
  (forward-agent
   (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)
  (default-options
    (alist '())
    "Configuration options for the default host.  This should be an
associative list representing a key-value pair.  A configuration like this:

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

would turn into this:

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

@lisp
(home-ssh-configuration
  (toplevel-options
    '((include . \"/some/path/to/file\"))))
@end lisp

would this:

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

@lisp
(home-ssh-configuration
 (extra-config
  (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:

@example
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
  (default-options
    (alist '()) "")
  (toplevel-options
   (alist '())
   ""
   (lambda (field-name val)
     (serialize-alist field-name val #:toplevel? #t)))
  (extra-config
   (list-of-ssh-host-or-ssh-match '())
   ""))

(define (add-ssh-configuration config)
  `((".ssh/config"
     ,(mixed-text-file "ssh-config"
                       (serialize-configuration
                        config
                        home-ssh-configuration-fields)))))

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

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

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

(define (generate-home-ssh-documentation)
  (generate-documentation
   `((home-ssh-configuration
      ,home-ssh-configuration-fields
      (ssh-host ssh-host)
      (ssh-match ssh-match))
     (ssh-host ,ssh-host-fields)
     (ssh-match ,ssh-match-fields))
   'home-ssh-configuration))
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
	      (home-ssh-configuration
	       (extra-config
	       (hosts
		(list
		 (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
	      (home-bash-configuration
	       (guix-defaults? #f)))
     (service home-ssh-service-type
	      (home-ssh-configuration
	       (extra-config
     (service home-openssh-service-type
	      (home-openssh-configuration
	       (hosts
		(list
                 (ssh-host (host "savannah")
			   (options '((compression . #f))))))))))))
                 (openssh-host (name "savannah")
                               (host-name "savannah")
			       (compression? #f))))))))))

sample-he
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
               ssh-host
               ssh-match))
  #:re-export (home-openssh-configuration
               home-ssh-agent-configuration
               openssh-host))


(define* (feature-ssh
          #:key
          (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."
    (append
     (if ssh-agent?
         (let* ((sock "ssh-agent.sock"))
           (list
            (simple-service
             'start-ssh-agent-at-startup
             home-shepherd-service-type
             (list
              (shepherd-service
               (documentation "Run the ssh-agent at startup.")
               (provision '(ssh-agent))
               (requirement '())
               (start
                #~(make-forkexec-constructor
                   (list (string-append
                          #$(get-value 'ssh config)
                          "/bin/ssh-agent")
                         "-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")))
                               "/ssh-agent.log")))
               (stop #~(make-kill-destructor)))))
            (simple-service
             'ssh-auth-socket-env-export
             home-environment-variables-service-type
             `(("SSH_AUTH_SOCK" . ,(string-append "$XDG_RUNTIME_DIR/" sock))))))
         '())
     (list (service home-ssh-service-type
                    ssh-configuration))))
    (append (list
             (simple-service 'package
                             home-profile-service-type (list openssh))
             (service home-openssh-service-type
                      ssh-configuration))
            (if ssh-agent?
                (list (service home-ssh-agent-service-type
                               ssh-agent-configuration))
                '())))

  (feature
   (name 'ssh)
   (values `((ssh . ,ssh)
   (values `((openssh . ,openssh)
             ,@(if ssh-agent?
                   '((ssh-agent? . #t))
                   '())))
-- 
2.39.2

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

---
 examples/src/abcdw/users/abcdw.scm          |  51 ++--
 src/gnu/home-services/ssh.scm               | 291 --------------------
 src/gnu/home/examples/home-environment.tmpl |  13 +-
 src/gnu/home/examples/minimal.tmpl          |  11 +-
 src/rde/features/ssh.scm                    |  64 ++---
 5 files changed, 59 insertions(+), 371 deletions(-)
 delete mode 100644 src/gnu/home-services/ssh.scm

diff --git a/examples/src/abcdw/users/abcdw.scm b/examples/src/abcdw/users/abcdw.scm
index 1c419a97..394aca91 100644
--- a/examples/src/abcdw/users/abcdw.scm
+++ b/examples/src/abcdw/users/abcdw.scm
@@ -3,7 +3,7 @@
  #:use-module (gnu home services shepherd)
  #:use-module (gnu home services xdg)
  #:use-module (gnu home services)
  #:use-module (gnu home-services ssh)
  #:use-module (gnu home services ssh)
  #:use-module (gnu packages)
  #:use-module (gnu services)
  #:use-module (guix channels)
@@ -236,36 +236,35 @@
(define ssh-extra-config-service
  (simple-service
   'ssh-extra-config
   home-ssh-service-type
   home-openssh-service-type
   (home-ssh-extension
    (extra-config
    (hosts
     (append
      (list
       (openssh-host
        (host-name "*")
        (host-key-algorithms "+ssh-rsa")
        (accepted-key-types "+ssh-rsa"))
       (openssh-host
        (host "pinky-ygg")
        (host-name "200:554d:3eb1:5bc5:6d7b:42f4:8792:efb8")
        (port 50621)
        (compression? #t)
        (options
         '((control-master . "auto")
           (control-path . "~/.ssh/master-%r@%h:%p"))))
       (openssh-host
        (host "pinky")
        (host-name "23.137.249.202")
        (port 50621)
        (compression? #t)))
      ;; TODO: Move it feature-qemu?
      (map (lambda (id)
             (ssh-host
             (openssh-host
              (host (format #f "qemu~a" id))
              (options
               `((host-name . "localhost")
                 (port . ,(+ 10020 id))))))
           (iota 4))
      (list
       (ssh-host
        (host "pinky-ygg")
        (options
         '((host-name . "200:554d:3eb1:5bc5:6d7b:42f4:8792:efb8")
           (port . 50621)
           (control-master . "auto")
           (control-path . "~/.ssh/master-%r@%h:%p")
           (compression . #t))))
       (ssh-host
        (host "pinky")
        (options
         '((host-name . "23.137.249.202")
           (port . 50621)
           (compression . #t)))))))
    (toplevel-options
     '((host-key-algorithms . "+ssh-rsa")
       (pubkey-accepted-key-types . "+ssh-rsa"))))))
              (host-name "localhost")
              (port ,(+ 10020 id))))
           (iota 4)))))))

(define (feature-additional-services)
  (feature-custom-services
diff --git a/src/gnu/home-services/ssh.scm b/src/gnu/home-services/ssh.scm
deleted file mode 100644
index 9c203921..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
            home-ssh-configuration
            home-ssh-extension
	    home-ssh-configuration?
            ssh-host
            ssh-match))

;;; 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))
  (cond
   ((boolean? val) (serialize-boolean field-name val))
   ((list? val) (serialize-list field-name val #:toplevel? toplevel?))
   (else
    (let ((field-name (uglify-field-name field-name)))
      (cond
       ((or (member field-name '("Host" "Match"))
            toplevel?)
        #~(format #f "\n~a ~a\n" #$field-name #$val))
       (else
        #~(format #f "  ~a ~a\n" #$field-name #$val)))))))

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

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

(define (serialize-extra-config field-name val)
  (define serialize-extra-config-entry
    (match-lambda
      ((host name alist)
       (list
        (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?
  (match-lambda
    ((keyword rest ...)
     (ssh-match-keywords? keyword))))

(define-configuration/no-serialization ssh-host
  (host
   (string)
   "A pattern to match one or multiple hosts.")
  (options
   (alist)
   "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
  (match
   (match-block)
   "A list where the first element is one of @code{ssh-match-keywords}
and the rest of the elements are arguments for the keyword.")
  (options
   (alist)
   "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
  (match-lambda
    (($ <ssh-host> host options _)
     #~(string-append
      #$(serialize-field 'host host)
      #$(serialize-alist #f options)))))

(define serialize-ssh-match
  (match-lambda
    (($ <ssh-match> match options _)
     #~(string-append
        #$(serialize-field
           'match
           (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")
                       ssh-match-keywords))))
        #$(serialize-alist #f options)))))

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

(define-configuration home-ssh-configuration
  (package
    (package openssh)
    "The SSH package to use.")
  (default-host
   (string "*")
   "The name of the default host."
   (serializer (lambda (field-name val) (serialize-field 'host val))))
  (user-known-hosts-file
   (list-of-strings '("~/.ssh/known_hosts"))
   "One or more files to use for the user host key database."
   (serializer serialize-list))
  (forward-agent
   (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)
  (default-options
    (alist '())
    "Configuration options for the default host.  This should be an
associative list representing a key-value pair.  A configuration like this:

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

would turn into this:

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

@lisp
(home-ssh-configuration
  (toplevel-options
    '((include . \"/some/path/to/file\"))))
@end lisp

would this:

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

@lisp
(home-ssh-configuration
 (extra-config
  (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:

@example
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
  (default-options
    (alist '()) "")
  (toplevel-options
   (alist '())
   ""
   (serializer (lambda (field-name val)
                 (serialize-alist field-name val #:toplevel? #t))))
  (extra-config
   (list-of-ssh-host-or-ssh-match '())
   ""))

(define (add-ssh-configuration config)
  `((".ssh/config"
     ,(mixed-text-file "ssh-config"
                       (serialize-configuration
                        config
                        home-ssh-configuration-fields)))))

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

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

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

(define (generate-home-ssh-documentation)
  (generate-documentation
   `((home-ssh-configuration
      ,home-ssh-configuration-fields
      (ssh-host ssh-host)
      (ssh-match ssh-match))
     (ssh-host ,ssh-host-fields)
     (ssh-match ,ssh-match-fields))
   'home-ssh-configuration))
diff --git a/src/gnu/home/examples/home-environment.tmpl b/src/gnu/home/examples/home-environment.tmpl
index 2a9678ac..be1db8e5 100644
--- a/src/gnu/home/examples/home-environment.tmpl
+++ b/src/gnu/home/examples/home-environment.tmpl
@@ -3,10 +3,10 @@
	     (gnu home services)
	     (gnu home-services gnupg)
	     (gnu home-services keyboard)
	     (gnu home-services ssh)
	     (gnu home-services version-control)
	     (gnu home-services state)
	     (gnu home services mcron)
	     (gnu home services ssh)
	     (gnu services)
	     (gnu packages)
	     (gnu packages linux)
@@ -63,12 +63,13 @@
			  (string-append (getenv "HOME") "/tmp-mcron-test-file")
                        (lambda (port)
                          (display "Mcron service" port)))))))))
     (service home-ssh-service-type
	      (home-ssh-configuration
	       (extra-config
     (service home-openssh-service-type
	      (home-openssh-configuration
	       (hosts
		(list
		 (ssh-host (host "savannah")
			   (options '((compression . #f))))))))
		 (openssh-host (name "savannah")
                               (host-name "savannah")
                               (compression? #f))))))
     (service home-gnupg-service-type
	      (home-gnupg-configuration
	       (gpg-agent-config
diff --git a/src/gnu/home/examples/minimal.tmpl b/src/gnu/home/examples/minimal.tmpl
index 91fca1c4..f18b534d 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
	      (home-bash-configuration
	       (guix-defaults? #f)))
     (service home-ssh-service-type
     (service home-openssh-service-type
	      (home-ssh-configuration
	       (extra-config
	       (hosts
		(list
                 (ssh-host (host "savannah")
			   (options '((compression . #f))))))))))))
                 (ssh-host (name "savannah")
                           (host-name "savannah")
                           (compression? #f))))))))))

sample-he
diff --git a/src/rde/features/ssh.scm b/src/rde/features/ssh.scm
index 836b0ea2..6e014511 100644
--- a/src/rde/features/ssh.scm
+++ b/src/rde/features/ssh.scm
@@ -21,9 +21,9 @@
(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)
  #:use-module (gnu home services shepherd)
  #:use-module (gnu home services ssh)
  #:use-module (gnu services)
  #:use-module (gnu packages)
  #:use-module (gnu packages ssh)
@@ -31,59 +31,37 @@

  #:export (feature-ssh)

  #:re-export (home-ssh-configuration
               ssh-host
               ssh-match))

  #:re-export (home-openssh-configuration
               home-ssh-agent-configuration
               openssh-host))

(define* (feature-ssh
          #:key
          (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."
    (append
     (if ssh-agent?
         (let* ((sock "ssh-agent.sock"))
           (list
            (simple-service
             'start-ssh-agent-at-startup
             home-shepherd-service-type
             (list
              (shepherd-service
               (documentation "Run the ssh-agent at startup.")
               (provision '(ssh-agent))
               (requirement '())
               (start
                #~(make-forkexec-constructor
                   (list (string-append
                          #$(get-value 'ssh config)
                          "/bin/ssh-agent")
                         "-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")))
                               "/ssh-agent.log")))
               (stop #~(make-kill-destructor)))))
            (simple-service
             'ssh-auth-socket-env-export
             home-environment-variables-service-type
             `(("SSH_AUTH_SOCK" . ,(string-append "$XDG_RUNTIME_DIR/" sock))))))
         '())
     (list (service home-ssh-service-type
                    ssh-configuration))))
    (append (list
             (simple-service 'package
                             home-profile-service-type (list openssh))
             (service home-openssh-service-type
                      ssh-configuration))
            (if ssh-agent?
                (list (service home-ssh-agent-service-type
                               ssh-agent-configuration))
                '())))

  (feature
   (name 'ssh)
   (values `((ssh . ,ssh)
   (values `((openssh . ,openssh)
             ,@(if ssh-agent?
                   '((ssh-agent? . #t))
                   '())))
-- 
2.40.1

[PATCH v3] rde: ssh: Rely on Guix ssh configuration Export this patch

---
 src/gnu/home-services/ssh.scm               | 291 --------------------
 src/gnu/home/examples/home-environment.tmpl |  13 +-
 src/gnu/home/examples/minimal.tmpl          |  11 +-
 src/rde/features/ssh.scm                    |  62 ++---
 4 files changed, 34 insertions(+), 343 deletions(-)
 delete mode 100644 src/gnu/home-services/ssh.scm

diff --git a/src/gnu/home-services/ssh.scm b/src/gnu/home-services/ssh.scm
deleted file mode 100644
index 9c203921..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
            home-ssh-configuration
            home-ssh-extension
	    home-ssh-configuration?
            ssh-host
            ssh-match))

;;; 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))
  (cond
   ((boolean? val) (serialize-boolean field-name val))
   ((list? val) (serialize-list field-name val #:toplevel? toplevel?))
   (else
    (let ((field-name (uglify-field-name field-name)))
      (cond
       ((or (member field-name '("Host" "Match"))
            toplevel?)
        #~(format #f "\n~a ~a\n" #$field-name #$val))
       (else
        #~(format #f "  ~a ~a\n" #$field-name #$val)))))))

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

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

(define (serialize-extra-config field-name val)
  (define serialize-extra-config-entry
    (match-lambda
      ((host name alist)
       (list
        (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?
  (match-lambda
    ((keyword rest ...)
     (ssh-match-keywords? keyword))))

(define-configuration/no-serialization ssh-host
  (host
   (string)
   "A pattern to match one or multiple hosts.")
  (options
   (alist)
   "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
  (match
   (match-block)
   "A list where the first element is one of @code{ssh-match-keywords}
and the rest of the elements are arguments for the keyword.")
  (options
   (alist)
   "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
  (match-lambda
    (($ <ssh-host> host options _)
     #~(string-append
      #$(serialize-field 'host host)
      #$(serialize-alist #f options)))))

(define serialize-ssh-match
  (match-lambda
    (($ <ssh-match> match options _)
     #~(string-append
        #$(serialize-field
           'match
           (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")
                       ssh-match-keywords))))
        #$(serialize-alist #f options)))))

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

(define-configuration home-ssh-configuration
  (package
    (package openssh)
    "The SSH package to use.")
  (default-host
   (string "*")
   "The name of the default host."
   (serializer (lambda (field-name val) (serialize-field 'host val))))
  (user-known-hosts-file
   (list-of-strings '("~/.ssh/known_hosts"))
   "One or more files to use for the user host key database."
   (serializer serialize-list))
  (forward-agent
   (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)
  (default-options
    (alist '())
    "Configuration options for the default host.  This should be an
associative list representing a key-value pair.  A configuration like this:

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

would turn into this:

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

@lisp
(home-ssh-configuration
  (toplevel-options
    '((include . \"/some/path/to/file\"))))
@end lisp

would this:

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

@lisp
(home-ssh-configuration
 (extra-config
  (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:

@example
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
  (default-options
    (alist '()) "")
  (toplevel-options
   (alist '())
   ""
   (serializer (lambda (field-name val)
                 (serialize-alist field-name val #:toplevel? #t))))
  (extra-config
   (list-of-ssh-host-or-ssh-match '())
   ""))

(define (add-ssh-configuration config)
  `((".ssh/config"
     ,(mixed-text-file "ssh-config"
                       (serialize-configuration
                        config
                        home-ssh-configuration-fields)))))

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

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

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

(define (generate-home-ssh-documentation)
  (generate-documentation
   `((home-ssh-configuration
      ,home-ssh-configuration-fields
      (ssh-host ssh-host)
      (ssh-match ssh-match))
     (ssh-host ,ssh-host-fields)
     (ssh-match ,ssh-match-fields))
   'home-ssh-configuration))
diff --git a/src/gnu/home/examples/home-environment.tmpl b/src/gnu/home/examples/home-environment.tmpl
index 2a9678ac..be1db8e5 100644
--- a/src/gnu/home/examples/home-environment.tmpl
+++ b/src/gnu/home/examples/home-environment.tmpl
@@ -3,10 +3,10 @@
	     (gnu home services)
	     (gnu home-services gnupg)
	     (gnu home-services keyboard)
	     (gnu home-services ssh)
	     (gnu home-services version-control)
	     (gnu home-services state)
	     (gnu home services mcron)
	     (gnu home services ssh)
	     (gnu services)
	     (gnu packages)
	     (gnu packages linux)
@@ -63,12 +63,13 @@
			  (string-append (getenv "HOME") "/tmp-mcron-test-file")
                        (lambda (port)
                          (display "Mcron service" port)))))))))
     (service home-ssh-service-type
	      (home-ssh-configuration
	       (extra-config
     (service home-openssh-service-type
	      (home-openssh-configuration
	       (hosts
		(list
		 (ssh-host (host "savannah")
			   (options '((compression . #f))))))))
		 (openssh-host (name "savannah")
                               (host-name "savannah")
                               (compression? #f))))))
     (service home-gnupg-service-type
	      (home-gnupg-configuration
	       (gpg-agent-config
diff --git a/src/gnu/home/examples/minimal.tmpl b/src/gnu/home/examples/minimal.tmpl
index 91fca1c4..f18b534d 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
	      (home-bash-configuration
	       (guix-defaults? #f)))
     (service home-ssh-service-type
     (service home-openssh-service-type
	      (home-ssh-configuration
	       (extra-config
	       (hosts
		(list
                 (ssh-host (host "savannah")
			   (options '((compression . #f))))))))))))
                 (ssh-host (name "savannah")
                           (host-name "savannah")
                           (compression? #f))))))))))

sample-he
diff --git a/src/rde/features/ssh.scm b/src/rde/features/ssh.scm
index be38d2ff..6e014511 100644
--- a/src/rde/features/ssh.scm
+++ b/src/rde/features/ssh.scm
@@ -21,9 +21,9 @@
(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)
  #:use-module (gnu home services shepherd)
  #:use-module (gnu home services ssh)
  #:use-module (gnu services)
  #:use-module (gnu packages)
  #:use-module (gnu packages ssh)
@@ -31,57 +31,37 @@

  #:export (feature-ssh)

  #:re-export (home-ssh-configuration
               ssh-host
               ssh-match))

  #:re-export (home-openssh-configuration
               home-ssh-agent-configuration
               openssh-host))

(define* (feature-ssh
          #:key
          (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."
    (append
     (if ssh-agent?
         (let* ((sock "ssh-agent.sock"))
           (list
            (simple-service
             'start-ssh-agent-at-startup
             home-shepherd-service-type
             (list
              (shepherd-service
               (documentation "Run the ssh-agent at startup.")
               (provision '(ssh-agent))
               (requirement '())
               (start
                #~(make-forkexec-constructor
                   (list (string-append
                          #$(get-value 'ssh config)
                          "/bin/ssh-agent")
                         "-d" "-a"
                         (string-append (getenv "XDG_RUNTIME_DIR") "/" #$sock))
                   #:log-file (string-append
                               (getenv "XDG_STATE_HOME") "/log"
                               "/ssh-agent.log")))
               (stop #~(make-kill-destructor)))))
            (simple-service
             'ssh-auth-socket-env-export
             home-environment-variables-service-type
             `(("SSH_AUTH_SOCK" . ,(string-append "$XDG_RUNTIME_DIR/" sock))))))
         '())
     (list (service home-ssh-service-type
                    ssh-configuration))))
    (append (list
             (simple-service 'package
                             home-profile-service-type (list openssh))
             (service home-openssh-service-type
                      ssh-configuration))
            (if ssh-agent?
                (list (service home-ssh-agent-service-type
                               ssh-agent-configuration))
                '())))

  (feature
   (name 'ssh)
   (values `((ssh . ,ssh)
   (values `((openssh . ,openssh)
             ,@(if ssh-agent?
                   '((ssh-agent? . #t))
                   '())))
-- 
2.41.0