diff options
Diffstat (limited to 'whispers/tests')
| -rw-r--r-- | whispers/tests/ssh-tunneler.scm | 107 |
1 files changed, 107 insertions, 0 deletions
diff --git a/whispers/tests/ssh-tunneler.scm b/whispers/tests/ssh-tunneler.scm new file mode 100644 index 0000000..7accb50 --- /dev/null +++ b/whispers/tests/ssh-tunneler.scm @@ -0,0 +1,107 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Christopher Baines <mail@cbaines.net> +;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> +;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2023 Runciter <runciter@whispers-vpn.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 (whispers tests ssh-tunneler) + #:use-module (gnu packages rsync) + #:use-module (gnu tests) + #:use-module (gnu system) + #:use-module (gnu system file-systems) + #:use-module (gnu system shadow) + #:use-module (gnu system vm) + #:use-module (gnu services) + #:use-module (gnu services ssh) + #:use-module (whispers services ssh-tunneler) + #:use-module (guix gexp) + #:use-module (guix store) + #:export (%test-ssh-tunneler)) + +(define* (run-ssh-tunneler-test ssh-tunneler-os) + "Run tests in SSH-TUNNELER-OS, which has a sshd running." + (define os + (marionette-operating-system + ssh-tunneler-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + (make-marionette (list #$vm))) + + (test-runner-current (system-test-runner #$output)) + (test-begin "ssh-tunneler") + + ;; Wait for the forwarding to be established + (test-assert "service running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + + (start-service + 'ssh-forwards@reverse-port,6283:127.0.0.1:22)) + marionette)) + + ;; (test-equal "Test file not copied to read-only share" + ;; 1 ;see "EXIT VALUES" in rsync(1) + ;; (marionette-eval + ;; '(status:exit-val + ;; (system* "rsync" "/tmp/input" + ;; (string-append "rsync://localhost:" + ;; (number->string #$rsync-port) + ;; "/read-only/input"))) + ;; marionette)) + + (test-end)))) + + (gexp->derivation "ssh-tunneler-test" test)) + +(define* %ssh-tunneler-os + ;; Return operating system under test. + (let ((base-os + (simple-operating-system + (service openssh-service-type + (openssh-configuration + (permit-root-login #t) + (allow-empty-passwords? #t))) + (service persistent-ssh-service-type + (ssh-connection-configuration + (extra-requires '(ssh-daemon)) + (require-networking? #f) + (forwards + (list (reverse-port-forward-configuration)))))))) + (operating-system + (inherit base-os) + (packages (operating-system-packages base-os))))) + +(define %test-ssh-tunneler + (system-test + (name "ssh-tunneler") + (description "Test a VM running ssh forwarding services.") + (value (run-ssh-tunneler-test %ssh-tunneler-os)))) |