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

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;;
;;; 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 (gnu packages ssh)
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system pam)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (srfi srfi-26)
  #:export (lsh-configuration
            lsh-configuration?
            lsh-service
            lsh-service-type

            dropbear-configuration
            dropbear-configuration?
            dropbear-service-type
            dropbear-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 (file-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?))))

\f
;;;
;;; Dropbear.
;;;

(define-record-type* <dropbear-configuration>
  dropbear-configuration make-dropbear-configuration
  dropbear-configuration?
  (dropbear               dropbear-configuration-dropbear
                          (default dropbear))
  (port-number            dropbear-configuration-port-number
                          (default 22))
  (syslog-output?         dropbear-configuration-syslog-output?
                          (default #t))
  (pid-file               dropbear-configuration-pid-file
                          (default "/var/run/dropbear.pid"))
  (root-login?            dropbear-configuration-root-login?
                          (default #f))
  (allow-empty-passwords? dropbear-configuration-allow-empty-passwords?
                          (default #f))
  (password-authentication? dropbear-configuration-password-authentication?
                            (default #t)))

(define (dropbear-activation config)
  "Return the activation gexp for CONFIG."
  #~(begin
      (mkdir-p "/etc/dropbear")))

(define (dropbear-shepherd-service config)
  "Return a <shepherd-service> for dropbear with CONFIG."
  (define dropbear
    (dropbear-configuration-dropbear config))

  (define pid-file
    (dropbear-configuration-pid-file config))

  (define dropbear-command
    #~(list (string-append #$dropbear "/sbin/dropbear")

            ;; '-R' allows host keys to be automatically generated upon first
            ;; connection, at a time when /dev/urandom is more likely securely
            ;; seeded.
            "-F" "-R"

            "-p" #$(number->string (dropbear-configuration-port-number config))
            "-P" #$pid-file
            #$@(if (dropbear-configuration-syslog-output? config) '() '("-E"))
            #$@(if (dropbear-configuration-root-login? config) '() '("-w"))
            #$@(if (dropbear-configuration-password-authentication? config)
                   '()
                   '("-s" "-g"))
            #$@(if (dropbear-configuration-allow-empty-passwords? config)
                   '("-B")
                   '())))

  (define requires
    (if (dropbear-configuration-syslog-output? config)
        '(networking syslogd) '(networking)))

  (list (shepherd-service
         (documentation "Dropbear SSH server.")
         (requirement requires)
         (provision '(ssh-daemon))
         (start #~(make-forkexec-constructor #$dropbear-command
                                             #:pid-file #$pid-file))
         (stop #~(make-kill-destructor)))))

(define dropbear-service-type
  (service-type (name 'dropbear)
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          dropbear-shepherd-service)
                       (service-extension activation-service-type
                                          dropbear-activation)))))

(define* (dropbear-service #:optional (config (dropbear-configuration)))
  "Run the @uref{https://matt.ucc.asn.au/dropbear/dropbear.html,Dropbear SSH
daemon} with the given @var{config}, a @code{<dropbear-configuration>}
object."
  (service dropbear-service-type config))

;;; ssh.scm ends here
Commit	Line	Data
f33e2d78	1	;;; GNU Guix --- Functional package management for GNU
71b0601a DC	2	;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
71b0601a DC	3	;;; Copyright © 2016 David Craven <david@craven.ch>
f33e2d78 LC	4	;;;
	5	;;; This file is part of GNU Guix.
	6	;;;
	7	;;; GNU Guix is free software; you can redistribute it and/or modify it
	8	;;; under the terms of the GNU General Public License as published by
	9	;;; the Free Software Foundation; either version 3 of the License, or (at
	10	;;; your option) any later version.
	11	;;;
	12	;;; GNU Guix is distributed in the hope that it will be useful, but
	13	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	14	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	;;; GNU General Public License for more details.
	16	;;;
	17	;;; You should have received a copy of the GNU General Public License
	18	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	19
	20	(define-module (gnu services ssh)
71b0601a	21	#:use-module (gnu packages ssh)
f33e2d78	22	#:use-module (gnu services)
0190c1c0	23	#:use-module (gnu services shepherd)
6e828634	24	#:use-module (gnu system pam)
71b0601a DC	25	#:use-module (guix gexp)
71b0601a DC	26	#:use-module (guix records)
fde40c98	27	#:use-module (srfi srfi-26)
24e96431 TČ	28	#:export (lsh-configuration
	29	lsh-configuration?
	30	lsh-service
	31	lsh-service-type
71b0601a DC	32
	33	dropbear-configuration
	34	dropbear-configuration?
	35	dropbear-service-type
	36	dropbear-service))
f33e2d78 LC	37
	38	;;; Commentary:
	39	;;;
	40	;;; This module implements secure shell (SSH) services.
	41	;;;
	42	;;; Code:
	43
0adfe95a LC	44	;; TODO: Export.
	45	(define-record-type* <lsh-configuration>
	46	lsh-configuration make-lsh-configuration
	47	lsh-configuration?
	48	(lsh lsh-configuration-lsh
	49	(default lsh))
	50	(daemonic? lsh-configuration-daemonic?)
	51	(host-key lsh-configuration-host-key)
	52	(interfaces lsh-configuration-interfaces)
	53	(port-number lsh-configuration-port-number)
	54	(allow-empty-passwords? lsh-configuration-allow-empty-passwords?)
	55	(root-login? lsh-configuration-root-login?)
	56	(syslog-output? lsh-configuration-syslog-output?)
	57	(pid-file? lsh-configuration-pid-file?)
	58	(pid-file lsh-configuration-pid-file)
	59	(x11-forwarding? lsh-configuration-x11-forwarding?)
	60	(tcp/ip-forwarding? lsh-configuration-tcp/ip-forwarding?)
	61	(password-authentication? lsh-configuration-password-authentication?)
	62	(public-key-authentication? lsh-configuration-public-key-authentication?)
	63	(initialize? lsh-configuration-initialize?))
	64
f33e2d78 LC	65	(define %yarrow-seed
	66	"/var/spool/lsh/yarrow-seed-file")
	67
0adfe95a LC	68	(define (lsh-initialization lsh host-key)
0adfe95a LC	69	"Return the gexp to initialize the LSH service for HOST-KEY."
f33e2d78 LC	70	#~(begin
	71	(unless (file-exists? #$%yarrow-seed)
	72	(system* (string-append #$lsh "/bin/lsh-make-seed")
	73	"--sloppy" "-o" #$%yarrow-seed))
	74
	75	(unless (file-exists? #$host-key)
	76	(mkdir-p (dirname #$host-key))
	77	(format #t "creating SSH host key '~a'...~%" #$host-key)
	78
	79	;; FIXME: We're just doing a simple pipeline, but 'system' cannot be
	80	;; used yet because /bin/sh might be dangling; factorize this somehow.
	81	(let* ((in+out (pipe))
	82	(keygen (primitive-fork)))
	83	(case keygen
	84	((0)
	85	(close-port (car in+out))
	86	(close-fdes 1)
	87	(dup2 (fileno (cdr in+out)) 1)
	88	(execl (string-append #$lsh "/bin/lsh-keygen")
	89	"lsh-keygen" "--server"))
	90	(else
	91	(let ((write-key (primitive-fork)))
	92	(case write-key
	93	((0)
	94	(close-port (cdr in+out))
	95	(close-fdes 0)
	96	(dup2 (fileno (car in+out)) 0)
	97	(execl (string-append #$lsh "/bin/lsh-writekey")
	98	"lsh-writekey" "--server" "-o" #$host-key))
	99	(else
	100	(close-port (car in+out))
	101	(close-port (cdr in+out))
	102	(waitpid keygen)
	103	(waitpid write-key))))))))))
	104
0adfe95a LC	105	(define (lsh-activation config)
	106	"Return the activation gexp for CONFIG."
	107	#~(begin
	108	(use-modules (guix build utils))
	109	(mkdir-p "/var/spool/lsh")
	110	#$(if (lsh-configuration-initialize? config)
	111	(lsh-initialization (lsh-configuration-lsh config)
	112	(lsh-configuration-host-key config))
	113	#t)))
	114
d4053c71 AK	115	(define (lsh-shepherd-service config)
d4053c71 AK	116	"Return a <shepherd-service> for lsh with CONFIG."
0adfe95a LC	117	(define lsh (lsh-configuration-lsh config))
	118	(define pid-file (lsh-configuration-pid-file config))
	119	(define pid-file? (lsh-configuration-pid-file? config))
	120	(define daemonic? (lsh-configuration-daemonic? config))
	121	(define interfaces (lsh-configuration-interfaces config))
	122
	123	(define lsh-command
	124	(append
9e41130b	125	(cons (file-append lsh "/sbin/lshd")
0adfe95a LC	126	(if daemonic?
	127	(let ((syslog (if (lsh-configuration-syslog-output? config)
	128	'()
	129	(list "--no-syslog"))))
	130	(cons "--daemonic"
	131	(if pid-file?
	132	(cons #~(string-append "--pid-file=" #$pid-file)
	133	syslog)
	134	(cons "--no-pid-file" syslog))))
	135	(if pid-file?
	136	(list #~(string-append "--pid-file=" #$pid-file))
	137	'())))
	138	(cons* #~(string-append "--host-key="
	139	#$(lsh-configuration-host-key config))
	140	#~(string-append "--password-helper=" #$lsh "/sbin/lsh-pam-checkpw")
	141	#~(string-append "--subsystems=sftp=" #$lsh "/sbin/sftp-server")
	142	"-p" (number->string (lsh-configuration-port-number config))
	143	(if (lsh-configuration-password-authentication? config)
	144	"--password" "--no-password")
	145	(if (lsh-configuration-public-key-authentication? config)
	146	"--publickey" "--no-publickey")
	147	(if (lsh-configuration-root-login? config)
	148	"--root-login" "--no-root-login")
	149	(if (lsh-configuration-x11-forwarding? config)
	150	"--x11-forward" "--no-x11-forward")
	151	(if (lsh-configuration-tcp/ip-forwarding? config)
	152	"--tcpip-forward" "--no-tcpip-forward")
	153	(if (null? interfaces)
	154	'()
fde40c98 LC	155	(map (cut string-append "--interface=" <>)
fde40c98 LC	156	interfaces)))))
0adfe95a LC	157
	158	(define requires
	159	(if (and daemonic? (lsh-configuration-syslog-output? config))
	160	'(networking syslogd)
	161	'(networking)))
	162
d4053c71	163	(list (shepherd-service
0adfe95a LC	164	(documentation "GNU lsh SSH server")
	165	(provision '(ssh-daemon))
	166	(requirement requires)
	167	(start #~(make-forkexec-constructor (list #$@lsh-command)))
	168	(stop #~(make-kill-destructor)))))
	169
	170	(define (lsh-pam-services config)
	171	"Return a list of <pam-services> for lshd with CONFIG."
	172	(list (unix-pam-service
	173	"lshd"
	174	#:allow-empty-passwords?
	175	(lsh-configuration-allow-empty-passwords? config))))
	176
	177	(define lsh-service-type
	178	(service-type (name 'lsh)
	179	(extensions
d4053c71 AK	180	(list (service-extension shepherd-root-service-type
d4053c71 AK	181	lsh-shepherd-service)
0adfe95a LC	182	(service-extension pam-root-service-type
	183	lsh-pam-services)
	184	(service-extension activation-service-type
	185	lsh-activation)))))
	186
f33e2d78 LC	187	(define* (lsh-service #:key
f33e2d78 LC	188	(lsh lsh)
5833bf33	189	(daemonic? #t)
f33e2d78 LC	190	(host-key "/etc/lsh/host-key")
	191	(interfaces '())
	192	(port-number 22)
	193	(allow-empty-passwords? #f)
	194	(root-login? #f)
	195	(syslog-output? #t)
5833bf33 DP	196	(pid-file? #f)
5833bf33 DP	197	(pid-file "/var/run/lshd.pid")
f33e2d78 LC	198	(x11-forwarding? #t)
	199	(tcp/ip-forwarding? #t)
	200	(password-authentication? #t)
	201	(public-key-authentication? #t)
21cc905a	202	(initialize? #t))
f33e2d78 LC	203	"Run the @command{lshd} program from @var{lsh} to listen on port @var{port-number}.
	204	@var{host-key} must designate a file containing the host key, and readable
	205	only by root.
	206
5833bf33 DP	207	When @var{daemonic?} is true, @command{lshd} will detach from the
	208	controlling terminal and log its output to syslogd, unless one sets
	209	@var{syslog-output?} to false. Obviously, it also makes lsh-service
	210	depend on existence of syslogd service. When @var{pid-file?} is true,
	211	@command{lshd} writes its PID to the file called @var{pid-file}.
	212
f33e2d78 LC	213	When @var{initialize?} is true, automatically create the seed and host key
	214	upon service activation if they do not exist yet. This may take long and
	215	require interaction.
	216
20dd519c LC	217	When @var{initialize?} is false, it is up to the user to initialize the
	218	randomness generator (@pxref{lsh-make-seed,,, lsh, LSH Manual}), and to create
	219	a key pair with the private key stored in file @var{host-key} (@pxref{lshd
	220	basics,,, lsh, LSH Manual}).
	221
f33e2d78 LC	222	When @var{interfaces} is empty, lshd listens for connections on all the
	223	network interfaces; otherwise, @var{interfaces} must be a list of host names
	224	or addresses.
	225
20dd519c LC	226	@var{allow-empty-passwords?} specifies whether to accept log-ins with empty
20dd519c LC	227	passwords, and @var{root-login?} specifies whether to accept log-ins as
f33e2d78 LC	228	root.
	229
	230	The other options should be self-descriptive."
0adfe95a LC	231	(service lsh-service-type
	232	(lsh-configuration (lsh lsh) (daemonic? daemonic?)
	233	(host-key host-key) (interfaces interfaces)
	234	(port-number port-number)
	235	(allow-empty-passwords? allow-empty-passwords?)
	236	(root-login? root-login?)
	237	(syslog-output? syslog-output?)
	238	(pid-file? pid-file?) (pid-file pid-file)
	239	(x11-forwarding? x11-forwarding?)
	240	(tcp/ip-forwarding? tcp/ip-forwarding?)
	241	(password-authentication?
	242	password-authentication?)
	243	(public-key-authentication?
	244	public-key-authentication?)
	245	(initialize? initialize?))))
f33e2d78	246
71b0601a DC	247	\f
	248	;;;
	249	;;; Dropbear.
	250	;;;
	251
	252	(define-record-type* <dropbear-configuration>
	253	dropbear-configuration make-dropbear-configuration
	254	dropbear-configuration?
	255	(dropbear dropbear-configuration-dropbear
	256	(default dropbear))
	257	(port-number dropbear-configuration-port-number
	258	(default 22))
	259	(syslog-output? dropbear-configuration-syslog-output?
	260	(default #t))
	261	(pid-file dropbear-configuration-pid-file
	262	(default "/var/run/dropbear.pid"))
	263	(root-login? dropbear-configuration-root-login?
	264	(default #f))
	265	(allow-empty-passwords? dropbear-configuration-allow-empty-passwords?
	266	(default #f))
	267	(password-authentication? dropbear-configuration-password-authentication?
	268	(default #t)))
	269
	270	(define (dropbear-activation config)
	271	"Return the activation gexp for CONFIG."
	272	#~(begin
	273	(mkdir-p "/etc/dropbear")))
	274
	275	(define (dropbear-shepherd-service config)
	276	"Return a <shepherd-service> for dropbear with CONFIG."
	277	(define dropbear
	278	(dropbear-configuration-dropbear config))
	279
	280	(define pid-file
	281	(dropbear-configuration-pid-file config))
	282
	283	(define dropbear-command
	284	#~(list (string-append #$dropbear "/sbin/dropbear")
	285
	286	;; '-R' allows host keys to be automatically generated upon first
	287	;; connection, at a time when /dev/urandom is more likely securely
	288	;; seeded.
	289	"-F" "-R"
	290
	291	"-p" #$(number->string (dropbear-configuration-port-number config))
	292	"-P" #$pid-file
	293	#$@(if (dropbear-configuration-syslog-output? config) '() '("-E"))
	294	#$@(if (dropbear-configuration-root-login? config) '() '("-w"))
	295	#$@(if (dropbear-configuration-password-authentication? config)
	296	'()
	297	'("-s" "-g"))
	298	#$@(if (dropbear-configuration-allow-empty-passwords? config)
	299	'("-B")
	300	'())))
	301
	302	(define requires
	303	(if (dropbear-configuration-syslog-output? config)
	304	'(networking syslogd) '(networking)))
	305
	306	(list (shepherd-service
	307	(documentation "Dropbear SSH server.")
	308	(requirement requires)
	309	(provision '(ssh-daemon))
	310	(start #~(make-forkexec-constructor #$dropbear-command
311	#:pid-file #$pid-file))
312	(stop #~(make-kill-destructor)))))
313
314	(define dropbear-service-type
315	(service-type (name 'dropbear)
316	(extensions
317	(list (service-extension shepherd-root-service-type
318	dropbear-shepherd-service)
319	(service-extension activation-service-type
320	dropbear-activation)))))
321
322	(define* (dropbear-service #:optional (config (dropbear-configuration)))
323	"Run the @uref{https://matt.ucc.asn.au/dropbear/dropbear.html,Dropbear SSH
324	daemon} with the given @var{config}, a @code{<dropbear-configuration>}
325	object."
326	(service dropbear-service-type config))
327
f33e2d78	328	;;; ssh.scm ends here