services: science.scm: Add missing copyright headers.
[jackhill/guix/guix.git] / gnu / services / ssh.scm
index bb94c5f..1e45495 100644 (file)
@@ -1,8 +1,11 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; 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>
+;;; Copyright © 2020 Oleg Pykhalov <go.wigust@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
   #:use-module (gnu packages admin)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
+  #:use-module (gnu services web)
   #:use-module (gnu system pam)
   #:use-module (gnu system shadow)
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix modules)
+  #:use-module ((guix i18n) #:select (G_))
+  #:use-module ((guix diagnostics) #:select (warning source-properties->location))
+  #:use-module ((guix memoization) #:select (mlambda))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
             dropbear-configuration
             dropbear-configuration?
             dropbear-service-type
-            dropbear-service))
+            dropbear-service
+
+            autossh-configuration
+            autossh-configuration?
+            autossh-service-type
+
+            webssh-configuration
+            webssh-configuration?
+            webssh-service-type
+            %webssh-configuration-nginx))
 
 ;;; Commentary:
 ;;;
 
   (list (shepherd-service
          (documentation "GNU lsh SSH server")
-         (provision '(ssh-daemon))
+         (provision '(ssh-daemon ssh sshd))
          (requirement requires)
          (start #~(make-forkexec-constructor (list #$@lsh-command)))
          (stop  #~(make-kill-destructor)))))
   "Return a list of <pam-services> for lshd with CONFIG."
   (list (unix-pam-service
          "lshd"
+         #:login-uid? #t
          #:allow-empty-passwords?
          (lsh-configuration-allow-empty-passwords? config))))
 
@@ -262,6 +279,16 @@ The other options should be self-descriptive."
 ;;; OpenSSH.
 ;;;
 
+(define true-but-soon-false
+  (mlambda (loc)
+    ;; The plan is to change the default 'password-authentication?' to #f in
+    ;; Guix 1.3.0 or so.  See <https://issues.guix.gnu.org/44808>.
+    (warning (source-properties->location loc)
+             (G_ "The default value of the 'password-authentication?'
+field of 'openssh-configuration' will change from #true to #false in the
+future.  Explicitly set it to #true to allow password authentication.~%"))
+    #t))
+
 (define-record-type* <openssh-configuration>
   openssh-configuration make-openssh-configuration
   openssh-configuration?
@@ -282,7 +309,8 @@ The other options should be self-descriptive."
                           (default #f))
   ;; Boolean
   (password-authentication? openssh-configuration-password-authentication?
-                            (default #t))
+                            (default (true-but-soon-false
+                                      (current-source-location))))
   ;; Boolean
   (public-key-authentication? openssh-configuration-public-key-authentication?
                               (default #t))
@@ -323,6 +351,12 @@ The other options should be self-descriptive."
   (log-level             openssh-configuration-log-level
                          (default 'info))
 
+  ;; String
+  ;; This is an "escape hatch" to provide configuration that isn't yet
+  ;; supported by this configuration record.
+  (extra-content         openssh-configuration-extra-content
+                         (default ""))
+
   ;; list of user-name/file-like tuples
   (authorized-keys       openssh-authorized-keys
                          (default '()))
@@ -342,7 +376,7 @@ The other options should be self-descriptive."
           (system? #t)
           (comment "sshd privilege separation user")
           (home-directory "/var/run/sshd")
-          (shell #~(string-append #$shadow "/sbin/nologin")))))
+          (shell (file-append shadow "/sbin/nologin")))))
 
 (define (openssh-activation config)
   "Return the activation GEXP for CONFIG."
@@ -471,6 +505,9 @@ of user-name/file-like tuples."
             (match-lambda
               ((name command) (format port "Subsystem\t~a\t~a\n" name command)))
             '#$(openssh-configuration-subsystems config))
+
+           (format port "~a\n"
+                   #$(openssh-configuration-extra-content config))
            #t)))))
 
 (define (openssh-shepherd-service config)
@@ -486,7 +523,7 @@ of user-name/file-like tuples."
   (list (shepherd-service
          (documentation "OpenSSH server.")
          (requirement '(syslogd loopback))
-         (provision '(ssh-daemon))
+         (provision '(ssh-daemon ssh sshd))
          (start #~(make-forkexec-constructor #$openssh-command
                                              #:pid-file #$pid-file))
          (stop #~(make-kill-destructor))
@@ -496,6 +533,7 @@ of user-name/file-like tuples."
   "Return a list of <pam-services> for sshd with CONFIG."
   (list (unix-pam-service
          "sshd"
+         #:login-uid? #t
          #:allow-empty-passwords?
          (openssh-configuration-allow-empty-passwords? config))))
 
@@ -594,7 +632,7 @@ of user-name/file-like tuples."
   (list (shepherd-service
          (documentation "Dropbear SSH server.")
          (requirement requires)
-         (provision '(ssh-daemon))
+         (provision '(ssh-daemon ssh sshd))
          (start #~(make-forkexec-constructor #$dropbear-command
                                              #:pid-file #$pid-file))
          (stop #~(make-kill-destructor)))))
@@ -607,7 +645,8 @@ of user-name/file-like tuples."
                  (list (service-extension shepherd-root-service-type
                                           dropbear-shepherd-service)
                        (service-extension activation-service-type
-                                          dropbear-activation)))))
+                                          dropbear-activation)))
+                (default-value (dropbear-configuration))))
 
 (define* (dropbear-service #:optional (config (dropbear-configuration)))
   "Run the @uref{https://matt.ucc.asn.au/dropbear/dropbear.html,Dropbear SSH
@@ -615,4 +654,225 @@ daemon} with the given @var{config}, a @code{<dropbear-configuration>}
 object."
   (service dropbear-service-type config))
 
+\f
+;;;
+;;; 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))))
+
+\f
+;;;
+;;; WebSSH
+;;;
+
+(define-record-type* <webssh-configuration>
+  webssh-configuration make-webssh-configuration
+  webssh-configuration?
+  (package     webssh-configuration-package     ;package
+               (default webssh))
+  (user-name   webssh-configuration-user-name   ;string
+               (default "webssh"))
+  (group-name  webssh-configuration-group-name  ;string
+               (default "webssh"))
+  (policy      webssh-configuration-policy      ;symbol
+               (default #f))
+  (known-hosts webssh-configuration-known-hosts ;list of strings
+               (default #f))
+  (port        webssh-configuration-port        ;number
+               (default #f))
+  (address     webssh-configuration-address     ;string
+               (default #f))
+  (log-file    webssh-configuration-log-file    ;string
+               (default "/var/log/webssh.log"))
+  (log-level   webssh-configuration-log-level   ;symbol
+               (default #f)))
+
+(define %webssh-configuration-nginx
+  (nginx-server-configuration
+   (listen '("80"))
+   (locations
+    (list (nginx-location-configuration
+           (uri "/")
+           (body '("proxy_pass http://127.0.0.1:8888;"
+                   "proxy_http_version 1.1;"
+                   "proxy_read_timeout 300;"
+                   "proxy_set_header Upgrade $http_upgrade;"
+                   "proxy_set_header Connection \"upgrade\";"
+                   "proxy_set_header Host $http_host;"
+                   "proxy_set_header X-Real-IP $remote_addr;"
+                   "proxy_set_header X-Real-PORT $remote_port;")))))))
+
+(define webssh-account
+  ;; Return the user accounts and user groups for CONFIG.
+  (match-lambda
+    (($ <webssh-configuration> _ user-name group-name _ _ _ _ _ _)
+     (list (user-group
+            (name group-name))
+           (user-account
+            (name user-name)
+            (group group-name)
+            (comment "webssh privilege separation user")
+            (home-directory (string-append "/var/run/" user-name))
+            (shell #~(string-append #$shadow "/sbin/nologin")))))))
+
+(define webssh-activation
+  ;; Return the activation GEXP for CONFIG.
+  (match-lambda
+    (($ <webssh-configuration> _ user-name group-name policy known-hosts _ _
+                               log-file _)
+     (with-imported-modules '((guix build utils))
+       #~(begin
+           (let* ((home-dir (string-append "/var/run/" #$user-name))
+                  (ssh-dir (string-append home-dir "/.ssh"))
+                  (known-hosts-file (string-append ssh-dir "/known_hosts")))
+             (call-with-output-file #$log-file (const #t))
+             (mkdir-p ssh-dir)
+             (case '#$policy
+               ((reject)
+                (if '#$known-hosts
+                    (call-with-output-file known-hosts-file
+                      (lambda (port)
+                        (for-each (lambda (host) (display host port) (newline port))
+                                  '#$known-hosts)))
+                    (display-hint (G_ "webssh: reject policy requires `known-hosts'.")))))
+             (for-each (lambda (file)
+                         (chown file
+                                (passwd:uid (getpw #$user-name))
+                                (group:gid (getpw #$group-name))))
+                       (list #$log-file ssh-dir known-hosts-file))
+             (chmod ssh-dir #o700)))))))
+
+(define webssh-shepherd-service
+  (match-lambda
+    (($ <webssh-configuration> package user-name group-name policy _ port
+                               address log-file log-level)
+     (list (shepherd-service
+            (provision '(webssh))
+            (documentation "Run webssh daemon.")
+            (start #~(make-forkexec-constructor
+                      `(,(string-append #$webssh "/bin/wssh")
+                        ,(string-append "--log-file-prefix=" #$log-file)
+                        ,@(case '#$log-level
+                            ((debug) '("--logging=debug"))
+                            (else '()))
+                        ,@(case '#$policy
+                            ((reject) '("--policy=reject"))
+                            (else '()))
+                        ,@(if #$port
+                              (list (string-append "--port=" (number->string #$port)))
+                              '())
+                        ,@(if #$address
+                              (list (string-append "--address=" #$address))
+                              '()))
+                      #:user #$user-name
+                      #:group #$group-name))
+            (stop #~(make-kill-destructor)))))))
+
+(define webssh-service-type
+  (service-type
+   (name 'webssh)
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             webssh-shepherd-service)
+          (service-extension account-service-type
+                             webssh-account)
+          (service-extension activation-service-type
+                             webssh-activation)))
+   (default-value (webssh-configuration))
+   (description
+    "Run the webssh.")))
+
 ;;; ssh.scm ends here