diff options
| -rw-r--r-- | ChangeLog | 29 | ||||
| -rw-r--r-- | NEWS | 5 | ||||
| -rw-r--r-- | doc/api-sessions.texi | 26 | ||||
| -rw-r--r-- | examples/echo/client.scm.in | 5 | ||||
| -rw-r--r-- | examples/sssh.scm.in | 3 | ||||
| -rw-r--r-- | ssh/session-func.c | 14 | ||||
| -rw-r--r-- | ssh/session.scm | 9 | ||||
| -rw-r--r-- | tests/client-server.scm | 111 |
8 files changed, 136 insertions, 66 deletions
@@ -1,3 +1,28 @@ +2014-05-31 Artyom Poptsov <poptsov.artyom@gmail.com> + + * tests/client-server.scm: Make sure that the received message is + not `#f' before handling it in a server thread. + (make-session-loop): New macro. + + * tests/client-server.scm (server-thread): Rename to + `*server-thread*'. + (spawn-server-thread): Update. + (cancel-server-thread): Update. + + * tests/client-server.scm ("get-public-key-hash"): Check the hash. + Check `bytevector->hex-string' return value. + + * ssh/session.scm (bytevector->hex-string): Fix a bug: Use + `format' from `(ice-9 format)' module. + + * doc/api-sessions.texi (Sessions): Update description of + `get-public-key-hash'. Add documentation for + `bytevector->hex-string'. Add examples. + + * ssh/session.scm (bytevector->hex-string): New procedure. + * examples/echo/client.scm.in (main): Use it. + * examples/sssh.scm.in (main): Use it. + 2014-05-30 Artyom Poptsov <poptsov.artyom@gmail.com> * README: Update requirements. @@ -9,6 +34,10 @@ * tests/client-server.scm ("userauth-pubkey!, success"): Public key is not needed anymore, remove it. + * ssh/session-func.c (guile_ssh_get_public_key_hash): Return the + hash as a bytevector instead of a string. + * NEWS: Update. + 2014-05-27 Artyom Poptsov <poptsov.artyom@gmail.com> Perform basic work on porting of Guile-SSH on libssh 0.6.3. @@ -7,6 +7,11 @@ Copyright (C) Artyom V. Poptsov <poptsov.artyom@gmail.com> are permitted in any medium without royalty provided the copyright notice and this notice are preserved. +* Unreleased +** `get-public-key-hash' now returns the hash as a bytevector +** New procedure `bytevector->hex-string' + in =(ssh session)= + * Changes in version 0.6.0 (2014-03-23) ** Remove username from parameter list of auth procedures `userauth-password!' and `userauth-pubkey!' don't take a username diff --git a/doc/api-sessions.texi b/doc/api-sessions.texi index ca0bc4a..64258b8 100644 --- a/doc/api-sessions.texi +++ b/doc/api-sessions.texi @@ -249,8 +249,30 @@ will be created if host key is accepted. @deffn {Scheme Procedure} get-public-key-hash session @cindex MD5 hash -Get MD5 hash of a public key. Return MD5 hash on success, @code{#f} -on error. +Get MD5 hash of a public key as a bytevector. Return the bytevector +on success, @code{#f} on error. + +Example: + +@lisp +(get-public-key-hash session) +@result{} #vu8(15 142 110 203 162 228 250 211 20 212 26 217 118 57 217 66) +@end lisp + +@end deffn + +@deffn {Scheme Procedure} bytevector->hex-string bv +@cindex MD5 hash +Convert the given bytevector @var{bv} to a colon separated string. + +Example: + +@lisp +(let ((hash (get-public-key-hash session))) + (bytevector->hex-string hash)) +@result{} "0f:8e:6e:cb:a2:e4:fa:d3:14:d4:1a:d9:76:39:d9:42" +@end lisp + @end deffn @deffn {Scheme Procedure} write-known-host! session diff --git a/examples/echo/client.scm.in b/examples/echo/client.scm.in index 861f794..28d58d8 100644 --- a/examples/echo/client.scm.in +++ b/examples/echo/client.scm.in @@ -134,8 +134,9 @@ Options: (case (authenticate-server session) ((not-known) - (display "The server is unknown. Please check MD5 sum:\n") - (format #t " ~a~%" (get-public-key-hash session)))) + (let ((hash (get-public-key-hash session))) + (display "The server is unknown. Please check MD5 sum:\n") + (format #t " ~a~%" (bytevector->hex-string hash))))) (let ((private-key (get-prvkey session identity-file))) diff --git a/examples/sssh.scm.in b/examples/sssh.scm.in index 5856ce4..3257615 100644 --- a/examples/sssh.scm.in +++ b/examples/sssh.scm.in @@ -175,7 +175,8 @@ Options: ((ok) (print-debug " ok\n")) ((not-known) (display " The server is unknown. Please check MD5.\n"))) - (format-debug " MD5 hash: ~a~%" (get-public-key-hash session)) + (let ((hash (get-public-key-hash session))) + (format-debug " MD5 hash: ~a~%" (bytevector->hex-string hash))) (print-debug "5. userauth-autopubkey!\n") (let ((res (userauth-pubkey-auto! session))) diff --git a/ssh/session-func.c b/ssh/session-func.c index d06c7c7..0788e3b 100644 --- a/ssh/session-func.c +++ b/ssh/session-func.c @@ -397,13 +397,17 @@ SCM_DEFINE (guile_ssh_get_public_key_hash, "get-public-key-hash", 1, 0, 0, res = ssh_get_pubkey_hash (session_data->ssh_session, &hash); scm_dynwind_free (hash); - hash_str = ssh_get_hexa (hash, res); - scm_dynwind_free (hash_str); - if (res >= 0) - ret = scm_from_locale_string (hash_str); + { + size_t idx; + ret = scm_c_make_bytevector (res); + for (idx = 0; idx < res; ++idx) + scm_c_bytevector_set_x(ret, idx, hash[idx]); + } else - ret = SCM_BOOL_F; + { + ret = SCM_BOOL_F; + } scm_dynwind_end (); return ret; diff --git a/ssh/session.scm b/ssh/session.scm index a3152e7..1cbcab2 100644 --- a/ssh/session.scm +++ b/ssh/session.scm @@ -43,6 +43,8 @@ (define-module (ssh session) #:use-module (ice-9 optargs) + #:use-module (ice-9 format) + #:use-module (rnrs bytevectors) #:export (session session? %make-session @@ -55,6 +57,7 @@ connected? authenticate-server get-public-key-hash + bytevector->hex-string write-known-host! get-error)) @@ -95,6 +98,12 @@ Return a new SSH session." (session-set-if-specified! compression-level) session)) +(define (bytevector->hex-string bv) + "Convert bytevector BV to a colon separated hex string." + (string-join (map (lambda (e) (format #f "~2,'0x" e)) + (bytevector->u8-list bv)) + ":")) + (load-extension "libguile-ssh" "init_session") ;;; session.scm ends here diff --git a/tests/client-server.scm b/tests/client-server.scm index 4be2c39..10cd0dd 100644 --- a/tests/client-server.scm +++ b/tests/client-server.scm @@ -20,6 +20,7 @@ (use-modules (srfi srfi-64) (ice-9 threads) (ice-9 rdelim) + (rnrs bytevectors) (ssh server) (ssh session) (ssh auth) @@ -38,7 +39,7 @@ (define topdir (getenv "abs_top_srcdir")) (define rsakey (format #f "~a/tests/rsakey" topdir)) (define log (test-runner-aux-value (test-runner-current))) -(define server-thread #f) +(define *server-thread* #f) ;;; Helper procedures and macros @@ -71,13 +72,18 @@ (format log " server: ~a~%" message)) (define-macro (spawn-server-thread . body) - `(set! server-thread + `(set! *server-thread* (make-thread (lambda () ,@body)))) (define (cancel-server-thread) - (cancel-thread server-thread)) + (cancel-thread *server-thread*)) + +(define-macro (make-session-loop session . body) + `(let session-loop ((msg (server-message-get ,session))) + (and msg (begin ,@body)) + (session-loop (server-message-get ,session)))) ;;; Testing of basic procedures. @@ -113,12 +119,15 @@ res))) (test-assert "get-public-key-hash" - (let ((session (make-session-for-test))) + (let ((hash-bv #vu8(15 142 110 203 162 228 250 211 20 212 26 217 118 57 217 66)) + (hash-str "0f:8e:6e:cb:a2:e4:fa:d3:14:d4:1a:d9:76:39:d9:42") + (session (make-session-for-test))) (connect! session) (authenticate-server session) (let ((res (get-public-key-hash session))) (disconnect! session) - res))) + (and (bytevector=? res hash-bv) + (string=? (bytevector->hex-string res) hash-str))))) (cancel-server-thread) @@ -129,12 +138,11 @@ (let ((server (make-server-for-test))) (server-listen server) (while #t - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (let session-loop ((msg (server-message-get s))) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (make-session-loop session (message-auth-set-methods! msg '(password public-key)) - (message-reply-default msg) - (session-loop (server-message-get s))))))) + (message-reply-default msg)))))) (test-assert "userauth-get-list" (let ((session (make-session-for-test))) @@ -153,12 +161,11 @@ (let ((server (make-server-for-test))) (server-listen server) (while #t - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (let session-loop ((msg (server-message-get s))) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (make-session-loop session (message-auth-set-methods! msg '(none)) - (message-reply-success msg) - (session-loop (server-message-get s))))))) + (message-reply-success msg)))))) (test-assert "userauth-none!, success" (let ((session (make-session-for-test))) @@ -176,12 +183,11 @@ (let ((server (make-server-for-test))) (server-listen server) (while #t - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (let session-loop ((msg (server-message-get s))) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (make-session-loop session (message-auth-set-methods! msg '(public-key)) - (message-reply-default msg) - (session-loop (server-message-get s))))))) + (message-reply-default msg)))))) (test-assert "userauth-none!, denied" (let ((session (make-session-for-test))) @@ -200,12 +206,11 @@ (let ((server (make-server-for-test))) (server-listen server) (while #t - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (let session-loop ((msg (server-message-get s))) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (make-session-loop session (message-auth-set-methods! msg '(none)) - (message-reply-success msg 'partial) - (session-loop (server-message-get s))))))) + (message-reply-success msg 'partial)))))) (test-assert "userauth-none!, partial" (let ((session (make-session-for-test))) @@ -222,12 +227,11 @@ (let ((server (make-server-for-test))) (server-listen server) (while #t - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (let session-loop ((msg (server-message-get s))) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (make-session-loop session (message-auth-set-methods! msg '(password)) - (message-reply-success msg) - (session-loop (server-message-get s))))))) + (message-reply-success msg)))))) (test-assert "userauth-password!, success" (let ((session (make-session-for-test))) @@ -244,12 +248,11 @@ (let ((server (make-server-for-test))) (server-listen server) (while #t - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (let session-loop ((msg (server-message-get s))) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (make-session-loop session (message-auth-set-methods! msg '(password)) - (message-reply-default msg) - (session-loop (server-message-get s))))))) + (message-reply-default msg)))))) (test-assert "userauth-password!, denied" (let ((session (make-session-for-test))) @@ -266,12 +269,11 @@ (let ((server (make-server-for-test))) (server-listen server) (while #t - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (let session-loop ((msg (server-message-get s))) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (make-session-loop session (message-auth-set-methods! msg '(password)) - (message-reply-success msg 'partial) - (session-loop (server-message-get s))))))) + (message-reply-success msg 'partial)))))) (test-assert "userauth-password!, partial" (let ((session (make-session-for-test))) @@ -288,11 +290,10 @@ (let ((server (make-server-for-test))) (server-listen server) (while #t - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (let session-loop ((msg (server-message-get s))) - (message-reply-success msg) - (session-loop (server-message-get s))))))) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (make-session-loop session + (message-reply-success msg)))))) (test-assert "userauth-pubkey!, success" (let ((session (make-session-for-test))) @@ -314,10 +315,10 @@ (let ((server (make-server-for-test))) (server-listen server) (while #t - (let ((s (server-accept server)) + (let ((session (server-accept server)) (channel #f)) - (server-handle-key-exchange s) - (let session-loop ((msg (server-message-get s))) + (server-handle-key-exchange session) + (make-session-loop session (let ((msg-type (message-get-type msg))) (srvmsg msg-type) (case (car msg-type) @@ -328,8 +329,7 @@ (write-line "pong" channel)) (message-reply-success msg)) (else - (message-reply-success msg)))) - (session-loop (server-message-get s))))))) + (message-reply-success msg))))))))) (define session (let ((session (make-session-for-test))) @@ -373,11 +373,11 @@ takes RWPROC procedure that handles I/O operation." (let ((server (make-server-for-test))) (server-listen server) (while #t - (let ((s (server-accept server)) + (let ((session (server-accept server)) (channel #f)) - (server-handle-key-exchange s) - (let session-loop ((msg (server-message-get s))) - (if (and msg (not (eof-object? msg))) + (server-handle-key-exchange session) + (make-session-loop session + (if (not (eof-object? msg)) (let ((msg-type (message-get-type msg))) (case (car msg-type) ((request-channel-open) @@ -389,8 +389,7 @@ takes RWPROC procedure that handles I/O operation." ((request-channel) (message-reply-success msg)) (else - (message-reply-success msg))))) - (session-loop (server-message-get s)))))))) + (message-reply-success msg))))))))))) (define (make-session-for-dt-test) (let ((s (make-session-for-test))) |