guix-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [PATCH 2/2] services: Add 'dropbear-service'. (David Craven)


From: David Craven
Subject: Re: [PATCH 2/2] services: Add 'dropbear-service'. (David Craven)
Date: Tue, 5 Jul 2016 12:56:34 +0200

To test this in a vm don't forget to replace `-net user` with `-net
user,hostfwd=tcp::10022-:22` in `gnu/system/vm.scm`.

I'm currently also working on a spice service. I'm thinking it would
be nice to be able to specify qemu flags in services, then adding
`(rngd-service)` would include the `-device virtio-rng-pci` and
`(spice-vdagent-service)` the spice specific flags. I'm not sure yet
how this would work exactly. Or if a `(hardware-configuration)` would
be a better which we could at some point pass to the kernel package to
build a custom kernel with only the required modules.

On Mon, Jul 4, 2016 at 10:56 PM,  <address@hidden> wrote:
> Send Guix-devel mailing list submissions to
>         address@hidden
>
> To subscribe or unsubscribe via the World Wide Web, visit
>         https://lists.gnu.org/mailman/listinfo/guix-devel
> or, via email, send a message with subject or body 'help' to
>         address@hidden
>
> You can reach the person managing the list at
>         address@hidden
>
> When replying, please edit your Subject line so it is more specific
> than "Re: Contents of Guix-devel digest..."
>
>
> Today's Topics:
>
>    1. Re: [PATCH] gnu: Add scrollkeeper. (Leo Famulari)
>    2. Re: [PATCH] gnu: Add scrollkeeper. (Roel Janssen)
>    3. [PATCH 1/2] gnu: lsh: Move to (gnu packages ssh) (David Craven)
>    4. [PATCH 2/2] services: Add 'dropbear-service'. (David Craven)
>
>
> ----------------------------------------------------------------------
>
> Message: 1
> Date: Mon, 4 Jul 2016 15:25:09 -0400
> From: Leo Famulari <address@hidden>
> To: Roel Janssen <address@hidden>
> Cc: guix-devel <address@hidden>
> Subject: Re: [PATCH] gnu: Add scrollkeeper.
> Message-ID: <address@hidden>
> Content-Type: text/plain; charset=us-ascii
>
> On Mon, Jul 04, 2016 at 10:04:58AM +0200, Roel Janssen wrote:
>> Dear Guix,
>>
>> As you may know, I am trying to package GParted.  It uses Scrollkeeper
>> for its help function, so I'd like to add it to the distribution
>> already.
>
> Thank you for continuing with this!!
>
>> If it's fine with you, I will continue to push this to the repository.
>> As always, thank you for your time.
>
>> * gnu/packages/documentation.scm (scrollkeeper): New variable.
>
> You forgot to add yourself to the list of authors of documentation.scm.
> Otherwise, it looks good to me.
>
>
>
> ------------------------------
>
> Message: 2
> Date: Mon, 04 Jul 2016 21:37:59 +0200
> From: Roel Janssen <address@hidden>
> To: Leo Famulari <address@hidden>
> Cc: guix-devel <address@hidden>
> Subject: Re: [PATCH] gnu: Add scrollkeeper.
> Message-ID: <address@hidden>
> Content-Type: text/plain
>
>
> Leo Famulari writes:
>
>> On Mon, Jul 04, 2016 at 10:04:58AM +0200, Roel Janssen wrote:
>>> Dear Guix,
>>>
>>> As you may know, I am trying to package GParted.  It uses Scrollkeeper
>>> for its help function, so I'd like to add it to the distribution
>>> already.
>>
>> Thank you for continuing with this!!
>>
>>> If it's fine with you, I will continue to push this to the repository.
>>> As always, thank you for your time.
>>
>>> * gnu/packages/documentation.scm (scrollkeeper): New variable.
>>
>> You forgot to add yourself to the list of authors of documentation.scm.
>> Otherwise, it looks good to me.
>
> Thank you for your quick reply, and for noticing this. :)
> I applied it with my copyright line added to it.
>
> Thanks!
>
> Kind regards,
> Roel Janssen
>
>
>
> ------------------------------
>
> Message: 3
> Date: Mon,  4 Jul 2016 22:56:15 +0200
> From: David Craven <address@hidden>
> To: address@hidden
> Cc: David Craven <address@hidden>
> Subject: [PATCH 1/2] gnu: lsh: Move to (gnu packages ssh)
> Message-ID: <address@hidden>
> Content-Type: text/plain; charset=UTF-8
>
> * gnu/packages/lsh.scm: Remove.  Move 'lsh and liboop' to...
> * gnu/packages/ssh.scm (liboop, lsh): ... here.  New variables.
> * gnu/services/ssh.scm: Adjust accordingly.
> ---
>  gnu/packages/lsh.scm | 159 
> ---------------------------------------------------
>  gnu/packages/ssh.scm | 157 ++++++++++++++++++++++++++++++++++++++++++++++----
>  gnu/services/ssh.scm |   2 +-
>  3 files changed, 146 insertions(+), 172 deletions(-)
>  delete mode 100644 gnu/packages/lsh.scm
>
> diff --git a/gnu/packages/lsh.scm b/gnu/packages/lsh.scm
> deleted file mode 100644
> index 2ea1591..0000000
> --- a/gnu/packages/lsh.scm
> +++ /dev/null
> @@ -1,159 +0,0 @@
> -;;; GNU Guix --- Functional package management for GNU
> -;;; Copyright ? 2012, 2013, 2014, 2015, 2016 Ludovic Court?s <address@hidden>
> -;;;
> -;;; 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 packages lsh)
> -  #:use-module ((guix licenses) #:prefix license:)
> -  #:use-module (guix packages)
> -  #:use-module (guix download)
> -  #:use-module (guix build-system gnu)
> -  #:use-module (gnu packages)
> -  #:use-module (gnu packages m4)
> -  #:use-module (gnu packages linux)
> -  #:use-module (gnu packages nettle)
> -  #:use-module (gnu packages compression)
> -  #:use-module (gnu packages multiprecision)
> -  #:use-module (gnu packages readline)
> -  #:use-module (gnu packages gperf)
> -  #:use-module (gnu packages guile)
> -  #:use-module (gnu packages xorg))
> -
> -(define-public liboop
> -  (package
> -    (name "liboop")
> -    (version "1.0")
> -    (source
> -     (origin
> -      (method url-fetch)
> -      (uri (string-append "http://download.ofb.net/liboop/liboop-";
> -                          version ".tar.gz"))
> -      (sha256
> -       (base32
> -        "0z6rlalhvfca64jpvksppc9bdhs7jwhiw4y35g5ibvh91xp3rn1l"))
> -      (patches (search-patches "liboop-mips64-deplibs-fix.patch"))))
> -    (build-system gnu-build-system)
> -    (home-page "http://www.lysator.liu.se/liboop/";)
> -    (synopsis "Event loop library")
> -    (description "Liboop is a low-level event loop management library for
> -POSIX-based operating systems.  It supports the development of modular,
> -multiplexed applications which may respond to events from several sources.  
> It
> -replaces the \"select() loop\" and allows the registration of event handlers
> -for file and network I/O, timers and signals.  Since processes use these
> -mechanisms for almost all external communication, liboop can be used as the
> -basis for almost any application.")
> -    (license license:lgpl2.1+)))
> -
> -(define-public lsh
> -  (package
> -    (name "lsh")
> -    (version "2.1")
> -    (source (origin
> -              (method url-fetch)
> -              (uri (string-append "mirror://gnu/lsh/lsh-"
> -                                  version ".tar.gz"))
> -              (sha256
> -               (base32
> -                "1qqjy9zfzgny0rkb27c8c7dfsylvb6n0ld8h3an2r83pmaqr9gwb"))
> -              (modules '((guix build utils)))
> -              (snippet
> -               '(begin
> -                  (substitute* "src/testsuite/functions.sh"
> -                    (("localhost")
> -                     ;; Avoid host name lookups since they don't work in
> -                     ;; chroot builds.
> -                     "127.0.0.1")
> -                    (("set -e")
> -                     ;; Make tests more verbose.
> -                     "set -e\nset -x"))
> -
> -                  (substitute* (find-files "src/testsuite" "-test$")
> -                    (("localhost") "127.0.0.1"))
> -
> -                  (substitute* "src/testsuite/login-auth-test"
> -                    (("/bin/cat") "cat"))))))
> -    (build-system gnu-build-system)
> -    (native-inputs
> -     `(("m4" ,m4)
> -       ("guile" ,guile-2.0)
> -       ("gperf" ,gperf)
> -       ("psmisc" ,psmisc)))                       ; for `killall'
> -    (inputs
> -     `(("nettle" ,nettle-2)
> -       ("linux-pam" ,linux-pam)
> -
> -       ;; 'rl.c' uses the 'CPPFunction' type, which is no longer in
> -       ;; Readline 6.3.
> -       ("readline" ,readline-6.2)
> -
> -       ("liboop" ,liboop)
> -       ("zlib" ,zlib)
> -       ("gmp" ,gmp)
> -
> -       ;; The server (lshd) invokes xauth when X11 forwarding is requested.
> -       ;; This adds 24 MiB (or 27%) to the closure of lsh.
> -       ("xauth" ,xauth)))
> -    (arguments
> -     '(;; Skip the `configure' test that checks whether /dev/ptmx &
> -       ;; co. work as expected, because it relies on impurities (for
> -       ;; instance, /dev/pts may be unavailable in chroots.)
> -       #:configure-flags '("lsh_cv_sys_unix98_ptys=yes")
> -
> -       ;; FIXME: Tests won't run in a chroot, presumably because
> -       ;; /etc/profile is missing, and thus clients get an empty $PATH
> -       ;; and nothing works.
> -       #:tests? #f
> -
> -       #:phases
> -       (modify-phases %standard-phases
> -         (add-before 'configure 'pre-configure
> -           (lambda* (#:key inputs #:allow-other-keys)
> -             (let* ((nettle    (assoc-ref inputs "nettle"))
> -                    (sexp-conv (string-append nettle "/bin/sexp-conv")))
> -               ;; Make sure 'lsh' and 'lshd' pick 'sexp-conv' in the right 
> place
> -               ;; by default.
> -               (substitute* "src/environ.h.in"
> -                 (("^#define PATH_SEXP_CONV.*")
> -                  (string-append "#define PATH_SEXP_CONV \""
> -                                 sexp-conv "\"\n")))
> -
> -               ;; Same for the 'lsh-authorize' script.
> -               (substitute* "src/lsh-authorize"
> -                 (("=sexp-conv")
> -                  (string-append "=" sexp-conv)))
> -
> -               ;; Tell lshd where 'xauth' lives.  Another option would be to
> -               ;; hardcode "/run/current-system/profile/bin/xauth", thereby
> -               ;; reducing the closure size, but that wouldn't work on 
> foreign
> -               ;; distros.
> -               (with-fluids ((%default-port-encoding "ISO-8859-1"))
> -                 (substitute* "src/server_x11.c"
> -                   (("define XAUTH_PROGRAM.*")
> -                    (string-append "define XAUTH_PROGRAM \""
> -                                   (assoc-ref inputs "xauth")
> -                                   "/bin/xauth\"\n")))))
> -
> -             ;; Tests rely on $USER being set.
> -             (setenv "USER" "guix"))))))
> -    (home-page "http://www.lysator.liu.se/~nisse/lsh/";)
> -    (synopsis "GNU implementation of the Secure Shell (ssh) protocols")
> -    (description
> -     "GNU lsh is a free implementation of the SSH version 2 protocol.  It is
> -used to create a secure line of communication between two computers,
> -providing shell access to the server system from the client.  It provides
> -both the server daemon and the client application, as well as tools for
> -manipulating key files.")
> -    (license license:gpl2+)))
> diff --git a/gnu/packages/ssh.scm b/gnu/packages/ssh.scm
> index b8f107b..f764ab9 100644
> --- a/gnu/packages/ssh.scm
> +++ b/gnu/packages/ssh.scm
> @@ -20,27 +20,34 @@
>  ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
>
>  (define-module (gnu packages ssh)
> -  #:use-module ((guix licenses) #:prefix license:)
> +  #:use-module (gnu packages)
> +  #:use-module (gnu packages autotools)
> +  #:use-module (gnu packages base)
> +  #:autoload   (gnu packages boost) (boost)
>    #:use-module (gnu packages compression)
> +  #:use-module (gnu packages elf)
>    #:use-module (gnu packages gnupg)
> +  #:use-module (gnu packages gperf)
>    #:use-module (gnu packages groff)
> -  #:use-module (gnu packages elf)
>    #:use-module (gnu packages guile)
> -  #:use-module (gnu packages pkg-config)
> -  #:use-module (gnu packages autotools)
> -  #:use-module (gnu packages texinfo)
> -  #:use-module (gnu packages perl)
> +  #:use-module (gnu packages linux)
> +  #:use-module (gnu packages m4)
> +  #:use-module (gnu packages multiprecision)
>    #:use-module (gnu packages ncurses)
> +  #:use-module (gnu packages nettle)
> +  #:use-module (gnu packages perl)
> +  #:use-module (gnu packages pkg-config)
>    #:autoload   (gnu packages protobuf) (protobuf)
> -  #:autoload   (gnu packages boost) (boost)
> -  #:use-module (gnu packages base)
> +  #:use-module (gnu packages readline)
> +  #:use-module (gnu packages texinfo)
>    #:use-module (gnu packages tls)
> -  #:use-module (gnu packages)
> -  #:use-module (guix packages)
> +  #:use-module (gnu packages xorg)
> +  #:use-module (guix build-system cmake)
> +  #:use-module (guix build-system gnu)
>    #:use-module (guix download)
>    #:use-module (guix git-download)
> -  #:use-module (guix build-system gnu)
> -  #:use-module (guix build-system cmake))
> +  #:use-module ((guix licenses) #:prefix license:)
> +  #:use-module (guix packages))
>
>  (define-public libssh
>    (package
> @@ -355,3 +362,129 @@ client.  It runs on a variety of POSIX-based platforms. 
>  Dropbear is
>  particularly useful for embedded systems, such as wireless routers.")
>      (home-page "https://matt.ucc.asn.au/dropbear/dropbear.html";)
>      (license (license:x11-style "" "See file LICENSE."))))
> +
> +(define-public liboop
> +  (package
> +    (name "liboop")
> +    (version "1.0")
> +    (source
> +     (origin
> +      (method url-fetch)
> +      (uri (string-append "http://download.ofb.net/liboop/liboop-";
> +                          version ".tar.gz"))
> +      (sha256
> +       (base32
> +        "0z6rlalhvfca64jpvksppc9bdhs7jwhiw4y35g5ibvh91xp3rn1l"))
> +      (patches (search-patches "liboop-mips64-deplibs-fix.patch"))))
> +    (build-system gnu-build-system)
> +    (home-page "http://www.lysator.liu.se/liboop/";)
> +    (synopsis "Event loop library")
> +    (description "Liboop is a low-level event loop management library for
> +POSIX-based operating systems.  It supports the development of modular,
> +multiplexed applications which may respond to events from several sources.  
> It
> +replaces the \"select() loop\" and allows the registration of event handlers
> +for file and network I/O, timers and signals.  Since processes use these
> +mechanisms for almost all external communication, liboop can be used as the
> +basis for almost any application.")
> +    (license license:lgpl2.1+)))
> +
> +(define-public lsh
> +  (package
> +    (name "lsh")
> +    (version "2.1")
> +    (source (origin
> +              (method url-fetch)
> +              (uri (string-append "mirror://gnu/lsh/lsh-"
> +                                  version ".tar.gz"))
> +              (sha256
> +               (base32
> +                "1qqjy9zfzgny0rkb27c8c7dfsylvb6n0ld8h3an2r83pmaqr9gwb"))
> +              (modules '((guix build utils)))
> +              (snippet
> +               '(begin
> +                  (substitute* "src/testsuite/functions.sh"
> +                    (("localhost")
> +                     ;; Avoid host name lookups since they don't work in
> +                     ;; chroot builds.
> +                     "127.0.0.1")
> +                    (("set -e")
> +                     ;; Make tests more verbose.
> +                     "set -e\nset -x"))
> +
> +                  (substitute* (find-files "src/testsuite" "-test$")
> +                    (("localhost") "127.0.0.1"))
> +
> +                  (substitute* "src/testsuite/login-auth-test"
> +                    (("/bin/cat") "cat"))))))
> +    (build-system gnu-build-system)
> +    (native-inputs
> +     `(("m4" ,m4)
> +       ("guile" ,guile-2.0)
> +       ("gperf" ,gperf)
> +       ("psmisc" ,psmisc)))                       ; for `killall'
> +    (inputs
> +     `(("nettle" ,nettle-2)
> +       ("linux-pam" ,linux-pam)
> +
> +       ;; 'rl.c' uses the 'CPPFunction' type, which is no longer in
> +       ;; Readline 6.3.
> +       ("readline" ,readline-6.2)
> +
> +       ("liboop" ,liboop)
> +       ("zlib" ,zlib)
> +       ("gmp" ,gmp)
> +
> +       ;; The server (lshd) invokes xauth when X11 forwarding is requested.
> +       ;; This adds 24 MiB (or 27%) to the closure of lsh.
> +       ("xauth" ,xauth)))
> +    (arguments
> +     '(;; Skip the `configure' test that checks whether /dev/ptmx &
> +       ;; co. work as expected, because it relies on impurities (for
> +       ;; instance, /dev/pts may be unavailable in chroots.)
> +       #:configure-flags '("lsh_cv_sys_unix98_ptys=yes")
> +
> +       ;; FIXME: Tests won't run in a chroot, presumably because
> +       ;; /etc/profile is missing, and thus clients get an empty $PATH
> +       ;; and nothing works.
> +       #:tests? #f
> +
> +       #:phases
> +       (modify-phases %standard-phases
> +         (add-before 'configure 'pre-configure
> +           (lambda* (#:key inputs #:allow-other-keys)
> +             (let* ((nettle    (assoc-ref inputs "nettle"))
> +                    (sexp-conv (string-append nettle "/bin/sexp-conv")))
> +               ;; Make sure 'lsh' and 'lshd' pick 'sexp-conv' in the right 
> place
> +               ;; by default.
> +               (substitute* "src/environ.h.in"
> +                 (("^#define PATH_SEXP_CONV.*")
> +                  (string-append "#define PATH_SEXP_CONV \""
> +                                 sexp-conv "\"\n")))
> +
> +               ;; Same for the 'lsh-authorize' script.
> +               (substitute* "src/lsh-authorize"
> +                 (("=sexp-conv")
> +                  (string-append "=" sexp-conv)))
> +
> +               ;; Tell lshd where 'xauth' lives.  Another option would be to
> +               ;; hardcode "/run/current-system/profile/bin/xauth", thereby
> +               ;; reducing the closure size, but that wouldn't work on 
> foreign
> +               ;; distros.
> +               (with-fluids ((%default-port-encoding "ISO-8859-1"))
> +                 (substitute* "src/server_x11.c"
> +                   (("define XAUTH_PROGRAM.*")
> +                    (string-append "define XAUTH_PROGRAM \""
> +                                   (assoc-ref inputs "xauth")
> +                                   "/bin/xauth\"\n")))))
> +
> +             ;; Tests rely on $USER being set.
> +             (setenv "USER" "guix"))))))
> +    (home-page "http://www.lysator.liu.se/~nisse/lsh/";)
> +    (synopsis "GNU implementation of the Secure Shell (ssh) protocols")
> +    (description
> +     "GNU lsh is a free implementation of the SSH version 2 protocol.  It is
> +used to create a secure line of communication between two computers,
> +providing shell access to the server system from the client.  It provides
> +both the server daemon and the client application, as well as tools for
> +manipulating key files.")
> +    (license license:gpl2+)))
> diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
> index 33e1951..1eb9382 100644
> --- a/gnu/services/ssh.scm
> +++ b/gnu/services/ssh.scm
> @@ -22,7 +22,7 @@
>    #:use-module (gnu services)
>    #:use-module (gnu services shepherd)
>    #:use-module (gnu system pam)
> -  #:use-module (gnu packages lsh)
> +  #:use-module (gnu packages ssh)
>    #:use-module (srfi srfi-26)
>    #:export (lsh-service))
>
> --
> 2.9.0
>
>
>
> ------------------------------
>
> Message: 4
> Date: Mon,  4 Jul 2016 22:56:16 +0200
> From: David Craven <address@hidden>
> To: address@hidden
> Cc: David Craven <address@hidden>
> Subject: [PATCH 2/2] services: Add 'dropbear-service'.
> Message-ID: <address@hidden>
>
> * gnu/services/ssh.scm (dropbear-service, ...): New variables.
> * doc/guix.texi: New node.
> ---
>  doc/guix.texi        |  25 ++++++++++++-
>  gnu/services/ssh.scm | 104 
> +++++++++++++++++++++++++++++++++++++++++++++++++--
>  2 files changed, 124 insertions(+), 5 deletions(-)
>
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 62c0d34..377004f 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -7695,7 +7695,7 @@ In addition, @var{extra-settings} specifies a string to 
> append to the
>  configuration file.
>  @end deffn
>
> -Furthermore, @code{(gnu services ssh)} provides the following service.
> +Furthermore, @code{(gnu services ssh)} provides the following services.
>
>  @deffn {Scheme Procedure} lsh-service [#:host-key "/etc/lsh/host-key"] @
>         [#:daemonic? #t] [#:interfaces '()] [#:port-number 22] @
> @@ -7733,6 +7733,29 @@ root.
>  The other options should be self-descriptive.
>  @end deffn
>
> address@hidden {Scheme Procedure} dropbear-service [#:host-key 
> "/etc/dropbear/dropbear_ecdsa_host-key"] @
> +       [#:port-number 22] [#:allow-empty-passwords? #f] @
> +       [#:root-login? #f] [#:password-authentication? #t] @
> +       [#:syslog-output? #t] [#:initialize? #t]
> +Run the @command{dropbear} program from @var{dropbear} to listen on port 
> @var{port-number}.
> address@hidden must designate a file containing the host key, and readable
> +only by root.
> +
> +By default dropbear logs its output to syslogd, unless one sets
> address@hidden to false. This also makes dropbear-service depend
> +on existence of syslogd service.
> +
> +When @var{initialize?} is true, @command{dropbear} automatically generates 
> the
> +host key upon service activation if it does not exist yet.
> +When @var{initialize?} is false, it is up to create a key pair with the 
> private
> +key stored in file @var{host-key}. For more information consult the
> address@hidden man pages.
> +
> address@hidden specifies whether to accept log-ins with empty
> +passwords, and @var{root-login?} specifies whether to accept log-ins as
> +root.
> address@hidden deffn
> +
>  @defvr {Scheme Variable} %facebook-host-aliases
>  This variable contains a string for use in @file{/etc/hosts}
>  (@pxref{Host Names,,, libc, The GNU C Library Reference Manual}).  Each
> diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
> index 1eb9382..13a5df1 100644
> --- a/gnu/services/ssh.scm
> +++ b/gnu/services/ssh.scm
> @@ -17,14 +17,15 @@
>  ;;; 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 packages ssh)
>    #:use-module (gnu services)
>    #:use-module (gnu services shepherd)
>    #:use-module (gnu system pam)
> -  #:use-module (gnu packages ssh)
> +  #:use-module (guix gexp)
> +  #:use-module (guix records)
>    #:use-module (srfi srfi-26)
> -  #:export (lsh-service))
> +  #:export (dropbear-service
> +            lsh-service))
>
>  ;;; Commentary:
>  ;;;
> @@ -235,4 +236,99 @@ The other options should be self-descriptive."
>                                 public-key-authentication?)
>                                (initialize? initialize?))))
>
> +;;;
> +;;; Dropbear ssh server
> +;;;
> +
> +(define-record-type* <dropbear-configuration>
> +  dropbear-configuration make-dropbear-configuration
> +  dropbear-configuration?
> +  (dropbear dropbear-configuration-dropbear
> +            (default dropbear))
> +  (host-key dropbear-configuration-host-key)
> +  (port-number dropbear-configuration-port-number)
> +  (syslog-output? dropbear-configuration-syslog-output?)
> +  (pid-file dropbear-configuration-pid-file)
> +  (root-login? dropbear-configuration-root-login?)
> +  (allow-empty-passwords? dropbear-configuration-allow-empty-passwords?)
> +  (password-authentication? dropbear-configuration-password-authentication?)
> +  (initialize? dropbear-configuration-initialize?))
> +
> +(define (dropbear-initialization dropbear host-key)
> +  "Return the gexp to initialize the dropbear service for HOST-KEY."
> +  #~(begin
> +    (unless (file-exists? #$host-key)
> +      (mkdir-p (dirname #$host-key))
> +      (format #t "creating SSH host key '~a'...~%" #$host-key)
> +      (system* (string-append #$dropbear "/bin/dropbearkey")
> +                "-t" "ecdsa" "-f" #$host-key))))
> +
> +(define (dropbear-activation config)
> +  "Return the activation gexp for CONFIG."
> +  #~(begin
> +      #$(if (dropbear-configuration-initialize? config)
> +            (dropbear-initialization
> +              (dropbear-configuration-dropbear config)
> +              (dropbear-configuration-host-key config))
> +            #t)))
> +
> +(define (dropbear-shepherd-service config)
> +  "Return a <shepherd-service> for dropbear with CONFIG."
> +  (define dropbear (dropbear-configuration-dropbear config))
> +
> +  (define dropbear-command
> +    (append
> +      (list
> +        #~(string-append #$dropbear "/sbin/dropbear") "-F"
> +        "-p" (number->string (dropbear-configuration-port-number config))
> +        "-P" (dropbear-configuration-pid-file config)
> +        "-r" (dropbear-configuration-host-key config))
> +      (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 address@hidden))
> +    (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 #:key
> +  (dropbear dropbear)
> +  (host-key "/etc/dropbear/dropbear_ecdsa_host_key")
> +  (port-number 22)
> +  (allow-empty-passwords? #f)
> +  (root-login? #f)
> +  (syslog-output? #t)
> +  (pid-file "/var/run/dropbear.pid")
> +  (password-authentication? #t)
> +  (initialize? #t))
> +  "Run the @command{dropbear} daemon from @var{dropbear} to start a ssh 
> server."
> +  (service dropbear-service-type
> +    (dropbear-configuration
> +      (dropbear dropbear)
> +      (host-key host-key)
> +      (port-number port-number)
> +      (allow-empty-passwords? allow-empty-passwords?)
> +      (root-login? root-login?)
> +      (syslog-output? syslog-output?)
> +      (pid-file pid-file)
> +      (password-authentication? password-authentication?)
> +      (initialize? initialize?))))
> +
>  ;;; ssh.scm ends here
> --
> 2.9.0
>
>
>
> ------------------------------
>
> Subject: Digest Footer
>
> _______________________________________________
> Guix-devel mailing list
> address@hidden
> https://lists.gnu.org/mailman/listinfo/guix-devel
>
>
> ------------------------------
>
> End of Guix-devel Digest, Vol 37, Issue 26
> ******************************************



reply via email to

[Prev in Thread] Current Thread [Next in Thread]