guix - Wojtek's customized Guix

diff options

Diffstat (limited to 'tests/combinators.scm')

0 files changed, 0 insertions, 0 deletions

h) (ssh channel) (ssh popen) (ssh sftp)) (define marionette ;; Enable TCP forwarding of the guest's port 22. (make-marionette (list #$vm))) (define (make-session-for-test) "Make a session with predefined parameters for a test." (make-session #:user "root" #:port 2222 #:host "localhost" #:log-verbosity 'protocol)) (define (call-with-connected-session proc) "Call the one-argument procedure PROC with a freshly created and connected SSH session object, return the result of the procedure call. The session is disconnected when the PROC is finished." (let ((session (make-session-for-test))) (dynamic-wind (lambda () (let ((result (connect! session))) (unless (equal? result 'ok) (error "Could not connect to a server" session result)))) (lambda () (proc session)) (lambda () (disconnect! session))))) (define (call-with-connected-session/auth proc) "Make an authenticated session. We should be able to connect as root with an empty password." (call-with-connected-session (lambda (session) ;; Try the simple authentication methods. Dropbear requires ;; 'none' when there are no passwords, whereas OpenSSH accepts ;; 'password' with an empty password. (let loop ((methods (list (cut userauth-password! <> "") (cut userauth-none! <>)))) (match methods (() (error "all the authentication methods failed")) ((auth rest ...) (match (pk 'auth (auth session)) ('success (proc session)) ('denied (loop rest))))))))) (test-runner-current (system-test-runner #$output)) (test-begin "ssh-daemon") ;; Wait for sshd to be up and running. (test-assert "service running" (marionette-eval '(begin (use-modules (gnu services herd)) (start-service 'ssh-daemon)) marionette)) ;; Check sshd's PID file. (test-assert "sshd PID" (let ((pid (marionette-eval '(begin (use-modules (gnu services herd) (srfi srfi-1)) (live-service-running (find (lambda (live) (memq 'ssh-daemon (live-service-provision live))) (current-services)))) marionette))) (if #$pid-file (= pid (wait-for-file #$pid-file marionette)) pid))) (test-assert "wait for port 22, IPv4" (wait-for-tcp-port 22 marionette)) (test-assert "wait for port 22, IPv6" ;; Make sure it's also available as IPv6. ;; See <https://issues.guix.gnu.org/55335>. (wait-for-tcp-port 22 marionette #:address `(make-socket-address AF_INET6 (inet-pton AF_INET6 "::1") 22))) ;; Connect to the guest over SSH. Make sure we can run a shell ;; command there. (test-equal "shell command" 'hello (call-with-connected-session/auth (lambda (session) ;; FIXME: 'get-server-public-key' segfaults. ;; (get-server-public-key session) (let ((channel (make-channel session))) (channel-open-session channel) (channel-request-exec channel "echo hello > /root/witness") (and (zero? (channel-get-exit-status channel)) (wait-for-file "/root/witness" marionette)))))) ;; Check whether the 'getlogin' procedure returns the right thing. (unless #$test-getlogin? (test-skip 1)) (test-equal "getlogin" '(0 "root") (call-with-connected-session/auth (lambda (session) (let* ((pipe (open-remote-input-pipe session "guile -c '(display (getlogin))'")) (output (get-string-all pipe)) (status (channel-get-exit-status pipe))) (list status output))))) ;; Connect to the guest over SFTP. Make sure we can write and ;; read a file there. (unless #$sftp? (test-skip 1)) (test-equal "SFTP file writing and reading" 'hello (call-with-connected-session/auth (lambda (session) (let ((sftp-session (make-sftp-session session)) (witness "/root/sftp-witness")) (call-with-remote-output-file sftp-session witness (cut display "hello" <>)) (call-with-remote-input-file sftp-session witness read))))) ;; Connect to the guest over SSH. Make sure we can run commands ;; from the system profile. (test-equal "run executables from system profile" #t (call-with-connected-session/auth (lambda (session) (let ((channel (make-channel session))) (channel-open-session channel) (channel-request-exec channel (string-append "mkdir -p /root/.guix-profile/bin && " "touch /root/.guix-profile/bin/path-witness && " "chmod 755 /root/.guix-profile/bin/path-witness")) (zero? (channel-get-exit-status channel)))))) ;; Connect to the guest over SSH. Make sure we can run commands ;; from the user profile. (test-equal "run executable from user profile" #t (call-with-connected-session/auth (lambda (session) (let ((channel (make-channel session))) (channel-open-session channel) (channel-request-exec channel "path-witness") (zero? (channel-get-exit-status channel)))))) (test-end))))) (gexp->derivation name test)) (define %test-openssh (system-test (name "openssh") (description "Connect to a running OpenSSH daemon.") (value (run-ssh-test name ;; Allow root logins with an empty password to ;; simplify testing. (service openssh-service-type (openssh-configuration (permit-root-login #t) (allow-empty-passwords? #t))) #f ;inetd-style, no PID file #:sftp? #t)))) (define %test-dropbear (system-test (name "dropbear") (description "Connect to a running Dropbear SSH daemon.") (value (run-ssh-test name (service dropbear-service-type (dropbear-configuration (root-login? #t) (allow-empty-passwords? #t))) "/var/run/dropbear.pid" ;; XXX: Our Dropbear is not built with PAM support. ;; Even when it is, it seems to ignore the PAM ;; 'session' requirements. #:test-getlogin? #f))))


context:
space:
mode: