[jackhill/guix/guix.git] / gnu / services / ssh.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services ssh)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system pam)
  #:use-module (gnu packages lsh)
  #:use-module (srfi srfi-26)
  #:export (lsh-service))

;;; Commentary:
;;;
;;; This module implements secure shell (SSH) services.
;;;
;;; Code:

;; TODO: Export.
(define-record-type* <lsh-configuration>
  lsh-configuration make-lsh-configuration
  lsh-configuration?
  (lsh lsh-configuration-lsh
       (default lsh))
  (daemonic? lsh-configuration-daemonic?)
  (host-key lsh-configuration-host-key)
  (interfaces lsh-configuration-interfaces)
  (port-number lsh-configuration-port-number)
  (allow-empty-passwords? lsh-configuration-allow-empty-passwords?)
  (root-login? lsh-configuration-root-login?)
  (syslog-output? lsh-configuration-syslog-output?)
  (pid-file? lsh-configuration-pid-file?)
  (pid-file lsh-configuration-pid-file)
  (x11-forwarding? lsh-configuration-x11-forwarding?)
  (tcp/ip-forwarding? lsh-configuration-tcp/ip-forwarding?)
  (password-authentication? lsh-configuration-password-authentication?)
  (public-key-authentication? lsh-configuration-public-key-authentication?)
  (initialize? lsh-configuration-initialize?))

(define %yarrow-seed
  "/var/spool/lsh/yarrow-seed-file")

(define (lsh-initialization lsh host-key)
  "Return the gexp to initialize the LSH service for HOST-KEY."
  #~(begin
      (unless (file-exists? #$%yarrow-seed)
        (system* (string-append #$lsh "/bin/lsh-make-seed")
                 "--sloppy" "-o" #$%yarrow-seed))

      (unless (file-exists? #$host-key)
        (mkdir-p (dirname #$host-key))
        (format #t "creating SSH host key '~a'...~%" #$host-key)

        ;; FIXME: We're just doing a simple pipeline, but 'system' cannot be
        ;; used yet because /bin/sh might be dangling; factorize this somehow.
        (let* ((in+out (pipe))
               (keygen (primitive-fork)))
          (case keygen
            ((0)
             (close-port (car in+out))
             (close-fdes 1)
             (dup2 (fileno (cdr in+out)) 1)
             (execl (string-append #$lsh "/bin/lsh-keygen")
                    "lsh-keygen" "--server"))
            (else
             (let ((write-key (primitive-fork)))
               (case write-key
                 ((0)
                  (close-port (cdr in+out))
                  (close-fdes 0)
                  (dup2 (fileno (car in+out)) 0)
                  (execl (string-append #$lsh "/bin/lsh-writekey")
                         "lsh-writekey" "--server" "-o" #$host-key))
                 (else
                  (close-port (car in+out))
                  (close-port (cdr in+out))
                  (waitpid keygen)
                  (waitpid write-key))))))))))

(define (lsh-activation config)
  "Return the activation gexp for CONFIG."
  #~(begin
      (use-modules (guix build utils))
      (mkdir-p "/var/spool/lsh")
      #$(if (lsh-configuration-initialize? config)
            (lsh-initialization (lsh-configuration-lsh config)
                                (lsh-configuration-host-key config))
            #t)))

(define (lsh-shepherd-service config)
  "Return a <shepherd-service> for lsh with CONFIG."
  (define lsh (lsh-configuration-lsh config))
  (define pid-file (lsh-configuration-pid-file config))
  (define pid-file? (lsh-configuration-pid-file? config))
  (define daemonic? (lsh-configuration-daemonic? config))
  (define interfaces (lsh-configuration-interfaces config))

  (define lsh-command
    (append
     (cons #~(string-append #$lsh "/sbin/lshd")
           (if daemonic?
               (let ((syslog (if (lsh-configuration-syslog-output? config)
                                 '()
                                 (list "--no-syslog"))))
                 (cons "--daemonic"
                       (if pid-file?
                           (cons #~(string-append "--pid-file=" #$pid-file)
                                 syslog)
                           (cons "--no-pid-file" syslog))))
               (if pid-file?
                   (list #~(string-append "--pid-file=" #$pid-file))
                   '())))
     (cons* #~(string-append "--host-key="
                             #$(lsh-configuration-host-key config))
            #~(string-append "--password-helper=" #$lsh "/sbin/lsh-pam-checkpw")
            #~(string-append "--subsystems=sftp=" #$lsh "/sbin/sftp-server")
            "-p" (number->string (lsh-configuration-port-number config))
            (if (lsh-configuration-password-authentication? config)
                "--password" "--no-password")
            (if (lsh-configuration-public-key-authentication? config)
                "--publickey" "--no-publickey")
            (if (lsh-configuration-root-login? config)
                "--root-login" "--no-root-login")
            (if (lsh-configuration-x11-forwarding? config)
                "--x11-forward" "--no-x11-forward")
            (if (lsh-configuration-tcp/ip-forwarding? config)
                "--tcpip-forward" "--no-tcpip-forward")
            (if (null? interfaces)
                '()
                (map (cut string-append "--interface=" <>)
                     interfaces)))))

  (define requires
    (if (and daemonic? (lsh-configuration-syslog-output? config))
        '(networking syslogd)
        '(networking)))

  (list (shepherd-service
         (documentation "GNU lsh SSH server")
         (provision '(ssh-daemon))
         (requirement requires)
         (start #~(make-forkexec-constructor (list #$@lsh-command)))
         (stop  #~(make-kill-destructor)))))

(define (lsh-pam-services config)
  "Return a list of <pam-services> for lshd with CONFIG."
  (list (unix-pam-service
         "lshd"
         #:allow-empty-passwords?
         (lsh-configuration-allow-empty-passwords? config))))

(define lsh-service-type
  (service-type (name 'lsh)
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          lsh-shepherd-service)
                       (service-extension pam-root-service-type
                                          lsh-pam-services)
                       (service-extension activation-service-type
                                          lsh-activation)))))

(define* (lsh-service #:key
                      (lsh lsh)
                      (daemonic? #t)
                      (host-key "/etc/lsh/host-key")
                      (interfaces '())
                      (port-number 22)
                      (allow-empty-passwords? #f)
                      (root-login? #f)
                      (syslog-output? #t)
                      (pid-file? #f)
                      (pid-file "/var/run/lshd.pid")
                      (x11-forwarding? #t)
                      (tcp/ip-forwarding? #t)
                      (password-authentication? #t)
                      (public-key-authentication? #t)
                      (initialize? #t))
  "Run the @command{lshd} program from @var{lsh} to listen on port @var{port-number}.
@var{host-key} must designate a file containing the host key, and readable
only by root.

When @var{daemonic?} is true, @command{lshd} will detach from the
controlling terminal and log its output to syslogd, unless one sets
@var{syslog-output?} to false.  Obviously, it also makes lsh-service
depend on existence of syslogd service.  When @var{pid-file?} is true,
@command{lshd} writes its PID to the file called @var{pid-file}.

When @var{initialize?} is true, automatically create the seed and host key
upon service activation if they do not exist yet.  This may take long and
require interaction.

When @var{initialize?} is false, it is up to the user to initialize the
randomness generator (@pxref{lsh-make-seed,,, lsh, LSH Manual}), and to create
a key pair with the private key stored in file @var{host-key} (@pxref{lshd
basics,,, lsh, LSH Manual}).

When @var{interfaces} is empty, lshd listens for connections on all the
network interfaces; otherwise, @var{interfaces} must be a list of host names
or addresses.

@var{allow-empty-passwords?} specifies whether to accept log-ins with empty
passwords, and @var{root-login?} specifies whether to accept log-ins as
root.

The other options should be self-descriptive."
  (service lsh-service-type
           (lsh-configuration (lsh lsh) (daemonic? daemonic?)
                              (host-key host-key) (interfaces interfaces)
                              (port-number port-number)
                              (allow-empty-passwords? allow-empty-passwords?)
                              (root-login? root-login?)
                              (syslog-output? syslog-output?)
                              (pid-file? pid-file?) (pid-file pid-file)
                              (x11-forwarding? x11-forwarding?)
                              (tcp/ip-forwarding? tcp/ip-forwarding?)
                              (password-authentication?
                               password-authentication?)
                              (public-key-authentication?
                               public-key-authentication?)
                              (initialize? initialize?))))

;;; ssh.scm ends here
Commit	Line	Data
f33e2d78	1	;;; GNU Guix --- Functional package management for GNU
e87f0591	2	;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
f33e2d78 LC	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)
0adfe95a	21	#:use-module (guix records)
f33e2d78	22	#:use-module (gnu services)
0190c1c0	23	#:use-module (gnu services shepherd)
6e828634	24	#:use-module (gnu system pam)
f33e2d78	25	#:use-module (gnu packages lsh)
fde40c98	26	#:use-module (srfi srfi-26)
f33e2d78 LC	27	#:export (lsh-service))
	28
	29	;;; Commentary:
	30	;;;
	31	;;; This module implements secure shell (SSH) services.
	32	;;;
	33	;;; Code:
	34
0adfe95a LC	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
f33e2d78 LC	56	(define %yarrow-seed
	57	"/var/spool/lsh/yarrow-seed-file")
	58
0adfe95a LC	59	(define (lsh-initialization lsh host-key)
0adfe95a LC	60	"Return the gexp to initialize the LSH service for HOST-KEY."
f33e2d78 LC	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
0adfe95a LC	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
d4053c71 AK	106	(define (lsh-shepherd-service config)
d4053c71 AK	107	"Return a <shepherd-service> for lsh with CONFIG."
0adfe95a LC	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	'()
fde40c98 LC	146	(map (cut string-append "--interface=" <>)
fde40c98 LC	147	interfaces)))))
0adfe95a LC	148
	149	(define requires
	150	(if (and daemonic? (lsh-configuration-syslog-output? config))
	151	'(networking syslogd)
	152	'(networking)))
	153
d4053c71	154	(list (shepherd-service
0adfe95a LC	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
d4053c71 AK	171	(list (service-extension shepherd-root-service-type
d4053c71 AK	172	lsh-shepherd-service)
0adfe95a LC	173	(service-extension pam-root-service-type
	174	lsh-pam-services)
	175	(service-extension activation-service-type
	176	lsh-activation)))))
	177
f33e2d78 LC	178	(define* (lsh-service #:key
f33e2d78 LC	179	(lsh lsh)
5833bf33	180	(daemonic? #t)
f33e2d78 LC	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)
5833bf33 DP	187	(pid-file? #f)
5833bf33 DP	188	(pid-file "/var/run/lshd.pid")
f33e2d78 LC	189	(x11-forwarding? #t)
	190	(tcp/ip-forwarding? #t)
	191	(password-authentication? #t)
	192	(public-key-authentication? #t)
21cc905a	193	(initialize? #t))
f33e2d78 LC	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
5833bf33 DP	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
f33e2d78 LC	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
20dd519c LC	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
f33e2d78 LC	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
20dd519c LC	217	@var{allow-empty-passwords?} specifies whether to accept log-ins with empty
20dd519c LC	218	passwords, and @var{root-login?} specifies whether to accept log-ins as
f33e2d78 LC	219	root.
	220
	221	The other options should be self-descriptive."
0adfe95a LC	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?))))
f33e2d78 LC	237
f33e2d78 LC	238	;;; ssh.scm ends here