me
/
guix
Archived
1
0
Fork 0
Code

tests: ssh: Add a test for SFTP. 

* gnu/tests/ssh.scm (run-ssh-test): Introduce "SFTP file writing and reading".
Make 'sftp?' a keyword parameter.
(%test-openssh): Pass #:sftp? #t to 'run-ssh-test'.
master
Clément Lassieur 2017-03-19 13:20:11 +01:00
parent cfaf4d1165
commit 36f666c63d
No known key found for this signature in database
GPG Key ID: 89F96D4808F359C7
1 changed files with 23 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gnu/tests/ssh.scm
View File

@ -55,10 +55,12 @@
(services (cons service (services (cons service
(operating-system-user-services %base-os))))) (operating-system-user-services %base-os)))))
(define (run-ssh-test name ssh-service pid-file) (define* (run-ssh-test name ssh-service pid-file #:key (sftp? #f))
"Run a test of an OS running SSH-SERVICE, which writes its PID to PID-FILE. "Run a test of an OS running SSH-SERVICE, which writes its PID to PID-FILE.
SSH-SERVICE must be configured to listen on port 22 and to allow for root and SSH-SERVICE must be configured to listen on port 22 and to allow for root and
empty-password logins." empty-password logins.
When SFTP? is true, run an SFTP server test."
(mlet* %store-monad ((os -> (marionette-operating-system (mlet* %store-monad ((os -> (marionette-operating-system
(os-with-service ssh-service) (os-with-service ssh-service)
#:imported-modules '((gnu services herd) #:imported-modules '((gnu services herd)
@ -81,7 +83,8 @@ empty-password logins."
(ice-9 match) (ice-9 match)
(ssh session) (ssh session)
(ssh auth) (ssh auth)
(ssh channel)) (ssh channel)
(ssh sftp))
(define marionette (define marionette
;; Enable TCP forwarding of the guest's port 22. ;; Enable TCP forwarding of the guest's port 22.
@ -187,6 +190,21 @@ root with an empty password."
(and (zero? (channel-get-exit-status channel)) (and (zero? (channel-get-exit-status channel))
(wait-for-file "/root/witness")))))) (wait-for-file "/root/witness"))))))
;; 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)))))
(test-end) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
@ -203,7 +221,8 @@ root with an empty password."
(openssh-configuration (openssh-configuration
(permit-root-login #t) (permit-root-login #t)
(allow-empty-passwords? #t))) (allow-empty-passwords? #t)))
"/var/run/sshd.pid")))) "/var/run/sshd.pid"
#:sftp? #t))))
(define %test-dropbear (define %test-dropbear
(system-test (system-test