Nicolas Graves: 1 features: ssh: Rely on Guix ssh configuration. 5 files changed, 55 insertions(+), 367 deletions(-)
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 -3Learn more about email & git
--- 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
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 : https://git.sr.ht/~ngraves/dotfiles/commit/00cb1fa19d7a808be234670bf13374c90ba52e4c - 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 "*".) Cheers!