From 051f3254cd56aa8f3cb65a7e35ef8578af2cd3c5 Mon Sep 17 00:00:00 2001
From: pinoaffe <pinoaffe@airmail.cc>
Date: Tue, 5 May 2020 09:31:11 +0200
Subject: gnu: Add AutoSSH service.

* gnu/services/ssh.scm (<autossh-configuration>): New record type.
(autossh-service-type): New variable.
(autossh-service-activation, autossh-file-name): New procedures.
* doc/guix.texi (Networking Services): Document this.

Signed-off-by: Oleg Pykhalov <go.wigust@gmail.com>
---
 gnu/services/ssh.scm | 106 ++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 105 insertions(+), 1 deletion(-)

(limited to 'gnu/services/ssh.scm')

diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index d2dbb8f80d..ced21c0742 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2020 pinoaffe <pinoaffe@airmail.cc>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -45,7 +46,11 @@
             dropbear-configuration
             dropbear-configuration?
             dropbear-service-type
-            dropbear-service))
+            dropbear-service
+
+            autossh-configuration
+            autossh-configuration?
+            autossh-service-type))
 
 ;;; Commentary:
 ;;;
@@ -628,4 +633,103 @@ daemon} with the given @var{config}, a @code{<dropbear-configuration>}
 object."
   (service dropbear-service-type config))
 
+
+;;;
+;;; AutoSSH.
+;;;
+
+
+(define-record-type* <autossh-configuration>
+  autossh-configuration make-autossh-configuration
+  autossh-configuration?
+  (user            autossh-configuration-user
+                   (default "autossh"))
+  (poll            autossh-configuration-poll
+                   (default 600))
+  (first-poll      autossh-configuration-first-poll
+                   (default #f))
+  (gate-time       autossh-configuration-gate-time
+                   (default 30))
+  (log-level       autossh-configuration-log-level
+                   (default 1))
+  (max-start       autossh-configuration-max-start
+                   (default #f))
+  (message         autossh-configuration-message
+                   (default ""))
+  (port            autossh-configuration-port
+                   (default "0"))
+  (ssh-options     autossh-configuration-ssh-options
+                   (default '())))
+
+(define (autossh-file-name config file)
+  "Return a path in /var/run/autossh/ that is writable
+   by @code{user} from @code{config}."
+  (string-append "/var/run/autossh/"
+                 (autossh-configuration-user config)
+                 "/" file))
+
+(define (autossh-shepherd-service config)
+  (shepherd-service
+   (documentation "Automatically set up ssh connections (and keep them alive).")
+   (provision '(autossh))
+   (start #~(make-forkexec-constructor
+             (list #$(file-append autossh "/bin/autossh")
+                   #$@(autossh-configuration-ssh-options config))
+             #:user #$(autossh-configuration-user config)
+             #:group (passwd:gid (getpw #$(autossh-configuration-user config)))
+             #:pid-file #$(autossh-file-name config "pid")
+             #:log-file #$(autossh-file-name config "log")
+             #:environment-variables
+             '(#$(string-append "AUTOSSH_PIDFILE="
+                                (autossh-file-name config "pid"))
+               #$(string-append "AUTOSSH_LOGFILE="
+                                (autossh-file-name config "log"))
+               #$(string-append "AUTOSSH_POLL="
+                                (number->string
+                                 (autossh-configuration-poll config)))
+               #$(string-append "AUTOSSH_FIRST_POLL="
+                                (number->string
+                                 (or
+                                  (autossh-configuration-first-poll config)
+                                  (autossh-configuration-poll config))))
+               #$(string-append "AUTOSSH_GATETIME="
+                                (number->string
+                                 (autossh-configuration-gate-time config)))
+               #$(string-append "AUTOSSH_LOGLEVEL="
+                                (number->string
+                                 (autossh-configuration-log-level config)))
+               #$(string-append "AUTOSSH_MAXSTART="
+                                (number->string
+                                 (or (autossh-configuration-max-start config)
+                                     -1)))
+               #$(string-append "AUTOSSH_MESSAGE="
+                                (autossh-configuration-message config))
+               #$(string-append "AUTOSSH_PORT="
+                                (autossh-configuration-port config)))))
+   (stop #~(make-kill-destructor))))
+
+(define (autossh-service-activation config)
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+        (define %user
+          (getpw #$(autossh-configuration-user config)))
+        (let* ((directory #$(autossh-file-name config ""))
+               (log (string-append directory "/log")))
+          (mkdir-p directory)
+          (chown directory (passwd:uid %user) (passwd:gid %user))
+          (call-with-output-file log (const #t))
+          (chown log (passwd:uid %user) (passwd:gid %user))))))
+
+(define autossh-service-type
+  (service-type
+   (name 'autossh)
+   (description "Automatically set up ssh connections (and keep them alive).")
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             (compose list autossh-shepherd-service))
+          (service-extension activation-service-type
+                             autossh-service-activation)))
+   (default-value (autossh-configuration))))
+
 ;;; ssh.scm ends here
-- 
cgit v1.2.3