diff options
| author | Artyom V. Poptsov <poptsov.artyom@gmail.com> | 2015-05-01 17:46:11 +0300 |
|---|---|---|
| committer | Artyom V. Poptsov <poptsov.artyom@gmail.com> | 2015-05-01 17:46:11 +0300 |
| commit | 880f089731230aed72794a7b04b74317791d2616 (patch) | |
| tree | 7ac18cae2e2e9b7048994ca3c44bc5d9d08b388e | |
| parent | ssh/channel-func.c: Fix a bug (diff) | |
| parent | NEWS: Bump version to 0.7.2 (diff) | |
| download | guile-ssh-880f089731230aed72794a7b04b74317791d2616.tar.gz | |
Merge branch 'master' into wip-port-forwarding
Conflicts:
ChangeLog
doc/api-channels.texi
ssh/channel.scm
58 files changed, 1648 insertions, 638 deletions
@@ -1,5 +1,312 @@ +2015-02-24 Artyom Poptsov <poptsov.artyom@gmail.com> + + * NEWS: Bump version to 0.7.2 + * configure.ac, doc/version.texi: Likewise. + + * doc/guile-ssh.texi: Update copyright dates. + + * configure.ac: Update copyright dates. Remove a trailing whitespace. + + * NEWS: Update. + + * ssh/key-type.h: Add parent object to the key structure. + * ssh/key-type.c (mark_key_smob): Mark parent. + (free_key_smob): Free the key only if it does not have a parent. + (_scm_from_ssh_key): Accept a parent object as the 2nd argument. All + callers updated. + * ssh/key-func.c (guile_ssh_string_to_public_key) + (guile_ssh_private_key_from_file) + (guile_ssh_public_key_from_private_key) + (guile_ssh_public_key_from_file, guile_ssh_make_keypair): Update. + * ssh/message-func.c (get_auth_req): Accept a SCM message as the 2nd + argument. All callers updated. + (guile_ssh_message_get_req): Update. + + * ssh/message-func.c (get_auth_req): Use `_scm_from_ssh_key'. + +2015-02-22 Artyom Poptsov <poptsov.artyom@gmail.com> + + * NEWS: Update. + + * examples/echo/server.scm.in: Update copyright dates. + + * examples/echo/server.scm.in (print-help): Rename to + `print-help-and-exit'. + (main): Use it. + + * examples/echo/client.scm.in (get-prvkey, main): Simplify checks. + + * examples/echo/client.scm.in (print-help): Rename to + `print-help-and-exit'. + (main): Use it. Remove extra checks. + + * README (Requirements): Require libssh 0.6.3 or 0.6.4. + * doc/guile-ssh.texi (Installation): Likewise. + * doc/version.texi: Update. + + * README (Distribution): Fix path to examples. + + * doc/examples.texi (Examples): Fix path to examples. + Use `channel-get-exit-status' in the client example. + + * ssh/auth.c, ssh/channel-func.c, ssh/session-func.c, + ssh/session-main.c, ssh/session-type.c, ssh/threads.c, ssh/auth.scm, + ssh/log.c: Remove trailing whitespaces. + + * ssh/channel-type.c: Update copyright dates. + + `ssh_channel_read' sometimes returns 0 even if `ssh_channel_poll' + returns a positive value. So we must ensure that res != 0 otherwise + an assertion in `scm_i_fill_input' won't be meet (see `ports.c' in + Guile 2.0.9). + + * ssh/channel-type.c (ptob_fill_input): Return EOF if + `ssh_channel_read' returns 0. + * NEWS: Update. + +2015-02-12 Artyom Poptsov <poptsov.artyom@gmail.com> + + * ssh/channel-type.c (print_channel, _scm_from_channel_data): Remove + trailing spaces. + + * ssh/channel-func.c (guile_ssh_channel_request_send_exit_status): Fix + wrong call to `SCM_ASSERT'. + + * ssh/channel-func.c (guile_ssh_channel_request_send_exit_status): + Validate exit status. + + * examples/ssshd.scm.in (handle-request-exec): Send exit status. + * examples/sssh.scm.in (main): Handle exit status. + * NEWS: Update. + +2015-02-09 Artyom Poptsov <poptsov.artyom@gmail.com> + + * doc/api-channels.texi (Channels): Update description of + `guile_ssh_channel_request_send_exit_status'. + * ssh/channel-func.c (guile_ssh_channel_request_send_exit_status): + Update the docstring. + +2015-02-08 Artyom Poptsov <poptsov.artyom@gmail.com> + + * ssh/channel.scm (channel-request-send-exit-status): Export. + * ssh/channel-func.c (guile_ssh_channel_request_send_exit_status): New + procedure. + * ssh/channel-func.h: Update. + * tests/client-server.scm ("channel-request-exec, exit status"): New + TC. + (start-server/channel-test): Update for exit status test. + * doc/api-channels.texi (Channels): Add description of + `channel-request-send-exit-status'. + * NEWS: Update. + + * ssh/channel-func.c (guile_ssh_channel_get_exit_status): New + procedure. + * ssh/channel-func.h: Update. + * ssh/channel.scm (channel-get-exit-status): Export. + * doc/api-channels.texi (Channels): Add description of + `channel-get-exit-status'. + + * NEWS: Update. + +2014-10-13 Artyom Poptsov <poptsov.artyom@gmail.com> + + * ssh/version.c: Don't include `gcrypt.h'. + +2014-10-12 Artyom Poptsov <poptsov.artyom@gmail.com> + + * ssh/server-func.c (guile_ssh_server_get): New procedure. + * ssh/server.scm (server-get): Export. + * tests/server.scm ("server-get"): New TC. + * doc/api-servers.texi (Servers): Add description of `server-get'. + * NEWS: Update. + + * ssh/server-type.c (print_server): Print object address. + + * ssh/server-type.h (server_data): Add `options' field. + * ssh/server-type.c (mark_server): Mark `options' field. + (guile_ssh_make_server): Initialize `options' field. + (print_server): New procedure. + (init_server_type): Register server printer procedure. + * ssh/server-func.c (guile_ssh_server_set_x): Add an option to the + server optons. + * ssh/server-func.h (server_options): Export. + * NEWS: Update. + +2014-10-11 Artyom Poptsov <poptsov.artyom@gmail.com> + + * NEWS: Bump version to 0.7.1. + * configure.ac, doc/version.texi: Likewise. + + * ssh/version.scm (get-crypto-library): Fix the docstring. + * doc/api-version.texi (Version): Fix description of + `get-crypto-library'. Improve description of `zlib-support?'. + + * tests/key.scm ("private-key-to-file") [GCrypt]: Don't perform the + test. + * doc/api-keys.texi (Keys): Update description of + `private-key-to-file'. + * NEWS: Update. + + * ssh/key-func.c (guile_ssh_private_key_to_file): New procedure. + * ssh/key.scm (private-key-to-file): Export. + * tests/key.scm ("private-key-to-file"): New TC. + + * doc/api-keys.texi (Keys): Add description of `private-key-to-file'. + * NEWS: Update. + + * ssh/key-func.c (guile_ssh_string_to_public_key) + (guile_ssh_private_key_from_file) + (guile_ssh_public_key_from_private_key) + (guile_ssh_public_key_from_file): Use `_scm_from_ssh_key'. + + * doc/guile-ssh.texi (Installation): Add note about GCrypt support in + libssh. Replace "libguile-ssh" with "guile-ssh". + + * doc/version.texi: Update. + + * NEWS: Update. + * TODO (Known Bugs): Update. + + * ssh/key.scm, ssh/log.scm: Update commentary. + + * ssh/key-type.c (_scm_from_ssh_key, guile_ssh_make_keypair): New + procedures. + * ssh/key-type.h: Update. + * ssh/key.scm (make-keypair): Export. + + * doc/api-keys.texi (Keys): Add description of `make-keypair'. + * tests/key.scm ("make-keypair"): New TC. + * NEWS: Update. + + * ssh/common.c (log_verbosity): Move to `ssh/log.c'. + * ssh/common.h, ssh/server-func.c, ssh/session-func.c: Update. + * ssh/log.scm (set-log-verbosity!, get-log-verbosity): Export. + * ssh/log.c (guile_ssh_set_log_verbosity_x) + (guile_ssh_get_log_verbosity): New procedures. + * ssh/log.h: Update. + * doc/api-logging.texi: Add descripton of `set-log-verbosity!' and + `get-log-verbosity'. + * NEWS: Update. + + * tests/log.scm ("set-log-verbosity!", "get-log-verbosity"): New TCs. + + * doc/api-keys.texi (Keys): Add note about support of ECDSA keys with + GCrypt. + +2014-10-10 Artyom Poptsov <poptsov.artyom@gmail.com> + + * tests/key.scm: Don't do ECDSA key tests if libssh was compiled with + GCrypt. + (when-openssl): New macro. + ("private-key-from-file", "public-key-from-file", "key?") + ("private-key->public-key", "get-key-type", "public-key->string") + ("string->public-key"): Use it. + +2014-10-10 Artyom Poptsov <poptsov.artyom@gmail.com> + + * ssh/version.c (get-libssh-version): Rename to `%get-libssh-version'. + Return raw libssh version string. + * ssh/version.scm (%get-libssh-version, get-crypto-library) + (zlib-support?): New procedures. + * doc/api-version.texi: Add description of `%get-libssh-version', + `get-crypto-library' and `zlib-support?'. + * NEWS: Update. + +2014-09-14 Artyom Poptsov <poptsov.artyom@gmail.com> + + * tests/server-client.scm ("accept, key exchange"): Add missed paren. + + * tests/client-server.scm (run-server-and-client): Rename to + `run-client-test'. All callers updated. + + * tests/server-client.scm: Use `dynamic-wind' for child processes in + tests. + (run-server-test): New procedure. + ("accept, key exchange", "server-message-get", "message-get-type") + ("message-get-session"): Use it. + + * tests/client-server.scm: Use `dynamic-wind' for child processes in + tests. + (run-server-and-client): New procedure. + ("connect!, disconnect!") + ("get-protocol-version", "authenticate-server, not-known") + ("authenticate-server, ok", "get-public-key-hash") + ("userauth-none!, success", "userauth-none!, denied") + ("userauth-none!, partial", "userauth-password!, success") + ("userauth-password!, denied", "userauth-password!, partial") + ("userauth-public-key!, success", "userauth-get-list") + ("make-channel", "channel-get-session", "channel-open-session") + ("channel-request-exec", "data transferring, string") + ("data transferring, bytevector"): Use it. + +2014-08-31 Artyom Poptsov <poptsov.artyom@gmail.com> + + * NEWS: Bump version to 0.7.0. + * configure.ac, doc/version.texi: Likewise. + + * README (Distribution): Update. + +2014-08-30 Artyom Poptsov <poptsov.artyom@gmail.com> + + * doc/api-keys.texi (Keys): Make description of `public-key?' more + accurate. + * ssh/key-type.c (guile_ssh_is_public_key_p): Update docstring. + +2014-08-26 Artyom Poptsov <poptsov.artyom@gmail.com> + + * ssh/key-func.c (guile_ssh_string_to_public_key): Fix a bug: Call + `scm_dynwind_end' at the end of the procedure so call to the procedure + won't lead to segfaults. + * tests/key.scm ("public-key->string"): Improve. + ("string->public-key"): New TC. + + * tests/key.scm ("public-key?"): Improve TC. + ("public-key->string"): New TC. + + * ssh/key-type.c (print_key): Use `_private_key_p' predicate to + determite type of the key so private key will be displayed as + "private", not "public". + +2014-08-23 Artyom Poptsov <poptsov.artyom@gmail.com> + + * TODO: Update. + +2014-08-22 Artyom Poptsov <poptsov.artyom@gmail.com> + + * tests/Makefile.am (CLEANFILES): Add `server-client-errors.log' and + `server-client-libssh.log'. + + * tests/client-server.scm (%knownhosts): Use `abs_top_builddir' + instead of `abs_top_srcdir' to fix the permission issue on `make + distcheck' during tests. + * tests/Makefile.am (AM_TESTS_ENVIRONMENT): Export `abs_top_builddir'. + +2014-08-21 Artyom Poptsov <poptsov.artyom@gmail.com> + + * ssh/message.scm (message-get-session): New procedure. + * ssh/message-func.c (guile_ssh_message_get_session): New procedure. + * ssh/message-func.h: Likewise. + * tests/server-client.scm ("message-get-session"): New TC. + * doc/api-messages.texi (Message Handling): Add description of + `message-get-session' + * doc/version.texi: Update. + * NEWS: Update. + 2014-08-09 Artyom Poptsov <poptsov.artyom@gmail.com> + * ssh/session-type.c (print_session): Print port number. + + * ssh/session-func.c (guile_ssh_session_get): Handle `port' option. + * doc/api-sessions.texi (Sessions): Update. + * tests/session.scm ("session-get"): Update. + + * ssh/channel-type.c (_ssh_channel_to_scm): Rename to + `_scm_from_channel_data'. All callers updated. + (guile_ssh_make_channel): Update. + * ssh/channel-type.h: Update. + * ssh/message-func.c + (guile_ssh_message_channel_request_open_reply_accept): Update. + * ssh/channel-func.c (guile_ssh_channel_open_forward) (guile_ssh_channel_open_reverse_forward) (guile_ssh_channel_cancel_forward): Fix a bug: Rename @@ -9,6 +316,17 @@ * ssh/session-func.c: Improve docstrings. Remove extra comments. + * ssh/channel-type.c (mark_channel): Mark the session. + * ssh/message-type.c (mark_message): Likewise. + + * ssh/channel-func.c (guile_ssh_channel_get_session): New procedure. + * ssh/channel-func.h (guile_ssh_channel_get_session): Likewise. + * ssh/channel.scm (channel-get-session): Export. + * tests/client-server.scm ("channel-get-session"): New TC. + * doc/api-channels.texi (Channels): Add description of + `channel-get-session' procedure. + * NEWS: Update. + * README: Require GNU Guile 2.0. * doc/guile-ssh.texi (Installation): Likewise. * configure.ac: Remove checks related to GNU Guile 1.8. @@ -322,6 +640,14 @@ 2014-06-06 Artyom Poptsov <poptsov.artyom@gmail.com> + * ssh/key-type.h (key_data): Remove `is_to_be_freed' field. + * ssh/key-type.c (free_key_smob): Always free the SSH key on GC'ing. + * ssh/key-func.c (guile_ssh_private_key_from_file) + (guile_ssh_public_key_from_private_key) + (guile_ssh_public_key_from_file): Likewise. + * ssh/message-func.c (get_auth_req): Likewise. + * ssh/session-func.c (guile_ssh_get_server_public_key): Likewise. + * ssh/key-func.c (guile_ssh_private_key_from_file): Remove `session' parameter. All callers updated. * doc/api-keys.texi (Keys): Update description of @@ -331,6 +657,25 @@ * tests/client-server.scm ("userauth-public-key!, success"): Update. * NEWS: Update. + Fix a GC issue: Keep a reference to the parent session in channel and + message smobs to prevent the session from premature GC'ing. Without + the fix GC could free a session even if there are live channels and by + that break the channels. + + Reported by Ludovic Courtès <ludo@gnu.org> + + * ssh/channel-type.h (channel_data): Store a reference to the parent + session. + * ssh/message-type.h (message_data): Likewise. + * ssh/channel-type.c (_ssh_channel_to_scm): Change argument list. All + callers updated. + (guile_ssh_make_channel): Update. + * ssh/message-func.c + (guile_ssh_message_channel_request_open_reply_accept): Update. + * ssh/server-func.c (guile_ssh_server_message_get): Store a reference + to a session in the message smob. + * NEWS: Update. + 2014-06-01 Artyom Poptsov <poptsov.artyom@gmail.com> * tests/key.scm: New test suite. @@ -7,7 +7,80 @@ 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 +* Changes in version 0.7.2 (2015-02-24) +** Remove dependency on libgcrypt added by a mistake +** Fix "double free or corruption" error on GC'ing of keys + Fix "double free or corruption" error that occures in case when a key was + derived from an authentication message by means of `message-get-req'. When + such a key is GC'ed then GC'ing of its parent message leads to error, or + vice versa. +** Fix a bug in the channel implementation + The bug could occasionally manifest itself on channel reading as the + following error: +#+BEGIN_EXAMPLE +guile: ports.c:1476: scm_i_fill_input: Assertion `pt->read_pos == pt->read_end' failed. +#+END_EXAMPLE +** New `server-get' procedure in (ssh server) + The procedure can be used to retrieve server options. +** New `channel-get-exit-status' procedure in (ssh channel) + The procedure allows to get exit status of an executed command from a + channel. +** New `channel-request-send-exit-status' procedure in (ssh channel) + The procedure can be used to send the exit status to a client. +** Improve printing of Guile-SSH server objects + Print the bind address of a server object and its bind port. Example: +#+BEGIN_EXAMPLE +#<server 127.0.0.1:12345 9b70ff0> +#+END_EXAMPLE +** Update examples +*** sssh + - Check exit status of an executed command. +*** ssshd + - Send exit status to the client according to the result of command + execution. +*** echo server and client + - Some cosmetic changes aimed to make the code cleaner. +** Update documentation + - Add description of the new procedures. + - Update examples. + +* Changes in version 0.7.1 (2014-10-11) +** New `%get-libssh-version' procedure in (ssh version) + The procedure can be used to get libssh version in the "raw" format such + as: "0.6.3/openssl/zlib". +** New `get-crypto-library' procedure in (ssh version) + The procedure returns name of a cryptographic library with which libssh was + compiled. +** New `zlib-support?' procedure in (ssh version) + The procedure checks if zlib support is enabled in libssh. +** New `set-log-verbosity!' procedure in (ssh log) + The procedure sets global libssh log verbosity. +** New `get-log-verbosity' procedure in (ssh log) + The procedure gets global libssh log verbosity. +** New `make-keypair' procedure in (ssh key) + The procedure can be used to generate a new keypair with the specified + parameters. +** New `private-key-to-file' procedure in (ssh key) + The procedure can be used to export a private key to a file (doesn't work + if libssh 0.6.3 is compiled with GCrypt). +** Changes in tests +*** Fix "end of file" errors in tests + Fix the following kind of errors in tests: +#+BEGIN_EXAMPLE +ERROR: In procedure scm_i_lreadparen: /path/to/guile-ssh/sources/tests/./client-server.scm:272:34: end of file +#+END_EXAMPLE + Thanks to Ludovic Courtès for reporting the issue and for a good advice how + to fix that. +*** Don't perform ECDSA key tests if libssh is compiled with GCrypt + libssh 0.6.3 does not support ECDSA keys if compiled with GCrypt instead + of OpenSSL. Thus, ECDSA key tests used to fail. Now there is a check + that prevents these tests from execution in case when libssh 0.6.3 is + compiled with GCrypt. +** Update documentation + - Add description of the new procedures. + - Add note about ECDSA keys support with GCrypt library. + +* Changes in version 0.7.0 (2014-08-31) ** Require GNU Guile 2.0 ** Require libssh 0.6.3 ** Change `get-public-key-hash' @@ -47,6 +120,8 @@ Copyright (C) Artyom V. Poptsov <poptsov.artyom@gmail.com> ** New `channel-open-forward' procedure in (ssh channel) ** New `channel-open-forward/reverse' procedure in (ssh channel) ** New `session-get' procedure in (ssh session) +** New `channel-get-session' procedure in (ssh channel) +** New `message-get-session' procedure in (ssh message) ** Improve printing of Guile-SSH objects *** Print more detailed information about `session' object Print user name, host name and current state of a `session' object. @@ -57,6 +132,10 @@ Copyright (C) Artyom V. Poptsov <poptsov.artyom@gmail.com> *** Add tests for Guile-SSH keys *** Add tests for `authenticate-server' procedure ** Bug fixes +*** Fix a GC issue + Keep a reference to the parent session in channels and messages to prevent + the session from premature GC'ing. Without that GC could free a session + even if there are live channels and by that break the channels. *** `public-key?' and `private-key?' now produce correct result Functions now return `#f' if the given argument is not a Guile-SSH key object. @@ -7,7 +7,7 @@ underlying [[http://www.libssh.org/][libssh]] library. * Requirements - [[https://www.gnu.org/software/guile/][GNU Guile]] 2.0.x - - [[http://www.libssh.org/][libssh]] 0.6.3 + - [[http://www.libssh.org/][libssh]] 0.6.3 or 0.6.4 * Distribution @@ -18,7 +18,7 @@ Files: - INSTALL contains general instructions for building/installing of Guile-SSH. - NEWS describes user-visible changes. - - TODO contains plans for the further development. + - TODO contains plans for the further development and list of known bugs. Directories: - examples -- Examples of Guile-SSH usage. @@ -52,7 +52,7 @@ All the modules will be compiled and produced .go files will be installed to Documentation in Info format, in =${prefix}/share/info/=: - guile-ssh.info -Examples, in =${prefix}/share/libguile-ssh/examples=: +Examples, in =${prefix}/share/guile-ssh/examples=: - ssshd.scm -- SSH server example. - sssh.scm -- SSH client example. + echo/ @@ -5,4 +5,3 @@ ** Make use of libssh callbacks to track asynchronous events on channels * Known Bugs - diff --git a/configure.ac b/configure.ac index 51f8109..7adfe9d 100644 --- a/configure.ac +++ b/configure.ac @@ -3,10 +3,10 @@ dnl Process this file with autoconf to produce configure. dnl define(GUILE_SSH_CONFIGURE_COPYRIGHT, [[ -Copyright (C) 2013, 2014 Artyom V. Poptsov <poptsov.artyom@gmail.com> +Copyright (C) 2013, 2014, 2015 Artyom V. Poptsov <poptsov.artyom@gmail.com> This file is part of Guile-SSH. - + Guile-SSH 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 @@ -21,7 +21,7 @@ You should have received a copy of the GNU General Public License along with Guile-SSH. If not, see <http://www.gnu.org/licenses/>. ]]) -AC_INIT([Guile-SSH], [0.6.0], [poptsov.artyom@gmail.com], +AC_INIT([Guile-SSH], [0.7.2], [poptsov.artyom@gmail.com], [guile-ssh], [https://github.com/artyom-poptsov/guile-ssh]) @@ -65,7 +65,7 @@ if test "x$guilesitedir" = "x"; then fi AC_SUBST([guilesitedir]) -LIBGUILE_SSH_INTERFACE="6:0:0" +LIBGUILE_SSH_INTERFACE="8:0:1" AC_SUBST(LIBGUILE_SSH_INTERFACE) GUILE_EFFECTIVE_VERSION=`$GUILE -c '(display (effective-version))'` diff --git a/doc/api-channels.texi b/doc/api-channels.texi index 019bcb0..7103842 100644 --- a/doc/api-channels.texi +++ b/doc/api-channels.texi @@ -75,6 +75,13 @@ Set an environment @var{variable} to @var{value}. Throw value is undefined. @end deffn +@deffn {Scheme Procedure} channel-request-send-exit-status channel exit-status +Send an @var{exit-status} to the remote process (as described in RFC 4254, +section 6.10). Only SSH-v2 is supported. Return value is undefined. + +The @var{channel} needs to be closed with after this message. +@end deffn + @deffn {Scheme Procedure} channel-set-pty-size! channel columns rows Change size of the @acronym{PTY} to @var{columns} and @var{rows}. The @var{channel} must be open. Return value is undefined. @@ -106,11 +113,23 @@ Example: @end lisp @end deffn +@deffn {Scheme Procedure} channel-get-session channel +Get the session to which belongs the @var{channel}. Throw +@code{guile-ssh-error} on an error. Return the session. +@end deffn + @deffn {Scheme Procedure} channel-eof? channel Return @code{#t} if remote has sent @acronym{EOF}, @code{#f} otherwise. Throw @code{guile-ssh-error} if the channel has been closed and freed. @end deffn +@deffn {Scheme Procedure} channel-get-exit-status channel +Get the exit status of the @var{channel} (error code from the executed +instruction). The @var{channel} must be open. Return the exist status, or +@code{#f} if no exit status has been returned (yet). Throw +@code{guile-ssh-error} on error. +@end deffn + @subsection Port forwarding @cindex Port forwarding diff --git a/doc/api-keys.texi b/doc/api-keys.texi index d757efc..c718dbd 100644 --- a/doc/api-keys.texi +++ b/doc/api-keys.texi @@ -13,13 +13,27 @@ The @code{(ssh key)} module provides procedures for handling of Guile-SSH keys. +@strong{Note} that Guile-SSH does not support ECDSA keys if libssh 0.6.3 is +compiled with GCrypt instead of OpenSSL. + +@deffn {Scheme Procedure} make-keypair type length +Generate a keypair of specified @var{type} and @var{length} (in bits). This +may take some time. + +Possible key types are: @code{dss}, @code{rsa}, @code{rsa1}, @code{ecdsa}. + +Return newly generated private key. Throw @code{guile-ssh-error} on error. +@end deffn + @deffn {Scheme Procedure} key? x Return @code{#t} if @var{x} is a Guile-SSH key, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} public-key? x -Return @code{#t} if @var{x} is a Guile-SSH public key, @code{#f} -otherwise. +Return @code{#t} if @var{x} is a Guile-SSH key and it @strong{contains} a +public key, @code{#f} otherwise. What it means is that the procedure will +return @code{#t} for a private key too (because the private key contains a +public key in some sense). @end deffn @deffn {Scheme Procedure} private-key? x @@ -46,6 +60,14 @@ user will be asked for passphrase to decrypt the key. Return a new Guile-SSH key of @code{#f} on error. @end deffn +@deffn {Scheme Procedure} private-key-to-file private-key file-name +Export @var{private-key} to a PAM file @var{file-name} on a disk. Throw +@code{guile-ssh-error} on error. Return value is undefined. + +@strong{Note} that this procedure won't work if libssh 0.6.3 is compiled with +GCrypt cryptographic library. +@end deffn + @deffn {Scheme Procedure} private-key->public-key private-key Get a public key from the @var{private-key}. @end deffn diff --git a/doc/api-logging.texi b/doc/api-logging.texi index d280426..c44f227 100644 --- a/doc/api-logging.texi +++ b/doc/api-logging.texi @@ -93,6 +93,31 @@ Function path @end deffn +@deffn {Scheme Procedure} set-log-verbosity! verbosity +Set the global log verbosity to a @var{verbosity}. Throw +@code{guile-ssh-error} on error. Return value is undefined. + +@var{verbosity} is expected to be one of the following symbols: + +@table @samp +@item nolog +The message will be printed even if the logging is disabled +@item rare +Rare and noteworthy events +@item protocol +High level protocol information +@item packet +Lower level protocol infomations, packet level +@item functions +Function path +@end table + +@end deffn + +@deffn {Scheme Procedure} get-log-verbosity +Get global log verbosity value. +@end deffn + @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: diff --git a/doc/api-messages.texi b/doc/api-messages.texi index 451b2e2..199cc4e 100644 --- a/doc/api-messages.texi +++ b/doc/api-messages.texi @@ -152,6 +152,11 @@ are: @code{password}, @code{public-key}, @code{interactive}, value is undefined. @end deffn +@deffn {Scheme Procedure} message-get-session message +Get the session from which the @var{message} was received. Return the +session. +@end deffn + @node Parsing of Requests @subsection Parsing of Requests diff --git a/doc/api-servers.texi b/doc/api-servers.texi index 0092b2e..1cdada5 100644 --- a/doc/api-servers.texi +++ b/doc/api-servers.texi @@ -94,6 +94,12 @@ Expected type of @var{value}: boolean. @end deffn +@deffn {Scheme Procedure} server-get server option +Get value of @var{option} for Guile-SSH @var{server}. Return @var{option} +value, or @code{#f} if the @var{option} does not set. Throw +@code{guile-ssh-error} on error. +@end deffn + @deffn {Scheme Procedure} server-listen server Start listening to the socket. Throw @code{guile-ssh-error} on error. Return value undefined. diff --git a/doc/api-sessions.texi b/doc/api-sessions.texi index 9160ee6..40745e6 100644 --- a/doc/api-sessions.texi +++ b/doc/api-sessions.texi @@ -223,6 +223,7 @@ with this procedure. Here is the list of allowed options: @table @samp @item host +@item port @item user @item identity @item proxycommand diff --git a/doc/api-version.texi b/doc/api-version.texi index ccf0188..1634b5c 100644 --- a/doc/api-version.texi +++ b/doc/api-version.texi @@ -22,6 +22,20 @@ follwing format: For example, @samp{0.5.2}. @end deffn +@deffn {Scheme Procedure} %get-libssh-version +Low-level procedure that returns a version string in libssh format, +eg. "0.6.3/openssl/zlib". +@end deffn + +@deffn {Scheme Procedure} get-crypto-library +Get cryptographic library name with which libssh was compiled. Possible +values are: @code{'openssl}, @code{'gnutls}. +@end deffn + +@deffn {Scheme Procedure} zlib-support? +Return @code{#t} if libssh was compiled wit zlib support, @code{#f} otherwise. +@end deffn + @deffn {Scheme Procedure} get-library-version Get version of the Guile-SSH. @end deffn diff --git a/doc/examples.texi b/doc/examples.texi index 0f5d20e..2f2ff64 100644 --- a/doc/examples.texi +++ b/doc/examples.texi @@ -7,7 +7,7 @@ @chapter Examples There are working examples that come with Guile-SSH. These examples are -normally installed in @file{$prefix/share/libguile-ssh/examples} directory: +normally installed in @file{$prefix/share/guile-ssh/examples} directory: @table @samp @item sssh.scm @@ -66,6 +66,10 @@ the server. ;; Execute a command (channel-request-exec channel "uname") + ;; Check the exit status of the command + (or (zero? (channel-get-exit-status channel)) + ...) ; Handle error + ;; Poll the channel for data (let poll ((ready? #f)) (if ready? diff --git a/doc/guile-ssh.texi b/doc/guile-ssh.texi index ebe8e12..1f8407b 100644 --- a/doc/guile-ssh.texi +++ b/doc/guile-ssh.texi @@ -10,7 +10,7 @@ @copying This manual documents Guile-SSH version @value{VERSION}. -Copyright (C) 2014 Artyom V. Poptsov +Copyright (C) 2014, 2015 Artyom V. Poptsov Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -93,9 +93,14 @@ Guile-SSH depends on the following packages: @itemize @item @url{https://www.gnu.org/software/guile/, GNU Guile}, 2.0 -@item @url{http://www.libssh.org/, libssh}, 0.6.3 +@item @url{http://www.libssh.org/, libssh}, 0.6.3 or 0.6.4 @end itemize +Please @strong{note} that you need +@url{http://git.libssh.org/projects/libssh.git/commit/?h=v0-6&id=a033b93c616f4a81afc3fc6a017396d507d96c19, +this} patch to get libssh working if it compiled with GCrypt instead of +OpenSSL, otherwise Guile-SSH will fail. One of the ways to get the patch is +to compile libssh from the @code{v0-6} Git branch. Get the sources of Guile-SSH from GitHub: @@ -106,7 +111,7 @@ $ git clone git@@github.com:artyom-poptsov/guile-ssh.git Configure the sources: @example -$ cd libguile-ssh/ +$ cd guile-ssh/ $ autoreconf -if $ ./configure @end example diff --git a/doc/version.texi b/doc/version.texi index cdfc440..fb1b83b 100644 --- a/doc/version.texi +++ b/doc/version.texi @@ -1,4 +1,4 @@ -@set UPDATED 20 July 2014 -@set UPDATED-MONTH July 2014 -@set EDITION 0.6.0 -@set VERSION 0.6.0 +@set UPDATED 24 February 2015 +@set UPDATED-MONTH February 2015 +@set EDITION 0.7.2 +@set VERSION 0.7.2 diff --git a/examples/echo/client.scm.in b/examples/echo/client.scm.in index 536a0f2..eb4b3f1 100644 --- a/examples/echo/client.scm.in +++ b/examples/echo/client.scm.in @@ -5,7 +5,7 @@ ;;; client.scm -- Echo client example. -;; Copyright (C) 2014 Artyom V. Poptsov <poptsov.artyom@gmail.com> +;; Copyright (C) 2014, 2015 Artyom V. Poptsov <poptsov.artyom@gmail.com> ;; ;; This program is free software: you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -60,7 +60,7 @@ (help (single-char #\h) (value #f)))) -(define (print-help) +(define (print-help-and-exit) "Print information about program usage." (display (string-append "\ " *program-name* " -- Echo client example. @@ -74,7 +74,8 @@ Options: --user=<user>, -u <user> User name --port=<port-number>, -p <port-number> Port number --identity-file=<file>, -i <file> Path to private key -"))) +")) + (exit 0)) (define (handle-error session) "Handle a SSH error." @@ -85,7 +86,7 @@ Options: (define (get-prvkey session identity-file) "Get a private SSH key. Handle possible errors." (let ((prvkey (private-key-from-file identity-file))) - (if (not prvkey) + (or prvkey (handle-error session)) prvkey)) @@ -100,11 +101,6 @@ Options: (define (main args) "Entry point of the program." - (if (null? (cdr args)) - (begin - (print-help) - (exit 0))) - (let* ((options (getopt-long args *option-spec*)) (user (option-ref options 'user *default-user*)) (port (option-ref options 'port *default-port*)) @@ -113,15 +109,8 @@ Options: (help-needed? (option-ref options 'help #f)) (args (option-ref options '() #f))) - (if help-needed? - (begin - (print-help) - (exit 0))) - - (if (or (null? args) (null? (cdr args))) - (begin - (print-help) - (exit 0))) + (and (or (null? args) help-needed?) + (print-help-and-exit)) (let* ((host (car args)) (str (cadr args)) @@ -141,12 +130,12 @@ Options: (let ((private-key (get-prvkey session identity-file))) - (if (eqv? (userauth-public-key! session private-key) 'error) - (handle-error session)) + (and (eqv? (userauth-public-key! session private-key) 'error) + (handle-error session)) (let ((channel (make-channel session))) - (if (not channel) + (or channel (handle-error session)) (channel-open-session channel) diff --git a/examples/echo/server.scm.in b/examples/echo/server.scm.in index 6a9ce04..82a6416 100644 --- a/examples/echo/server.scm.in +++ b/examples/echo/server.scm.in @@ -5,7 +5,7 @@ ;;; client.scm -- Echo server example. -;; Copyright (C) 2014 Artyom V. Poptsov <poptsov.artyom@gmail.com> +;; Copyright (C) 2014, 2015 Artyom V. Poptsov <poptsov.artyom@gmail.com> ;; ;; This program is free software: you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -121,7 +121,7 @@ (r (string-append res str) (read-line port 'concat)) res))) -(define (print-help) +(define (print-help-and-exit) "Print help message and exit." (display "\ Usage: server.scm [ options ] @@ -131,8 +131,8 @@ Options: --dsakey=<key>, -d <key> Set host DSA key. --port=<port>, -p <port> Set bind port of the server. --help, -h Print this message and exit. -")) - +") + (exit 0)) (define *option-spec* '((dsakey (single-char #\d) (value #t)) @@ -148,10 +148,8 @@ Options: (port (option-ref options 'port *default-bindport*)) (help-wanted (option-ref options 'help #f))) - (if help-wanted - (begin - (print-help) - (exit))) + (and help-wanted + (print-help-and-exit)) (let ((server (make-server #:bindport (string->number port) #:rsakey rsakey diff --git a/examples/sssh.scm.in b/examples/sssh.scm.in index 6894a70..bb1f79e 100644 --- a/examples/sssh.scm.in +++ b/examples/sssh.scm.in @@ -209,14 +209,21 @@ Options: (print-debug "8. channel-request-exec (ssh_channel_request_exec)\n") (channel-request-exec channel cmd) - (print-debug "9. channel-poll (ssh_channel_poll)\n") - (let poll ((ready? #f)) - (if ready? - (begin - (print-debug "10. channel-read (ssh_channel_read)\n") - (display (read-all channel)) - (newline)) - (poll (char-ready? channel)))) + (case (channel-get-exit-status channel) + ((0) + (print-debug "9. channel-poll (ssh_channel_poll)\n") + (let poll ((ready? #f)) + (if ready? + (begin + (print-debug "10. channel-read (ssh_channel_read)\n") + (display (read-all channel)) + (newline)) + (poll (char-ready? channel))))) + (else => + (lambda (status) + (format #t + "ERROR: Failed to execute command `~a' (exit status ~a)~%" + cmd status)))) (close channel) (disconnect! session)))))) diff --git a/examples/ssshd.scm.in b/examples/ssshd.scm.in index 0c595d7..ba52818 100644 --- a/examples/ssshd.scm.in +++ b/examples/ssshd.scm.in @@ -82,6 +82,11 @@ (format #t " cmd: ~a~%" cmd) (let* ((port (open-input-pipe cmd)) (res (read-all port))) + + (if (string-null? res) + (channel-request-send-exit-status channel 1) + (channel-request-send-exit-status channel 0)) + (display res channel)))) (define (handle-req-auth session msg msg-type) @@ -39,7 +39,7 @@ be set by `session-set!' call. - avp */ -/* Convert SSH authentication result to a Scheme symbol +/* Convert SSH authentication result to a Scheme symbol Return a symbol, or #f on error. */ static SCM @@ -206,7 +206,7 @@ Throw `wrong-type-arg' if a disconnected SESSION is passed as an argument.\ #undef FUNC_NAME -/* Try to authenticate through the "none" method. +/* Try to authenticate through the "none" method. Return one of the following symbols: 'success, 'error, 'denied, 'partial, 'again */ @@ -224,7 +224,7 @@ Throw `wrong-type-arg' if a disconnected SESSION is passed as an argument.\ GSSH_VALIDATE_CONNECTED_SESSION (session_data, arg1, SCM_ARG1); /* username is deprecated parameter. Should be set to NULL. */ - res = ssh_userauth_none (session_data->ssh_session, + res = ssh_userauth_none (session_data->ssh_session, NULL); /* Username */ return ssh_auth_result_to_symbol (res); diff --git a/ssh/auth.scm b/ssh/auth.scm index 47f7b6e..5a9cdb0 100644 --- a/ssh/auth.scm +++ b/ssh/auth.scm @@ -21,7 +21,7 @@ ;;; Commentary: ;; This module contains API that is used for SSH user authentication. -;; +;; ;; These methods are exported: ;; ;; userauth-public-key! diff --git a/ssh/channel-func.c b/ssh/channel-func.c index ed2e210..66bb4a0 100644 --- a/ssh/channel-func.c +++ b/ssh/channel-func.c @@ -1,6 +1,6 @@ /* channel-func.c -- SSH channel manipulation functions. * - * Copyright (C) 2013, 2014 Artyom V. Poptsov <poptsov.artyom@gmail.com> + * Copyright (C) 2013, 2014, 2015 Artyom V. Poptsov <poptsov.artyom@gmail.com> * * This file is part of Guile-SSH. * @@ -80,6 +80,55 @@ Run a shell command CMD without an interactive shell.\ } #undef FUNC_NAME +SCM_DEFINE (guile_ssh_channel_get_exit_status, + "channel-get-exit-status", 1, 0, 0, + (SCM channel), + "\ +Get the exit status of the channel (error code from the executed \ +instruction). Return the exist status, or #f if no exit status has been \ +returned (yet). \ +") +#define FUNC_NAME s_guile_ssh_channel_get_exit_status +{ + struct channel_data *cd = _scm_to_channel_data (channel); + int res; + + GSSH_VALIDATE_OPEN_CHANNEL (channel, SCM_ARG1, FUNC_NAME); + + res = ssh_channel_get_exit_status (cd->ssh_channel); + return (res == SSH_ERROR) ? SCM_BOOL_F : scm_from_int (res); +} +#undef FUNC_NAME + +SCM_DEFINE (guile_ssh_channel_request_send_exit_status, + "channel-request-send-exit-status", 2, 0, 0, + (SCM channel, SCM exit_status), + "\ +Send the exit status to the remote process (as described in RFC 4254, section\n\ +6.10).\n\ +Return value is undefined.\ +") +#define FUNC_NAME s_guile_ssh_channel_request_send_exit_status +{ + struct channel_data *cd = _scm_to_channel_data (channel); + int res; + + GSSH_VALIDATE_OPEN_CHANNEL (channel, SCM_ARG1, FUNC_NAME); + SCM_ASSERT (scm_is_unsigned_integer (exit_status, 0, UINT32_MAX), exit_status, + SCM_ARG2, FUNC_NAME); + + res = ssh_channel_request_send_exit_status (cd->ssh_channel, + scm_to_uint32 (exit_status)); + if (res != SSH_OK) + { + ssh_session session = ssh_channel_get_session (cd->ssh_channel); + guile_ssh_session_error1 (FUNC_NAME, session, channel); + } + + return SCM_UNDEFINED; +} +#undef FUNC_NAME + SCM_DEFINE (guile_ssh_channel_request_pty, "channel-request-pty", 1, 0, 0, (SCM channel), "\ @@ -128,7 +177,7 @@ Return value is undefined.\ } #undef FUNC_NAME -/* Set an environment variable NAME to value VALUE +/* Set an environment variable NAME to value VALUE Return value is undefined. */ SCM_DEFINE (guile_ssh_channel_request_env, "channel-request-env", 3, 0, 0, (SCM channel, SCM name, SCM value), @@ -369,6 +418,21 @@ Return one of the following symbols: \"stdout\", \"stderr\".\ } #undef FUNC_NAME +SCM_DEFINE (guile_ssh_channel_get_session, + "channel-get-session", 1, 0, 0, + (SCM channel), + "\ +Get the session to which belongs the CHANNEL. Throw `guile-ssh-error' on an \n\ +error. Return the session.\ +") +#define FUNC_NAME s_guile_ssh_channel_get_session +{ + struct channel_data *cd = _scm_to_channel_data (channel); + GSSH_VALIDATE_CHANNEL_DATA (cd, channel, FUNC_NAME); + return cd->session; +} +#undef FUNC_NAME + /* Predicates */ diff --git a/ssh/channel-func.h b/ssh/channel-func.h index 82afc23..0fb83f4 100644 --- a/ssh/channel-func.h +++ b/ssh/channel-func.h @@ -1,4 +1,4 @@ -/* Copyright (C) 2013, 2014 Artyom V. Poptsov <poptsov.artyom@gmail.com> +/* Copyright (C) 2013, 2014, 2015 Artyom V. Poptsov <poptsov.artyom@gmail.com> * * This file is part of Guile-SSH * @@ -21,12 +21,15 @@ extern SCM guile_ssh_channel_open_session (SCM arg1); extern SCM guile_ssh_channel_request_exec (SCM arg1, SCM arg2); +extern SCM guile_ssh_channel_request_send_exit_status (SCM arg1, SCM arg2); extern SCM guile_ssh_channel_is_open_p (SCM arg1); extern SCM guile_ssh_channel_is_eof_p (SCM arg1); extern SCM guile_ssh_channel_set_pty_size_x (SCM arg1, SCM arg2, SCM arg3); +extern SCM guile_ssh_channel_get_exit_status (SCM arg1); + extern void init_channel_func (void); #endif /* ifndef __CHANNEL_FUNC_H__ */ diff --git a/ssh/channel-type.c b/ssh/channel-type.c index 0cbf63e..cd11b36 100644 --- a/ssh/channel-type.c +++ b/ssh/channel-type.c @@ -1,9 +1,9 @@ /* channel-type.c -- SSH channel smob. * - * Copyright (C) 2013, 2014 Artyom V. Poptsov <poptsov.artyom@gmail.com> + * Copyright (C) 2013, 2014, 2015 Artyom V. Poptsov <poptsov.artyom@gmail.com> * * This file is part of Guile-SSH. - * + * * Guile-SSH 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 @@ -65,7 +65,10 @@ ptob_fill_input (SCM channel) if (res == SSH_ERROR) guile_ssh_error1 (FUNC_NAME, "Error reading from the channel", channel); - if (res == SSH_AGAIN) + /* `ssh_channel_read' sometimes returns 0 even if `ssh_channel_poll' returns + a positive value. So we must ensure that res != 0 otherwise an assertion + in `scm_i_fill_input' won't be meet (see `ports.c' in Guile 2.0.9). */ + if ((! res) || (res == SSH_AGAIN)) return EOF; pt->read_pos = pt->read_buf; @@ -162,7 +165,8 @@ ptob_close (SCM channel) SCM mark_channel (SCM channel_smob) { - return SCM_BOOL_F; + struct channel_data *cd = _scm_to_channel_data (channel_smob); + return cd->session; } size_t @@ -193,47 +197,10 @@ print_channel (SCM channel, SCM port, scm_print_state *pstate) scm_puts ("(closed) ", port); } scm_display (_scm_object_hex_address (channel), port); - scm_puts (">", port); + scm_puts (">", port); return 1; } -/* Pack the SSH channel CH to a Scheme port and return newly created - port. */ -SCM -_ssh_channel_to_scm (ssh_channel ch) -{ - struct channel_data *channel_data; - SCM ptob; - scm_port *pt; - - channel_data = scm_gc_malloc (sizeof (struct channel_data), "channel"); - - channel_data->ssh_channel = ch; - channel_data->is_stderr = 0; /* Reading from stderr disabled by default */ - - ptob = scm_new_port_table_entry (channel_tag); - pt = SCM_PTAB_ENTRY (ptob); - - pt->rw_random = 0; - - /* Output init */ - pt->write_buf_size = DEFAULT_PORT_W_BUFSZ; - pt->write_buf = scm_gc_malloc (pt->write_buf_size, "port write buffer"); - pt->write_pos = pt->write_buf; - pt->write_end = pt->write_buf; - - /* Input init */ - pt->read_buf_size = DEFAULT_PORT_R_BUFSZ; - pt->read_buf = scm_gc_malloc (pt->read_buf_size, "port read buffer"); - pt->read_pos = pt->read_buf; - pt->read_end = pt->read_buf; - - SCM_SET_CELL_TYPE (ptob, channel_tag | SCM_RDNG | SCM_WRTNG); - SCM_SETSTREAM (ptob, channel_data); - - return ptob; -} - /* Allocate a new SSH channel. */ SCM_DEFINE (guile_ssh_make_channel, "make-channel", 1, 0, 0, (SCM arg1), @@ -247,7 +214,7 @@ Allocate a new SSH channel.\ if (! ch) return SCM_BOOL_F; - return _ssh_channel_to_scm (ch); + return _scm_from_channel_data (ch, arg1); } @@ -279,6 +246,44 @@ equalp_channel (SCM x1, SCM x2) /* Helper procedures */ +/* Pack the SSH channel CH to a Scheme port and return newly created + port. */ +SCM +_scm_from_channel_data (ssh_channel ch, SCM session) +{ + struct channel_data *channel_data; + SCM ptob; + scm_port *pt; + + channel_data = scm_gc_malloc (sizeof (struct channel_data), "channel"); + + channel_data->ssh_channel = ch; + channel_data->is_stderr = 0; /* Reading from stderr disabled by default */ + channel_data->session = session; + + ptob = scm_new_port_table_entry (channel_tag); + pt = SCM_PTAB_ENTRY (ptob); + + pt->rw_random = 0; + + /* Output init */ + pt->write_buf_size = DEFAULT_PORT_W_BUFSZ; + pt->write_buf = scm_gc_malloc (pt->write_buf_size, "port write buffer"); + pt->write_pos = pt->write_buf; + pt->write_end = pt->write_buf; + + /* Input init */ + pt->read_buf_size = DEFAULT_PORT_R_BUFSZ; + pt->read_buf = scm_gc_malloc (pt->read_buf_size, "port read buffer"); + pt->read_pos = pt->read_buf; + pt->read_end = pt->read_buf; + + SCM_SET_CELL_TYPE (ptob, channel_tag | SCM_RDNG | SCM_WRTNG); + SCM_SETSTREAM (ptob, channel_data); + + return ptob; +} + /* Convert X to a SSH channel. Return the channel data or NULL if the channel has been freed. */ struct channel_data * diff --git a/ssh/channel-type.h b/ssh/channel-type.h index ef2ca2a..1ac8a28 100644 --- a/ssh/channel-type.h +++ b/ssh/channel-type.h @@ -27,6 +27,10 @@ extern scm_t_bits channel_tag; /* Smob data. */ struct channel_data { + /* Reference to the parent session. We need to keep the reference + to prevent the session from premature freeing by the GC. */ + SCM session; + ssh_channel ssh_channel; uint8_t is_stderr; }; @@ -50,12 +54,13 @@ struct channel_data { extern SCM guile_ssh_make_channel (SCM arg1); extern SCM guile_ssh_is_channel_p (SCM arg1); +extern SCM guile_ssh_channel_get_session (SCM arg1); extern void init_channel_type (void); /* Helper procedures */ extern struct channel_data *_scm_to_channel_data (SCM x); -extern SCM _ssh_channel_to_scm (ssh_channel ch); +extern SCM _scm_from_channel_data (ssh_channel ch, SCM session); #endif /* ifndef __CHANNEL_TYPE_H__ */ diff --git a/ssh/channel.scm b/ssh/channel.scm index dc09d8d..c790542 100644 --- a/ssh/channel.scm +++ b/ssh/channel.scm @@ -59,9 +59,12 @@ channel-open-forward channel-open-forward/reverse channel-cancel-forward + channel-request-send-exit-status channel-set-pty-size! channel-set-stream! channel-get-stream + channel-get-session + channel-get-exit-status channel-open? channel-eof?)) diff --git a/ssh/common.c b/ssh/common.c index 7f7104c..bfa259e 100644 --- a/ssh/common.c +++ b/ssh/common.c @@ -22,21 +22,6 @@ #include <libssh/libssh.h> #include "common.h" -/* Log verbosity levels used by libssh sessions and servers. */ -struct symbol_mapping log_verbosity[] = { - /* 0, No logging at all */ - { "nolog", SSH_LOG_NOLOG }, - /* 1, Only rare and noteworthy events */ - { "rare", SSH_LOG_RARE }, - /* 2, High level protocol information */ - { "protocol", SSH_LOG_PROTOCOL }, - /* 3, Lower level protocol infomations, packet level */ - { "packet", SSH_LOG_PACKET }, - /* 4, Every function path */ - { "functions", SSH_LOG_FUNCTIONS }, - { NULL, -1 } -}; - /* Convert the SSH constant VALUE to a Scheme symbol */ SCM _ssh_const_to_scm (struct symbol_mapping *types, int value) diff --git a/ssh/common.h b/ssh/common.h index 30a7e68..93bcc8c 100644 --- a/ssh/common.h +++ b/ssh/common.h @@ -26,8 +26,6 @@ struct symbol_mapping { int value; }; -extern struct symbol_mapping log_verbosity[]; - extern SCM _ssh_const_to_scm (struct symbol_mapping *types, int value); diff --git a/ssh/key-func.c b/ssh/key-func.c index 3b0660a..6a52de6 100644 --- a/ssh/key-func.c +++ b/ssh/key-func.c @@ -53,19 +53,16 @@ Throw `guile-ssh-error' on error.\ ") #define FUNC_NAME s_guile_ssh_string_to_public_key { - struct key_data *kd = NULL; char *c_base64_str = NULL; struct symbol_mapping *key_type = NULL; + ssh_key ssh_public_key = NULL; int res; - SCM key_smob; SCM_ASSERT (scm_is_string (base64_str), base64_str, SCM_ARG1, FUNC_NAME); SCM_ASSERT (scm_is_symbol (type), type, SCM_ARG2, FUNC_NAME); scm_dynwind_begin (0); - kd = scm_gc_malloc (sizeof (struct key_data), "ssh key"); - c_base64_str = scm_to_locale_string (base64_str); scm_dynwind_free (c_base64_str); @@ -75,16 +72,16 @@ Throw `guile-ssh-error' on error.\ res = ssh_pki_import_pubkey_base64 (c_base64_str, key_type->value, - &kd->ssh_key); + &ssh_public_key); if (res != SSH_OK) { const char *msg = "Could not convert the given string to a public key"; guile_ssh_error1 (FUNC_NAME, msg, scm_list_2 (base64_str, type)); } - SCM_NEWSMOB (key_smob, key_tag, kd); + scm_dynwind_end (); - return key_smob; + return _scm_from_ssh_key (ssh_public_key, SCM_BOOL_F); } #undef FUNC_NAME @@ -98,8 +95,7 @@ Return a new SSH key of #f on error.\ ") #define FUNC_NAME s_guile_ssh_private_key_from_file { - SCM key_smob; - struct key_data *key_data; + ssh_key ssh_key = NULL; char *c_filename; /* NULL means that either the public key is unecrypted or the user should be asked for the passphrase. */ @@ -110,9 +106,6 @@ Return a new SSH key of #f on error.\ SCM_ASSERT (scm_is_string (filename), filename, SCM_ARG1, FUNC_NAME); - key_data = (struct key_data *) scm_gc_malloc (sizeof (struct key_data), - "ssh key"); - c_filename = scm_to_locale_string (filename); scm_dynwind_free (c_filename); @@ -120,9 +113,7 @@ Return a new SSH key of #f on error.\ passphrase, NULL, /* auth_fn */ NULL, /* auth_data */ - &key_data->ssh_key); - - key_data->is_to_be_freed = 0; /* Key will be freed along with its session. */ + &ssh_key); if (res == SSH_EOF) { @@ -135,11 +126,47 @@ Return a new SSH key of #f on error.\ guile_ssh_error1 (FUNC_NAME, msg, filename); } - SCM_NEWSMOB (key_smob, key_tag, key_data); + scm_dynwind_end (); + + return _scm_from_ssh_key (ssh_key, SCM_BOOL_F); +} +#undef FUNC_NAME + +SCM_DEFINE (guile_ssh_private_key_to_file, + "private-key-to-file", 2, 0, 0, + (SCM key, SCM file_name), + "\ +Export a private KEY to file FILE_NAME. Throw `guile-ssh-error' on error. \ +Return value is undefined.\ +") +#define FUNC_NAME s_guile_ssh_private_key_to_file +{ + struct key_data *kd = _scm_to_key_data (key); + char *c_file_name = NULL; + int res; + + scm_dynwind_begin (0); + + SCM_ASSERT (_private_key_p (kd), key, SCM_ARG1, FUNC_NAME); + SCM_ASSERT (scm_is_string (file_name), file_name, SCM_ARG2, FUNC_NAME); + + c_file_name = scm_to_locale_string (file_name); + scm_dynwind_free (c_file_name); + + res = ssh_pki_export_privkey_file (kd->ssh_key, + NULL, /* passphrase */ + NULL, /* auth_fn */ + NULL, /* auth_data */ + c_file_name); + if (res == SSH_ERROR) + { + guile_ssh_error1 (FUNC_NAME, "Unable to export a key to a file", + scm_list_2 (key, file_name)); + } scm_dynwind_end (); - return key_smob; + return SCM_UNDEFINED; } #undef FUNC_NAME @@ -152,26 +179,18 @@ Get public key from a private key KEY.\ #define FUNC_NAME s_guile_ssh_public_key_from_private_key { struct key_data *private_key_data = _scm_to_key_data (key); - struct key_data *public_key_data; - SCM smob; + ssh_key ssh_public_key = NULL; int res; SCM_ASSERT (_private_key_p (private_key_data), key, SCM_ARG1, FUNC_NAME); - public_key_data = (struct key_data *) scm_gc_malloc (sizeof (struct key_data), - "ssh key"); - res = ssh_pki_export_privkey_to_pubkey (private_key_data->ssh_key, - &public_key_data->ssh_key); - - public_key_data->is_to_be_freed = 1; /* The key must be freed by GC. */ + &ssh_public_key); if (res != SSH_OK) return SCM_BOOL_F; - SCM_NEWSMOB (smob, key_tag, public_key_data); - - return smob; + return _scm_from_ssh_key (ssh_public_key, SCM_BOOL_F); } #undef FUNC_NAME @@ -186,11 +205,8 @@ Read public key from a file FILENAME. Return a SSH key.\ ") #define FUNC_NAME s_guile_ssh_public_key_from_file { - struct key_data *public_key_data; + ssh_key ssh_public_key = NULL; char *c_filename; - ssh_string public_key_str; - SCM key_smob; - int key_type; int res; scm_dynwind_begin (0); @@ -200,10 +216,7 @@ Read public key from a file FILENAME. Return a SSH key.\ c_filename = scm_to_locale_string (filename); scm_dynwind_free (c_filename); - public_key_data = (struct key_data *) scm_gc_malloc (sizeof (struct key_data), - "ssh key"); - - res = ssh_pki_import_pubkey_file (c_filename, &public_key_data->ssh_key); + res = ssh_pki_import_pubkey_file (c_filename, &ssh_public_key); if (res == SSH_EOF) { @@ -216,14 +229,9 @@ Read public key from a file FILENAME. Return a SSH key.\ guile_ssh_error1 (FUNC_NAME, msg, filename); } - /* Key will be freed along with the session. */ - public_key_data->is_to_be_freed = 0; - - SCM_NEWSMOB (key_smob, key_tag, public_key_data); - scm_dynwind_end (); - return key_smob; + return _scm_from_ssh_key (ssh_public_key, SCM_BOOL_F); } #undef FUNC_NAME diff --git a/ssh/key-type.c b/ssh/key-type.c index 60f97af..2b95912 100644 --- a/ssh/key-type.c +++ b/ssh/key-type.c @@ -48,7 +48,8 @@ struct symbol_mapping key_types[] = { SCM mark_key_smob (SCM key_smob) { - return SCM_BOOL_F; + struct key_data *kd = _scm_to_key_data (key_smob); + return kd->parent; } /* Free the smob. */ @@ -56,10 +57,14 @@ size_t free_key_smob (SCM arg1) { struct key_data *data = _scm_to_key_data (arg1); - - if (data->is_to_be_freed) - ssh_key_free (data->ssh_key); - + if (scm_is_false (data->parent)) + { + /* It's safe to free the key only if it was not derived from some other + object and thereby does not share any resources with it. If the key + does have a parent then all the resources will be freed along with + it. */ + ssh_key_free (data->ssh_key); + } return 0; } @@ -72,7 +77,7 @@ print_key (SCM smob, SCM port, scm_print_state *pstate) scm_puts ("#<key ", port); scm_display (type, port); scm_putc (' ', port); - scm_puts (_public_key_p (key_data) ? "(public) " : "(private) ", port); + scm_puts (_private_key_p (key_data) ? "(private) " : "(public) ", port); scm_display (_scm_object_hex_address (smob), port); scm_puts (">", port); @@ -112,6 +117,37 @@ Possible types are: 'dss, 'rsa, 'rsa1, 'ecdsa, 'unknown\ return _ssh_key_type_to_scm (type); } +SCM_DEFINE (guile_ssh_make_keypair, "make-keypair", 2, 0, 0, + (SCM type, SCM length), + "\ +Generate a keypair of specified TYPE and LENGTH. This may take some time.\ +Return newly generated private key. Throw `guile-ssh-error' on error.\ +") +#define FUNC_NAME s_guile_ssh_make_keypair +{ + ssh_key key = NULL; + struct symbol_mapping *c_type = _scm_to_ssh_key_type (type); + int c_length; + int res; + + SCM_ASSERT (scm_is_unsigned_integer (length, 9, UINT32_MAX), length, + SCM_ARG2, FUNC_NAME); + + if (! c_type) + guile_ssh_error1 (FUNC_NAME, "Wrong key type", type); + + c_length = scm_to_int (length); + res = ssh_pki_generate (c_type->value, c_length, &key); + if (res == SSH_ERROR) + { + guile_ssh_error1 (FUNC_NAME, "Could not generate key", + scm_list_2 (type, length)); + } + + return _scm_from_ssh_key (key, SCM_BOOL_F); +} +#undef FUNC_NAME + /* Predicates */ @@ -127,7 +163,7 @@ Return #t if X is a SSH key, #f otherwise.\ SCM_DEFINE (guile_ssh_is_public_key_p, "public-key?", 1, 0, 0, (SCM x), "\ -Return #t if X is a SSH public-key, #f otherwise.\ +Return #t if X is a SSH key and it contains a public key, #f otherwise.\ ") { return scm_from_bool (SCM_SMOB_PREDICATE (key_tag, x) @@ -161,6 +197,19 @@ equalp_key (SCM x1, SCM x2) /* Helper procedures */ +SCM +_scm_from_ssh_key (ssh_key key, SCM parent) +{ + struct key_data *key_data; + SCM key_smob; + key_data = (struct key_data *) scm_gc_malloc (sizeof (struct key_data), + "ssh key"); + key_data->ssh_key = key; + key_data->parent = parent; + SCM_NEWSMOB (key_smob, key_tag, key_data); + return key_smob; +} + /* Convert X to a SSH key */ struct key_data * _scm_to_key_data (SCM x) diff --git a/ssh/key-type.h b/ssh/key-type.h index c6a8385..d9d8a42 100644 --- a/ssh/key-type.h +++ b/ssh/key-type.h @@ -27,10 +27,8 @@ extern scm_t_bits key_tag; /* Smob data. */ struct key_data { - /* If this key is gotten from some other libssh object such as - session or message -- it must not be freed by GC, because it will - be freed along with this object. */ - uint8_t is_to_be_freed; + /* Store the parent object to prevent it from premature GC'ing. */ + SCM parent; ssh_key ssh_key; }; @@ -40,6 +38,7 @@ extern struct symbol_mapping key_types[]; /* Procedures */ +extern SCM guile_ssh_make_keypair (SCM arg1, SCM arg2); extern SCM guile_ssh_is_key_p (SCM arg1); extern SCM guile_ssh_is_public_key_p (SCM arg1); extern SCM guile_ssh_is_private_key_p (SCM arg1); @@ -50,6 +49,7 @@ extern void init_key_type (void); /* Helper procedures */ +extern SCM _scm_from_ssh_key (ssh_key key, SCM x); extern struct key_data *_scm_to_key_data (SCM x); extern inline int _private_key_p (struct key_data *key); extern inline int _public_key_p (struct key_data *key); diff --git a/ssh/key.scm b/ssh/key.scm index a577cd4..450c4ce 100644 --- a/ssh/key.scm +++ b/ssh/key.scm @@ -1,6 +1,6 @@ ;;; key.scm -- SSH keys management. -;; Copyright (C) 2013 Artyom V. Poptsov <poptsov.artyom@gmail.com> +;; Copyright (C) 2013, 2014 Artyom V. Poptsov <poptsov.artyom@gmail.com> ;; ;; This file is a part of Guile-SSH. ;; @@ -24,15 +24,19 @@ ;; ;; These methods are exported: ;; -;; key ;; key? ;; public-key? ;; private-key? +;; make-keypair ;; get-key-type ;; public-key->string +;; string->pubilc-key ;; public-key-from-file ;; private-key->public-key ;; private-key-from-file +;; private-key-to-file +;; get-public-key-hash +;; bytevector->hex-string ;;; Code: @@ -45,12 +49,14 @@ key? public-key? private-key? + make-keypair get-key-type public-key->string string->public-key public-key-from-file private-key->public-key private-key-from-file + private-key-to-file get-public-key-hash bytevector->hex-string)) @@ -23,10 +23,27 @@ #include <sys/time.h> #include <time.h> +#include <stdio.h> /* DEBUG */ +#include <unistd.h> /* DEBUG */ #include "error.h" #include "common.h" +/* Log verbosity levels used by libssh sessions and servers. */ +struct symbol_mapping log_verbosity[] = { + /* 0, No logging at all */ + { "nolog", SSH_LOG_NOLOG }, + /* 1, Only rare and noteworthy events */ + { "rare", SSH_LOG_RARE }, + /* 2, High level protocol information */ + { "protocol", SSH_LOG_PROTOCOL }, + /* 3, Lower level protocol infomations, packet level */ + { "packet", SSH_LOG_PACKET }, + /* 4, Every function path */ + { "functions", SSH_LOG_FUNCTIONS }, + { NULL, -1 } +}; + /* Whether the default calback was set or not. */ static int is_logging_callback_set = 0; @@ -81,7 +98,7 @@ SCM_DEFINE (guile_ssh_default_libssh_log_printer, int rc = _get_current_timestring (date, sizeof(date)); scm_puts ("[", scm_current_error_port ()); - if (rc == 0) + if (rc == 0) { scm_puts (date, scm_current_error_port ()); scm_puts (", ", scm_current_error_port ()); @@ -185,6 +202,39 @@ undefined. \ } #undef FUNC_NAME +SCM_DEFINE (guile_ssh_set_log_verbosity_x, + "set-log-verbosity!", 1, 0, 0, + (SCM verbosity), + "\ +Set the global log verbosity to a VERBOSITY. Throw `guile-ssh-error' on \ +error. Return value is undefined.\ +") +#define FUNC_NAME s_guile_ssh_set_log_verbosity_x +{ + struct symbol_mapping *opt = _scm_to_ssh_const (log_verbosity, verbosity); + int res; + + if (! opt) + guile_ssh_error1 (FUNC_NAME, "Wrong verbosity level", verbosity); + + res = ssh_set_log_level (opt->value); + if (res == SSH_ERROR) + guile_ssh_error1 (FUNC_NAME, "Could not set log verbosity", verbosity); + + return SCM_UNDEFINED; +} +#undef FUNC_NAME + +SCM_DEFINE (guile_ssh_get_log_verbosity, + "get-log-verbosity", 0, 0, 0, + (void), + "\ +Get global log verbosity value.\ +") +{ + return _ssh_const_to_scm (log_verbosity, ssh_get_log_level ()); +} + /* Initialization */ @@ -16,6 +16,8 @@ * along with Guile-SSH. If not, see <http://www.gnu.org/licenses/>. */ +extern struct symbol_mapping log_verbosity[]; + extern void init_log_func (void); /* log.h ends here */ diff --git a/ssh/log.scm b/ssh/log.scm index 787c7b2..d0aa018 100644 --- a/ssh/log.scm +++ b/ssh/log.scm @@ -17,6 +17,25 @@ ;; You should have received a copy of the GNU General Public License ;; along with Guile-SSH. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This module provides access to libssh logging facilities. These methods +;; are exported: +;; +;; %default-log-printer +;; %default-libssh-log-printer +;; current-logging-callback +;; set-logging-callback! +;; set-log-userdata! +;; get-log-userdata +;; set-log-verbosity! +;; get-log-verbosity +;; format-log + + +;;; Code: + (define-module (ssh log) #:export (%default-log-printer %default-libssh-log-printer @@ -24,6 +43,8 @@ set-logging-callback! set-log-userdata! get-log-userdata + set-log-verbosity! + get-log-verbosity format-log)) diff --git a/ssh/message-func.c b/ssh/message-func.c index dd995e3..882b1ac 100644 --- a/ssh/message-func.c +++ b/ssh/message-func.c @@ -138,7 +138,8 @@ Return a new SSH channel.\ if (! ch) return SCM_BOOL_F; - SCM channel = _ssh_channel_to_scm (ch); + SCM channel = _scm_from_channel_data (ch, msg_data->session); + SCM_SET_CELL_TYPE (channel, SCM_CELL_TYPE (channel) | SCM_OPN); return channel; @@ -255,7 +256,7 @@ Get type of the message MSG.\ /* <result> = "#(" <user> <WSP> <password> <WSP> <key> ")" */ static SCM -get_auth_req (ssh_message msg) +get_auth_req (ssh_message msg, SCM scm_msg) /* FIXME: accept only SCM */ { SCM result = scm_c_make_vector (4, SCM_UNDEFINED); const char *user = ssh_message_auth_user (msg); @@ -275,16 +276,7 @@ get_auth_req (ssh_message msg) else SCM_SIMPLE_VECTOR_SET (result, 1, SCM_BOOL_F); - pkey_data = (struct key_data *) scm_gc_malloc (sizeof (struct key_data), - "ssh key"); - pkey_data->ssh_key = public_key; - - /* The key will be freed along with the message. */ - pkey_data->is_to_be_freed = 0; - - SCM_NEWSMOB (pkey_smob, key_tag, pkey_data); - - SCM_SIMPLE_VECTOR_SET (result, 2, pkey_smob); + SCM_SIMPLE_VECTOR_SET (result, 2, _scm_from_ssh_key (public_key, scm_msg)); pkey_state = _ssh_const_to_scm (pubkey_state_type, (int) ssh_message_auth_publickey_state (msg)); @@ -406,7 +398,7 @@ Get a request object from the message MSG\ return get_service_req (ssh_msg); case SSH_REQUEST_AUTH: - return get_auth_req (ssh_msg); + return get_auth_req (ssh_msg, msg); case SSH_REQUEST_CHANNEL_OPEN: { @@ -498,6 +490,18 @@ Return value is undefined.\ #undef FUNC_NAME +SCM_DEFINE (guile_ssh_message_get_session, + "message-get-session", 1, 0, 0, + (SCM message), + "\ +Get the session from which the MESSAGE was received. Return the session.\ +") +{ + struct message_data *md = _scm_to_message_data (message); + return md->session; +} + + void init_message_func (void) { diff --git a/ssh/message-func.h b/ssh/message-func.h index aee121a..951ba59 100644 --- a/ssh/message-func.h +++ b/ssh/message-func.h @@ -23,6 +23,7 @@ extern SCM guile_ssh_message_reply_default (SCM arg1); extern SCM guile_ssh_message_get_type (SCM arg1); +extern SCM guile_ssh_message_get_session (SCM arg1); extern void init_message_func (void); diff --git a/ssh/message-type.c b/ssh/message-type.c index 7caf43d..fb37085 100644 --- a/ssh/message-type.c +++ b/ssh/message-type.c @@ -34,7 +34,8 @@ scm_t_bits message_tag; /* Smob tag. */ SCM mark_message (SCM message) { - return SCM_BOOL_F; + struct message_data *md = _scm_to_message_data (message); + return md->session; } size_t diff --git a/ssh/message-type.h b/ssh/message-type.h index 25de4b9..eca423a 100644 --- a/ssh/message-type.h +++ b/ssh/message-type.h @@ -27,6 +27,10 @@ extern scm_t_bits message_tag; /* Smob data. */ struct message_data { + /* Reference to the parent session. We need to keep the reference + to prevent the session from premature freeing by the GC. */ + SCM session; + ssh_message message; }; diff --git a/ssh/message.scm b/ssh/message.scm index 72e6d34..8805eab 100644 --- a/ssh/message.scm +++ b/ssh/message.scm @@ -43,6 +43,7 @@ message-reply-success message-get-type message-get-req + message-get-session message-service-reply-success service-req:service diff --git a/ssh/server-func.c b/ssh/server-func.c index fcdca86..0edd32e 100644 --- a/ssh/server-func.c +++ b/ssh/server-func.c @@ -27,6 +27,7 @@ #include "server-type.h" #include "message-type.h" #include "error.h" +#include "log.h" /* Guile SSH specific options that are aimed to unificate the way of server configuration. */ @@ -37,7 +38,7 @@ enum gssh_server_options { /* SSH server options mapping to Guile symbols. */ -static struct symbol_mapping server_options[] = { +struct symbol_mapping server_options[] = { { "bindaddr", SSH_BIND_OPTIONS_BINDADDR }, { "bindport", SSH_BIND_OPTIONS_BINDPORT }, { "hostkey", SSH_BIND_OPTIONS_HOSTKEY }, @@ -170,12 +171,32 @@ Return value is undefined.\ scm_list_3 (server, option, value)); } + server_data->options = scm_assoc_set_x (server_data->options, option, value); + scm_remember_upto_here_1 (server); return SCM_UNDEFINED; } #undef FUNC_NAME +SCM_DEFINE (guile_ssh_server_get, "server-get", 2, 0, 0, + (SCM server, SCM option), + "\ +Get a Guile-SSH server option. Return option value, or `#f' if option is\n\ +not set. Throw `guile-ssh-error' on error.\ +") +#define FUNC_NAME s_guile_ssh_server_get +{ + struct server_data *sd = _scm_to_server_data (server); + struct symbol_mapping *opt = _scm_to_ssh_const (server_options, option); + + if (! opt) + guile_ssh_error1 (FUNC_NAME, "No such option", option); + + return scm_assoc_ref (sd->options, option); +} +#undef FUNC_NAME + SCM_DEFINE (guile_ssh_server_listen, "server-listen", 1, 0, 0, (SCM server), @@ -253,6 +274,8 @@ Get a message.\ return SCM_BOOL_F; } + message_data->session = session; + SCM_NEWSMOB (smob, message_tag, message_data); return smob; } diff --git a/ssh/server-func.h b/ssh/server-func.h index d947ffc..cea93b1 100644 --- a/ssh/server-func.h +++ b/ssh/server-func.h @@ -20,6 +20,9 @@ #define __SERVER_FUNC_H__ #include <libguile.h> +#include <common.h> + +extern struct symbol_mapping server_options[]; extern SCM guile_ssh_server_set_x (SCM arg1, SCM arg2, SCM arg3); extern SCM guile_ssh_server_accept (SCM arg1); diff --git a/ssh/server-type.c b/ssh/server-type.c index 1c54a82..ab29a54 100644 --- a/ssh/server-type.c +++ b/ssh/server-type.c @@ -23,6 +23,7 @@ #include <libssh/server.h> #include "server-type.h" +#include "server-func.h" scm_t_bits server_tag; /* Smob tag. */ @@ -32,7 +33,8 @@ scm_t_bits server_tag; /* Smob tag. */ SCM mark_server (SCM server) { - return SCM_BOOL_F; + struct server_data *sd = _scm_to_server_data (server); + return sd->options; } size_t @@ -55,6 +57,7 @@ SCM_DEFINE (guile_ssh_make_server, "%make-server", 0, 0, 0, = (struct server_data *) scm_gc_malloc (sizeof (struct server_data), "server"); server_data->bind = ssh_bind_new (); + server_data->options = SCM_EOL; SCM_NEWSMOB (smob, server_tag, server_data); return smob; } @@ -83,6 +86,40 @@ equalp_server (SCM x1, SCM x2) return SCM_BOOL_T; } +static int +print_server (SCM server, SCM port, scm_print_state *pstate) +{ + struct server_data *sd = _scm_to_server_data (server); + SCM bindaddr = scm_assoc_ref (sd->options, + _ssh_const_to_scm (server_options, + SSH_BIND_OPTIONS_BINDADDR)); + SCM bindport = scm_assoc_ref (sd->options, + _ssh_const_to_scm (server_options, + SSH_BIND_OPTIONS_BINDPORT)); + scm_puts ("#<server", port); + if (scm_is_true (bindaddr)) + { + scm_putc (' ', port); + scm_display (bindaddr, port); + } + + if (scm_is_true (bindport)) + { + if (scm_is_false (bindaddr)) + scm_putc (' ', port); + + scm_putc (':', port); + scm_display (bindport, port); + } + + scm_putc (' ', port); + scm_display (_scm_object_hex_address (server), port); + + scm_putc ('>', port); + + return 1; +} + /* Helper procedures. */ @@ -102,6 +139,7 @@ init_server_type (void) server_tag = scm_make_smob_type ("server", sizeof (struct server_data)); scm_set_smob_mark (server_tag, mark_server); scm_set_smob_free (server_tag, free_server); + scm_set_smob_print (server_tag, print_server); scm_set_smob_equalp (server_tag, equalp_server); #include "server-type.x" diff --git a/ssh/server-type.h b/ssh/server-type.h index ea0c08c..c7514b7 100644 --- a/ssh/server-type.h +++ b/ssh/server-type.h @@ -28,6 +28,7 @@ extern scm_t_bits server_tag; /* Smob data. */ struct server_data { ssh_bind bind; + SCM options; }; extern SCM guile_ssh_is_server_p (SCM arg1); diff --git a/ssh/server.scm b/ssh/server.scm index 72bb949..68438e7 100644 --- a/ssh/server.scm +++ b/ssh/server.scm @@ -29,6 +29,7 @@ ;; make-server ;; server-accept ;; server-set! +;; server-get ;; server-listen! ;; server-handle-key-exchange ;; server-message-get @@ -45,6 +46,7 @@ make-server server-accept server-set! + server-get server-listen server-handle-key-exchange server-message-get)) diff --git a/ssh/session-func.c b/ssh/session-func.c index 806d575..9e9f9eb 100644 --- a/ssh/session-func.c +++ b/ssh/session-func.c @@ -26,6 +26,7 @@ #include "error.h" #include "session-type.h" #include "key-type.h" +#include "log.h" /* SSH option mapping. */ struct option { @@ -63,7 +64,7 @@ static struct symbol_mapping session_options[] = { /* Blocking flush of the outgoing buffer. - Return on of the following symbols: 'ok, 'error. 'again. + Return on of the following symbols: 'ok, 'error. 'again. Asserts: - Return value of `ssh_blocking_flush' is one of the valid constants @@ -285,6 +286,7 @@ Return value is undefined.\ /* Options whose values can be requested through `session-get' */ static struct symbol_mapping session_options_getable[] = { { "host", SSH_OPTIONS_HOST }, + { "port", SSH_OPTIONS_PORT }, { "user", SSH_OPTIONS_USER }, { "identity", SSH_OPTIONS_IDENTITY }, { "proxycommand", SSH_OPTIONS_PROXYCOMMAND }, @@ -300,7 +302,7 @@ Get value of the OPTION. Throw `guile-ssh-error' on an error.\ { struct session_data*sd = _scm_to_session_data (session); struct symbol_mapping *opt = NULL; - char *value = NULL; /* Value of the option */ + SCM value; /*Value of the option */ int res; SCM_ASSERT (scm_is_symbol (option), option, SCM_ARG2, FUNC_NAME); @@ -309,17 +311,29 @@ Get value of the OPTION. Throw `guile-ssh-error' on an error.\ if (! opt) guile_ssh_error1 (FUNC_NAME, "Wrong option", option); - res = ssh_options_get (sd->ssh_session, opt->value, &value); + if (opt->value == SSH_OPTIONS_PORT) + { + unsigned int port; + res = ssh_options_get_port (sd->ssh_session, &port); + value = (res == SSH_OK) ? scm_from_int (port) : SCM_UNDEFINED; + } + else + { + char *c_value = NULL; + res = ssh_options_get (sd->ssh_session, opt->value, &c_value); + value = (res == SSH_OK) ? scm_from_locale_string (c_value) : SCM_UNDEFINED; + } + if (res == SSH_ERROR) guile_ssh_error1 (FUNC_NAME, "Unable to get value of the option", option); - return scm_from_locale_string (value); + return value; } #undef FUNC_NAME -/* Connect to the SSH server. +/* Connect to the SSH server. - Return one of the following symbols: 'ok, 'again, 'error + Return one of the following symbols: 'ok, 'again, 'error Asserts: - Return value of `ssh_connect' is one of the valid constants described in @@ -400,7 +414,7 @@ Retrieve the error text message from the last error.\ return error; } -/* Authenticate the server. +/* Authenticate the server. Return one of the following symbols: 'ok, 'known-changed, 'found-other, 'not-known, 'file-not-found, 'error @@ -473,8 +487,6 @@ Return server's public key. Throw `guile-ssh-error' on error.\ if (res != SSH_OK) guile_ssh_error1 (FUNC_NAME, "Unable to get the server key", session); - kd->is_to_be_freed = 1; /* The key must be freed by GC. */ - SCM_NEWSMOB (key_smob, key_tag, kd); return key_smob; @@ -498,7 +510,7 @@ Return value is undefined.\ if (res != SSH_OK) guile_ssh_session_error1 (FUNC_NAME, session_data->ssh_session, session); - + return SCM_UNDEFINED; } #undef FUNC_NAME diff --git a/ssh/session-main.c b/ssh/session-main.c index 7f143c9..d204868 100644 --- a/ssh/session-main.c +++ b/ssh/session-main.c @@ -3,7 +3,7 @@ * Copyright (C) 2013 Artyom V. Poptsov <poptsov.artyom@gmail.com> * * This file is part of Guile-SSH. - * + * * Guile-SSH 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 diff --git a/ssh/session-type.c b/ssh/session-type.c index bbbb0f7..0397e6d 100644 --- a/ssh/session-type.c +++ b/ssh/session-type.c @@ -78,6 +78,7 @@ print_session (SCM session, SCM port, scm_print_state *pstate) struct session_data *sd = _scm_to_session_data (session); char *user = NULL; char *host = NULL; + unsigned int ssh_port; uint32_t smob_addr = (uint32_t) scm_object_address (session); int res; @@ -95,6 +96,11 @@ print_session (SCM session, SCM port, scm_print_state *pstate) port); ssh_string_free_char (host); + scm_putc (':', port); + + res = ssh_options_get_port (sd->ssh_session, &ssh_port); + scm_display ((res == SSH_OK) ? scm_from_int (ssh_port) : SCM_UNDEFINED, port); + scm_puts (ssh_is_connected (sd->ssh_session) ? " (connected) " : " (disconnected) ", port); @@ -147,7 +153,7 @@ _scm_to_session_data (SCM x) void init_session_type (void) { - session_tag = scm_make_smob_type ("session", + session_tag = scm_make_smob_type ("session", sizeof (struct session_data)); scm_set_smob_mark (session_tag, mark_session); scm_set_smob_free (session_tag, free_session); diff --git a/ssh/threads.c b/ssh/threads.c index 0cef993..5378551 100644 --- a/ssh/threads.c +++ b/ssh/threads.c @@ -3,7 +3,7 @@ * Copyright (C) 2013 Artyom V. Poptsov <poptsov.artyom@gmail.com> * * This file is part of Guile-SSH. - * + * * Guile-SSH 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 diff --git a/ssh/version.c b/ssh/version.c index 8542a75..9d83040 100644 --- a/ssh/version.c +++ b/ssh/version.c @@ -22,13 +22,14 @@ #include <libssh/libssh.h> /* Get version of the libssh. */ -SCM_DEFINE (guile_ssh_get_libssh_version, "get-libssh-version", 0, 0, 0, +SCM_DEFINE (guile_ssh_get_libssh_version, "%get-libssh-version", 0, 0, 0, (), "\ Get version of the libssh.\ ") { - return scm_from_locale_string (SSH_STRINGIFY (LIBSSH_VERSION)); + const char *version = ssh_version (0); + return scm_from_locale_string (version); } /* Get version of the Guile-SSH. */ diff --git a/ssh/version.scm b/ssh/version.scm index 095d26e..7be237d 100644 --- a/ssh/version.scm +++ b/ssh/version.scm @@ -44,8 +44,27 @@ (define-module (ssh version) #:use-module (ssh log) #:export (get-libssh-version - get-library-version)) + get-library-version + get-crypto-library + zlib-support? + ;; Low-level procedures + %get-libssh-version)) (load-extension "libguile-ssh" "init_version") +(define (get-libssh-version) + "Get version of the libssh." + (car (string-split (%get-libssh-version) #\/))) + +(define (get-crypto-library) + "Get cryptographic library name with which libssh was compiled. Possible +values are: 'openssl, 'gnutls" + (string->symbol (cadr (string-split (%get-libssh-version) #\/)))) + +(define (zlib-support?) + "Return #t if libssh was compiled wit zlib support, #f otherwise." + (let ((version (string-split (%get-libssh-version) #\/))) + (and (not (null? (cddr version))) + (string=? "zlib" (caddr version))))) + ;;; session.scm ends here diff --git a/tests/Makefile.am b/tests/Makefile.am index 99ea835..1d3cdd7 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -32,6 +32,7 @@ TEST_EXTENSIONS = .scm AM_TESTS_ENVIRONMENT = \ abs_top_srcdir="$(abs_top_srcdir)"; export abs_top_srcdir; \ + abs_top_builddir="$(abs_top_builddir)"; export abs_top_builddir; \ ORIGTERM=${TERM}; export ORIGTERM; \ TERM=xterm; export TERM; \ GUILE_AUTO_COMPILE=0; export GUILE_AUTO_COMPILE; @@ -58,4 +59,6 @@ EXTRA_DIST = \ CLEANFILES = \ client-server-errors.log \ - client-server-libssh.log + client-server-libssh.log \ + server-client-errors.log \ + server-client-libssh.log diff --git a/tests/client-server.scm b/tests/client-server.scm index 486f9c7..acb6dee 100644 --- a/tests/client-server.scm +++ b/tests/client-server.scm @@ -39,7 +39,8 @@ (define port 12400) (define topdir (getenv "abs_top_srcdir")) (define rsakey (format #f "~a/tests/rsakey" topdir)) -(define %knownhosts (format #f "~a/tests/knownhosts" topdir)) +(define %knownhosts (format #f "~a/tests/knownhosts" + (getenv "abs_top_builddir"))) (define log (test-runner-aux-value (test-runner-current))) (define *server-thread* #f) @@ -110,124 +111,133 @@ body ...))))) +(define (run-client-test server-proc client-proc) + "Run a SERVER-PROC in newly created process. The server passed to a +SERVER-PROC as an argument. CLIENT-PROC is expected to be a thunk that should +be executed in the parent process. The procedure returns a result of +CLIENT-PROC call." + (let ((server (make-server-for-test)) + (pid (primitive-fork))) + (if (zero? pid) + ;; server + (dynamic-wind + (const #f) + (lambda () + (server-proc server)) + (lambda () + (primitive-exit 1))) + ;; client + (client-proc)))) + + ;;; Testing of basic procedures. (test-assert-with-log "connect!, disconnect!" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) + (run-client-test - (if (not (= 0 pid)) - - ;; client - (let ((session (make-session-for-test))) - (sleep 1) - (connect! session) - (let ((res (connected? session))) - (disconnect! session) - res)) + ;; server + (lambda (server) + (server-listen server) + (let ((s (server-accept server))) + (server-handle-key-exchange s) + (primitive-exit))) - ;; server - (begin - (server-listen server) - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (primitive-exit)))))) + ;; client + (lambda () + (let ((session (make-session-for-test))) + (sleep 1) + (connect! session) + (let ((res (connected? session))) + (disconnect! session) + res))))) (test-assert-with-log "get-protocol-version" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) + (run-client-test - (if (not (= 0 pid)) + ;; server + (lambda (server) + (server-listen server) + (let ((s (server-accept server))) + (server-handle-key-exchange s) + (primitive-exit))) - ;; client - (let ((session (make-session-for-test))) - (sleep 1) - (connect! session) - (let ((res (get-protocol-version session))) - (disconnect! session) - (eq? 2 res))) - - ;; server - (begin - (server-listen server) - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (primitive-exit)))))) + ;; client + (lambda () + (let ((session (make-session-for-test))) + (sleep 1) + (connect! session) + (let ((res (get-protocol-version session))) + (disconnect! session) + (eq? 2 res)))))) (test-assert-with-log "authenticate-server, not-known" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) - - (if (not (= 0 pid)) + (run-client-test - ;; client - (let ((session (make-session-for-test))) - (sleep 1) - (connect! session) - (let ((res (authenticate-server session))) - (disconnect! session) - (eq? res 'not-known))) + ;; server + (lambda (server) + (server-listen server) + (let ((s (server-accept server))) + (server-handle-key-exchange s) + (primitive-exit))) - ;; server - (begin - (server-listen server) - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (primitive-exit)))))) + ;; client + (lambda () + (let ((session (make-session-for-test))) + (sleep 1) + (connect! session) + (let ((res (authenticate-server session))) + (disconnect! session) + (eq? res 'not-known)))))) (test-assert-with-log "authenticate-server, ok" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) + (run-client-test - (if (not (= 0 pid)) + ;; server + (lambda (server) + (server-listen server) + (let ((s (server-accept server))) + (server-handle-key-exchange s) + (primitive-exit))) - ;; client - (let ((session (make-session-for-test))) - (sleep 1) - (connect! session) - (write-known-host! session) - (let ((res (authenticate-server session))) - (disconnect! session) - (delete-file %knownhosts) - (eq? res 'ok))) - - ;; server - (begin - (server-listen server) - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (primitive-exit)))))) + ;; client + (lambda () + (let ((session (make-session-for-test))) + (sleep 1) + (connect! session) + (write-known-host! session) + (let ((res (authenticate-server session))) + (disconnect! session) + (delete-file %knownhosts) + (eq? res 'ok)))))) (test-assert-with-log "get-public-key-hash" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) + (run-client-test - (if (not (= 0 pid)) + ;; server + (lambda (server) + (server-listen server) + (let ((s (server-accept server))) + (server-handle-key-exchange s) + (primitive-exit))) - ;; client - (let ((hash-md5-bv #vu8(15 142 110 203 162 228 250 211 20 212 26 217 118 57 217 66)) - (hash-md5-str "0f:8e:6e:cb:a2:e4:fa:d3:14:d4:1a:d9:76:39:d9:42") - (hash-sha1-bv #vu8(20 65 56 155 119 45 84 163 50 26 59 92 215 159 139 5 229 174 84 80)) - (hash-sha1-str "14:41:38:9b:77:2d:54:a3:32:1a:3b:5c:d7:9f:8b:05:e5:ae:54:50") - (session (make-session-for-test))) - (sleep 1) - (connect! session) - (authenticate-server session) - (let* ((pubkey (get-server-public-key session)) - (md5-res (get-public-key-hash pubkey 'md5)) - (sha1-res (get-public-key-hash pubkey 'sha1))) - (disconnect! session) - (and (bytevector=? md5-res hash-md5-bv) - (string=? (bytevector->hex-string md5-res) hash-md5-str) - (bytevector=? sha1-res hash-sha1-bv) - (string=? (bytevector->hex-string sha1-res) hash-sha1-str)))) - - ;; server - (begin - (server-listen server) - (let ((s (server-accept server))) - (server-handle-key-exchange s) - (primitive-exit)))))) + ;; client + (lambda () + (let ((hash-md5-bv #vu8(15 142 110 203 162 228 250 211 20 212 26 217 118 57 217 66)) + (hash-md5-str "0f:8e:6e:cb:a2:e4:fa:d3:14:d4:1a:d9:76:39:d9:42") + (hash-sha1-bv #vu8(20 65 56 155 119 45 84 163 50 26 59 92 215 159 139 5 229 174 84 80)) + (hash-sha1-str "14:41:38:9b:77:2d:54:a3:32:1a:3b:5c:d7:9f:8b:05:e5:ae:54:50") + (session (make-session-for-test))) + (sleep 1) + (connect! session) + (authenticate-server session) + (let* ((pubkey (get-server-public-key session)) + (md5-res (get-public-key-hash pubkey 'md5)) + (sha1-res (get-public-key-hash pubkey 'sha1))) + (disconnect! session) + (and (bytevector=? md5-res hash-md5-bv) + (string=? (bytevector->hex-string md5-res) hash-md5-str) + (bytevector=? sha1-res hash-sha1-bv) + (string=? (bytevector->hex-string sha1-res) hash-sha1-str))))))) ;;; Authentication @@ -235,216 +245,199 @@ ;; Server replies with "success", client receives 'success. (test-assert-with-log "userauth-none!, success" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) - - (if (not (= 0 pid)) + (run-client-test - ;; client - (let ((session (make-session-for-test))) - (sleep 1) - (connect! session) - (authenticate-server session) - (let ((res (userauth-none! session))) - (disconnect! session) - (eq? res 'success))) + ;; server + (lambda (server) + (server-listen server) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (make-session-loop session + (message-auth-set-methods! msg '(none)) + (message-reply-success msg))) + (primitive-exit)) - ;; server - (begin - (server-listen server) - (let ((session (server-accept server))) - (server-handle-key-exchange session) - (make-session-loop session - (message-auth-set-methods! msg '(none)) - (message-reply-success msg))) - (primitive-exit))))) + ;; client + (lambda () + (let ((session (make-session-for-test))) + (sleep 1) + (connect! session) + (authenticate-server session) + (let ((res (userauth-none! session))) + (disconnect! session) + (eq? res 'success)))))) ;; Server replies with "default", client receives 'denied. (test-assert-with-log "userauth-none!, denied" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) - - (if (not (= 0 pid)) + (run-client-test - ;; client - (let ((session (make-session-for-test))) - (sleep 1) - (connect! session) - (authenticate-server session) - (let ((res (userauth-none! session))) - (disconnect! session) - (eq? res 'denied))) + ;; server + (lambda (server) + (server-listen server) + (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))) + (primitive-exit)) - ;; server - (begin - (server-listen server) - (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))) - (primitive-exit))))) + ;; client + (lambda () + (let ((session (make-session-for-test))) + (sleep 1) + (connect! session) + (authenticate-server session) + (let ((res (userauth-none! session))) + (disconnect! session) + (eq? res 'denied)))))) ;; Server replies with "partial success", client receives 'partial. (test-assert-with-log "userauth-none!, partial" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) + (run-client-test - (if (not (= 0 pid)) + ;; server + (lambda (server) + (server-listen server) + (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))) + (primitive-exit)) - ;; client - (let ((session (make-session-for-test))) - (sleep 1) - (connect! session) - (authenticate-server session) - (let ((res (userauth-none! session))) - (disconnect! session) - (eq? res 'partial))) - - ;; server - (begin - (server-listen server) - (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))) - (primitive-exit))))) + ;; client + (lambda () + (let ((session (make-session-for-test))) + (sleep 1) + (connect! session) + (authenticate-server session) + (let ((res (userauth-none! session))) + (disconnect! session) + (eq? res 'partial)))))) (test-assert-with-log "userauth-password!, success" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) + (run-client-test - (if (not (= 0 pid)) + ;; server + (lambda (server) + (server-listen server) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (make-session-loop session + (message-auth-set-methods! msg '(password)) + (message-reply-success msg))) + (primitive-exit)) - ;; client - (let ((session (make-session-for-test))) - (sleep 1) - (connect! session) - (authenticate-server session) - (let ((res (userauth-password! session "password"))) - (disconnect! session) - (eq? res 'success))) - - ;; server - (begin - (server-listen server) - (let ((session (server-accept server))) - (server-handle-key-exchange session) - (make-session-loop session - (message-auth-set-methods! msg '(password)) - (message-reply-success msg))) - (primitive-exit))))) + ;; client + (lambda () + (let ((session (make-session-for-test))) + (sleep 1) + (connect! session) + (authenticate-server session) + (let ((res (userauth-password! session "password"))) + (disconnect! session) + (eq? res 'success)))))) (test-assert-with-log "userauth-password!, denied" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) - - (if (not (= 0 pid)) + (run-client-test - ;; client - (let ((session (make-session-for-test))) - (sleep 1) - (connect! session) - (authenticate-server session) - (let ((res (userauth-password! session "password"))) - (disconnect! session) - (eq? res 'denied))) + ;; server + (lambda (server) + (server-listen server) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (make-session-loop session + (message-auth-set-methods! msg '(password)) + (message-reply-default msg))) + (primitive-exit)) - ;; server - (begin - (server-listen server) - (let ((session (server-accept server))) - (server-handle-key-exchange session) - (make-session-loop session - (message-auth-set-methods! msg '(password)) - (message-reply-default msg))) - (primitive-exit))))) + ;; client + (lambda () + (let ((session (make-session-for-test))) + (sleep 1) + (connect! session) + (authenticate-server session) + (let ((res (userauth-password! session "password"))) + (disconnect! session) + (eq? res 'denied)))))) (test-assert-with-log "userauth-password!, partial" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) + (run-client-test - (if (not (= 0 pid)) + ;; server + (lambda (server) + (server-listen server) + (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))) + (primitive-exit)) - ;; client - (let ((session (make-session-for-test))) - (sleep 1) - (connect! session) - (authenticate-server session) - (let ((res (userauth-password! session "password"))) - (disconnect! session) - (eq? res 'partial))) - - ;; server - (begin - (server-listen server) - (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))) - (primitive-exit))))) + ;; client + (lambda () + (let ((session (make-session-for-test))) + (sleep 1) + (connect! session) + (authenticate-server session) + (let ((res (userauth-password! session "password"))) + (disconnect! session) + (eq? res 'partial)))))) (test-assert-with-log "userauth-public-key!, success" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) + (run-client-test - (if (not (= 0 pid)) + ;; server + (lambda (server) + (server-listen server) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (make-session-loop session + (message-reply-success msg))) + (primitive-exit)) - ;; client - (let ((session (make-session-for-test))) - (sleep 1) - (connect! session) - (authenticate-server session) - (let* ((prvkey (private-key-from-file rsakey))) - (let ((res (userauth-public-key! session prvkey))) - (disconnect! session) - (eq? res 'success)))) - - ;; server - (begin - (server-listen server) - (let ((session (server-accept server))) - (server-handle-key-exchange session) - (make-session-loop session - (message-reply-success msg))) - (primitive-exit))))) + ;; client + (lambda () + (let ((session (make-session-for-test))) + (sleep 1) + (connect! session) + (authenticate-server session) + (let* ((prvkey (private-key-from-file rsakey))) + (let ((res (userauth-public-key! session prvkey))) + (disconnect! session) + (eq? res 'success))))))) ;; Server replies "default" with the list of allowed authentication ;; methods. Client receives the list. (test-assert-with-log "userauth-get-list" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) - - (if (not (= 0 pid)) - - ;; client - (let ((session (make-session-for-test))) - (sleep 1) - (connect! session) - (authenticate-server session) - (userauth-none! session) - (let ((res (userauth-get-list session))) - (equal? res '(password public-key)))) + (run-client-test - ;; server - (begin - (server-listen server) - (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))) - (primitive-exit))))) + ;; server + (lambda (server) + (server-listen server) + (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))) + (primitive-exit)) + ;; client + (lambda () + (let ((session (make-session-for-test))) + (sleep 1) + (connect! session) + (authenticate-server session) + (userauth-none! session) + (let ((res (userauth-get-list session))) + (equal? res '(password public-key))))))) ;;; Channel test @@ -465,8 +458,15 @@ (set! channel (message-channel-request-open-reply-accept msg))) ((request-channel) (if (equal? (cadr msg-type) 'channel-request-exec) - (write-line "pong" channel)) - (message-reply-success msg)) + (let ((cmd (exec-req:cmd (message-get-req msg)))) + (cond + ((string=? cmd "ping") + (write-line "pong" channel) + (message-reply-success msg)) + ((string=? cmd "uname") ; For exit status testing + (message-reply-success msg) + (channel-request-send-exit-status channel 0)))) + (message-reply-success msg))) (else (message-reply-success msg))))) (primitive-exit))) @@ -481,50 +481,77 @@ session)) (test-assert "make-channel" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) + (run-client-test - (if (not (= 0 pid)) + ;; server + (lambda (server) + (start-server/channel-test server)) - ;; client - (let ((session (make-session/channel-test))) - (make-channel session)) + ;; client + (lambda () + (let ((session (make-session/channel-test))) + (make-channel session))))) - ;; server - (start-server/channel-test server)))) +(test-assert-with-log "channel-get-session" + (run-client-test -(test-assert-with-log "channel-open-session" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) + ;; server + (lambda (server) + (start-server/channel-test server)) - (if (not (= 0 pid)) + ;; client + (lambda () + (let* ((session (make-session/channel-test)) + (channel (make-channel session))) + (eq? session (channel-get-session channel)))))) - ;; client - (let* ((session (make-session/channel-test)) - (channel (make-channel session))) - (channel-open-session channel) - (not (port-closed? channel))) +(test-assert-with-log "channel-open-session" + (run-client-test - ;; server - (start-server/channel-test server)))) + ;; server + (lambda (server) + (start-server/channel-test server)) + + ;; client + (lambda () + (let* ((session (make-session/channel-test)) + (channel (make-channel session))) + (channel-open-session channel) + (not (port-closed? channel)))))) ;; Client sends "ping" as a command to execute, server replies with "pong" (test-assert-with-log "channel-request-exec" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) + (run-client-test - (if (not (= 0 pid)) + ;; server + (lambda (server) + (start-server/channel-test server)) - ;; client - (let* ((session (make-session/channel-test)) - (channel (make-channel session))) - (channel-open-session channel) - (channel-request-exec channel "ping") - (let ((res (read-line channel))) - (and res - (string=? "pong" res)))) + ;; client + (lambda () + (let* ((session (make-session/channel-test)) + (channel (make-channel session))) + (channel-open-session channel) + (channel-request-exec channel "ping") + (let ((res (read-line channel))) + (and res + (string=? "pong" res))))))) - (start-server/channel-test server)))) +;; Client sends "uname" as a command to execute, server returns exit status 0. +(test-assert-with-log "channel-request-exec, exit status" + (run-client-test + + ;; server + (lambda (server) + (start-server/channel-test server)) + + ;; client + (lambda () + (let* ((session (make-session/channel-test)) + (channel (make-channel session))) + (channel-open-session channel) + (channel-request-exec channel "uname") + (= (channel-get-exit-status channel) 0))))) ;; data transferring @@ -558,55 +585,55 @@ (test-assert-with-log "data transferring, string" - (let ((server (make-server-for-test)) - (pid (primitive-fork))) + (run-client-test - (if (not (= 0 pid)) + ;; server + (lambda (server) + (start-server/dt-test server + (lambda (channel) + (let ((str (read-line channel))) + (write-line str channel))))) - ;; client - (let* ((session (make-session/channel-test)) - (channel (make-channel/dt-test session)) - (str "Hello Scheme World!")) - (write-line str channel) - (let poll ((ready? #f)) - (if ready? - (let ((res (read-line channel))) - (disconnect! session) - (equal? res str)) - (poll (char-ready? channel))))) - - ;; server - (start-server/dt-test server - (lambda (channel) - (let ((str (read-line channel))) - (write-line str channel))))))) + ;; client + (lambda () + (let* ((session (make-session/channel-test)) + (channel (make-channel/dt-test session)) + (str "Hello Scheme World!")) + (write-line str channel) + (let poll ((ready? #f)) + (if ready? + (let ((res (read-line channel))) + (disconnect! session) + (equal? res str)) + (poll (char-ready? channel)))))))) (test-assert-with-log "data transferring, bytevector" - (let ((server (make-server-for-test)) - (pid (primitive-fork)) - (vect-size 10) + (let ((vect-size 10) (vect-fill 10)) - (if (not (= 0 pid)) + (run-client-test - ;; client - (let* ((session (make-session/channel-test)) - (channel (make-channel/dt-test session)) - (vect (make-u8vector vect-size vect-fill))) - (uniform-array-write vect channel) - (let poll ((ready? #f)) - (if ready? - (let ((res (make-u8vector vect-size 0))) - (uniform-array-read! res channel) - (equal? res vect)) - (poll (char-ready? channel))))) + ;; server + (lambda (server) + (start-server/dt-test server + (lambda (channel) + (let ((v (make-u8vector vect-size 0))) + (uniform-array-read! v channel) + (uniform-array-write v channel))))) - (start-server/dt-test server - (lambda (channel) - (let ((v (make-u8vector vect-size 0))) - (uniform-array-read! v channel) - (uniform-array-write v channel))))))) + ;; client + (lambda () + (let* ((session (make-session/channel-test)) + (channel (make-channel/dt-test session)) + (vect (make-u8vector vect-size vect-fill))) + (uniform-array-write vect channel) + (let poll ((ready? #f)) + (if ready? + (let ((res (make-u8vector vect-size 0))) + (uniform-array-read! res channel) + (equal? res vect)) + (poll (char-ready? channel))))))))) (test-end "client-server") diff --git a/tests/key.scm b/tests/key.scm index 3c1521f..37d1915 100644 --- a/tests/key.scm +++ b/tests/key.scm @@ -18,8 +18,17 @@ ;; along with Guile-SSH. If not, see <http://www.gnu.org/licenses/>. (use-modules (srfi srfi-64) - (ssh key)) + (ssh key) + (ssh version)) + +;; ECDSA doesn't work if libssh 0.6.3 was compiled GCrypt +(define %openssl? (eq? (get-crypto-library) 'openssl)) +(define-syntax-rule (when-openssl test) + (or (not %openssl?) + test)) + + (define %topdir (getenv "abs_top_srcdir")) (define %rsa-private-key-file (format #f "~a/tests/rsakey" %topdir)) (define %dsa-private-key-file (format #f "~a/tests/dsakey" %topdir)) @@ -33,28 +42,34 @@ (test-assert "private-key-from-file" (and (private-key-from-file %rsa-private-key-file) (private-key-from-file %dsa-private-key-file) - (private-key-from-file %ecdsa-private-key-file))) + (when-openssl + (private-key-from-file %ecdsa-private-key-file)))) (test-assert "public-key-from-file" (and (public-key-from-file %rsa-public-key-file) (public-key-from-file %dsa-public-key-file) - (public-key-from-file %ecdsa-public-key-file))) + (when-openssl + (public-key-from-file %ecdsa-public-key-file)))) (define *rsa-key* (private-key-from-file %rsa-private-key-file)) (define *dsa-key* (private-key-from-file %dsa-private-key-file)) -(define *ecdsa-key* (private-key-from-file %ecdsa-private-key-file)) +(define *ecdsa-key* (when-openssl + (private-key-from-file %ecdsa-private-key-file))) (define *rsa-pub-key* (public-key-from-file %rsa-public-key-file)) (define *dsa-pub-key* (public-key-from-file %dsa-public-key-file)) -(define *ecdsa-pub-key* (public-key-from-file %ecdsa-public-key-file)) +(define *ecdsa-pub-key* (when-openssl + (public-key-from-file %ecdsa-public-key-file))) (test-assert "key?" (and (not (key? "not a key")) (key? *rsa-key*) (key? *dsa-key*) - (key? *ecdsa-key*) + (when-openssl + (key? *ecdsa-key*)) (key? *rsa-pub-key*) (key? *dsa-pub-key*) - (key? *ecdsa-pub-key*))) + (when-openssl + (key? *ecdsa-pub-key*)))) (test-assert "private-key?" (and (private-key? *rsa-key*) @@ -63,23 +78,73 @@ (test-assert "public-key?" (and (public-key? *rsa-pub-key*) - ;; FIXME: Currently a SSH key that has been read from a file - ;; has both public and private flags. It means that we cannot - ;; distinguish whether the key is private or public. - ;; - ;; So that will return `#f': - ;; (not (public-key? *rsa-key*)) + + ;; XXX: Currently a SSH key that has been read from a file + ;; has both public and private flags. + (public-key? *rsa-key*) + (not (public-key? "not a key")))) (test-assert "private-key->public-key" (and (private-key->public-key *rsa-key*) (private-key->public-key *dsa-key*) - (private-key->public-key *ecdsa-key*))) + (when-openssl + (private-key->public-key *ecdsa-key*)))) (test-assert "get-key-type" (and (eq? 'rsa (get-key-type *rsa-key*)) (eq? 'dss (get-key-type *dsa-key*)) - (eq? 'ecdsa (get-key-type *ecdsa-key*)))) + (when-openssl + (eq? 'ecdsa (get-key-type *ecdsa-key*))))) + + +(test-assert "private-key-to-file" + (when-openssl + (let ((file-name "./tmp-rsa-key")) + (private-key-to-file *rsa-key* file-name) + (let ((key (private-key-from-file file-name))) + (delete-file file-name) + (and (key? key) + (private-key? key)))))) + + +;;; Converting between strings and keys + +(define %rsakey-pub-string + "AAAAB3NzaC1yc2EAAAADAQABAAABAQC+8H9j5Yt3xeqaAxXAtSbBsW0JsJegngwfLveHA0ev3ndEKruylR6CZgf6OxshTwUeBaqn7jJMf+6RRQPTcxihgtZAfdyKdPGWDtmePBnG64+uGEaP8N3KvCzlANKf5tmxS8brJlQhxKL8t+3IE8w3QmCMnCGKWprsL/ygPA9koWauUqqKvOQbZXdUEfLvZfnsE1laRyK4dwLiiM2vyGZM/2yePLP4xYu/uYdPFaukxt3DMcgrEy9zuVcU8wbkJMKM57sambvituzMVVqRdeMX9exZv32qcXlpChl4XjFClQ0lqOb8S8CNTPXm3zQ2ZJrQtUHiD54RYhlXD7X0TO6v") +(define %dsakey-pub-string + "AAAAB3NzaC1kc3MAAACBAOpnJ64w3Qo3HkCCODTPpLqPUrDLg0bxWdoae2tsXFwhBthIlCV8N0hTzOj1Qrgnx/WiuDk5qXSKOHisyqVBv8sGLOUTBy0Fdz1SobZ9+WGu5+5EiJm78MZcgtHXHu1GPuImANifbSaDJpIGKItq0V5WhpLXyQC7o0Vt70sGQboVAAAAFQDeu+6APBWXtqq2Ch+nODn7VDSIhQAAAIA5iGHYbztSq8KnWj1J/6GTvsPp1JFqZ3hFX5wlGIV4XxBdeEZnCPrhYJumM7SRjYjWMpW5eqFNs5o3d+rJPFFwDo7yW10WC3Bfpo5xRxU35xf/aFAVbm3vi/HRQvv4cFrwTLvPHgNYGYdZiHXCXPoYIh+WoKT9n3MfrBXB4hpAmwAAAIEArkWuRnbjfPVFpXrWGw6kMPVdhOZr1ghdlG5bY31y4UKUlmHvXx5YZ776dSRSMJY2u4lS73+SFgwPdkmpgGma/rZdd9gly9T7SiSr/4qXJyS8Muh203xsAU3ukRocY8lsvllKEGiCJmrUTJWmj0UYEDsbqy2k/1Yz2Q/awygyk9c=") +(define %ecdsakey-pub-string + "AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBHcpje/fp21KjuZFKgmKAAwHeYJ6e3ny4LwEVjZr8hOCVlBvqj7/krVqxbwZI7EcowbpYI1F8ZszS7zfUhKT3U4=") + +(test-assert "public-key->string" + (and (string=? (public-key->string *rsa-pub-key*) %rsakey-pub-string) + (string=? (public-key->string *dsa-pub-key*) %dsakey-pub-string) + (when-openssl + (string=? (public-key->string *ecdsa-pub-key*) %ecdsakey-pub-string)))) + +(test-assert "string->public-key" + (and (string=? (public-key->string (string->public-key %rsakey-pub-string 'rsa)) + %rsakey-pub-string) + (string=? (public-key->string (string->public-key %dsakey-pub-string 'dss)) + %dsakey-pub-string) + (when-openssl + (string=? (public-key->string (string->public-key %ecdsakey-pub-string 'ecdsa)) + %ecdsakey-pub-string)))) + +(test-assert "make-keypair" + (and (let ((key (make-keypair 'rsa 1024))) + (and (key? key) + (eq? (get-key-type key) 'rsa))) + (let ((key (make-keypair 'dss 1024))) + (and (key? key) + (eq? (get-key-type key) 'dss))) + (when-openssl + (let ((key (make-keypair 'ecdsa 256))) + (and (key? key) + (eq? (get-key-type key) 'ecdsa)))))) + +;;; (test-end "key") diff --git a/tests/log.scm b/tests/log.scm index dbdba5b..fd4c6f6 100644 --- a/tests/log.scm +++ b/tests/log.scm @@ -45,6 +45,20 @@ (eq? (current-logging-callback) %default-log-printer))) +(test-assert "set-log-verbosity!" + (begin + (set-log-verbosity! 'functions) + (catch #t + (lambda () + (set-log-verbosity! 'wrong-verbosity) + #f) + (lambda (key . args) + #t)))) + +(test-assert "get-log-verbosity" + (eq? (get-log-verbosity) 'functions)) + + (test-end "log") (exit (= (test-runner-fail-count (test-runner-current)) 0)) diff --git a/tests/server-client.scm b/tests/server-client.scm index d183794..fa15056 100644 --- a/tests/server-client.scm +++ b/tests/server-client.scm @@ -98,92 +98,128 @@ body ...))))) -;;; Testing of basic procedures - -(test-assert-with-log "accept, key exchange" - (let ((server (make-server-for-test)) +(define (run-server-test client-proc server-proc) + "Run a CLIENT-PROC in newly created process. A session is passed to a +CLIENT-PROC as an argument. SERVER-PROC is called with a server as an +argument. The procedure returns a result of SERVER-PROC call." + (let ((server (make-server-for-test)) (session (make-session-for-test)) (pid (primitive-fork))) + (if (zero? pid) + ;; server + (dynamic-wind + (const #f) + (lambda () + (client-proc session)) + (lambda () + (primitive-exit 1))) + ;; client + (server-proc server)))) - (if (not (= 0 pid)) + +;;; Testing of basic procedures - ;; server - (begin - (server-listen server) - (let ((s (server-accept server))) - (catch #t - (lambda () - (server-handle-key-exchange s)) - (lambda (key . args) - (display args) - (newline))) - s)) +(test-assert-with-log "accept, key exchange" + (run-server-test - ;; client - (begin - (sleep 1) - (connect! session) - (authenticate-server session) - (primitive-exit))))) + ;; client + (lambda (session) + (sleep 1) + (connect! session) + (authenticate-server session) + (primitive-exit)) + + ;; server + (lambda (server) + (server-listen server) + (let ((s (server-accept server))) + (catch #t + (lambda () + (server-handle-key-exchange s)) + (lambda (key . args) + (display args) + (newline))) + s)))) (test-assert-with-log "server-message-get" - (let ((session (make-session-for-test)) - (pid (primitive-fork))) + (run-server-test - (if (not (= 0 pid)) + ;; client + (lambda (session) + (sleep 1) + (connect! session) + (clnmsg "connected") + (authenticate-server session) + (clnmsg "server authenticated") + (userauth-none! session) + (clnmsg "client authenticated") + (primitive-exit)) - ;; server - (let ((server (make-server-for-test))) - (server-listen server) - (let ((session (server-accept server))) - (server-handle-key-exchange session) - (let ((msg (server-message-get session))) - (message-auth-set-methods! msg '(none)) - (message-reply-success msg) - (message? msg)))) - - ;; client - (begin - (sleep 1) - (connect! session) - (clnmsg "connected") - (authenticate-server session) - (clnmsg "server authenticated") - (userauth-none! session) - (clnmsg "client authenticated") - (primitive-exit))))) + ;; server + (lambda (server) + (server-listen server) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (let ((msg (server-message-get session))) + (message-auth-set-methods! msg '(none)) + (message-reply-success msg) + (message? msg)))))) (test-assert-with-log "message-get-type" - (let ((session (make-session-for-test)) - (pid (primitive-fork))) + (run-server-test - (if (not (= 0 pid)) + ;; client + (lambda (session) + (sleep 1) + (connect! session) + (clnmsg "connected") + (authenticate-server session) + (clnmsg "server authenticated") + (userauth-none! session) + (clnmsg "client authenticated") + (primitive-exit)) - ;; server - (let ((server (make-server-for-test))) - (server-listen server) - (let ((session (server-accept server))) - (server-handle-key-exchange session) - (let ((msg (server-message-get session))) - (let ((msg-type (message-get-type msg)) - (expected-type '(request-service))) - (message-auth-set-methods! msg '(none)) - (message-reply-success msg) - (disconnect! session) - (equal? msg-type expected-type))))) + ;; server + (lambda (server) + (server-listen server) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (let ((msg (server-message-get session))) + (let ((msg-type (message-get-type msg)) + (expected-type '(request-service))) + (message-auth-set-methods! msg '(none)) + (message-reply-success msg) + (disconnect! session) + (equal? msg-type expected-type))))))) - ;; client - (begin - (sleep 1) - (connect! session) - (clnmsg "connected") - (authenticate-server session) - (clnmsg "server authenticated") - (userauth-none! session) - (clnmsg "client authenticated") - (primitive-exit))))) + +(test-assert-with-log "message-get-session" + (run-server-test + + ;; client + (lambda (session) + (sleep 1) + (connect! session) + (clnmsg "connected") + (authenticate-server session) + (clnmsg "server authenticated") + (userauth-none! session) + (clnmsg "client authenticated") + (primitive-exit)) + + ;; server + (lambda (server) + (server-listen server) + (let ((session (server-accept server))) + (server-handle-key-exchange session) + (let* ((msg (server-message-get session)) + (x (message-get-session msg))) + (message-auth-set-methods! msg '(none)) + (message-reply-success msg) + (disconnect! x) + (equal? x session)))))) (test-end "server-client") diff --git a/tests/server.scm b/tests/server.scm index a1bc7af..3ce475f 100644 --- a/tests/server.scm +++ b/tests/server.scm @@ -114,6 +114,30 @@ #:log-verbosity 'nolog #:blocking-mode #f))) +(test-assert "server-get" + (let* ((topdir (getenv "abs_top_srcdir")) + (bindaddr "127.0.0.1") + (bindport 123456) + (rsakey (format #f "~a/tests/rsakey" topdir)) + (dsakey (format #f "~a/tests/dsakey" topdir)) + (banner "banner") + (log-verbosity 'nolog) + (blocking-mode #f) + (server (make-server #:bindaddr bindaddr + #:bindport bindport + #:rsakey rsakey + #:dsakey dsakey + #:banner banner + #:log-verbosity log-verbosity + #:blocking-mode blocking-mode))) + (and (eq? (server-get server 'bindaddr) bindaddr) + (eq? (server-get server 'bindport) bindport) + (eq? (server-get server 'rsakey) rsakey) + (eq? (server-get server 'dsakey) dsakey) + (eq? (server-get server 'banner) banner) + (eq? (server-get server 'log-verbosity) log-verbosity) + (eq? (server-get server 'blocking-mode) blocking-mode)))) + (test-assert "server-listen" (let* ((topdir (getenv "abs_top_srcdir")) (server (make-server #:bindaddr "127.0.0.1" diff --git a/tests/session.scm b/tests/session.scm index 3be2c04..3b5ffa2 100644 --- a/tests/session.scm +++ b/tests/session.scm @@ -98,13 +98,16 @@ (test-assert "session-get" (let* ((host "example.com") + (port 12345) (user "alice") (proxycommand "test") (session (make-session #:host host + #:port port #:user user #:identity %rsakey #:proxycommand proxycommand))) (and (string=? (session-get session 'host) host) + (= (session-get session 'port) port) (string=? (session-get session 'user) user) (string=? (session-get session 'identity) %rsakey) (string=? (session-get session 'proxycommand) proxycommand)))) |