;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2013, 2014 Andreas Enge ;;; Copyright © 2014, 2015, 2016 Mark H Weaver ;;; Copyright © 2015, 2016, 2018, 2019, 2020, 2021 Efraim Flashner ;;; Copyright © 2016, 2019 Leo Famulari ;;; Copyright © 2016, 2021 Nicolas Goaziou ;;; Copyright © 2016 Christine Lemmer-Webber ;;; Copyright © 2017–2021 Tobias Geerinckx-Rice ;;; Copyright © 2017 Stefan Reichör ;;; Copyright © 2017 Ricardo Wurmus ;;; Copyright © 2017 Nikita ;;; Copyright © 2018 Manuel Graf ;;; Copyright © 2019 Gábor Boskovits ;;; Copyright © 2019, 2020 Mathieu Othacehe ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; Copyright © 2020 Oleg Pykhalov ;;; Copyright © 2020 Maxim Cournoyer ;;; Copyright © 2021 Brice Waegeneire ;;; ;;; 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 . (define-module (gnu packages ssh) #:use-module (
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013-2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
;;;
;;; 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 build install)
  #:use-module (guix build syscalls)
  #:use-module (guix build utils)
  #:use-module (guix build store-copy)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)
  #:export (install-boot-config
            evaluate-populate-directive
            populate-root-file-system
            install-database-and-gc-roots
            populate-single-profile-directory
            mount-cow-store
            unmount-cow-store))

;;; Commentary:
;;;
;;; This module supports the installation of the GNU system on a hard disk.
;;; It is meant to be used both in a build environment (in derivations that
;;; build VM images), and on the bare metal (when really installing the
;;; system.)
;;;
;;; Code:

(define (install-boot-config bootcfg bootcfg-location mount-point)
  "Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT.  Note
that the caller must make sure that BOOTCFG is registered as a GC root so
that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
  (let* ((target (string-append mount-point bootcfg-location))
         (pivot  (string-append target ".new")))
    (mkdir-p (dirname target))

    ;; Copy BOOTCFG instead of just symlinking it, because symlinks won't
    ;; work when /boot is on a separate partition.  Do that atomically.
    (copy-file bootcfg pivot)
    (rename-file pivot target)))

(define* (evaluate-populate-directive directive target
                                      #:key
                                      (default-gid 0)
                                      (default-uid 0)
                                      (error-on-dangling-symlink? #t))
  "Evaluate DIRECTIVE, an sexp describing a file or directory to create under
directory TARGET.  DEFAULT-UID and DEFAULT-GID are the default UID and GID in
the context of the caller.  If the directive matches those defaults then,
'chown' won't be run.  When ERROR-ON-DANGLING-SYMLINK? is true, abort with an
error when a dangling symlink would be created."
  (define target* (if (string-suffix? "/" target)
                      target
                      (string-append target "/")))
  (let loop ((directive directive))
    (catch 'system-error
      (lambda ()
        (match directive
          (('directory name)
           (mkdir-p (string-append target* name)))
          (('directory name uid gid)
           (let ((dir (string-append target* name)))
             (mkdir-p dir)
             ;; If called from a context without "root" permissions, "chown"
             ;; to root will fail.  In that case, do not try to run "chown"
             ;; and assume that the file will be chowned elsewhere (when
             ;; interned in the store for instance).
             (or (and (= uid default-uid) (= gid default-gid))
                 (chown dir uid gid))))
          (('directory name uid gid mode)
           (loop `(directory ,name ,uid ,gid))
           (chmod (string-append target* name) mode))
          (('file name)
           (call-with-output-file (string-append target* name)
             (const #t)))
          (('file name (? string? content))
           (call-with-output-file (string-append target* name)
             (lambda (port)
               (display content port))))
          ((new '-> old)
           (let ((new* (string-append target* new)))
             (let try ()
               (catch 'system-error
                 (lambda ()
                   (when error-on-dangling-symlink?
                     ;; When the symbolic link points to a relative path,
                     ;; checking if its target exists must be done relatively
                     ;; to the link location.
                     (unless (if (string-prefix? "/" old)
                                 (file-exists? old)
                                 (with-directory-excursion (dirname new*)
                                   (file-exists? old)))
                       (error (format #f "symlink `~a' points to nonexistent \
file `~a'" new* old))))
                   (symlink old new*))
                 (lambda args
                   ;; When doing 'guix system init' on the current '/', some
                   ;; symlinks may already exists.  Override them.
                   (if (= EEXIST (system-error-errno args))
                       (begin
                         (delete-file new*)
                         (try))
                       (apply throw args)))))))))
      (lambda args
        ;; Usually we can only get here when installing to an existing root,
        ;; as with 'guix system init foo.scm /'.
        (format (current-error-port)
                "error: failed to evaluate directive: ~s~%"
                directive)
        (apply throw args)))))

(define (directives store)
  "Return a list of directives to populate the root file system that will host
STORE."
  `((directory ,store 0 0 #o1775)

    (directory "/etc")
    (directory "/var/log")                          ; for shepherd
    (directory "/var/guix/gcroots")
    (directory "/var/empty")                        ; for no-login accounts
    (directory "/var/db")                           ; for dhclient, etc.
    (directory "/mnt")
    (directory "/var/guix/profiles/per-user/root" 0 0)

    ;; Link to the initial system generation.
    ("/var/guix/profiles/system" -> "system-1-link")

    ("/var/guix/gcroots/booted-system" -> "/run/booted-system")
    ("/var/guix/gcroots/current-system" -> "/run/current-system")
    ("/var/guix/gcroots/profiles" -> "/var/guix/profiles")

    (directory "/bin")
    (directory "/tmp" 0 0 #o1777)                 ; sticky bit
    (directory "/var/tmp" 0 0 #o1777)
    (directory "/var/lock" 0 0 #o1777)

    (directory "/home" 0 0)))

(define* (populate-root-file-system system target
                                    #:key (extras '()))
  "Make the essential non-store files and directories on TARGET.  This
includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM.
EXTRAS is a list of directives appended to the built-in directives to populate
TARGET."
  ;; It's expected that some symbolic link targets do not exist yet, so do not
  ;; error on dangling links.
  (for-each (cut evaluate-populate-directive <> target
                 #:error-on-dangling-symlink? #f)
            (append (directives (%store-directory)) extras))

  ;; Add system generation 1.
  (let ((generation-1 (string-append target
                                     "/var/guix/profiles/system-1-link")))
    (let try ()
      (catch 'system-error
        (lambda ()
          (symlink system generation-1))
        (lambda args
          ;; If GENERATION-1 already exists, overwrite it.
          (if (= EEXIST (system-error-errno args))
              (begin
                (delete-file generation-1)
                (try))
              (apply throw args)))))))

(define %root-profile
  "/var/guix/profiles/per-user/root")

(define* (install-database-and-gc-roots root database profile
                                        #:key (profile-name "guix-profile"))
  "Install DATABASE, the store database, under directory ROOT.  Create
PROFILE-NAME and have it link to PROFILE, a store item."
  (define (scope file)
    (string-append root "/" file))

  (define (mkdir-p* dir)
    (mkdir-p (scope dir)))

  (define (symlink* old new)
    (symlink old (scope new)))

  (install-file database (scope "/var/guix/db/"))
  (chmod (scope "/var/guix/db/db.sqlite") #o644)
  (mkdir-p* "/var/guix/profiles")
  (mkdir-p* "/var/guix/gcroots")
  (symlink* "/var/guix/profiles" "/var/guix/gcroots/profiles")

  ;; Make root's profile, which makes it a GC root.
  (mkdir-p* %root-profile)
  (symlink* profile
            (string-append %root-profile "/" profile-name "-1-link"))
  (symlink* (string-append profile-name "-1-link")
            (string-append %root-profile "/" profile-name)))

(define* (populate-single-profile-directory directory
                                            #:key profile closure
                                            (profile-name "guix-profile")
                                            database)
  "Populate DIRECTORY with a store containing PROFILE, whose closure is given
in the file called CLOSURE (as generated by #:references-graphs.)  DIRECTORY
is initialized to contain a single profile under /root pointing to PROFILE.

When DATABASE is true, copy it to DIRECTORY/var/guix/db and create
DIRECTORY/var/guix/gcroots and friends.

PROFILE-NAME is the name of the profile being created under
/var/guix/profiles, typically either \"guix-profile\" or \"current-guix\".

This is used to create the self-contained tarballs with 'guix pack'."
  (define (scope file)
    (string-append directory "/" file))

  (define (mkdir-p* dir)
    (mkdir-p (scope dir)))

  (define (symlink* old new)
    (symlink old (scope new)))

  ;; Populate the store.
  (populate-store (list closure) directory
                  #:deduplicate? #f)

  (when database
    (install-database-and-gc-roots directory database profile
                                   #:profile-name profile-name))

  (match profile-name
    ("guix-profile"
     (mkdir-p* "/root")
     (symlink* (string-append %root-profile "/guix-profile")
               "/root/.guix-profile"))
    ("current-guix"
     (mkdir-p* "/root/.config/guix")
     (symlink* (string-append %root-profile "/current-guix")
               "/root/.config/guix/current"))
    (_
     #t)))

(define (mount-cow-store target backing-directory)
  "Make the store copy-on-write, using TARGET as the backing store.  This is
useful when TARGET is on a hard disk, whereas the current store is on a RAM
disk."
  (define (set-store-permissions directory)
    "Set the right perms on DIRECTORY to use it as the store."
    (chown directory 0 30000)      ;use the fixed 'guixbuild' GID
    (chmod directory #o1775))

  (let ((tmpdir (string-append target "/tmp")))
    (mkdir-p tmpdir)
    (mount tmpdir "/tmp" "none" MS_BIND))

  (let* ((rw-dir (string-append target backing-directory))
         (work-dir (string-append rw-dir "/../.overlayfs-workdir")))
    (mkdir-p rw-dir)
    (mkdir-p work-dir)
    (mkdir-p "/.rw-store")
    (set-store-permissions rw-dir)
    (set-store-permissions "/.rw-store")

    ;; Mount the overlay, then atomically make it the store.
    (mount "none" "/.rw-store" "overlay" 0
           (string-append "lowerdir=" (%store-directory) ","
                          "upperdir=" rw-dir ","
                          "workdir=" work-dir))
    (mount "/.rw-store" (%store-directory) "" MS_MOVE)
    (rmdir "/.rw-store")))

(define (umount* directory)
  "Unmount DIRECTORY, but retry a few times upon EBUSY."
  (let loop ((attempts 5))
    (catch 'system-error
      (lambda ()
        (umount directory))
      (lambda args
        (if (and (= EBUSY (system-error-errno args))
                 (> attempts 0))
            (begin
              (sleep 1)
              (loop (- attempts 1)))
            (apply throw args))))))

(define (unmount-cow-store target backing-directory)
  "Unmount copy-on-write store."
  (let ((tmp-dir "/remove"))
    (mkdir-p tmp-dir)
    (mount (%store-directory) tmp-dir "" MS_MOVE)

    ;; We might get EBUSY at this point, possibly because of lingering
    ;; processes with open file descriptors.  Use 'umount*' to retry upon
    ;; EBUSY, leaving a bit of time.  See <https://issues.guix.gnu.org/59884>.
    (umount* tmp-dir)

    (rmdir tmp-dir)
    (delete-file-recursively
     (string-append target backing-directory))))

;;; install.scm ends here
generated by cgit
sively bin) #t)))))) (native-inputs `(("autoconf" ,autoconf) ("automake" ,automake) ("libtool" ,libtool) ("texinfo" ,texinfo) ("pkg-config" ,pkg-config) ("which" ,which) ("guile" ,guile-3.0))) ;needed when cross-compiling. (inputs `(("guile" ,guile-3.0) ("libssh" ,libssh) ("libgcrypt" ,libgcrypt))) (synopsis "Guile bindings to libssh") (description "Guile-SSH is a library that provides access to the SSH protocol for programs written in GNU Guile interpreter. It is a wrapper to the underlying libssh library.") (license license:gpl3+))) (define-public guile2.0-ssh (package (inherit guile-ssh) (name "guile2.0-ssh") (native-inputs `(("guile" ,guile-2.0) ;needed when cross-compiling. ,@(alist-delete "guile" (package-native-inputs guile-ssh)))) (inputs `(("guile" ,guile-2.0) ,@(alist-delete "guile" (package-inputs guile-ssh)))))) (define-public guile2.2-ssh (package (inherit guile-ssh) (name "guile2.2-ssh") (native-inputs `(("guile" ,guile-2.2) ;needed when cross-compiling. ,@(alist-delete "guile" (package-native-inputs guile-ssh)))) (inputs `(("guile" ,guile-2.2) ,@(alist-delete "guile" (package-inputs guile-ssh)))))) (define-public guile3.0-ssh (deprecated-package "guile3.0-ssh" guile-ssh)) (define-public corkscrew ;; The last 2.0 release hails from 2009. Use a fork (submitted upstream as ;; ) that adds now-essential ;; IPv6 and TLS support. (let ((revision "0") (commit "268b71e88ee51fddceab96d665b327394f1feb12")) (package (name "corkscrew") (version (git-version "2.0" revision commit)) (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/rtgill82/corkscrew") (commit commit))) (sha256 (base32 "1rylbimlfig3ii4bqr4r058lkc43pqkxnxqpqdpm31blh3xs0dcw")) (file-name (git-file-name name version)))) (build-system gnu-build-system) (arguments `(#:configure-flags (list "--enable-ssl") #:phases (modify-phases %standard-phases (add-after 'unpack 'update-metadata (lambda _ (substitute* "configure.ac" ;; Our version differs significantly. (("2.0") (string-append ,version " (Guix)"))) (substitute* "corkscrew.c" ;; This domain's since been squat. (("\\(agroman@agroman\\.net\\)") (format #f "<~a>" ,(package-home-page this-package)))))) (add-after 'install 'install-documentation (lambda* (#:key outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (doc (string-append out "/share/doc/" ,name "-" ,version))) (install-file "README.md" doc) #t)))))) (native-inputs `(("autoconf" ,autoconf) ("automake" ,automake) ("pkg-config" ,pkg-config))) (inputs `(("openssl" ,openssl))) (home-page "https://github.com/patpadgett/corkscrew") (synopsis "SSH tunneling through HTTP(S) proxies") (description "Corkscrew tunnels SSH connections through most HTTP and HTTPS proxies. It supports proxy authentication through the HTTP basic authentication scheme with optional @acronym{TLS, Transport-Level Security} to protect credentials.") (license license:gpl2+)))) (define-public mosh (package (name "mosh") (version "1.3.2") (source (origin (method url-fetch) (uri (string-append "https://mosh.org/mosh-" version ".tar.gz")) (sha256 (base32 "05hjhlp6lk8yjcy59zywpf0r6s0h0b9zxq0lw66dh9x8vxrhaq6s")))) (build-system gnu-build-system) (arguments '(#:phases (modify-phases %standard-phases (add-after 'unpack 'patch-FHS-file-names (lambda _ (substitute* "scripts/mosh.pl" (("/bin/sh") (which "sh"))) #t)) (add-after 'install 'wrap (lambda* (#:key outputs #:allow-other-keys) ;; Make sure 'mosh' can find 'mosh-client' and ;; 'mosh-server'. (let* ((out (assoc-ref outputs "out")) (bin (string-append out "/bin"))) (wrap-program (string-append bin "/mosh") `("PATH" ":" prefix (,bin))))))))) (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("openssl" ,openssl) ("perl" ,perl) ("perl-io-tty" ,perl-io-tty) ("zlib" ,zlib) ("ncurses" ,ncurses) ("protobuf" ,protobuf) ("boost-headers" ,boost))) (home-page "https://mosh.org/") (synopsis "Remote shell tolerant to intermittent connectivity") (description "Mosh is a remote terminal application that allows client roaming, supports intermittent connectivity, and provides intelligent local echo and line editing of user keystrokes. It's a replacement for SSH that's more robust and responsive, especially over Wi-Fi, cellular, and long-distance links.") (license license:gpl3+))) (define-public dropbear (package (name "dropbear") (version "2020.81") (source (origin (method url-fetch) (uri (string-append "https://matt.ucc.asn.au/dropbear/releases/" "dropbear-" version ".tar.bz2")) (sha256 (base32 "0fy5ma4cfc2pk25mcccc67b2mf1rnb2c06ilb7ddnxbpnc85s8s8")) (modules '((guix build utils))) (snippet '(begin (delete-file-recursively "libtommath") (delete-file-recursively "libtomcrypt") (substitute* "configure" (("-ltomcrypt") "-ltomcrypt -ltommath")) #t)))) (build-system gnu-build-system) (arguments `(#:configure-flags '("--disable-bundled-libtom") #:tests? #f)) ; there is no "make check" or anything similar (inputs `(("libtomcrypt" ,libtomcrypt) ("libtommath" ,libtommath) ("zlib" ,zlib))) (synopsis "Small SSH server and client") (description "Dropbear is a relatively small SSH server and 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.1") (source (origin (method url-fetch) (uri (string-append "http://ftp.lysator.liu.se/pub/liboop/" name "-" version ".tar.gz")) (sha256 (base32 "1q0p1l72pq9k3bi7a366j2rishv7dzzkg3i6r2npsfg7cnnidbsn")))) (build-system gnu-build-system) (home-page "https://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")) #t)) (patches (search-patches "lsh-fix-x11-forwarding.patch")))) (build-system gnu-build-system) (native-inputs `(("autoconf" ,autoconf) ("automake" ,automake) ("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) ("libxau" ,libxau))) ;also required for x11-forwarding (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" ;; Use glibc's argp rather than the bundled one. "--with-system-argp" ;; 'lsh_argp.h' checks HAVE_ARGP_PARSE but nothing ;; defines it. "CPPFLAGS=-DHAVE_ARGP_PARSE") #:phases (modify-phases %standard-phases (add-after 'unpack 'disable-failing-tests (lambda _ ;; FIXME: Most tests won't run in a chroot, presumably because ;; /etc/profile is missing, and thus clients get an empty $PATH ;; and nothing works. Run only the subset that passes. (delete-file "configure") ;force rebootstrap (substitute* "src/testsuite/Makefile.am" (("seed-test \\\\") ;prevent trailing slash "seed-test") (("^\t(lsh|daemon|tcpip|socks|lshg|lcp|rapid7|lshd).*test.*") "")) #t)) (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"))) ;; Remove argp from the list of sub-directories; we don't want ;; to build it, really. (substitute* "src/Makefile.in" (("^SUBDIRS = argp") "SUBDIRS =")) ;; 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 "https://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+))) (define-public sshpass (package (name "sshpass") (version "1.09") (source (origin (method url-fetch) (uri (string-append "mirror://sourceforge/sshpass/sshpass/" version "/sshpass-" version ".tar.gz")) (sha256 (base32 "1dwzqknpswa8vjlbwsx9rcq1j2a7px9h9i2anh09pzkz0mg6wx3i")))) (build-system gnu-build-system) (home-page "https://sourceforge.net/projects/sshpass/") (synopsis "Non-interactive password authentication with SSH") (description "sshpass is a tool for non-interactively performing password authentication with SSH's so-called @dfn{interactive keyboard password authentication}.") (license license:gpl2+))) (define-public autossh (package (name "autossh") (version "1.4g") (source (origin (method url-fetch) (uri (string-append "https://www.harding.motd.ca/autossh/autossh-" version ".tgz")) (sha256 (base32 "0xqjw8df68f4kzkns5gcah61s5wk0m44qdk2z1d6388w6viwxhsz")))) (build-system gnu-build-system) (arguments `(#:tests? #f)) ; There is no "make check" or anything similar (inputs `(("openssh" ,openssh))) (synopsis "Automatically restart SSH sessions and tunnels") (description "autossh is a program to start a copy of @command{ssh} and monitor it, restarting it as necessary should it die or stop passing traffic.") (home-page "https://www.harding.motd.ca/autossh/") (license ;; Why point to a source file? Well, all the individual files have a ;; copy of this license in their headers, but there's no separate file ;; with that information. (license:non-copyleft "file://autossh.c")))) (define-public pdsh (package (name "pdsh") (version "2.34") (source (origin (method url-fetch) (uri (string-append "https://github.com/chaos/pdsh/" "releases/download/pdsh-" version "/pdsh-" version ".tar.gz")) (sha256 (base32 "1s91hmhrz7rfb6h3l5k97s393rcm1ww3svp8dx5z8vkkc933wyxl")))) (build-system gnu-build-system) (arguments `(#:configure-flags (list "--with-ssh") #:phases (modify-phases %standard-phases (add-after 'unpack 'patch-/bin/sh (lambda _ (substitute* '("tests/t0006-pdcp.sh" "tests/t0004-module-loading.sh" "tests/t2001-ssh.sh" "tests/t1003-slurm.sh" "tests/t6036-long-output-lines.sh" "tests/aggregate-results.sh" "tests/t2000-exec.sh" "tests/t0002-internal.sh" "tests/t1002-dshgroup.sh" "tests/t5000-dshbak.sh" "tests/t0001-basic.sh" "tests/t0005-rcmd_type-and-user.sh" "tests/test-lib.sh" "tests/t2002-mrsh.sh" "tests/t0003-wcoll.sh" "tests/test-modules/pcptest.c") (("/bin/sh") (which "bash"))) #t)) (add-after 'unpack 'patch-tests (lambda _ (substitute* "tests/t6036-long-output-lines.sh" (("which") (which "which"))) #t))))) (inputs `(("openssh" ,openssh) ("mit-krb5" ,mit-krb5) ("perl" ,perl))) (native-inputs `(("which" ,which))) (home-page "https://github.com/chaos/pdsh") (synopsis "Parallel distributed shell") (description "Pdsh is a an efficient, multithreaded remote shell client which executes commands on multiple remote hosts in parallel. Pdsh implements dynamically loadable modules for extended functionality such as new remote shell services and remote host selection.") (license license:gpl2+))) (define-public python-asyncssh (package (name "python-asyncssh") (version "2.7.1") (source (origin (method url-fetch) (uri (pypi-uri "asyncssh" version)) (sha256 (base32 "0lnhh2h1mj79j66ni883s9f3xldnbjb10vh80g24b7m003mm524c")))) (build-system python-build-system) (propagated-inputs `(("python-cryptography" ,python-cryptography) ("python-pyopenssl" ,python-pyopenssl) ("python-gssapi" ,python-gssapi) ("python-bcrypt" ,python-bcrypt))) (native-inputs `(("openssh" ,openssh) ("openssl" ,openssl))) (arguments `(#:phases (modify-phases %standard-phases (add-after 'unpack 'disable-tests (lambda* _ (substitute* "tests/test_agent.py" ;; TODO Test fails for unknown reason (("(.+)async def test_confirm" all indent) (string-append indent "@unittest.skip('disabled by guix')\n" indent "async def test_confirm"))) #t))))) (home-page "https://asyncssh.readthedocs.io/") (synopsis "Asynchronous SSHv2 client and server library for Python") (description "AsyncSSH is a Python package which provides an asynchronous client and server implementation of the SSHv2 protocol on top of the Python 3.6+ asyncio framework.") (license license:epl2.0))) (define-public clustershell (package (name "clustershell") (version "1.8.3") (source (origin (method url-fetch) (uri (string-append "https://github.com/cea-hpc/clustershell/releases" "/download/v" version "/ClusterShell-" version ".tar.gz")) (sha256 (base32 "1qdcgh733szwj9r1gambrgfkizvbjci0bnnkds9a8mnyb3sasnan")))) (build-system python-build-system) (inputs `(("openssh" ,openssh))) (propagated-inputs `(("python-pyyaml" ,python-pyyaml))) (arguments `(#:phases (modify-phases %standard-phases (add-before 'build 'record-openssh-file-name (lambda* (#:key inputs #:allow-other-keys) (let ((ssh (assoc-ref inputs "openssh"))) (substitute* "lib/ClusterShell/Worker/Ssh.py" (("info\\(\"ssh_path\"\\) or \"ssh\"") (string-append "info(\"ssh_path\") or \"" ssh "/bin/ssh\""))) #t)))))) (home-page "https://cea-hpc.github.io/clustershell/") (synopsis "Scalable event-driven Python framework for cluster administration") (description "ClusterShell is an event-driven Python framework, designed to run local or distant commands in parallel on server farms or on large GNU/Linux clusters. It will take care of common issues encountered on HPC clusters, such as operating on groups of nodes, running distributed commands using optimized execution algorithms, as well as gathering results and merging identical outputs, or retrieving return codes. ClusterShell takes advantage of existing remote shell facilities such as SSH.") (license license:lgpl2.1+))) (define-public endlessh (package (name "endlessh") (version "1.1") (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/skeeto/endlessh") (commit version))) (file-name (git-file-name name version)) (sha256 (base32 "0ziwr8j1frsp3dajr8h5glkm1dn5cci404kazz5w1jfrp0736x68")))) (build-system gnu-build-system) (arguments `(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")) ,(string-append "CC=" (cc-for-target))) #:tests? #f ; no test target #:phases (modify-phases %standard-phases (delete 'configure)))) ; no configure script (home-page "https://github.com/skeeto/endlessh") (synopsis "SSH tarpit that slowly sends an endless banner") (description "Endlessh is an SSH tarpit that very slowly sends an endless, random SSH banner. It keeps SSH clients locked up for hours or even days at a time. The purpose is to put your real SSH server on another port and then let the script kiddies get stuck in this tarpit instead of bothering a real server. Since the tarpit is in the banner before any cryptographic exchange occurs, this program doesn't depend on any cryptographic libraries. It's a simple, single-threaded, standalone C program. It uses @code{poll()} to trap multiple clients at a time.") (license license:unlicense))) (define-public webssh (package (name "webssh") (version "1.5.3") (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/huashengdun/webssh") (commit (string-append "v" version)))) (file-name (git-file-name name version)) (sha256 (base32 "1bcy9flrzbvams5p77swwiygv54ac58ia7hpic1bvg30b3wpvv7b")))) (build-system python-build-system) (propagated-inputs `(("python-paramiko" ,python-paramiko) ("python-tornado" ,python-tornado))) (home-page "https://webssh.huashengdun.org/") (synopsis "Web application to be used as an SSH client") (description "This package provides a web application to be used as an SSH client. Features: @itemize @bullet @item SSH password authentication supported, including empty password. @item SSH public-key authentication supported, including DSA RSA ECDSA Ed25519 keys. @item Encrypted keys supported. @item Two-Factor Authentication (time-based one-time password) supported. @item Fullscreen terminal supported. @item Terminal window resizable. @item Auto detect the ssh server's default encoding. @item Modern browsers are supported. @end itemize") (license license:expat)))