projects/guix·blob javascript-team · refs

541 lines · 20.5 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2022 Ludovic Courtès <[email protected]>
3;;; Copyright © 2023 Janneke Nieuwenhuizen <[email protected]>
4;;; Copyright © 2023 Nicolas Graves <[email protected]>
5;;; Copyright © 2023 Efraim Flashner <[email protected]>
6;;; Copyright © 2026 Oleg Pykhalov <[email protected]>
7;;;
8;;; This file is part of GNU Guix.
9;;;
10;;; GNU Guix is free software; you can redistribute it and/or modify it
11;;; under the terms of the GNU General Public License as published by
12;;; the Free Software Foundation; either version 3 of the License, or (at
13;;; your option) any later version.
14;;;
15;;; GNU Guix is distributed in the hope that it will be useful, but
16;;; WITHOUT ANY WARRANTY; without even the implied warranty of
17;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;;; GNU General Public License for more details.
19;;;
20;;; You should have received a copy of the GNU General Public License
21;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
22
23(define-module (gnu home services ssh)
24 #:use-module (guix gexp)
25 #:use-module (guix records)
26 #:use-module (guix deprecation)
27 #:use-module (guix diagnostics)
28 #:use-module (guix i18n)
29 #:use-module ((guix utils) #:select (%current-system))
30 #:use-module (gnu services)
31 #:use-module (gnu services configuration)
32 #:use-module (guix modules)
33 #:use-module (gnu home services)
34 #:use-module (gnu home services shepherd)
35 #:use-module ((gnu home services utils)
36 #:select (object->camel-case-string))
37 #:autoload (gnu packages base) (libc-utf8-locales-for-target)
38 #:use-module (gnu packages ssh)
39 #:use-module (srfi srfi-1)
40 #:use-module (srfi srfi-9)
41 #:use-module (srfi srfi-9 gnu)
42 #:use-module (srfi srfi-34)
43 #:use-module (srfi srfi-35)
44 #:use-module (ice-9 match)
45 #:autoload (ice-9 regex) (string-match match:substring)
46 #:export (home-openssh-configuration
47 home-openssh-configuration-authorized-keys
48 home-openssh-configuration-known-hosts
49 home-openssh-configuration-hosts
50 home-openssh-configuration-add-keys-to-agent
51 home-openssh-configuration?
52
53 home-ssh-agent-configuration
54 home-ssh-agent-openssh
55 home-ssh-agent-socket-directory
56 home-ssh-agent-extra-options
57 home-ssh-agent-configuration?
58
59 openssh-host
60 openssh-host-host-name
61 openssh-host-match-criteria
62 openssh-host-identity-file
63 openssh-host-name
64 openssh-host-port
65 openssh-host-user
66 openssh-host-forward-x11?
67 openssh-host-forward-x11-trusted?
68 openssh-host-forward-agent?
69 openssh-host-compression?
70 openssh-host-proxy-command
71 openssh-host-host-key-algorithms
72 openssh-host-accepted-key-types
73 openssh-host-control-master
74 openssh-host-control-file-name
75 openssh-host-control-persist
76 openssh-host-sent-environment-variables
77 openssh-host-environment-variables
78 openssh-host-extra-content
79 proxy-jump
80 proxy-jump-host-name
81 proxy-jump-port
82 proxy-jump-user
83 proxy-command
84 proxy-command->string
85
86 home-openssh-service-type
87 home-ssh-agent-service-type))
88
89(define (serialize-field-name name)
90 (match name
91 ('accepted-key-types "PubkeyAcceptedKeyTypes")
92 ('sent-environment-variables "SendEnv")
93 ('environment-variables "SetEnv")
94 ('control-file-name "ControlPath")
95 (_
96 (let ((name (let ((str (symbol->string name)))
97 (if (string-suffix? "?" str)
98 (string->symbol (string-drop-right str 1))
99 name))))
100 (object->camel-case-string name 'upper)))))
101
102(define (serialize-string field value)
103 (string-append " " (serialize-field-name field)
104 " " value "\n"))
105
106(define (address-family? obj)
107 (memv obj (list AF_INET AF_INET6)))
108
109(define-maybe address-family)
110
111(define (serialize-address-family field family)
112 (if (maybe-value-set? family)
113 (string-append " " (serialize-field-name field) " "
114 (cond ((= family AF_INET) "inet")
115 ((= family AF_INET6) "inet6")
116 ;; The 'else' branch is unreachable.
117 (else
118 (raise
119 (formatted-message
120 (G_ "~s: invalid address family value")
121 family))))
122 "\n")
123 ""))
124
125(define (natural-number? obj)
126 (and (integer? obj) (exact? obj) (> obj 0)))
127
128(define (serialize-natural-number field value)
129 (string-append " " (serialize-field-name field) " "
130 (number->string value) "\n"))
131
132(define-maybe boolean)
133
134(define (serialize-boolean field value)
135 (string-append " " (serialize-field-name field) " "
136 (if value "yes" "no") "\n"))
137
138(define-maybe string)
139(define-maybe natural-number)
140
141(define (serialize-symbol field value)
142 (if (maybe-value-set? value)
143 (string-append " " (serialize-field-name field) " "
144 (symbol->string value) "\n")
145 ""))
146
147(define-maybe symbol)
148
149(define (serialize-raw-configuration-string field value)
150 (string-append value "\n"))
151(define raw-configuration-string? string?)
152
153(define (string-list? lst)
154 (and (pair? lst) (every string? lst)))
155(define (serialize-string-list field lst)
156 (string-append " " (serialize-field-name field) " "
157 (string-join lst ",") "\n"))
158
159(define-maybe string-list)
160
161(define (env-list? lst)
162 (string-list? lst))
163
164(define (serialize-env-list field lst)
165 (string-append " " (serialize-field-name field) " "
166 (string-join lst " ") "\n"))
167
168(define-maybe env-list)
169
170(define (string-alist? lst)
171 (and (list? lst)
172 (every (lambda (x)
173 (and (pair? x)
174 (string? (car x))
175 (string? (cdr x))))
176 lst)))
177
178(define (serialize-string-alist field lst)
179 (string-append " " (serialize-field-name field) " "
180 (string-join
181 (map (match-lambda
182 ((key . value)
183 (format #nil "~s" (string-append key "=" value))))
184 lst) " ") "\n"))
185
186(define-maybe string-alist)
187
188(define-record-type <proxy-command>
189 (proxy-command command)
190 proxy-command?
191 (command proxy-command->string))
192
193(set-record-type-printer! <proxy-command>
194 (lambda (obj port)
195 (format port "#<proxy-command ~s>" (proxy-command->string obj))))
196
197(define-configuration/no-serialization proxy-jump
198 (user
199 maybe-string
200 "User name on the remote host.")
201 (host-name
202 (string)
203 "Host name---e.g., @code{foo.example.org} or @code{192.168.1.2}.")
204 (port
205 maybe-natural-number
206 "TCP port number to connect to."))
207
208(define (proxy-jump->string proxy-jump)
209 (match-record proxy-jump <proxy-jump>
210 (host-name user port)
211 (string-append
212 (if (maybe-value-set? user) (string-append user "@") "")
213 host-name
214 (if (maybe-value-set? port) (string-append ":" (number->string port)) ""))))
215
216(define (proxy-command-or-jump-list? x)
217 (or (proxy-command? x)
218 (and (list? x)
219 (every proxy-jump? x))))
220
221(define (serialize-proxy-command-or-jump-list field value)
222 (if (proxy-command? value)
223 (serialize-string 'proxy-command (proxy-command->string value))
224 (serialize-string-list 'proxy-jump (map proxy-jump->string value))))
225
226(define-maybe proxy-command-or-jump-list)
227
228(define (sanitize-proxy-command properties)
229 (lambda (value)
230 (when (maybe-value-set? value)
231 (warn-about-deprecation 'proxy-command properties #:replacement 'proxy))
232 (unless (maybe-string? value)
233 (configuration-field-error (source-properties->location properties) 'proxy-command value))
234 value))
235
236(define ssh-match-keywords
237 '(canonical final exec host originalhost user localuser))
238
239(define (match-criteria? str)
240 ;; Rule out the case of "all" keyword.
241 (if (member str '("all"
242 "canonical all"
243 "final all"))
244 #t
245 (let* ((first (string-take str (string-index str #\ )))
246 (keyword (string->symbol (if (string-prefix? "!" first)
247 (string-drop first 1)
248 first))))
249 (memq keyword ssh-match-keywords))))
250
251(define (serialize-match-criteria _ value)
252 (string-append "Match " value "\n"))
253
254(define-maybe match-criteria)
255
256(define-configuration openssh-host
257 (name
258 maybe-string
259 "Name of this host declaration. A @code{openssh-host} must define only
260@code{name} or @code{match-criteria}. Use host-name @code{\"*\"} for
261top-level options.")
262 (host-name
263 maybe-string
264 "Host name---e.g., @code{\"foo.example.org\"} or @code{\"192.168.1.2\"}.")
265 (match-criteria
266 maybe-match-criteria
267 "When specified, this string denotes the set of hosts to which the entry
268applies, superseding the @code{host-name} field. Its first element must be
269all or one of @code{ssh-match-keywords}. The rest of the elements are
270arguments for the keyword, or other criteria. A @code{openssh-host} must
271define only @code{name} or @code{match-criteria}. Other host configuration
272options will apply to all hosts matching @code{match-criteria}.")
273 (address-family
274 maybe-address-family
275 "Address family to use when connecting to this host: one of
276@code{AF_INET} (for IPv4 only), @code{AF_INET6} (for IPv6 only).
277Additionally, the field can be left unset to allow any address family.")
278 (identity-file
279 maybe-string
280 "The identity file to use---e.g.,
281@code{\"/home/charlie/.ssh/id_ed25519\"}.")
282 (port
283 maybe-natural-number
284 "TCP port number to connect to.")
285 (user
286 maybe-string
287 "User name on the remote host.")
288 (forward-x11?
289 maybe-boolean
290 "Whether to forward remote client connections to the local X11 graphical
291display.")
292 (forward-x11-trusted?
293 maybe-boolean
294 "Whether remote X11 clients have full access to the original X11 graphical
295display.")
296 (forward-agent?
297 maybe-boolean
298 "Whether the authentication agent (if any) is forwarded to the remote
299machine.")
300 (compression?
301 maybe-boolean
302 "Whether to compress data in transit.")
303 (proxy-command
304 maybe-string
305 "The command to use to connect to the server. As an example, a command
306to connect via an HTTP proxy at 192.0.2.0 would be: @code{\"nc -X
307connect -x 192.0.2.0:8080 %h %p\"}. Using 'proxy-command' is deprecated, use
308'proxy' instead."
309 (sanitizer (sanitize-proxy-command (current-source-location))))
310 (proxy
311 maybe-proxy-command-or-jump-list
312 "The command to use to connect to the server or a list of SSH hosts to jump
313through before connecting to the server.")
314 (host-key-algorithms
315 maybe-string-list
316 "The list of accepted host key algorithms---e.g.,
317@code{'(\"ssh-ed25519\")}.")
318 (accepted-key-types
319 maybe-string-list
320 "The list of accepted user public key types.")
321 (control-master
322 maybe-symbol
323 "Enables the sharing of multiple sessions over a single network connection.
324Acceptable values are @code{'no}, @code{'yes}, @code{'auto}, @code{'ask}, and
325@code{'autoask}.")
326 (control-file-name
327 maybe-string
328 "The file name of the control socket used for connection sharing, or
329@code{\"none\"} to disable connection sharing.")
330 (control-persist
331 maybe-string
332 "When used in conjunction with @env{control-master}, specifies that the
333master connection should remain open in the background (waiting for future
334client connections) after the initial client connection has been closed.")
335 (sent-environment-variables
336 maybe-env-list
337 "Specifies which variables from the local environment should be sent to the
338server. The server must also support it, and the server must be configured to
339accept those environment variables.")
340 (environment-variables
341 maybe-string-alist
342 "List of environment variables with corresponding values to send to the
343server, as an alist of strings of the form @code{'(\"@var{variable}\"
344. \"@var{value}\")}. The server must also support it, and the server must be
345configured to accept those environment variables.")
346 (extra-content
347 (raw-configuration-string "")
348 "Extra content appended as-is to this @code{Host} block in
349@file{~/.ssh/config}."))
350
351(define (serialize-openssh-host config)
352 (define (openssh-host-name-or-match-field? field)
353 (or (eq? (configuration-field-name field) 'name)
354 (eq? (configuration-field-name field) 'match-criteria)))
355
356 (string-append
357 (if (maybe-value-set? (openssh-host-name config))
358 (if (maybe-value-set? (openssh-host-match-criteria config))
359 (raise
360 (formatted-message
361 (G_ "define either 'name' or 'match-criteria', not both")))
362 (string-append "Host " (openssh-host-name config) "\n"))
363 (if (maybe-value-set? (openssh-host-match-criteria config))
364 (serialize-match-criteria #t (openssh-host-match-criteria config))
365 (raise
366 (formatted-message
367 (G_ "define either 'name' or 'match-criteria' once")))))
368 (string-concatenate
369 (map (lambda (field)
370 ((configuration-field-serializer field)
371 (configuration-field-name field)
372 ((configuration-field-getter field) config)))
373 (remove openssh-host-name-or-match-field?
374 openssh-host-fields)))))
375
376(define-record-type* <home-openssh-configuration>
377 home-openssh-configuration make-home-openssh-configuration
378 home-openssh-configuration?
379 (authorized-keys home-openssh-configuration-authorized-keys ;list of file-like
380 (default #f))
381 (known-hosts home-openssh-configuration-known-hosts ;unspec | list of file-like
382 (default *unspecified*))
383 (known-hosts2 home-openssh-configuration-known-hosts2 ;unspec | list of file-like
384 (default *unspecified*))
385 (hosts home-openssh-configuration-hosts ;list of <openssh-host>
386 (default '()))
387 (add-keys-to-agent home-openssh-configuration-add-keys-to-agent ;string with limited values
388 (default "no")))
389
390(define (serialize-add-keys-to-agent value)
391 (define (valid-time-string? str)
392 (and (> (string-length str) 0)
393 (equal?
394 str
395 (match:substring
396 (string-match "\
397[0-9]+|([0-9]+[Ww])?([0-9]+[Dd])?([0-9]+[Hh])?([0-9]+[Mm])?([0-9]+[Ss])?"
398 str)))))
399
400 (string-append "AddKeysToAgent "
401 (cond ((member value '("yes" "no" "confirm" "ask")) value)
402 ((valid-time-string? value) value)
403 ((and (string-prefix? "confirm" value)
404 (valid-time-string?
405 (cdr (string-split value #\ )))) value)
406 ;; The 'else' branch is unreachable.
407 (else
408 (raise
409 (formatted-message
410 (G_ "~s: invalid 'add-keys-to-agent' value")
411 value))))))
412
413(define (openssh-configuration->string config)
414 (string-join
415 (cons* (serialize-add-keys-to-agent
416 (home-openssh-configuration-add-keys-to-agent config))
417 (map serialize-openssh-host
418 (home-openssh-configuration-hosts config)))
419 "\n"))
420
421(define* (file-join name files #:optional (delimiter " "))
422 "Return a file in the store called @var{name} that is the concatenation
423of all the file-like objects listed in @var{files}, with @var{delimited}
424inserted after each of them."
425 (computed-file name
426 (with-imported-modules '((guix build utils))
427 #~(begin
428 (use-modules (guix build utils))
429
430 ;; Support non-ASCII file names.
431 (setenv "GUIX_LOCPATH"
432 #+(file-append
433 (libc-utf8-locales-for-target (%current-system))
434 "/lib/locale"))
435 (setlocale LC_ALL "en_US.utf8")
436
437 (call-with-output-file #$output
438 (lambda (output)
439 (for-each (lambda (file)
440 (call-with-input-file file
441 (lambda (input)
442 (dump-port input output)))
443 (display #$delimiter output))
444 '#$files)))))))
445
446(define (openssh-configuration-files config)
447 (let* ((ssh-config (plain-file "ssh.conf"
448 (openssh-configuration->string config)))
449 (known-hosts (home-openssh-configuration-known-hosts config))
450 (known-hosts2 (home-openssh-configuration-known-hosts2 config))
451 (authorized-keys (home-openssh-configuration-authorized-keys config))
452 (authorized-keys (and
453 authorized-keys
454 (file-join "authorized_keys" authorized-keys "\n"))))
455 `(,@(if authorized-keys
456 `((".ssh/authorized_keys" ,authorized-keys))
457 '())
458 ,@(if (unspecified? known-hosts)
459 '()
460 `((".ssh/known_hosts"
461 ,(file-join "known_hosts" known-hosts "\n"))))
462 ,@(if (unspecified? known-hosts2)
463 '()
464 `((".ssh/known_hosts2"
465 ,(file-join "known_hosts2" known-hosts2 "\n"))))
466 (".ssh/config" ,ssh-config))))
467
468(define openssh-activation
469 (with-imported-modules (source-module-closure
470 '((gnu build activation)))
471 #~(begin
472 (use-modules (gnu build activation))
473
474 ;; Make sure ~/.ssh is #o700.
475 (let* ((home (getenv "HOME"))
476 (dot-ssh (string-append home "/.ssh")))
477 (mkdir-p/perms dot-ssh (getpw (getuid)) #o700)))))
478
479(define home-openssh-service-type
480 (service-type
481 (name 'home-openssh)
482 (extensions
483 (list (service-extension home-files-service-type
484 openssh-configuration-files)
485 (service-extension home-activation-service-type
486 (const openssh-activation))))
487 (description "Configure the OpenSSH @acronym{SSH, secure shell} client
488by providing a @file{~/.ssh/config} file, which is honored by the OpenSSH
489client,@command{ssh}, and by other tools such as @command{guix deploy}.")
490 (default-value (home-openssh-configuration))))
491
492
493;;;
494;;; Ssh-agent.
495;;;
496(define-record-type* <home-ssh-agent-configuration>
497 home-ssh-agent-configuration make-home-ssh-agent-configuration
498 home-ssh-agent-configuration?
499 (openssh home-ssh-agent-openssh ;file-like
500 (default openssh))
501 (socket-directory home-ssh-agent-socket-directory ;string
502 (default #~(string-append %user-runtime-dir "/ssh-agent")))
503 (extra-options home-ssh-agent-extra-options ;list of string
504 (default '())))
505
506(define (home-ssh-agent-services config)
507 "Return a <shepherd-service> for an ssh-agent with CONFIG."
508 (match-record config <home-ssh-agent-configuration>
509 (openssh socket-directory extra-options)
510 (let* ((ssh-agent (file-append openssh "/bin/ssh-agent"))
511 (socket-file #~(string-append #$socket-directory "/socket"))
512 (command #~`(#$ssh-agent
513 "-D" "-a" ,#$socket-file
514 #$@extra-options))
515 (log-file #~(string-append %user-log-dir "/ssh-agent.log")))
516 (list (shepherd-service
517 (documentation "Run the ssh-agent.")
518 (provision '(ssh-agent))
519 (modules '((shepherd support))) ;for '%user-runtime-dir', etc.
520 (start #~(lambda _
521 (unless (file-exists? #$socket-directory)
522 (mkdir-p #$socket-directory)
523 (chmod #$socket-directory #o700))
524 (fork+exec-command #$command #:log-file #$log-file)))
525 (stop #~(make-kill-destructor)))))))
526
527(define (home-ssh-agent-environment-variables config)
528 '(("SSH_AUTH_SOCK"
529 . "${SSH_AUTH_SOCK-${XDG_RUNTIME_DIR-$HOME/.cache}/ssh-agent/socket}")))
530
531(define home-ssh-agent-service-type
532 (service-type
533 (name 'home-ssh-agent)
534 (default-value (home-ssh-agent-configuration))
535 (extensions
536 (list (service-extension home-shepherd-service-type
537 home-ssh-agent-services)
538 (service-extension home-environment-variables-service-type
539 home-ssh-agent-environment-variables)))
540 (description
541 "Install and configure @command{ssh-agent} as a Shepherd service.")))