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 store)
  22   #:use-module (guix monads)
  23   #:use-module (gnu services)
  24   #:use-module (gnu system linux)                 ; 'pam-service'
  25   #:use-module (gnu packages lsh)
  26   #:export (lsh-service))
  27
  28 ;;; Commentary:
  29 ;;;
  30 ;;; This module implements secure shell (SSH) services.
  31 ;;;
  32 ;;; Code:
  33
  34 (define %yarrow-seed
  35   "/var/spool/lsh/yarrow-seed-file")
  36
  37 (define (activation lsh host-key)
  38   "Return the gexp to activate the LSH service for HOST-KEY."
  39   #~(begin
  40       (unless (file-exists? #$%yarrow-seed)
  41         (system* (string-append #$lsh "/bin/lsh-make-seed")
  42                  "--sloppy" "-o" #$%yarrow-seed))
  43
  44       (unless (file-exists? #$host-key)
  45         (mkdir-p (dirname #$host-key))
  46         (format #t "creating SSH host key '~a'...~%" #$host-key)
  47
  48         ;; FIXME: We're just doing a simple pipeline, but 'system' cannot be
  49         ;; used yet because /bin/sh might be dangling; factorize this somehow.
  50         (let* ((in+out (pipe))
  51                (keygen (primitive-fork)))
  52           (case keygen
  53             ((0)
  54              (close-port (car in+out))
  55              (close-fdes 1)
  56              (dup2 (fileno (cdr in+out)) 1)
  57              (execl (string-append #$lsh "/bin/lsh-keygen")
  58                     "lsh-keygen" "--server"))
  59             (else
  60              (let ((write-key (primitive-fork)))
  61                (case write-key
  62                  ((0)
  63                   (close-port (cdr in+out))
  64                   (close-fdes 0)
  65                   (dup2 (fileno (car in+out)) 0)
  66                   (execl (string-append #$lsh "/bin/lsh-writekey")
  67                          "lsh-writekey" "--server" "-o" #$host-key))
  68                  (else
  69                   (close-port (car in+out))
  70                   (close-port (cdr in+out))
  71                   (waitpid keygen)
  72                   (waitpid write-key))))))))))
  73
  74 (define* (lsh-service #:key
  75                       (lsh lsh)
  76                       (daemonic? #t)
  77                       (host-key "/etc/lsh/host-key")
  78                       (interfaces '())
  79                       (port-number 22)
  80                       (allow-empty-passwords? #f)
  81                       (root-login? #f)
  82                       (syslog-output? #t)
  83                       (pid-file? #f)
  84                       (pid-file "/var/run/lshd.pid")
  85                       (x11-forwarding? #t)
  86                       (tcp/ip-forwarding? #t)
  87                       (password-authentication? #t)
  88                       (public-key-authentication? #t)
  89                       (initialize? #t))
  90   "Run the @command{lshd} program from @var{lsh} to listen on port @var{port-number}.
  91 @var{host-key} must designate a file containing the host key, and readable
  92 only by root.
  93
  94 When @var{daemonic?} is true, @command{lshd} will detach from the
  95 controlling terminal and log its output to syslogd, unless one sets
  96 @var{syslog-output?} to false.  Obviously, it also makes lsh-service
  97 depend on existence of syslogd service.  When @var{pid-file?} is true,
  98 @command{lshd} writes its PID to the file called @var{pid-file}.
  99
 100 When @var{initialize?} is true, automatically create the seed and host key
 101 upon service activation if they do not exist yet.  This may take long and
 102 require interaction.
 103
 104 When @var{initialize?} is false, it is up to the user to initialize the
 105 randomness generator (@pxref{lsh-make-seed,,, lsh, LSH Manual}), and to create
 106 a key pair with the private key stored in file @var{host-key} (@pxref{lshd
 107 basics,,, lsh, LSH Manual}).
 108
 109 When @var{interfaces} is empty, lshd listens for connections on all the
 110 network interfaces; otherwise, @var{interfaces} must be a list of host names
 111 or addresses.
 112
 113 @var{allow-empty-passwords?} specifies whether to accept log-ins with empty
 114 passwords, and @var{root-login?} specifies whether to accept log-ins as
 115 root.
 116
 117 The other options should be self-descriptive."
 118   (define lsh-command
 119     (append
 120      (cons #~(string-append #$lsh "/sbin/lshd")
 121            (if daemonic?
 122                (let ((syslog (if syslog-output? '()
 123                                  (list "--no-syslog"))))
 124                  (cons "--daemonic"
 125                        (if pid-file?
 126                            (cons #~(string-append "--pid-file=" #$pid-file)
 127                                  syslog)
 128                            (cons "--no-pid-file" syslog))))
 129                (if pid-file?
 130                    (list #~(string-append "--pid-file=" #$pid-file))
 131                    '())))
 132      (cons* #~(string-append "--host-key=" #$host-key)
 133             #~(string-append "--password-helper=" #$lsh "/sbin/lsh-pam-checkpw")
 134             #~(string-append "--subsystems=sftp=" #$lsh "/sbin/sftp-server")
 135             "-p" (number->string port-number)
 136             (if password-authentication? "--password" "--no-password")
 137             (if public-key-authentication?
 138                 "--publickey" "--no-publickey")
 139             (if root-login?
 140                 "--root-login" "--no-root-login")
 141             (if x11-forwarding?
 142                 "--x11-forward" "--no-x11-forward")
 143             (if tcp/ip-forwarding?
 144                 "--tcpip-forward" "--no-tcpip-forward")
 145             (if (null? interfaces)
 146                 '()
 147                 (list (string-append "--interfaces="
 148                                      (string-join interfaces ",")))))))
 149
 150   (define requires
 151     (if (and daemonic? syslog-output?)
 152         '(networking syslogd)
 153         '(networking)))
 154
 155   (with-monad %store-monad
 156     (return (service
 157              (documentation "GNU lsh SSH server")
 158              (provision '(ssh-daemon))
 159              (requirement requires)
 160              (start #~(make-forkexec-constructor (list #$@lsh-command)))
 161              (stop  #~(make-kill-destructor))
 162              (pam-services
 163               (list (unix-pam-service
 164                      "lshd"
 165                      #:allow-empty-passwords? allow-empty-passwords?)))
 166              (activate #~(begin
 167                            (use-modules (guix build utils))
 168                            (mkdir-p "/var/spool/lsh")
 169                            #$(if initialize?
 170                                  (activation lsh host-key)
 171                                  #t)))))))
 172
 173 ;;; ssh.scm ends here