diff options
author | Hans Nilsson <[email protected]> | 2015-06-15 22:09:53 +0200 |
---|---|---|
committer | Hans Nilsson <[email protected]> | 2015-07-02 12:01:48 +0200 |
commit | 941ddfbeab3357177ce6eac709456fd881ac2429 (patch) | |
tree | bd5facee29c211e3bd2f1730f1467c6b7daa6326 /lib/ssh | |
parent | 2e36a5f144ff1c996f02d5a55b07f3c840869ebf (diff) | |
download | otp-941ddfbeab3357177ce6eac709456fd881ac2429.tar.gz otp-941ddfbeab3357177ce6eac709456fd881ac2429.tar.bz2 otp-941ddfbeab3357177ce6eac709456fd881ac2429.zip |
ssh: Initial ssh_tprt_test_lib.erl and ssh_protocol_SUITE
This test lib is intended for deeper testing of the SSH application. It
makes it possible to do exact steps in the message exchange to test "corner
cases"
Diffstat (limited to 'lib/ssh')
-rw-r--r-- | lib/ssh/test/Makefile | 2 | ||||
-rw-r--r-- | lib/ssh/test/ssh_protocol_SUITE.erl | 314 | ||||
-rw-r--r-- | lib/ssh/test/ssh_protocol_SUITE_data/id_dsa | 13 | ||||
-rw-r--r-- | lib/ssh/test/ssh_protocol_SUITE_data/id_rsa | 15 | ||||
-rw-r--r-- | lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_dsa_key | 13 | ||||
-rw-r--r-- | lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_dsa_key.pub | 11 | ||||
-rw-r--r-- | lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_rsa_key | 16 | ||||
-rw-r--r-- | lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_rsa_key.pub | 5 | ||||
-rw-r--r-- | lib/ssh/test/ssh_trpt_test_lib.erl | 691 |
9 files changed, 1080 insertions, 0 deletions
diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 6503d5b643..47c189c162 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -33,8 +33,10 @@ VSN=$(GS_VSN) MODULES= \ ssh_test_lib \ + ssh_trpt_test_lib \ ssh_sup_SUITE \ ssh_basic_SUITE \ + ssh_protocol_SUITE \ ssh_to_openssh_SUITE \ ssh_sftp_SUITE \ ssh_sftpd_SUITE \ diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl new file mode 100644 index 0000000000..3fb2840a19 --- /dev/null +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -0,0 +1,314 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssh_protocol_SUITE). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("kernel/include/inet.hrl"). +-include_lib("ssh/src/ssh.hrl"). % ?UINT32, ?BYTE, #ssh{} ... +-include_lib("ssh/src/ssh_transport.hrl"). +-include_lib("ssh/src/ssh_auth.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(NEWLINE, <<"\r\n">>). +-define(REKEY_DATA_TMO, 65000). + +-define(v(Key, Config), proplists:get_value(Key, Config)). +-define(v(Key, Config, Default), proplists:get_value(Key, Config, Default)). + + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group,tool_tests} + ]. + +groups() -> + [{tool_tests, [], [lib_works_as_client, + lib_works_as_server, + lib_match, + lib_no_match + ]} + ]. + + +init_per_suite(Config) -> + start_std_daemon( setup_dirs( start_apps(Config))). + +end_per_suite(Config) -> + stop_apps(Config). + + +init_per_testcase(_TestCase, Config) -> + check_std_daemon_works(Config, ?LINE). + +end_per_testcase(_TestCase, Config) -> + check_std_daemon_works(Config, ?LINE). + + +%%%-------------------------------------------------------------------- +%%% Test Cases -------------------------------------------------------- +%%%-------------------------------------------------------------------- + +%%%-------------------------------------------------------------------- +%%% Connect to an erlang server and check that the testlib acts as a client. +lib_works_as_client(Config) -> + %% Connect and negotiate keys + {ok,InitialState} = + ssh_trpt_test_lib:exec( + [{set_options, [print_ops, print_seqnums, print_messages]}, + {connect, + server_host(Config),server_port(Config), + [{silently_accept_hosts, true}, + {user_dir, user_dir(Config)}, + {user_interaction, false}]}, + receive_hello, + {send, hello}, + {send, ssh_msg_kexinit}, + {match, #ssh_msg_kexinit{_='_'}, receive_msg}, + {send, ssh_msg_kexdh_init}, + {match,# ssh_msg_kexdh_reply{_='_'}, receive_msg}, + {send, #ssh_msg_newkeys{}}, + {match, #ssh_msg_newkeys{_='_'}, receive_msg} + ] + ), + + %% Do the authentcation + {User,Pwd} = server_user_password(Config), + {ok,EndState} = + ssh_trpt_test_lib:exec( + [{send, #ssh_msg_service_request{name = "ssh-userauth"}}, + {match, #ssh_msg_service_accept{name = "ssh-userauth"}, receive_msg}, + {send, #ssh_msg_userauth_request{user = User, + service = "ssh-connection", + method = "password", + data = <<?BOOLEAN(?FALSE), + ?STRING(unicode:characters_to_binary(Pwd))>> + }}, + {match, #ssh_msg_userauth_success{_='_'}, receive_msg} + ], InitialState), + + %% Disconnect + {ok,_} = + ssh_trpt_test_lib:exec( + [{send, #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "End of the fun", + language = "" + }}, + close_socket + ], EndState). + + +%%-------------------------------------------------------------------- +%%% Connect an erlang client and check that the testlib can act as a server. +lib_works_as_server(Config) -> + {User,_Pwd} = server_user_password(Config), + + %% Create a listening socket as server socket: + {ok,InitialState} = ssh_trpt_test_lib:exec(listen), + HostPort = ssh_trpt_test_lib:server_host_port(InitialState), + + %% Start a process handling one connection on the server side: + spawn_link( + fun() -> + {ok,_} = + ssh_trpt_test_lib:exec( + [{set_options, [print_ops, print_messages]}, + {accept, [{system_dir, system_dir(Config)}, + {user_dir, user_dir(Config)}]}, + receive_hello, + {send, hello}, + + {send, ssh_msg_kexinit}, + {match, #ssh_msg_kexinit{_='_'}, receive_msg}, + + {match, #ssh_msg_kexdh_init{_='_'}, receive_msg}, + {send, ssh_msg_kexdh_reply}, + + {send, #ssh_msg_newkeys{}}, + {match, #ssh_msg_newkeys{_='_'}, receive_msg}, + + {match, #ssh_msg_service_request{name="ssh-userauth"}, receive_msg}, + {send, #ssh_msg_service_accept{name="ssh-userauth"}}, + + {match, #ssh_msg_userauth_request{service="ssh-connection", + method="none", + user=User, + _='_'}, receive_msg}, + + {send, #ssh_msg_userauth_failure{authentications = "password", + partial_success = false}}, + + {match, #ssh_msg_userauth_request{service="ssh-connection", + method="password", + user=User, + _='_'}, receive_msg}, + {send, #ssh_msg_userauth_success{}}, + close_socket, + print_state + ], + InitialState) + end), + + %% and finally connect to it with a regular Erlang SSH client: + {ok,_} = std_connect(HostPort, Config). + +%%-------------------------------------------------------------------- +%%% Matching +lib_match(_Config) -> + {ok,_} = + ssh_trpt_test_lib:exec([{set_options, [print_ops]}, + {match, abc, abc}, + {match, '$a', {cde,fgh}}, + {match, {cde,fgh}, '$a'}, + {match, '_', {cde,fgh}}, + {match, [a,'$a',b], [a,{cde,fgh},b]}, + {match, [a,'$a'|'$b'], [a,{cde,fgh},b,c]}, + {match, '$b', [b,c]} + ]). + +%%-------------------------------------------------------------------- +%%% Not matching +lib_no_match(_Config) -> + case ssh_trpt_test_lib:exec([{set_options, [print_ops]}, + {match, '$x', b}, + {match, a, '$x'}]) + of + {ok,_} -> {fail,"Unexpected match"}; + {error, {_Op,{expected,a,b},_State}} -> ok + end. + +%%%================================================================ +%%%==== Internal functions ======================================== +%%%================================================================ + +%%%---- init_suite and end_suite --------------------------------------- +start_apps(Config) -> + catch crypto:stop(), + case catch crypto:start() of + ok -> + catch ssh:stop(), + ok = ssh:start(), + [{stop_apps, + fun() -> + ssh:stop(), + crypto:stop() + end} | Config]; + _Else -> + {skip, "Crypto could not be started!"} + end. + + +stop_apps(Config) -> + (?v(stop_apps, Config, fun()-> ok end))(), + ssh:stop(). + + +setup_dirs(Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + ssh_test_lib:setup_rsa(DataDir, PrivDir), + Config. + +system_dir(Config) -> filename:join(?config(priv_dir, Config), system). + +user_dir(Config) -> ?config(priv_dir, Config). + +%%%---------------------------------------------------------------- +start_std_daemon(Config) -> + start_std_daemon(Config, []). + +start_std_daemon(Config, ExtraOpts) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + UserPasswords = [{"user1","pwd1"}], + Options = [{system_dir, system_dir(Config)}, + {user_dir, user_dir(Config)}, + {user_passwords, UserPasswords}, + {failfun, fun ssh_test_lib:failfun/2} + | ExtraOpts], + Ref = {Server, Host, Port} = ssh_test_lib:daemon(Options), + ct:log("Std server ~p started at ~p:~p~nOptions=~p",[Server, Host, Port, Options]), + [{server,Ref}, {user_passwords, UserPasswords} | Config]. + + +stop_std_daemon(Config) -> + ssh:stop_daemon(server_pid(Config)), + ct:log("Std server ~p at ~p:~p stopped", [server_pid(Config), server_host(Config), server_port(Config)]), + lists:keydelete(server, 1, Config). + +check_std_daemon_works(Config, Line) -> + case std_connect(Config) of + {ok,C} -> + ct:log("Server ~p:~p ~p is ok at line ~p", + [server_host(Config), server_port(Config), + server_pid(Config), Line]), + ok = ssh:close(C), + Config; + Error = {error,_} -> + {fail, + lists:flatten( + io_lib:format("Standard server ~p:~p ~p is ill at line ~p: ~p", + [server_host(Config), server_port(Config), + server_pid(Config), Line, Error]) + ) + } + end. + +server_pid(Config) -> element(1,?v(server,Config)). +server_host(Config) -> element(2,?v(server,Config)). +server_port(Config) -> element(3,?v(server,Config)). + +server_user_password(Config) -> server_user_password(1, Config). + +server_user_password(N, Config) -> lists:nth(N, ?v(user_passwords,Config)). + + +std_connect(Config) -> + {User,Pwd} = server_user_password(Config), + std_connect(server_host(Config), server_port(Config), + Config, + [{user,User},{password,Pwd}]). + +std_connect({Host,Port}, Config) -> + {User,Pwd} = server_user_password(Config), + std_connect(Host, Port, Config, [{user,User},{password,Pwd}]). + +std_connect({Host,Port}, Config, Opts) -> + std_connect(Host, Port, Config, Opts). + +std_connect(Host, Port, Config, Opts) -> + ssh:connect(Host, Port, + [{silently_accept_hosts, true}, + {user_dir, user_dir(Config)}, + {user_interaction, false} | Opts], + 30000). + + +%%%---------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/id_dsa b/lib/ssh/test/ssh_protocol_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_protocol_SUITE_data/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/id_rsa b/lib/ssh/test/ssh_protocol_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_protocol_SUITE_data/id_rsa @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_protocol_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl new file mode 100644 index 0000000000..8623020a31 --- /dev/null +++ b/lib/ssh/test/ssh_trpt_test_lib.erl @@ -0,0 +1,691 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ssh_trpt_test_lib). + +%%-compile(export_all). + +-export([exec/1, exec/2, + format_msg/1, + server_host_port/1 + ] + ). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("ssh/src/ssh.hrl"). % ?UINT32, ?BYTE, #ssh{} ... +-include_lib("ssh/src/ssh_transport.hrl"). +-include_lib("ssh/src/ssh_auth.hrl"). + +%%%---------------------------------------------------------------- +-record(s, { + socket, + listen_socket, + opts = [], + timeout = 5000, % ms + seen_hello = false, + enc = <<>>, + ssh = #ssh{}, % #ssh{} + own_kexinit, + peer_kexinit, + vars = dict:new(), + reply = [], % Some repy msgs are generated hidden in ssh_transport :[ + prints = [], + return_value + }). + +-define(role(S), ((S#s.ssh)#ssh.role) ). + + +server_host_port(S=#s{}) -> + {Host,Port} = ok(inet:sockname(S#s.listen_socket)), + {host(Host), Port}. + + +%%% Options: {print_messages, false} true|detail +%%% {print_seqnums,false} true +%%% {print_ops,false} true + +exec(L) -> exec(L, #s{}). + +exec(L, S) when is_list(L) -> lists:foldl(fun exec/2, S, L); + +exec(Op, S0=#s{}) -> + S1 = init_op_traces(Op, S0), + try seqnum_trace( + op(Op, S1)) + of + S = #s{} -> + print_traces(S), + {ok,S} + catch + {fail,Reason,Se} -> + report_trace('', Reason, Se), + {error,{Op,Reason,Se}}; + + throw:Term -> + report_trace(throw, Term, S1), + throw(Term); + + error:Error -> + report_trace(error, Error, S1), + error(Error); + + exit:Exit -> + report_trace(exit, Exit, S1), + exit(Exit) + end; +exec(Op, {ok,S=#s{}}) -> exec(Op, S); +exec(_, Error) -> Error. + + +%%%---- Server ops +op(listen, S) when ?role(S) == undefined -> op({listen,0}, S); + +op({listen,Port}, S) when ?role(S) == undefined -> + S#s{listen_socket = ok(gen_tcp:listen(Port, mangle_opts([]))), + ssh = (S#s.ssh)#ssh{role=server} + }; + +op({accept,Opts}, S) when ?role(S) == server -> + {ok,Socket} = gen_tcp:accept(S#s.listen_socket, S#s.timeout), + {Host,_Port} = ok(inet:sockname(Socket)), + S#s{socket = Socket, + ssh = init_ssh(server,Socket,[{host,host(Host)}|Opts]), + return_value = ok}; + +%%%---- Client ops +op({connect,Host,Port,Opts}, S) when ?role(S) == undefined -> + Socket = ok(gen_tcp:connect(host(Host), Port, mangle_opts([]))), + S#s{socket = Socket, + ssh = init_ssh(client, Socket, [{host,host(Host)}|Opts]), + return_value = ok}; + +%%%---- ops for both client and server +op(close_socket, S) -> + catch tcp_gen:close(S#s.socket), + catch tcp_gen:close(S#s.listen_socket), + S#s{socket = undefined, + listen_socket = undefined, + return_value = ok}; + +op({set_options,Opts}, S) -> + S#s{opts = Opts}; + +op({send,X}, S) -> + send(S, instantiate(X,S)); + +op(receive_hello, S0) when S0#s.seen_hello =/= true -> + case recv(S0) of + S1=#s{return_value={hello,_}} -> S1; + S1=#s{} -> op(receive_hello, receive_wait(S1)) + end; + +op(receive_msg, S) when S#s.seen_hello == true -> + try recv(S) + catch + {tcp,Exc} -> S#s{return_value=Exc} + end; + + +op({expect,timeout,E}, S0) -> + try op(E, S0) + of + S=#s{} -> fail({expected,timeout,S#s.return_value}, S) + catch + {receive_timeout,_} -> S0#s{return_value=timeout} + end; + +op({match,M,E}, S0) -> + {Val,S2} = op_val(E, S0), + case match(M, Val, S2) of + {true,S3} -> + opt(print_ops,S3, + fun(true) -> + case dict:fold( + fun(K,V,Acc) -> + case dict:find(K,S0#s.vars) of + error -> [{K,V}|Acc]; + _ -> Acc + end + end, [], S3#s.vars) + of + [] -> {"Matches! No new bindings.",[]}; + New -> + Width = lists:max([length(atom_to_list(K)) || {K,_} <- New]), + {lists:flatten( + ["Matches! New bindings:~n" | + [io_lib:format(" ~*s = ~p~n",[Width,K,V]) || {K,V}<-New]]), + []} + end + end); + false -> + fail({expected,M,Val}, + opt(print_ops,S2,fun(true) -> {"nomatch!!~n",[]} end) + ) + end; + +op({print,E}, S0) -> + {Val,S} = op_val(E, S0), + io:format("Result of ~p ~p =~n~s~n",[?role(S0),E,format_msg(Val)]), + S; + +op(print_state, S) -> + io:format("State(~p)=~n~s~n",[?role(S), format_msg(S)]), + S; + +op('$$', S) -> + %% For matching etc + S. + + +op_val(E, S0) -> + case catch op(E, S0) of + {'EXIT',{function_clause,[{ssh_trpt_test_lib,op,[E,S0],_}|_]}} -> + {instantiate(E,S0), S0}; + S=#s{} -> + {S#s.return_value, S} + end. + + +fail(Reason, S) -> + throw({fail, Reason, S}). + +%%%---------------------------------------------------------------- +%% No optimizations :) + +match('$$', V, S) -> + match(S#s.return_value, V, S); + +match('_', _, S) -> + {true, S}; + +match(P, V, S) when is_atom(P) -> + case atom_to_list(P) of + "$"++_ -> + %% Variable + case dict:find(P,S#s.vars) of + {ok,Val} -> match(Val, V, S); + error -> {true,S#s{vars = dict:store(P,V,S#s.vars)}} + end; + _ when P==V -> + {true,S}; + _ -> + false + end; + +match(P, V, S) when P==V -> + {true, S}; + +match(P, V, S) when is_tuple(P), + is_tuple(V) -> + match(tuple_to_list(P), tuple_to_list(V), S); + +match([Hp|Tp], [Hv|Tv], S0) -> + case match(Hp, Hv, S0) of + {true,S} -> match(Tp, Tv, S); + false -> false + end; + +match(_, _, _) -> + false. + + + +instantiate('$$', S) -> + S#s.return_value; % FIXME: What if $$ or $... in return_value? + +instantiate(A, S) when is_atom(A) -> + case atom_to_list(A) of + "$"++_ -> + %% Variable + case dict:find(A,S#s.vars) of + {ok,Val} -> Val; % FIXME: What if $$ or $... in Val? + error -> throw({unbound,A}) + end; + _ -> + A + end; + +instantiate(T, S) when is_tuple(T) -> + list_to_tuple( instantiate(tuple_to_list(T),S) ); + +instantiate([H|T], S) -> + [instantiate(H,S) | instantiate(T,S)]; + +instantiate(X, _S) -> + X. + +%%%================================================================ +%%% +init_ssh(Role, Socket, Options0) -> + Options = [{user_interaction,false} + | Options0], + ssh_connection_handler:init_ssh(Role, + {2,0}, + lists:concat(["SSH-2.0-ErlangTestLib ",Role]), + Options, Socket). + +mangle_opts(Options) -> + SysOpts = [{reuseaddr, true}, + {active, false}, + {mode, binary} + ], + SysOpts ++ lists:foldl(fun({K,_},Opts) -> + lists:keydelete(K,1,Opts) + end, Options, SysOpts). + +host({0,0,0,0}) -> "localhost"; +host(H) -> H. + +%%%---------------------------------------------------------------- +send(S=#s{ssh=C}, hello) -> + Hello = case ?role(S) of + client -> C#ssh.c_version; + server -> C#ssh.s_version + end ++ "\r\n", + send(S, list_to_binary(Hello)); + +send(S0, ssh_msg_kexinit) -> + {Msg, Bytes, C0} = ssh_transport:key_exchange_init_msg(S0#s.ssh), + S1 = opt(print_messages, S0, + fun(X) when X==true;X==detail -> {"Send~n~s~n",[format_msg(Msg)]} end), + S = case ?role(S1) of + server when is_record(S1#s.peer_kexinit, ssh_msg_kexinit) -> + {ok, C} = + ssh_transport:handle_kexinit_msg(S1#s.peer_kexinit, Msg, C0), + S1#s{peer_kexinit = used, + own_kexinit = used, + ssh = C}; + _ -> + S1#s{ssh = C0, + own_kexinit = Msg} + end, + send_bytes(Bytes, S#s{return_value = Msg}); + +send(S0, ssh_msg_kexdh_init) when ?role(S0) == client, + is_record(S0#s.peer_kexinit, ssh_msg_kexinit), + is_record(S0#s.own_kexinit, ssh_msg_kexinit) -> + {ok, NextKexMsgBin, C} = + ssh_transport:handle_kexinit_msg(S0#s.peer_kexinit, S0#s.own_kexinit, S0#s.ssh), + + S = opt(print_messages, S0, + fun(X) when X==true;X==detail -> + #ssh{keyex_key = {{_Private, Public}, {_G, _P}}} = C, + Msg = #ssh_msg_kexdh_init{e = Public}, + {"Send (reconstructed)~n~s~n",[format_msg(Msg)]} + end), + + send_bytes(NextKexMsgBin, S#s{ssh = C, + peer_kexinit = used, + own_kexinit = used}); + +send(S0, ssh_msg_kexdh_reply) -> + Bytes = proplists:get_value(ssh_msg_kexdh_reply, S0#s.reply), + S = opt(print_messages, S0, + fun(X) when X==true;X==detail -> + {{_Private, Public}, _} = (S0#s.ssh)#ssh.keyex_key, + Msg = #ssh_msg_kexdh_reply{public_host_key = 'Key', + f = Public, + h_sig = 'H_SIG' + }, + {"Send (reconstructed)~n~s~n",[format_msg(Msg)]} + end), + send_bytes(Bytes, S#s{return_value = Bytes}); + +send(S0, Line) when is_binary(Line) -> + S = opt(print_messages, S0, + fun(X) when X==true;X==detail -> {"Send line~n~p~n",[Line]} end), + send_bytes(Line, S#s{return_value = Line}); + +%%% Msg = #ssh_msg_*{} +send(S0, Msg) when is_tuple(Msg) -> + S = opt(print_messages, S0, + fun(X) when X==true;X==detail -> {"Send~n~s~n",[format_msg(Msg)]} end), + {Packet, C} = ssh_transport:ssh_packet(Msg, S#s.ssh), + send_bytes(Packet, S#s{ssh = C, %%inc_send_seq_num(C), + return_value = Msg}). + +send_bytes(B, S0) -> + S = opt(print_messages, S0, fun(detail) -> {"Send bytes~n~p~n",[B]} end), + ok(gen_tcp:send(S#s.socket, B)), + S. + +%%%---------------------------------------------------------------- +recv(S0 = #s{}) -> + S1 = receive_poll(S0), + case S1#s.seen_hello of + {more,Seen} -> + %% Has received parts of a line. Has not seen a complete hello. + try_find_crlf(Seen, S1); + false -> + %% Must see hello before binary messages + try_find_crlf(<<>>, S1); + true -> + %% Has seen hello, therefore no more crlf-messages are alowed. + S = receive_binary_msg(S1), + case M=S#s.return_value of + #ssh_msg_kexinit{} when ?role(S) == server, + S#s.own_kexinit =/= undefined -> + {ok, C} = + ssh_transport:handle_kexinit_msg(M, S#s.own_kexinit, S#s.ssh), + S#s{peer_kexinit = used, + own_kexinit = used, + ssh = C}; + #ssh_msg_kexinit{} -> + S#s{peer_kexinit = M}; + #ssh_msg_kexdh_init{} -> % Always the server + {ok, Reply, C} = ssh_transport:handle_kexdh_init(M, S#s.ssh), + S#s{ssh = C, + reply = [{ssh_msg_kexdh_reply,Reply} | S#s.reply] + }; + #ssh_msg_kexdh_reply{} -> + {ok, _NewKeys, C} = ssh_transport:handle_kexdh_reply(M, S#s.ssh), + S#s{ssh=C#ssh{send_sequence=S#s.ssh#ssh.send_sequence}}; % Back the number + #ssh_msg_newkeys{} -> + {ok, C} = ssh_transport:handle_new_keys(M, S#s.ssh), + S#s{ssh=C}; + _ -> + S + end + end. + +%%%================================================================ +try_find_crlf(Seen, S0) -> + case erlang:decode_packet(line,S0#s.enc,[]) of + {more,_} -> + Line = <<Seen/binary,(S0#s.enc)/binary>>, + S0#s{seen_hello = {more,Line}, + enc = <<>>, % didn't find a complete line + % -> no more characters to test + return_value = {more,Line} + }; + {ok,Used,Rest} -> + Line = <<Seen/binary,Used/binary>>, + case handle_hello(Line, S0) of + false -> + S = opt(print_messages, S0, + fun(X) when X==true;X==detail -> {"Recv info~n~p~n",[Line]} end), + S#s{seen_hello = false, + enc = Rest, + return_value = {info,Line}}; + S1=#s{} -> + S = opt(print_messages, S1, + fun(X) when X==true;X==detail -> {"Recv hello~n~p~n",[Line]} end), + S#s{seen_hello = true, + enc = Rest, + return_value = {hello,Line}} + end + end. + + +handle_hello(Bin, S=#s{ssh=C}) -> + case {ssh_transport:handle_hello_version(binary_to_list(Bin)), + ?role(S)} + of + {{undefined,_}, _} -> false; + {{Vp,Vs}, client} -> S#s{ssh = C#ssh{s_vsn=Vp, s_version=Vs}}; + {{Vp,Vs}, server} -> S#s{ssh = C#ssh{c_vsn=Vp, c_version=Vs}} + end. + +receive_binary_msg(S0=#s{ssh=C0=#ssh{decrypt_block_size = BlockSize, + recv_mac_size = MacSize + } + }) -> + case size(S0#s.enc) >= max(8,BlockSize) of + false -> + %% Need more bytes to decode the packet_length field + Remaining = max(8,BlockSize) - size(S0#s.enc), + receive_binary_msg( receive_wait(Remaining, S0) ); + true -> + %% Has enough bytes to decode the packet_length field + {_, <<?UINT32(PacketLen), _/binary>>, _} = + ssh_transport:decrypt_blocks(S0#s.enc, BlockSize, C0), % FIXME: BlockSize should be at least 4 + + %% FIXME: Check that ((4+PacketLen) rem BlockSize) == 0 ? + + S1 = if + PacketLen > ?SSH_MAX_PACKET_SIZE -> + fail({too_large_message,PacketLen},S0); % FIXME: disconnect + + ((4+PacketLen) rem BlockSize) =/= 0 -> + fail(bad_packet_length_modulo, S0); % FIXME: disconnect + + size(S0#s.enc) >= (4 + PacketLen + MacSize) -> + %% has the whole packet + S0; + + true -> + %% need more bytes to get have the whole packet + Remaining = (4 + PacketLen + MacSize) - size(S0#s.enc), + receive_wait(Remaining, S0) + end, + + %% Decrypt all, including the packet_length part (re-use the initial #ssh{}) + {C1, SshPacket = <<?UINT32(_),?BYTE(PadLen),Tail/binary>>, EncRest} = + ssh_transport:decrypt_blocks(S1#s.enc, PacketLen+4, C0), + + PayloadLen = PacketLen - 1 - PadLen, + <<CompressedPayload:PayloadLen/binary, _Padding:PadLen/binary>> = Tail, + + {C2, Payload} = ssh_transport:decompress(C1, CompressedPayload), + + <<Mac:MacSize/binary, Rest/binary>> = EncRest, + + case {ssh_transport:is_valid_mac(Mac, SshPacket, C2), + catch ssh_message:decode(Payload)} + of + {false, _} -> fail(bad_mac,S1); + {_, {'EXIT',_}} -> fail(decode_failed,S1); + + {true, Msg} -> + C3 = case Msg of + #ssh_msg_kexinit{} -> + ssh_transport:key_init(opposite_role(C2), C2, Payload); + _ -> + C2 + end, + S2 = opt(print_messages, S1, + fun(X) when X==true;X==detail -> {"Recv~n~s~n",[format_msg(Msg)]} end), + S3 = opt(print_messages, S2, + fun(detail) -> {"decrypted bytes ~p~n",[SshPacket]} end), + S3#s{ssh = inc_recv_seq_num(C3), + enc = Rest, + return_value = Msg + } + end + end. + + +receive_poll(S=#s{socket=Sock}) -> + inet:setopts(Sock, [{active,once}]), + receive + {tcp,Sock,Data} -> + receive_poll( S#s{enc = <<(S#s.enc)/binary,Data/binary>>} ); + {tcp_closed,Sock} -> + throw({tcp,tcp_closed}); + {tcp_error, Sock, Reason} -> + throw({tcp,{tcp_error,Reason}}) + after 0 -> + S + end. + +receive_wait(S=#s{socket=Sock, + timeout=Timeout}) -> + inet:setopts(Sock, [{active,once}]), + receive + {tcp,Sock,Data} -> + S#s{enc = <<(S#s.enc)/binary,Data/binary>>}; + {tcp_closed,Sock} -> + throw({tcp,tcp_closed}); + {tcp_error, Sock, Reason} -> + throw({tcp,{tcp_error,Reason}}) + after Timeout -> + fail(receive_timeout,S) + end. + +receive_wait(N, S=#s{socket=Sock, + timeout=Timeout, + enc=Enc0}) when N>0 -> + inet:setopts(Sock, [{active,once}]), + receive + {tcp,Sock,Data} -> + receive_wait(N-size(Data), S#s{enc = <<Enc0/binary,Data/binary>>}); + {tcp_closed,Sock} -> + throw({tcp,tcp_closed}); + {tcp_error, Sock, Reason} -> + throw({tcp,{tcp_error,Reason}}) + after Timeout -> + fail(receive_timeout, S) + end; +receive_wait(_N, S) -> + S. + +%% random_padding_len(PaddingLen1, ChunkSize) -> +%% MaxAdditionalRandomPaddingLen = % max 255 bytes padding totaƶ +%% (255 - PaddingLen1) - ((255 - PaddingLen1) rem ChunkSize), +%% AddLen0 = crypto:rand_uniform(0,MaxAdditionalRandomPaddingLen), +%% AddLen0 - (AddLen0 rem ChunkSize). % preserve the blocking + +inc_recv_seq_num(C=#ssh{recv_sequence=N}) -> C#ssh{recv_sequence=(N+1) band 16#ffffffff}. +%%%inc_send_seq_num(C=#ssh{send_sequence=N}) -> C#ssh{send_sequence=(N+1) band 16#ffffffff}. + +opposite_role(#ssh{role=R}) -> opposite_role(R); +opposite_role(client) -> server; +opposite_role(server) -> client. + +ok(ok) -> ok; +ok({ok,R}) -> R; +ok({error,E}) -> erlang:error(E). + + +%%%================================================================ +%%% +%%% Formating of records +%%% + +format_msg(M) -> format_msg(M, 0). + +format_msg(M, I0) -> + case fields(M) of + undefined -> io_lib:format('~p',[M]); + Fields -> + [Name|Args] = tuple_to_list(M), + Head = io_lib:format('#~p{',[Name]), + I = lists:flatlength(Head)+I0, + NL = io_lib:format('~n~*c',[I,$ ]), + Sep = io_lib:format(',~n~*c',[I,$ ]), + Tail = [begin + S0 = io_lib:format('~p = ',[F]), + I1 = I + lists:flatlength(S0), + [S0,format_msg(A,I1)] + end + || {F,A} <- lists:zip(Fields,Args)], + [[Head|string:join(Tail,Sep)],NL,"}"] + end. + +fields(M) -> + case M of + #ssh_msg_debug{} -> record_info(fields, ssh_msg_debug); + #ssh_msg_disconnect{} -> record_info(fields, ssh_msg_disconnect); + #ssh_msg_ignore{} -> record_info(fields, ssh_msg_ignore); + #ssh_msg_kex_dh_gex_group{} -> record_info(fields, ssh_msg_kex_dh_gex_group); + #ssh_msg_kex_dh_gex_init{} -> record_info(fields, ssh_msg_kex_dh_gex_init); + #ssh_msg_kex_dh_gex_reply{} -> record_info(fields, ssh_msg_kex_dh_gex_reply); + #ssh_msg_kex_dh_gex_request{} -> record_info(fields, ssh_msg_kex_dh_gex_request); + #ssh_msg_kex_dh_gex_request_old{} -> record_info(fields, ssh_msg_kex_dh_gex_request_old); + #ssh_msg_kexdh_init{} -> record_info(fields, ssh_msg_kexdh_init); + #ssh_msg_kexdh_reply{} -> record_info(fields, ssh_msg_kexdh_reply); + #ssh_msg_kexinit{} -> record_info(fields, ssh_msg_kexinit); + #ssh_msg_newkeys{} -> record_info(fields, ssh_msg_newkeys); + #ssh_msg_service_accept{} -> record_info(fields, ssh_msg_service_accept); + #ssh_msg_service_request{} -> record_info(fields, ssh_msg_service_request); + #ssh_msg_unimplemented{} -> record_info(fields, ssh_msg_unimplemented); + #ssh_msg_userauth_request{} -> record_info(fields, ssh_msg_userauth_request); + #ssh_msg_userauth_failure{} -> record_info(fields, ssh_msg_userauth_failure); + #ssh_msg_userauth_success{} -> record_info(fields, ssh_msg_userauth_success); + #ssh_msg_userauth_banner{} -> record_info(fields, ssh_msg_userauth_banner); + #ssh_msg_userauth_passwd_changereq{} -> record_info(fields, ssh_msg_userauth_passwd_changereq); + #ssh_msg_userauth_pk_ok{} -> record_info(fields, ssh_msg_userauth_pk_ok); + #ssh_msg_userauth_info_request{} -> record_info(fields, ssh_msg_userauth_info_request); + #ssh_msg_userauth_info_response{} -> record_info(fields, ssh_msg_userauth_info_response); + #s{} -> record_info(fields, s); + #ssh{} -> record_info(fields, ssh); + #alg{} -> record_info(fields, alg); + _ -> undefined + end. + +%%%================================================================ +%%% +%%% Trace handling +%%% + +init_op_traces(Op, S0) -> + opt(print_ops, S0#s{prints=[]}, + fun(true) -> + case ?role(S0) of + undefined -> {"-- ~p~n",[Op]}; + Role -> {"-- ~p ~p~n",[Role,Op]} + end + end + ). + +report_trace(Class, Term, S) -> + print_traces( + opt(print_ops, S, + fun(true) -> {"~s ~p",[Class,Term]} end) + ). + +seqnum_trace(S) -> + opt(print_seqnums, S, + fun(true) when S#s.ssh#ssh.send_sequence =/= S#s.ssh#ssh.send_sequence, + S#s.ssh#ssh.recv_sequence =/= S#s.ssh#ssh.recv_sequence -> + {"~p seq num: send ~p->~p, recv ~p->~p~n", + [?role(S), + S#s.ssh#ssh.send_sequence, S#s.ssh#ssh.send_sequence, + S#s.ssh#ssh.recv_sequence, S#s.ssh#ssh.recv_sequence + ]}; + (true) when S#s.ssh#ssh.send_sequence =/= S#s.ssh#ssh.send_sequence -> + {"~p seq num: send ~p->~p~n", + [?role(S), + S#s.ssh#ssh.send_sequence, S#s.ssh#ssh.send_sequence]}; + (true) when S#s.ssh#ssh.recv_sequence =/= S#s.ssh#ssh.recv_sequence -> + {"~p seq num: recv ~p->~p~n", + [?role(S), + S#s.ssh#ssh.recv_sequence, S#s.ssh#ssh.recv_sequence]} + end). + +print_traces(S) when S#s.prints == [] -> S; +print_traces(S) -> + ct:log("~s", + [lists:foldl(fun({Fmt,Args}, Acc) -> + [io_lib:format(Fmt,Args) | Acc] + end, "", S#s.prints)] + ). + +opt(Flag, S, Fun) when is_function(Fun,1) -> + try Fun(proplists:get_value(Flag,S#s.opts)) + of P={Fmt,Args} when is_list(Fmt), is_list(Args) -> + save_prints(P, S) + catch _:_ -> + S + end. + +save_prints({Fmt,Args}, S) -> + S#s{prints = [{Fmt,Args}|S#s.prints]}. |