gnu/services/ssh.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu services ssh)
  20   #:use-module (guix gexp)
  21   #:use-module (guix records)
  22   #:use-module (gnu services)
  23   #:use-module (gnu services dmd)
  24   #:use-module (gnu system pam)
  25   #:use-module (gnu packages lsh)
  26   #:use-module (srfi srfi-26)
  27   #:export (lsh-service))
  28
  29 ;;; Commentary:
  30 ;;;
  31 ;;; This module implements secure shell (SSH) services.
  32 ;;;
  33 ;;; Code:
  34
  35 ;; TODO: Export.
  36 (define-record-type* <lsh-configuration>
  37   lsh-configuration make-lsh-configuration
  38   lsh-configuration?
  39   (lsh lsh-configuration-lsh
  40        (default lsh))
  41   (daemonic? lsh-configuration-daemonic?)
  42   (host-key lsh-configuration-host-key)
  43   (interfaces lsh-configuration-interfaces)
  44   (port-number lsh-configuration-port-number)
  45   (allow-empty-passwords? lsh-configuration-allow-empty-passwords?)
  46   (root-login? lsh-configuration-root-login?)
  47   (syslog-output? lsh-configuration-syslog-output?)
  48   (pid-file? lsh-configuration-pid-file?)
  49   (pid-file lsh-configuration-pid-file)
  50   (x11-forwarding? lsh-configuration-x11-forwarding?)
  51   (tcp/ip-forwarding? lsh-configuration-tcp/ip-forwarding?)
  52   (password-authentication? lsh-configuration-password-authentication?)
  53   (public-key-authentication? lsh-configuration-public-key-authentication?)
  54   (initialize? lsh-configuration-initialize?))
  55
  56 (define %yarrow-seed
  57   "/var/spool/lsh/yarrow-seed-file")
  58
  59 (define (lsh-initialization lsh host-key)
  60   "Return the gexp to initialize the LSH service for HOST-KEY."
  61   #~(begin
  62       (unless (file-exists? #$%yarrow-seed)
  63         (system* (string-append #$lsh "/bin/lsh-make-seed")
  64                  "--sloppy" "-o" #$%yarrow-seed))
  65
  66       (unless (file-exists? #$host-key)
  67         (mkdir-p (dirname #$host-key))
  68         (format #t "creating SSH host key '~a'...~%" #$host-key)
  69
  70         ;; FIXME: We're just doing a simple pipeline, but 'system' cannot be
  71         ;; used yet because /bin/sh might be dangling; factorize this somehow.
  72         (let* ((in+out (pipe))
  73                (keygen (primitive-fork)))
  74           (case keygen
  75             ((0)
  76              (close-port (car in+out))
  77              (close-fdes 1)
  78              (dup2 (fileno (cdr in+out)) 1)
  79              (execl (string-append #$lsh "/bin/lsh-keygen")
  80                     "lsh-keygen" "--server"))
  81             (else
  82              (let ((write-key (primitive-fork)))
  83                (case write-key
  84                  ((0)
  85                   (close-port (cdr in+out))
  86                   (close-fdes 0)
  87                   (dup2 (fileno (car in+out)) 0)
  88                   (execl (string-append #$lsh "/bin/lsh-writekey")
  89                          "lsh-writekey" "--server" "-o" #$host-key))
  90                  (else
  91                   (close-port (car in+out))
  92                   (close-port (cdr in+out))
  93                   (waitpid keygen)
  94                   (waitpid write-key))))))))))
  95
  96 (define (lsh-activation config)
  97   "Return the activation gexp for CONFIG."
  98   #~(begin
  99       (use-modules (guix build utils))
 100       (mkdir-p "/var/spool/lsh")
 101       #$(if (lsh-configuration-initialize? config)
 102             (lsh-initialization (lsh-configuration-lsh config)
 103                                 (lsh-configuration-host-key config))
 104             #t)))
 105
 106 (define (lsh-dmd-service config)
 107   "Return a <dmd-service> for lsh with CONFIG."
 108   (define lsh (lsh-configuration-lsh config))
 109   (define pid-file (lsh-configuration-pid-file config))
 110   (define pid-file? (lsh-configuration-pid-file? config))
 111   (define daemonic? (lsh-configuration-daemonic? config))
 112   (define interfaces (lsh-configuration-interfaces config))
 113
 114   (define lsh-command
 115     (append
 116      (cons #~(string-append #$lsh "/sbin/lshd")
 117            (if daemonic?
 118                (let ((syslog (if (lsh-configuration-syslog-output? config)
 119                                  '()
 120                                  (list "--no-syslog"))))
 121                  (cons "--daemonic"
 122                        (if pid-file?
 123                            (cons #~(string-append "--pid-file=" #$pid-file)
 124                                  syslog)
 125                            (cons "--no-pid-file" syslog))))
 126                (if pid-file?
 127                    (list #~(string-append "--pid-file=" #$pid-file))
 128                    '())))
 129      (cons* #~(string-append "--host-key="
 130                              #$(lsh-configuration-host-key config))
 131             #~(string-append "--password-helper=" #$lsh "/sbin/lsh-pam-checkpw")
 132             #~(string-append "--subsystems=sftp=" #$lsh "/sbin/sftp-server")
 133             "-p" (number->string (lsh-configuration-port-number config))
 134             (if (lsh-configuration-password-authentication? config)
 135                 "--password" "--no-password")
 136             (if (lsh-configuration-public-key-authentication? config)
 137                 "--publickey" "--no-publickey")
 138             (if (lsh-configuration-root-login? config)
 139                 "--root-login" "--no-root-login")
 140             (if (lsh-configuration-x11-forwarding? config)
 141                 "--x11-forward" "--no-x11-forward")
 142             (if (lsh-configuration-tcp/ip-forwarding? config)
 143                 "--tcpip-forward" "--no-tcpip-forward")
 144             (if (null? interfaces)
 145                 '()
 146                 (map (cut string-append "--interface=" <>)
 147                      interfaces)))))
 148
 149   (define requires
 150     (if (and daemonic? (lsh-configuration-syslog-output? config))
 151         '(networking syslogd)
 152         '(networking)))
 153
 154   (list (dmd-service
 155          (documentation "GNU lsh SSH server")
 156          (provision '(ssh-daemon))
 157          (requirement requires)
 158          (start #~(make-forkexec-constructor (list #$@lsh-command)))
 159          (stop  #~(make-kill-destructor)))))
 160
 161 (define (lsh-pam-services config)
 162   "Return a list of <pam-services> for lshd with CONFIG."
 163   (list (unix-pam-service
 164          "lshd"
 165          #:allow-empty-passwords?
 166          (lsh-configuration-allow-empty-passwords? config))))
 167
 168 (define lsh-service-type
 169   (service-type (name 'lsh)
 170                 (extensions
 171                  (list (service-extension dmd-root-service-type
 172                                           lsh-dmd-service)
 173                        (service-extension pam-root-service-type
 174                                           lsh-pam-services)
 175                        (service-extension activation-service-type
 176                                           lsh-activation)))))
 177
 178 (define* (lsh-service #:key
 179                       (lsh lsh)
 180                       (daemonic? #t)
 181                       (host-key "/etc/lsh/host-key")
 182                       (interfaces '())
 183                       (port-number 22)
 184                       (allow-empty-passwords? #f)
 185                       (root-login? #f)
 186                       (syslog-output? #t)
 187                       (pid-file? #f)
 188                       (pid-file "/var/run/lshd.pid")
 189                       (x11-forwarding? #t)
 190                       (tcp/ip-forwarding? #t)
 191                       (password-authentication? #t)
 192                       (public-key-authentication? #t)
 193                       (initialize? #t))
 194   "Run the @command{lshd} program from @var{lsh} to listen on port @var{port-number}.
 195 @var{host-key} must designate a file containing the host key, and readable
 196 only by root.
 197
 198 When @var{daemonic?} is true, @command{lshd} will detach from the
 199 controlling terminal and log its output to syslogd, unless one sets
 200 @var{syslog-output?} to false.  Obviously, it also makes lsh-service
 201 depend on existence of syslogd service.  When @var{pid-file?} is true,
 202 @command{lshd} writes its PID to the file called @var{pid-file}.
 203
 204 When @var{initialize?} is true, automatically create the seed and host key
 205 upon service activation if they do not exist yet.  This may take long and
 206 require interaction.
 207
 208 When @var{initialize?} is false, it is up to the user to initialize the
 209 randomness generator (@pxref{lsh-make-seed,,, lsh, LSH Manual}), and to create
 210 a key pair with the private key stored in file @var{host-key} (@pxref{lshd
 211 basics,,, lsh, LSH Manual}).
 212
 213 When @var{interfaces} is empty, lshd listens for connections on all the
 214 network interfaces; otherwise, @var{interfaces} must be a list of host names
 215 or addresses.
 216
 217 @var{allow-empty-passwords?} specifies whether to accept log-ins with empty
 218 passwords, and @var{root-login?} specifies whether to accept log-ins as
 219 root.
 220
 221 The other options should be self-descriptive."
 222   (service lsh-service-type
 223            (lsh-configuration (lsh lsh) (daemonic? daemonic?)
 224                               (host-key host-key) (interfaces interfaces)
 225                               (port-number port-number)
 226                               (allow-empty-passwords? allow-empty-passwords?)
 227                               (root-login? root-login?)
 228                               (syslog-output? syslog-output?)
 229                               (pid-file? pid-file?) (pid-file pid-file)
 230                               (x11-forwarding? x11-forwarding?)
 231                               (tcp/ip-forwarding? tcp/ip-forwarding?)
 232                               (password-authentication?
 233                                password-authentication?)
 234                               (public-key-authentication?
 235                                public-key-authentication?)
 236                               (initialize? initialize?))))
 237
 238 ;;; ssh.scm ends here