1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
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))
30 ;;; This module implements secure shell (SSH) services.
35 "/var/spool/lsh/yarrow-seed-file")
37 (define (activation lsh host-key)
38 "Return the gexp to activate the LSH service for HOST-KEY."
40 (unless (file-exists? #$%yarrow-seed)
41 (system* (string-append #$lsh "/bin/lsh-make-seed")
42 "--sloppy" "-o" #$%yarrow-seed))
44 (unless (file-exists? #$host-key)
45 (mkdir-p (dirname #$host-key))
46 (format #t "creating SSH host key '~a'...~%" #$host-key)
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)))
54 (close-port (car in+out))
56 (dup2 (fileno (cdr in+out)) 1)
57 (execl (string-append #$lsh "/bin/lsh-keygen")
58 "lsh-keygen" "--server"))
60 (let ((write-key (primitive-fork)))
63 (close-port (cdr in+out))
65 (dup2 (fileno (car in+out)) 0)
66 (execl (string-append #$lsh "/bin/lsh-writekey")
67 "lsh-writekey" "--server" "-o" #$host-key))
69 (close-port (car in+out))
70 (close-port (cdr in+out))
72 (waitpid write-key))))))))))
74 (define* (lsh-service #:key
76 (host-key "/etc/lsh/host-key")
79 (allow-empty-passwords? #f)
83 (tcp/ip-forwarding? #t)
84 (password-authentication? #t)
85 (public-key-authentication? #t)
87 "Run the @command{lshd} program from @var{lsh} to listen on port @var{port-number}.
88 @var{host-key} must designate a file containing the host key, and readable
91 When @var{initialize?} is true, automatically create the seed and host key
92 upon service activation if they do not exist yet. This may take long and
95 When @var{initialize?} is false, it is up to the user to initialize the
96 randomness generator (@pxref{lsh-make-seed,,, lsh, LSH Manual}), and to create
97 a key pair with the private key stored in file @var{host-key} (@pxref{lshd
98 basics,,, lsh, LSH Manual}).
100 When @var{interfaces} is empty, lshd listens for connections on all the
101 network interfaces; otherwise, @var{interfaces} must be a list of host names
104 @var{allow-empty-passwords?} specifies whether to accept log-ins with empty
105 passwords, and @var{root-login?} specifies whether to accept log-ins as
108 The other options should be self-descriptive."
110 (cons* #~(string-append #$lsh "/sbin/lshd")
111 #~(string-append "--host-key=" #$host-key)
112 #~(string-append "--password-helper=" #$lsh "/sbin/lsh-pam-checkpw")
113 #~(string-append "--subsystems=sftp=" #$lsh "/sbin/sftp-server")
114 "-p" (number->string port-number)
115 (if password-authentication? "--password" "--no-password")
116 (if public-key-authentication?
117 "--publickey" "--no-publickey")
119 "--root-login" "--no-root-login")
121 "--x11-forward" "--no-x11-forward")
122 (if tcp/ip-forwarding?
123 "--tcpip-forward" "--no-tcpip-forward")
124 (if (null? interfaces)
126 (list (string-append "--interfaces="
127 (string-join interfaces ","))))))
129 (with-monad %store-monad
131 (documentation "GNU lsh SSH server")
132 (provision '(ssh-daemon))
133 (requirement '(networking))
134 (start #~(make-forkexec-constructor (list #$@lsh-command)))
135 (stop #~(make-kill-destructor))
137 (list (unix-pam-service
139 #:allow-empty-passwords? allow-empty-passwords?)))
141 (use-modules (guix build utils))
142 (mkdir-p "/var/spool/lsh")
144 (activation lsh host-key)
147 ;;; ssh.scm ends here