gnu: surgescript: Update to 0.5.4.4.
[jackhill/guix/guix.git] / gnu / services / ssh.scm
1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2016 David Craven <david@craven.ch>
4 ;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
5 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
6 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
7 ;;; Copyright © 2020 pinoaffe <pinoaffe@airmail.cc>
8 ;;;
9 ;;; This file is part of GNU Guix.
10 ;;;
11 ;;; GNU Guix is free software; you can redistribute it and/or modify it
12 ;;; under the terms of the GNU General Public License as published by
13 ;;; the Free Software Foundation; either version 3 of the License, or (at
14 ;;; your option) any later version.
15 ;;;
16 ;;; GNU Guix is distributed in the hope that it will be useful, but
17 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;;; GNU General Public License for more details.
20 ;;;
21 ;;; You should have received a copy of the GNU General Public License
22 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
23
24 (define-module (gnu services ssh)
25 #:use-module (gnu packages ssh)
26 #:use-module (gnu packages admin)
27 #:use-module (gnu services)
28 #:use-module (gnu services shepherd)
29 #:use-module (gnu system pam)
30 #:use-module (gnu system shadow)
31 #:use-module (guix gexp)
32 #:use-module (guix records)
33 #:use-module (guix modules)
34 #:use-module (srfi srfi-1)
35 #:use-module (srfi srfi-26)
36 #:use-module (ice-9 match)
37 #:export (lsh-configuration
38 lsh-configuration?
39 lsh-service
40 lsh-service-type
41
42 openssh-configuration
43 openssh-configuration?
44 openssh-service-type
45
46 dropbear-configuration
47 dropbear-configuration?
48 dropbear-service-type
49 dropbear-service
50
51 autossh-configuration
52 autossh-configuration?
53 autossh-service-type))
54
55 ;;; Commentary:
56 ;;;
57 ;;; This module implements secure shell (SSH) services.
58 ;;;
59 ;;; Code:
60
61 (define-record-type* <lsh-configuration>
62 lsh-configuration make-lsh-configuration
63 lsh-configuration?
64 (lsh lsh-configuration-lsh
65 (default lsh))
66 (daemonic? lsh-configuration-daemonic?)
67 (host-key lsh-configuration-host-key)
68 (interfaces lsh-configuration-interfaces)
69 (port-number lsh-configuration-port-number)
70 (allow-empty-passwords? lsh-configuration-allow-empty-passwords?)
71 (root-login? lsh-configuration-root-login?)
72 (syslog-output? lsh-configuration-syslog-output?)
73 (pid-file? lsh-configuration-pid-file?)
74 (pid-file lsh-configuration-pid-file)
75 (x11-forwarding? lsh-configuration-x11-forwarding?)
76 (tcp/ip-forwarding? lsh-configuration-tcp/ip-forwarding?)
77 (password-authentication? lsh-configuration-password-authentication?)
78 (public-key-authentication? lsh-configuration-public-key-authentication?)
79 (initialize? lsh-configuration-initialize?))
80
81 (define %yarrow-seed
82 "/var/spool/lsh/yarrow-seed-file")
83
84 (define (lsh-initialization lsh host-key)
85 "Return the gexp to initialize the LSH service for HOST-KEY."
86 #~(begin
87 (unless (file-exists? #$%yarrow-seed)
88 (system* (string-append #$lsh "/bin/lsh-make-seed")
89 "--sloppy" "-o" #$%yarrow-seed))
90
91 (unless (file-exists? #$host-key)
92 (mkdir-p (dirname #$host-key))
93 (format #t "creating SSH host key '~a'...~%" #$host-key)
94
95 ;; FIXME: We're just doing a simple pipeline, but 'system' cannot be
96 ;; used yet because /bin/sh might be dangling; factorize this somehow.
97 (let* ((in+out (pipe))
98 (keygen (primitive-fork)))
99 (case keygen
100 ((0)
101 (close-port (car in+out))
102 (close-fdes 1)
103 (dup2 (fileno (cdr in+out)) 1)
104 (execl (string-append #$lsh "/bin/lsh-keygen")
105 "lsh-keygen" "--server"))
106 (else
107 (let ((write-key (primitive-fork)))
108 (case write-key
109 ((0)
110 (close-port (cdr in+out))
111 (close-fdes 0)
112 (dup2 (fileno (car in+out)) 0)
113 (execl (string-append #$lsh "/bin/lsh-writekey")
114 "lsh-writekey" "--server" "-o" #$host-key))
115 (else
116 (close-port (car in+out))
117 (close-port (cdr in+out))
118 (waitpid keygen)
119 (waitpid write-key))))))))))
120
121 (define (lsh-activation config)
122 "Return the activation gexp for CONFIG."
123 #~(begin
124 (use-modules (guix build utils))
125 (mkdir-p "/var/spool/lsh")
126 #$(if (lsh-configuration-initialize? config)
127 (lsh-initialization (lsh-configuration-lsh config)
128 (lsh-configuration-host-key config))
129 #t)))
130
131 (define (lsh-shepherd-service config)
132 "Return a <shepherd-service> for lsh with CONFIG."
133 (define lsh (lsh-configuration-lsh config))
134 (define pid-file (lsh-configuration-pid-file config))
135 (define pid-file? (lsh-configuration-pid-file? config))
136 (define daemonic? (lsh-configuration-daemonic? config))
137 (define interfaces (lsh-configuration-interfaces config))
138
139 (define lsh-command
140 (append
141 (cons (file-append lsh "/sbin/lshd")
142 (if daemonic?
143 (let ((syslog (if (lsh-configuration-syslog-output? config)
144 '()
145 (list "--no-syslog"))))
146 (cons "--daemonic"
147 (if pid-file?
148 (cons #~(string-append "--pid-file=" #$pid-file)
149 syslog)
150 (cons "--no-pid-file" syslog))))
151 (if pid-file?
152 (list #~(string-append "--pid-file=" #$pid-file))
153 '())))
154 (cons* #~(string-append "--host-key="
155 #$(lsh-configuration-host-key config))
156 #~(string-append "--password-helper=" #$lsh "/sbin/lsh-pam-checkpw")
157 #~(string-append "--subsystems=sftp=" #$lsh "/sbin/sftp-server")
158 "-p" (number->string (lsh-configuration-port-number config))
159 (if (lsh-configuration-password-authentication? config)
160 "--password" "--no-password")
161 (if (lsh-configuration-public-key-authentication? config)
162 "--publickey" "--no-publickey")
163 (if (lsh-configuration-root-login? config)
164 "--root-login" "--no-root-login")
165 (if (lsh-configuration-x11-forwarding? config)
166 "--x11-forward" "--no-x11-forward")
167 (if (lsh-configuration-tcp/ip-forwarding? config)
168 "--tcpip-forward" "--no-tcpip-forward")
169 (if (null? interfaces)
170 '()
171 (map (cut string-append "--interface=" <>)
172 interfaces)))))
173
174 (define requires
175 (if (and daemonic? (lsh-configuration-syslog-output? config))
176 '(networking syslogd)
177 '(networking)))
178
179 (list (shepherd-service
180 (documentation "GNU lsh SSH server")
181 (provision '(ssh-daemon ssh sshd))
182 (requirement requires)
183 (start #~(make-forkexec-constructor (list #$@lsh-command)))
184 (stop #~(make-kill-destructor)))))
185
186 (define (lsh-pam-services config)
187 "Return a list of <pam-services> for lshd with CONFIG."
188 (list (unix-pam-service
189 "lshd"
190 #:login-uid? #t
191 #:allow-empty-passwords?
192 (lsh-configuration-allow-empty-passwords? config))))
193
194 (define lsh-service-type
195 (service-type (name 'lsh)
196 (description
197 "Run the GNU@tie{}lsh secure shell (SSH) daemon,
198 @command{lshd}.")
199 (extensions
200 (list (service-extension shepherd-root-service-type
201 lsh-shepherd-service)
202 (service-extension pam-root-service-type
203 lsh-pam-services)
204 (service-extension activation-service-type
205 lsh-activation)))))
206
207 (define* (lsh-service #:key
208 (lsh lsh)
209 (daemonic? #t)
210 (host-key "/etc/lsh/host-key")
211 (interfaces '())
212 (port-number 22)
213 (allow-empty-passwords? #f)
214 (root-login? #f)
215 (syslog-output? #t)
216 (pid-file? #f)
217 (pid-file "/var/run/lshd.pid")
218 (x11-forwarding? #t)
219 (tcp/ip-forwarding? #t)
220 (password-authentication? #t)
221 (public-key-authentication? #t)
222 (initialize? #t))
223 "Run the @command{lshd} program from @var{lsh} to listen on port @var{port-number}.
224 @var{host-key} must designate a file containing the host key, and readable
225 only by root.
226
227 When @var{daemonic?} is true, @command{lshd} will detach from the
228 controlling terminal and log its output to syslogd, unless one sets
229 @var{syslog-output?} to false. Obviously, it also makes lsh-service
230 depend on existence of syslogd service. When @var{pid-file?} is true,
231 @command{lshd} writes its PID to the file called @var{pid-file}.
232
233 When @var{initialize?} is true, automatically create the seed and host key
234 upon service activation if they do not exist yet. This may take long and
235 require interaction.
236
237 When @var{initialize?} is false, it is up to the user to initialize the
238 randomness generator (@pxref{lsh-make-seed,,, lsh, LSH Manual}), and to create
239 a key pair with the private key stored in file @var{host-key} (@pxref{lshd
240 basics,,, lsh, LSH Manual}).
241
242 When @var{interfaces} is empty, lshd listens for connections on all the
243 network interfaces; otherwise, @var{interfaces} must be a list of host names
244 or addresses.
245
246 @var{allow-empty-passwords?} specifies whether to accept log-ins with empty
247 passwords, and @var{root-login?} specifies whether to accept log-ins as
248 root.
249
250 The other options should be self-descriptive."
251 (service lsh-service-type
252 (lsh-configuration (lsh lsh) (daemonic? daemonic?)
253 (host-key host-key) (interfaces interfaces)
254 (port-number port-number)
255 (allow-empty-passwords? allow-empty-passwords?)
256 (root-login? root-login?)
257 (syslog-output? syslog-output?)
258 (pid-file? pid-file?) (pid-file pid-file)
259 (x11-forwarding? x11-forwarding?)
260 (tcp/ip-forwarding? tcp/ip-forwarding?)
261 (password-authentication?
262 password-authentication?)
263 (public-key-authentication?
264 public-key-authentication?)
265 (initialize? initialize?))))
266
267 \f
268 ;;;
269 ;;; OpenSSH.
270 ;;;
271
272 (define-record-type* <openssh-configuration>
273 openssh-configuration make-openssh-configuration
274 openssh-configuration?
275 ;; <package>
276 (openssh openssh-configuration-openssh
277 (default openssh))
278 ;; string
279 (pid-file openssh-configuration-pid-file
280 (default "/var/run/sshd.pid"))
281 ;; integer
282 (port-number openssh-configuration-port-number
283 (default 22))
284 ;; Boolean | 'without-password
285 (permit-root-login openssh-configuration-permit-root-login
286 (default #f))
287 ;; Boolean
288 (allow-empty-passwords? openssh-configuration-allow-empty-passwords?
289 (default #f))
290 ;; Boolean
291 (password-authentication? openssh-configuration-password-authentication?
292 (default #t))
293 ;; Boolean
294 (public-key-authentication? openssh-configuration-public-key-authentication?
295 (default #t))
296 ;; Boolean
297 (x11-forwarding? openssh-configuration-x11-forwarding?
298 (default #f))
299
300 ;; Boolean
301 (allow-agent-forwarding? openssh-configuration-allow-agent-forwarding?
302 (default #t))
303
304 ;; Boolean
305 (allow-tcp-forwarding? openssh-configuration-allow-tcp-forwarding?
306 (default #t))
307
308 ;; Boolean
309 (gateway-ports? openssh-configuration-gateway-ports?
310 (default #f))
311
312 ;; Boolean
313 (challenge-response-authentication? openssh-challenge-response-authentication?
314 (default #f))
315 ;; Boolean
316 (use-pam? openssh-configuration-use-pam?
317 (default #t))
318 ;; Boolean
319 (print-last-log? openssh-configuration-print-last-log?
320 (default #t))
321 ;; list of two-element lists
322 (subsystems openssh-configuration-subsystems
323 (default '(("sftp" "internal-sftp"))))
324
325 ;; list of strings
326 (accepted-environment openssh-configuration-accepted-environment
327 (default '()))
328
329 ;; symbol
330 (log-level openssh-configuration-log-level
331 (default 'info))
332
333 ;; String
334 ;; This is an "escape hatch" to provide configuration that isn't yet
335 ;; supported by this configuration record.
336 (extra-content openssh-configuration-extra-content
337 (default ""))
338
339 ;; list of user-name/file-like tuples
340 (authorized-keys openssh-authorized-keys
341 (default '()))
342
343 ;; Boolean
344 ;; XXX: This should really be handled in an orthogonal way, for instance as
345 ;; proposed in <https://bugs.gnu.org/27155>. Keep it internal/undocumented
346 ;; for now.
347 (%auto-start? openssh-auto-start?
348 (default #t)))
349
350 (define %openssh-accounts
351 (list (user-group (name "sshd") (system? #t))
352 (user-account
353 (name "sshd")
354 (group "sshd")
355 (system? #t)
356 (comment "sshd privilege separation user")
357 (home-directory "/var/run/sshd")
358 (shell (file-append shadow "/sbin/nologin")))))
359
360 (define (openssh-activation config)
361 "Return the activation GEXP for CONFIG."
362 (with-imported-modules '((guix build utils))
363 #~(begin
364 (use-modules (guix build utils))
365
366 (define (touch file-name)
367 (call-with-output-file file-name (const #t)))
368
369 ;; Make sure /etc/ssh can be read by the 'sshd' user.
370 (mkdir-p "/etc/ssh")
371 (chmod "/etc/ssh" #o755)
372 (mkdir-p (dirname #$(openssh-configuration-pid-file config)))
373
374 ;; 'sshd' complains if the authorized-key directory and its parents
375 ;; are group-writable, which rules out /gnu/store. Thus we copy the
376 ;; authorized-key directory to /etc.
377 (catch 'system-error
378 (lambda ()
379 (delete-file-recursively "/etc/authorized_keys.d"))
380 (lambda args
381 (unless (= ENOENT (system-error-errno args))
382 (apply throw args))))
383 (copy-recursively #$(authorized-key-directory
384 (openssh-authorized-keys config))
385 "/etc/ssh/authorized_keys.d")
386
387 (chmod "/etc/ssh/authorized_keys.d" #o555)
388
389 (let ((lastlog "/var/log/lastlog"))
390 (when #$(openssh-configuration-print-last-log? config)
391 (unless (file-exists? lastlog)
392 (touch lastlog))))
393
394 ;; Generate missing host keys.
395 (system* (string-append #$(openssh-configuration-openssh config)
396 "/bin/ssh-keygen") "-A"))))
397
398 (define (authorized-key-directory keys)
399 "Return a directory containing the authorized keys specified in KEYS, a list
400 of user-name/file-like tuples."
401 (define build
402 (with-imported-modules (source-module-closure '((guix build utils)))
403 #~(begin
404 (use-modules (ice-9 match) (srfi srfi-26)
405 (guix build utils))
406
407 (mkdir #$output)
408 (for-each (match-lambda
409 ((user keys ...)
410 (let ((file (string-append #$output "/" user)))
411 (call-with-output-file file
412 (lambda (port)
413 (for-each (lambda (key)
414 (call-with-input-file key
415 (cut dump-port <> port)))
416 keys))))))
417 '#$keys))))
418
419 (computed-file "openssh-authorized-keys" build))
420
421 (define (openssh-config-file config)
422 "Return the sshd configuration file corresponding to CONFIG."
423 (computed-file
424 "sshd_config"
425 #~(begin
426 (use-modules (ice-9 match))
427 (call-with-output-file #$output
428 (lambda (port)
429 (display "# Generated by 'openssh-service'.\n" port)
430 (format port "Port ~a\n"
431 #$(number->string
432 (openssh-configuration-port-number config)))
433 (format port "PermitRootLogin ~a\n"
434 #$(match (openssh-configuration-permit-root-login config)
435 (#t "yes")
436 (#f "no")
437 ('without-password "without-password")))
438 (format port "PermitEmptyPasswords ~a\n"
439 #$(if (openssh-configuration-allow-empty-passwords? config)
440 "yes" "no"))
441 (format port "PasswordAuthentication ~a\n"
442 #$(if (openssh-configuration-password-authentication? config)
443 "yes" "no"))
444 (format port "PubkeyAuthentication ~a\n"
445 #$(if (openssh-configuration-public-key-authentication?
446 config)
447 "yes" "no"))
448 (format port "X11Forwarding ~a\n"
449 #$(if (openssh-configuration-x11-forwarding? config)
450 "yes" "no"))
451 (format port "AllowAgentForwarding ~a\n"
452 #$(if (openssh-configuration-allow-agent-forwarding? config)
453 "yes" "no"))
454 (format port "AllowTcpForwarding ~a\n"
455 #$(if (openssh-configuration-allow-tcp-forwarding? config)
456 "yes" "no"))
457 (format port "GatewayPorts ~a\n"
458 #$(if (openssh-configuration-gateway-ports? config)
459 "yes" "no"))
460 (format port "PidFile ~a\n"
461 #$(openssh-configuration-pid-file config))
462 (format port "ChallengeResponseAuthentication ~a\n"
463 #$(if (openssh-challenge-response-authentication? config)
464 "yes" "no"))
465 (format port "UsePAM ~a\n"
466 #$(if (openssh-configuration-use-pam? config)
467 "yes" "no"))
468 (format port "PrintLastLog ~a\n"
469 #$(if (openssh-configuration-print-last-log? config)
470 "yes" "no"))
471 (format port "LogLevel ~a\n"
472 #$(string-upcase
473 (symbol->string
474 (openssh-configuration-log-level config))))
475
476 ;; Add '/etc/authorized_keys.d/%u', which we populate.
477 (format port "AuthorizedKeysFile \
478 .ssh/authorized_keys .ssh/authorized_keys2 /etc/ssh/authorized_keys.d/%u\n")
479
480 (for-each (lambda (s) (format port "AcceptEnv ~a\n" s))
481 '#$(openssh-configuration-accepted-environment config))
482
483 (for-each
484 (match-lambda
485 ((name command) (format port "Subsystem\t~a\t~a\n" name command)))
486 '#$(openssh-configuration-subsystems config))
487
488 (format port "~a\n"
489 #$(openssh-configuration-extra-content config))
490 #t)))))
491
492 (define (openssh-shepherd-service config)
493 "Return a <shepherd-service> for openssh with CONFIG."
494
495 (define pid-file
496 (openssh-configuration-pid-file config))
497
498 (define openssh-command
499 #~(list (string-append #$(openssh-configuration-openssh config) "/sbin/sshd")
500 "-D" "-f" #$(openssh-config-file config)))
501
502 (list (shepherd-service
503 (documentation "OpenSSH server.")
504 (requirement '(syslogd loopback))
505 (provision '(ssh-daemon ssh sshd))
506 (start #~(make-forkexec-constructor #$openssh-command
507 #:pid-file #$pid-file))
508 (stop #~(make-kill-destructor))
509 (auto-start? (openssh-auto-start? config)))))
510
511 (define (openssh-pam-services config)
512 "Return a list of <pam-services> for sshd with CONFIG."
513 (list (unix-pam-service
514 "sshd"
515 #:login-uid? #t
516 #:allow-empty-passwords?
517 (openssh-configuration-allow-empty-passwords? config))))
518
519 (define (extend-openssh-authorized-keys config keys)
520 "Extend CONFIG with the extra authorized keys listed in KEYS."
521 (openssh-configuration
522 (inherit config)
523 (authorized-keys
524 (append (openssh-authorized-keys config) keys))))
525
526 (define openssh-service-type
527 (service-type (name 'openssh)
528 (description
529 "Run the OpenSSH secure shell (SSH) server, @command{sshd}.")
530 (extensions
531 (list (service-extension shepherd-root-service-type
532 openssh-shepherd-service)
533 (service-extension pam-root-service-type
534 openssh-pam-services)
535 (service-extension activation-service-type
536 openssh-activation)
537 (service-extension account-service-type
538 (const %openssh-accounts))
539
540 ;; Install OpenSSH in the system profile. That way,
541 ;; 'scp' is found when someone tries to copy to or from
542 ;; this machine.
543 (service-extension profile-service-type
544 (lambda (config)
545 (list (openssh-configuration-openssh
546 config))))))
547 (compose concatenate)
548 (extend extend-openssh-authorized-keys)
549 (default-value (openssh-configuration))))
550
551 \f
552 ;;;
553 ;;; Dropbear.
554 ;;;
555
556 (define-record-type* <dropbear-configuration>
557 dropbear-configuration make-dropbear-configuration
558 dropbear-configuration?
559 (dropbear dropbear-configuration-dropbear
560 (default dropbear))
561 (port-number dropbear-configuration-port-number
562 (default 22))
563 (syslog-output? dropbear-configuration-syslog-output?
564 (default #t))
565 (pid-file dropbear-configuration-pid-file
566 (default "/var/run/dropbear.pid"))
567 (root-login? dropbear-configuration-root-login?
568 (default #f))
569 (allow-empty-passwords? dropbear-configuration-allow-empty-passwords?
570 (default #f))
571 (password-authentication? dropbear-configuration-password-authentication?
572 (default #t)))
573
574 (define (dropbear-activation config)
575 "Return the activation gexp for CONFIG."
576 #~(begin
577 (use-modules (guix build utils))
578 (mkdir-p "/etc/dropbear")))
579
580 (define (dropbear-shepherd-service config)
581 "Return a <shepherd-service> for dropbear with CONFIG."
582 (define dropbear
583 (dropbear-configuration-dropbear config))
584
585 (define pid-file
586 (dropbear-configuration-pid-file config))
587
588 (define dropbear-command
589 #~(list (string-append #$dropbear "/sbin/dropbear")
590
591 ;; '-R' allows host keys to be automatically generated upon first
592 ;; connection, at a time when /dev/urandom is more likely securely
593 ;; seeded.
594 "-F" "-R"
595
596 "-p" #$(number->string (dropbear-configuration-port-number config))
597 "-P" #$pid-file
598 #$@(if (dropbear-configuration-syslog-output? config) '() '("-E"))
599 #$@(if (dropbear-configuration-root-login? config) '() '("-w"))
600 #$@(if (dropbear-configuration-password-authentication? config)
601 '()
602 '("-s" "-g"))
603 #$@(if (dropbear-configuration-allow-empty-passwords? config)
604 '("-B")
605 '())))
606
607 (define requires
608 (if (dropbear-configuration-syslog-output? config)
609 '(networking syslogd) '(networking)))
610
611 (list (shepherd-service
612 (documentation "Dropbear SSH server.")
613 (requirement requires)
614 (provision '(ssh-daemon ssh sshd))
615 (start #~(make-forkexec-constructor #$dropbear-command
616 #:pid-file #$pid-file))
617 (stop #~(make-kill-destructor)))))
618
619 (define dropbear-service-type
620 (service-type (name 'dropbear)
621 (description
622 "Run the Dropbear secure shell (SSH) server.")
623 (extensions
624 (list (service-extension shepherd-root-service-type
625 dropbear-shepherd-service)
626 (service-extension activation-service-type
627 dropbear-activation)))
628 (default-value (dropbear-configuration))))
629
630 (define* (dropbear-service #:optional (config (dropbear-configuration)))
631 "Run the @uref{https://matt.ucc.asn.au/dropbear/dropbear.html,Dropbear SSH
632 daemon} with the given @var{config}, a @code{<dropbear-configuration>}
633 object."
634 (service dropbear-service-type config))
635
636 \f
637 ;;;
638 ;;; AutoSSH.
639 ;;;
640
641
642 (define-record-type* <autossh-configuration>
643 autossh-configuration make-autossh-configuration
644 autossh-configuration?
645 (user autossh-configuration-user
646 (default "autossh"))
647 (poll autossh-configuration-poll
648 (default 600))
649 (first-poll autossh-configuration-first-poll
650 (default #f))
651 (gate-time autossh-configuration-gate-time
652 (default 30))
653 (log-level autossh-configuration-log-level
654 (default 1))
655 (max-start autossh-configuration-max-start
656 (default #f))
657 (message autossh-configuration-message
658 (default ""))
659 (port autossh-configuration-port
660 (default "0"))
661 (ssh-options autossh-configuration-ssh-options
662 (default '())))
663
664 (define (autossh-file-name config file)
665 "Return a path in /var/run/autossh/ that is writable
666 by @code{user} from @code{config}."
667 (string-append "/var/run/autossh/"
668 (autossh-configuration-user config)
669 "/" file))
670
671 (define (autossh-shepherd-service config)
672 (shepherd-service
673 (documentation "Automatically set up ssh connections (and keep them alive).")
674 (provision '(autossh))
675 (start #~(make-forkexec-constructor
676 (list #$(file-append autossh "/bin/autossh")
677 #$@(autossh-configuration-ssh-options config))
678 #:user #$(autossh-configuration-user config)
679 #:group (passwd:gid (getpw #$(autossh-configuration-user config)))
680 #:pid-file #$(autossh-file-name config "pid")
681 #:log-file #$(autossh-file-name config "log")
682 #:environment-variables
683 '(#$(string-append "AUTOSSH_PIDFILE="
684 (autossh-file-name config "pid"))
685 #$(string-append "AUTOSSH_LOGFILE="
686 (autossh-file-name config "log"))
687 #$(string-append "AUTOSSH_POLL="
688 (number->string
689 (autossh-configuration-poll config)))
690 #$(string-append "AUTOSSH_FIRST_POLL="
691 (number->string
692 (or
693 (autossh-configuration-first-poll config)
694 (autossh-configuration-poll config))))
695 #$(string-append "AUTOSSH_GATETIME="
696 (number->string
697 (autossh-configuration-gate-time config)))
698 #$(string-append "AUTOSSH_LOGLEVEL="
699 (number->string
700 (autossh-configuration-log-level config)))
701 #$(string-append "AUTOSSH_MAXSTART="
702 (number->string
703 (or (autossh-configuration-max-start config)
704 -1)))
705 #$(string-append "AUTOSSH_MESSAGE="
706 (autossh-configuration-message config))
707 #$(string-append "AUTOSSH_PORT="
708 (autossh-configuration-port config)))))
709 (stop #~(make-kill-destructor))))
710
711 (define (autossh-service-activation config)
712 (with-imported-modules '((guix build utils))
713 #~(begin
714 (use-modules (guix build utils))
715 (define %user
716 (getpw #$(autossh-configuration-user config)))
717 (let* ((directory #$(autossh-file-name config ""))
718 (log (string-append directory "/log")))
719 (mkdir-p directory)
720 (chown directory (passwd:uid %user) (passwd:gid %user))
721 (call-with-output-file log (const #t))
722 (chown log (passwd:uid %user) (passwd:gid %user))))))
723
724 (define autossh-service-type
725 (service-type
726 (name 'autossh)
727 (description "Automatically set up ssh connections (and keep them alive).")
728 (extensions
729 (list (service-extension shepherd-root-service-type
730 (compose list autossh-shepherd-service))
731 (service-extension activation-service-type
732 autossh-service-activation)))
733 (default-value (autossh-configuration))))
734
735 ;;; ssh.scm ends here