diff options
Diffstat (limited to 'lib')
53 files changed, 2500 insertions, 260 deletions
diff --git a/lib/asn1/doc/src/asn1_ug.xml b/lib/asn1/doc/src/asn1_ug.xml index 020e58c615..8b33497dd3 100644 --- a/lib/asn1/doc/src/asn1_ug.xml +++ b/lib/asn1/doc/src/asn1_ug.xml @@ -1390,7 +1390,7 @@ GENERAL-PROCEDURES GENERAL-PROCEDURE ::= { instance, if a Type is used in a definition with certain purpose, one want the type-name to express the intention. This can be done with parameterization.</p> - <p>When many types (or an other ASN.1 entity) only differs in some + <p>When many types (or another ASN.1 entity) only differs in some minor cases, but the structure of the types are similar, only one general type can be defined and the differences may be supplied through parameters. </p> diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile index 99161ce68a..57233a7f6c 100644 --- a/lib/common_test/doc/src/Makefile +++ b/lib/common_test/doc/src/Makefile @@ -47,6 +47,7 @@ CT_MODULES = \ ct_snmp \ unix_telnet \ ct_slave \ + ct_property_test \ ct_netconfc CT_XML_FILES = $(CT_MODULES:=.xml) diff --git a/lib/common_test/doc/src/ref_man.xml b/lib/common_test/doc/src/ref_man.xml index 2f5c892e60..c266b70d00 100644 --- a/lib/common_test/doc/src/ref_man.xml +++ b/lib/common_test/doc/src/ref_man.xml @@ -78,6 +78,7 @@ <xi:include href="unix_telnet.xml"/> <xi:include href="ct_slave.xml"/> <xi:include href="ct_hooks.xml"/> + <xi:include href="ct_property_test.xml"/> </application> diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index e28751fb59..580d5dbd7b 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -1,7 +1,7 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2014. 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 @@ -64,7 +64,7 @@ {applications, [kernel,stdlib]}, {env, []}, {runtime_dependencies,["xmerl-1.3.7","webtool-0.8.10","tools-2.6.14", - "test_server-3.7","stdlib-2.0","ssh-3.0.1", + "test_server-3.7.1","stdlib-2.0","ssh-3.0.1", "snmp-4.25.1","sasl-2.4","runtime_tools-1.8.14", "kernel-3.0","inets-5.10","erts-6.0", "debugger-4.0","crypto-3.3","compiler-5.0"]}]}. diff --git a/lib/common_test/src/ct_property_test.erl b/lib/common_test/src/ct_property_test.erl new file mode 100644 index 0000000000..e401fef669 --- /dev/null +++ b/lib/common_test/src/ct_property_test.erl @@ -0,0 +1,178 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-2014. 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% +%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +%%% @doc EXPERIMENTAL support in common-test for calling property based tests. +%%% +%%% <p>This module is a first step towards running Property Based testing in the +%%% Common Test framework. A property testing tool like QuickCheck or PropEr is +%%% assumed to be installed.</p> +%%% +%%% <p>The idea is to have a common_test testsuite calling a property testing +%%% tool with special property test suites as defined by that tool. In this manual +%%% we assume the usual Erlang Application directory structure. The tests are +%%% collected in the application's <c>test</c> directory. The test directory +%%% has a sub-directory called <c>property_test</c> where everything needed for +%%% the property tests are collected.</p> +%%% +%%% <p>A typical ct test suite using <c>ct_property_test</c> is organized as follows: +%%% </p> +%%% ``` +%%% -include_lib("common_test/include/ct.hrl"). +%%% +%%% all() -> [prop_ftp_case]. +%%% +%%% init_per_suite(Config) -> +%%% ct_property_test:init_per_suite(Config). +%%% +%%% %%%---- test case +%%% prop_ftp_case(Config) -> +%%% ct_property_test:quickcheck( +%%% ftp_simple_client_server:prop_ftp(Config), +%%% Config +%%% ). +%%% ''' +%%% +%%% <warning> +%%% This is experimental code which may be changed or removed +%%% anytime without any warning. +%%% </warning> +%%% +%%% @end + +-module(ct_property_test). + +%% API +-export([init_per_suite/1, + quickcheck/2]). + +-include_lib("common_test/include/ct.hrl"). + +%%%----------------------------------------------------------------- +%%% @spec init_per_suite(Config) -> Config | {skip,Reason} +%%% +%%% @doc Initializes Config for property testing. +%%% +%%% <p>The function investigates if support is available for either Quickcheck or PropEr. +%%% The options <c>{property_dir,AbsPath}</c> and +%%% <c>{property_test_tool,Tool}</c> is set in the Config returned.</p> +%%% <p>The function is intended to be called in the init_per_suite in the test suite.</p> +%%% <p>The property tests are assumed to be in the subdirectory <c>property_test</c>.</p> +%%% @end + +init_per_suite(Config) -> + case which_module_exists([eqc,proper]) of + {ok,ToolModule} -> + ct:pal("Found property tester ~p",[ToolModule]), + Path = property_tests_path("property_test", Config), + case compile_tests(Path,ToolModule) of + error -> + {fail, "Property test compilation failed in "++Path}; + up_to_date -> + add_code_pathz(Path), + [{property_dir,Path}, + {property_test_tool,ToolModule} | Config] + end; + + not_found -> + ct:pal("No property tester found",[]), + {skip, "No property testing tool found"} + end. + +%%%----------------------------------------------------------------- +%%% @spec quickcheck(Property, Config) -> true | {fail,Reason} +%%% +%%% @doc Call quickcheck and return the result in a form suitable for common_test. +%%% +%%% <p>The function is intended to be called in the test cases in the test suite.</p> +%%% @end + +quickcheck(Property, Config) -> + Tool = proplists:get_value(property_test_tool,Config), + mk_ct_return( Tool:quickcheck(Property) ). + + +%%%================================================================ +%%% +%%% Local functions +%%% + +%%% Make return values back to the calling Common Test suite +mk_ct_return(true) -> + true; +mk_ct_return(Other) -> + try lists:last(hd(eqc:counterexample())) + of + {set,{var,_},{call,M,F,Args}} -> + {fail, io_lib:format("~p:~p/~p returned bad result",[M,F,length(Args)])} + catch + _:_ -> + {fail, Other} + end. + +%%% Check if a property testing tool is found +which_module_exists([Module|Modules]) -> + case module_exists(Module) of + true -> {ok,Module}; + false -> which_module_exists(Modules) + end; +which_module_exists(_) -> + not_found. + +module_exists(Module) -> + is_list(catch Module:module_info()). + +%%% The path to the property tests +property_tests_path(Dir, Config) -> + DataDir = proplists:get_value(data_dir, Config), + filename:join(lists:droplast(filename:split(DataDir))++[Dir]). + +%%% Extend the code path with Dir if it not already present +add_code_pathz(Dir) -> + case lists:member(Dir, code:get_path()) of + true -> ok; + false -> code:add_pathz(Dir) + end. + +compile_tests(Path, ToolModule) -> + MacroDefs = macro_def(ToolModule), + {ok,Cwd} = file:get_cwd(), + ok = file:set_cwd(Path), + {ok,FileNames} = file:list_dir("."), + BeamFiles = [F || F<-FileNames, + filename:extension(F) == ".beam"], + [file:delete(F) || F<-BeamFiles], + ct:pal("Compiling in ~p:~n Deleted ~p~n MacroDefs=~p",[Path,BeamFiles,MacroDefs]), + Result = make:all([load|MacroDefs]), + file:set_cwd(Cwd), + Result. + + +macro_def(eqc) -> [{d, 'EQC'}]; +macro_def(proper) -> [{d, 'PROPER'}]. + diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index def8a6a6f4..00c0925b40 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.8.1 +COMMON_TEST_VSN = 1.8.2 diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index ce40213bad..82817a987a 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -2248,23 +2248,23 @@ letify(#c_var{name=Vname}=Var, Val, Body) -> %% opt_case_in_let(LetExpr) -> LetExpr' -opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) -> - opt_case_in_let_0(Vs, Arg, B, Let). +opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> + opt_case_in_let_0(Vs, Arg, B, Let, Sub). opt_case_in_let_0([#c_var{name=V}], Arg, - #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let) -> + #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) -> case opt_case_in_let_1(V, Arg, Cs) of impossible -> case is_simple_case_arg(Arg) andalso not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of true -> - expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new()); + expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub)); false -> Let end; Expr -> Expr end; -opt_case_in_let_0(_, _, _, Let) -> Let. +opt_case_in_let_0(_, _, _, Let, _) -> Let. opt_case_in_let_1(V, Arg, Cs) -> try @@ -2607,7 +2607,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body0, effect, Sub) -> expr(#c_seq{arg=Arg,body=Body}, effect, sub_new_preserve_types(Sub)); true -> Let = Let0#c_let{vars=Vs,arg=Arg,body=Body}, - opt_case_in_let_arg(opt_case_in_let(Let), effect, Sub) + opt_case_in_let_arg(opt_case_in_let(Let, Sub), effect, Sub) end end; opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> @@ -2630,7 +2630,7 @@ opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub)); {Vs,Arg,Body} -> opt_case_in_let_arg( - opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}), + opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}, Sub), value, Sub) end. diff --git a/lib/eldap/test/README b/lib/eldap/test/README index 8774db1504..ec774c1ae3 100644 --- a/lib/eldap/test/README +++ b/lib/eldap/test/README @@ -19,7 +19,7 @@ This will however not work, since slapd is guarded by apparmor that checks that To make a local extension of alowed operations: sudo emacs /etc/apparmor.d/local/usr.sbin.slapd -and, after the change (yes, at least on Ubuntu it is right to edit ../local/.. but run with an other file) : +and, after the change (yes, at least on Ubuntu it is right to edit ../local/.. but run with another file): sudo apparmor_parser -r /etc/apparmor.d/usr.sbin.slapd diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 2e8418d61e..45c000ef76 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -761,7 +761,7 @@ int ei_close_connection(int fd) #endif /* - * Accept and initiate a connection from an other + * Accept and initiate a connection from another * Erlang node. Return a file descriptor at success, * otherwise -1; */ diff --git a/lib/erl_interface/src/legacy/erl_connect.c b/lib/erl_interface/src/legacy/erl_connect.c index ae0265a388..d70d914b79 100644 --- a/lib/erl_interface/src/legacy/erl_connect.c +++ b/lib/erl_interface/src/legacy/erl_connect.c @@ -190,7 +190,7 @@ int erl_close_connection(int fd) } /* - * Accept and initiate a connection from an other + * Accept and initiate a connection from another * Erlang node. Return a file descriptor at success, * otherwise -1; */ diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 37eb7ba718..06cb035370 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -332,7 +332,7 @@ filename() = string() <p>Defaults to <c>true</c>. </p> </item> - <tag><c><![CDATA[header_as_is]]></c></tag> + <tag><c><![CDATA[headers_as_is]]></c></tag> <item> <p>Shall the headers provided by the user be made lower case or be regarded as case sensitive. </p> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 5ae6760f08..d152d9f0be 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1793,7 +1793,7 @@ tls_tunnel_request(#request{headers = Headers, host_header(#http_request_h{host = Host}, _) -> Host; -%% Handles header_as_is +%% Handles headers_as_is host_header(_, URI) -> {ok, {_, _, Host, _, _, _}} = http_uri:parse(URI), Host. diff --git a/lib/inets/test/ftp_property_test_SUITE.erl b/lib/inets/test/ftp_property_test_SUITE.erl new file mode 100644 index 0000000000..c7077421f4 --- /dev/null +++ b/lib/inets/test/ftp_property_test_SUITE.erl @@ -0,0 +1,52 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. 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% +%% +%% + +%%% Run like this: +%%% ct:run_test([{suite,"ftp_property_test_SUITE"}, {logdir,"/ldisk/OTP/LOG"}]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(ftp_property_test_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +all() -> [prop_ftp_case]. + + +init_per_suite(Config) -> + inets:start(), + ct_property_test:init_per_suite(Config). + + +%%%---- test case +prop_ftp_case(Config) -> + ct_property_test:quickcheck( + ftp_simple_client_server:prop_ftp(Config), + Config + ). diff --git a/lib/inets/test/property_test/README b/lib/inets/test/property_test/README new file mode 100644 index 0000000000..57602bf719 --- /dev/null +++ b/lib/inets/test/property_test/README @@ -0,0 +1,12 @@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +The test in this directory are written assuming that the user has a QuickCheck license. They are to be run manually. Some may be possible to be run with other tools, e.g. PropEr. + diff --git a/lib/inets/test/property_test/ftp_simple_client_server.erl b/lib/inets/test/property_test/ftp_simple_client_server.erl new file mode 100644 index 0000000000..40e630ee5c --- /dev/null +++ b/lib/inets/test/property_test/ftp_simple_client_server.erl @@ -0,0 +1,306 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. 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(ftp_simple_client_server). + +-compile(export_all). + +-ifndef(EQC). +-ifndef(PROPER). +-define(EQC,true). +%%-define(PROPER,true). +-endif. +-endif. + + +-ifdef(EQC). + +-include_lib("eqc/include/eqc.hrl"). +-include_lib("eqc/include/eqc_statem.hrl"). +-define(MOD_eqc, eqc). +-define(MOD_eqc_gen, eqc_gen). +-define(MOD_eqc_statem, eqc_statem). + +-else. +-ifdef(PROPER). + +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc, proper). +-define(MOD_eqc_gen, proper_gen). +-define(MOD_eqc_statem, proper_statem). + +-endif. +-endif. + +-record(state, { + initialized = false, + priv_dir, + data_dir, + servers = [], % [ {IP,Port,Userid,Pwd} ] + clients = [], % [ client_ref() ] + store = [] % [ {Name,Contents} ] + }). + +-define(fmt(F,A), io:format(F,A)). +%%-define(fmt(F,A), ok). + +-define(v(K,L), proplists:get_value(K,L)). + +%%%================================================================ +%%% +%%% Properties +%%% + +%% This function is for normal eqc calls: +prop_ftp() -> + {ok,PWD} = file:get_cwd(), + prop_ftp(filename:join([PWD,?MODULE_STRING++"_data"]), + filename:join([PWD,?MODULE_STRING,"_files"])). + +%% This function is for calls from common_test test cases: +prop_ftp(Config) -> + prop_ftp(filename:join([?v(property_dir,Config), ?MODULE_STRING++"_data"]), + ?v(priv_dir,Config) ). + + +prop_ftp(DataDir, PrivDir) -> + S0 = #state{data_dir = DataDir, + priv_dir = PrivDir}, + ?FORALL(Cmds, more_commands(10,commands(?MODULE,S0)), + aggregate(command_names(Cmds), + begin {_H,S,Result} = run_commands(?MODULE,Cmds), + % io:format('**** Result=~p~n',[Result]), + % io:format('**** S=~p~n',[S]), + % io:format('**** _H=~p~n',[_H]), + % io:format('**** Cmds=~p~n',[Cmds]), + [cmnd_stop_server(X) || X <- S#state.servers], + [inets:stop(ftpc,X) || {ok,X} <- S#state.clients], + Result==ok + end) + ). + +%%%================================================================ +%%% +%%% State model +%%% + +%% @doc Returns the state in which each test case starts. (Unless a different +%% initial state is supplied explicitly to, e.g. commands/2.) +-spec initial_state() ->?MOD_eqc_statem:symbolic_state(). +initial_state() -> + ?fmt("Initial_state()~n",[]), + #state{}. + +%% @doc Command generator, S is the current state +-spec command(S :: ?MOD_eqc_statem:symbolic_state()) -> ?MOD_eqc_gen:gen(eqc_statem:call()). + +command(#state{initialized=false, + priv_dir=PrivDir}) -> + {call,?MODULE,cmnd_init,[PrivDir]}; + +command(#state{servers=[], + priv_dir=PrivDir, + data_dir=DataDir}) -> + {call,?MODULE,cmnd_start_server,[PrivDir,DataDir]}; + +command(#state{servers=Ss=[_|_], + clients=[]}) -> + {call,?MODULE,cmnd_start_client,[oneof(Ss)]}; + +command(#state{servers=Ss=[_|_], + clients=Cs=[_|_], + store=Store=[_|_] + }) -> + frequency([ + { 5, {call,?MODULE,cmnd_start_client,[oneof(Ss)]}}, + { 5, {call,?MODULE,cmnd_stop_client,[oneof(Cs)]}}, + {10, {call,?MODULE,cmnd_put,[oneof(Cs),file_path(),file_contents()]}}, + {20, {call,?MODULE,cmnd_get,[oneof(Cs),oneof(Store)]}}, + {10, {call,?MODULE,cmnd_delete,[oneof(Cs),oneof(Store)]}} + ]); + +command(#state{servers=Ss=[_|_], + clients=Cs=[_|_], + store=[] + }) -> + frequency([ + {5, {call,?MODULE,cmnd_start_client,[oneof(Ss)]}}, + {5, {call,?MODULE,cmnd_stop_client,[oneof(Cs)]}}, + {10, {call,?MODULE,cmnd_put,[oneof(Cs),file_path(),file_contents()]}} + ]). + +%% @doc Precondition, checked before command is added to the command sequence. +-spec precondition(S :: ?MOD_eqc_statem:symbolic_state(), C :: ?MOD_eqc_statem:call()) -> boolean(). + +precondition(#state{clients=Cs}, {call, _, cmnd_put, [C,_,_]}) -> lists:member(C,Cs); + +precondition(#state{clients=Cs, store=Store}, + {call, _, cmnd_get, [C,X]}) -> lists:member(C,Cs) andalso lists:member(X,Store); + +precondition(#state{clients=Cs, store=Store}, + {call, _, cmnd_delete, [C,X]}) -> lists:member(C,Cs) andalso lists:member(X,Store); + +precondition(#state{servers=Ss}, {call, _, cmnd_start_client, _}) -> Ss =/= []; + +precondition(#state{clients=Cs}, {call, _, cmnd_stop_client, [C]}) -> lists:member(C,Cs); + +precondition(#state{initialized=IsInit}, {call, _, cmnd_init, _}) -> IsInit==false; + +precondition(_S, {call, _, _, _}) -> true. + + +%% @doc Postcondition, checked after command has been evaluated +%% Note: S is the state before next_state(S,_,C) +-spec postcondition(S :: ?MOD_eqc_statem:dynamic_state(), C :: ?MOD_eqc_statem:call(), + Res :: term()) -> boolean(). + +postcondition(_S, {call, _, cmnd_get, [_,{_Name,Expected}]}, {ok,Value}) -> + Value == Expected; + +postcondition(S, {call, _, cmnd_delete, [_,{Name,_Expected}]}, ok) -> + ?fmt("file:read_file(..) = ~p~n",[file:read_file(filename:join(S#state.priv_dir,Name))]), + {error,enoent} == file:read_file(filename:join(S#state.priv_dir,Name)); + +postcondition(S, {call, _, cmnd_put, [_,Name,Value]}, ok) -> + {ok,Bin} = file:read_file(filename:join(S#state.priv_dir,Name)), + Bin == unicode:characters_to_binary(Value); + +postcondition(_S, {call, _, cmnd_stop_client, _}, ok) -> true; + +postcondition(_S, {call, _, cmnd_start_client, _}, {ok,_}) -> true; + +postcondition(_S, {call, _, cmnd_init, _}, ok) -> true; + +postcondition(_S, {call, _, cmnd_start_server, _}, {ok,_}) -> true. + + +%% @doc Next state transformation, S is the current state. Returns next state. +-spec next_state(S :: ?MOD_eqc_statem:symbolic_state(), + V :: ?MOD_eqc_statem:var(), + C :: ?MOD_eqc_statem:call()) -> ?MOD_eqc_statem:symbolic_state(). + +next_state(S, _V, {call, _, cmnd_put, [_,Name,Val]}) -> + S#state{store = [{Name,Val} | lists:keydelete(Name,1,S#state.store)]}; + +next_state(S, _V, {call, _, cmnd_delete, [_,{Name,_Val}]}) -> + S#state{store = lists:keydelete(Name,1,S#state.store)}; + +next_state(S, V, {call, _, cmnd_start_client, _}) -> + S#state{clients = [V | S#state.clients]}; + +next_state(S, V, {call, _, cmnd_start_server, _}) -> + S#state{servers = [V | S#state.servers]}; + +next_state(S, _V, {call, _, cmnd_stop_client, [C]}) -> + S#state{clients = S#state.clients -- [C]}; + +next_state(S, _V, {call, _, cmnd_init, _}) -> + S#state{initialized=true}; + +next_state(S, _V, {call, _, _, _}) -> + S. + +%%%================================================================ +%%% +%%% Data model +%%% + +file_path() -> non_empty(list(alphanum_char())). +%%file_path() -> non_empty( list(oneof([alphanum_char(), utf8_char()])) ). + +%%file_contents() -> list(alphanum_char()). +file_contents() -> list(oneof([alphanum_char(), utf8_char()])). + +alphanum_char() -> oneof(lists:seq($a,$z) ++ lists:seq($A,$Z) ++ lists:seq($0,$9)). + +utf8_char() -> oneof("åäöÅÄÖ話话カタカナひらがな"). + +%%%================================================================ +%%% +%%% Commands doing something with the System Under Test +%%% + +cmnd_init(PrivDir) -> + ?fmt('Call cmnd_init(~p)~n',[PrivDir]), + os:cmd("killall vsftpd"), + clear_files(PrivDir), + ok. + +cmnd_start_server(PrivDir, DataDir) -> + ?fmt('Call cmnd_start_server(~p, ~p)~n',[PrivDir,DataDir]), + Cmnd = ["vsftpd ", filename:join(DataDir,"vsftpd.conf"), + " -oftpd_banner=erlang_otp_testing" + " -oanon_root=",PrivDir + ], + ?fmt("Cmnd=~s~n",[Cmnd]), + case os:cmd(Cmnd) of + [] -> + {ok,{"localhost",9999,"ftp","[email protected]"}}; + Other -> + {error,Other} + end. + +cmnd_stop_server({ok,{_Host,Port,_Usr,_Pwd}}) -> + os:cmd("kill `netstat -tpln | grep "++integer_to_list(Port)++" | awk '{print $7}' | awk -F/ '{print $1}'`"). + +cmnd_start_client({ok,{Host,Port,Usr,Pwd}}) -> + ?fmt('Call cmnd_start_client(~p)...',[{Host,Port,Usr,Pwd}]), + case inets:start(ftpc, [{host,Host},{port,Port}]) of + {ok,Client} -> + ?fmt("~p...",[{ok,Client}]), + case ftp:user(Client, Usr, Pwd) of + ok -> + ?fmt("OK!~n",[]), + {ok,Client}; + Other -> + ?fmt("Other1=~p~n",[Other]), + inets:stop(ftpc,Client), Other + end; + Other -> + ?fmt("Other2=~p~n",[Other]), + Other + end. + +cmnd_stop_client({ok,Client}) -> + ?fmt('Call cmnd_stop_client(~p)~n',[Client]), + inets:stop(ftpc, Client). %% -> ok | Other + +cmnd_delete({ok,Client}, {Name,_ExpectedValue}) -> + ?fmt('Call cmnd_delete(~p, ~p)~n',[Client,Name]), + R=ftp:delete(Client, Name), + ?fmt("R=~p~n",[R]), + R. + +cmnd_put({ok,Client}, Name, Value) -> + ?fmt('Call cmnd_put(~p, ~p, ~p)...',[Client, Name, Value]), + R = ftp:send_bin(Client, unicode:characters_to_binary(Value), Name), % ok | {error,Error} + ?fmt('~p~n',[R]), + R. + +cmnd_get({ok,Client}, {Name,_ExpectedValue}) -> + ?fmt('Call cmnd_get(~p, ~p)~n',[Client,Name]), + case ftp:recv_bin(Client, Name) of + {ok,Bin} -> {ok, unicode:characters_to_list(Bin)}; + Other -> Other + end. + + +clear_files(Dir) -> + os:cmd(["rm -fr ",filename:join(Dir,"*")]). diff --git a/lib/inets/test/property_test/ftp_simple_client_server_data/vsftpd.conf b/lib/inets/test/property_test/ftp_simple_client_server_data/vsftpd.conf new file mode 100644 index 0000000000..fd48e2abf0 --- /dev/null +++ b/lib/inets/test/property_test/ftp_simple_client_server_data/vsftpd.conf @@ -0,0 +1,26 @@ + +### +### Some parameters are given in the vsftpd start command. +### +### Typical command-line paramters are such that has a file path +### component like cert files. +### + + +listen=YES +listen_port=9999 +run_as_launching_user=YES +ssl_enable=NO +#allow_anon_ssl=YES + +background=YES + +write_enable=YES +anonymous_enable=YES +anon_upload_enable=YES +anon_mkdir_write_enable=YES +anon_other_write_enable=YES +anon_world_readable_only=NO + +### Shouldn't be necessary.... +require_ssl_reuse=NO diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 79081f371c..029f6ac4d2 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.10.2 +INETS_VSN = 5.10.3 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 2df4bf7c95..4e4aeb67e2 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -882,7 +882,7 @@ passive_sockets_server_send(Socket, X) -> accept_closed_by_other_process(doc) -> ["Tests the return value from gen_tcp:accept when ", - "the socket is closed from an other process. (OTP-3817)"]; + "the socket is closed from another process. (OTP-3817)"]; accept_closed_by_other_process(Config) when is_list(Config) -> ?line Parent = self(), ?line {ok, ListenSocket} = gen_tcp:listen(0, []), diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index 08212dfede..df2c27afba 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -38,7 +38,23 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.12.1</title> + <section><title>Mnesia 4.12.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a race which could make create_table fail if a node + was going down during the transaction.</p> + <p> + Own Id: OTP-12124 Aux Id: seq12694 </p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.12.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index fe2fd67d71..5a9bae54da 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -300,8 +300,13 @@ mnesia_down(Node) -> end. wait_for_schema_commit_lock() -> - link(whereis(?SERVER_NAME)), - unsafe_call(wait_for_schema_commit_lock). + try + Pid = whereis(?SERVER_NAME), + link(Pid), %% Keep the link until release_schema_commit_lock + gen_server:call(Pid, wait_for_schema_commit_lock, infinity) + catch _:_ -> + mnesia:abort({node_not_running, node()}) + end. block_controller() -> call(block_controller). @@ -557,12 +562,6 @@ cast(Msg) -> abcast(Nodes, Msg) -> gen_server:abcast(Nodes, ?SERVER_NAME, Msg). -unsafe_call(Msg) -> - case whereis(?SERVER_NAME) of - undefined -> {error, {node_not_running, node()}}; - Pid -> gen_server:call(Pid, Msg, infinity) - end. - call(Msg) -> case whereis(?SERVER_NAME) of undefined -> diff --git a/lib/mnesia/src/mnesia_frag.erl b/lib/mnesia/src/mnesia_frag.erl index 4a1616e054..66fc20913c 100644 --- a/lib/mnesia/src/mnesia_frag.erl +++ b/lib/mnesia/src/mnesia_frag.erl @@ -939,7 +939,7 @@ do_split(_FH, _OldN, _FragNames, [], Ops) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Delete a fragment from a fragmented table -%% and merge its records with an other fragment +%% and merge its records with another fragment make_multi_del_frag(Tab) -> verify_multi(Tab), diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index 173c46898b..d16d501103 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.12.1 +MNESIA_VSN = 4.12.2 diff --git a/lib/odbc/doc/src/error_handling.xml b/lib/odbc/doc/src/error_handling.xml index b255865263..0b6179409d 100644 --- a/lib/odbc/doc/src/error_handling.xml +++ b/lib/odbc/doc/src/error_handling.xml @@ -88,7 +88,7 @@ <section> <title>The whole picture </title> <p>As the Erlang ODBC application relies on third party products - and communicates with a database that probably runs on an other + and communicates with a database that probably runs on another computer in the network there are plenty of things that might go wrong. To fully understand the things that might happen it facilitate to know the design of the Erlang ODBC application, diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index 2a16388929..1907069726 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-2014. 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 @@ -47,7 +47,7 @@ all() -> case odbc_test_lib:odbc_check() of ok -> [not_exist_db, commit, rollback, not_explicit_commit, - no_c_node, port_dies, control_process_dies, + no_c_executable, port_dies, control_process_dies, {group, client_dies}, connect_timeout, timeout, many_timeouts, timeout_reset, disconnect_on_timeout, connection_closed, disable_scrollable_cursors, @@ -248,28 +248,31 @@ not_exist_db(_Config) -> test_server:sleep(100). %%------------------------------------------------------------------------- -no_c_node(doc) -> +no_c_executable(doc) -> "Test what happens if the port-program can not be found"; -no_c_node(suite) -> []; -no_c_node(_Config) -> +no_c_executable(suite) -> []; +no_c_executable(_Config) -> process_flag(trap_exit, true), Dir = filename:nativename(filename:join(code:priv_dir(odbc), "bin")), FileName1 = filename:nativename(os:find_executable("odbcserver", Dir)), FileName2 = filename:nativename(filename:join(Dir, "odbcsrv")), - ok = file:rename(FileName1, FileName2), - Result = - case catch odbc:connect(?RDBMS:connection_string(), - odbc_test_lib:platform_options()) of - {error, port_program_executable_not_found} -> - ok; - Else -> - Else - end, - - ok = file:rename(FileName2, FileName1), - ok = Result. + case file:rename(FileName1, FileName2) of + ok -> + Result = + case catch odbc:connect(?RDBMS:connection_string(), + odbc_test_lib:platform_options()) of + {error, port_program_executable_not_found} -> + ok; + Else -> + Else + end, + ok = file:rename(FileName2, FileName1), + ok = Result; + _ -> + {skip, "File permission issues"} + end. %%------------------------------------------------------------------------ port_dies(doc) -> diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index f8011cd5c0..88b1a9248e 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -92,7 +92,7 @@ not_encrypted | cipher_info()}</code></p> <p><code>cipher_info() = {"RC2-CBC | "DES-CBC" | "DES-EDE3-CBC", - crypto:rand_bytes(8)} | 'PBES2-params'}</code></p> + crypto:rand_bytes(8) | {#'PBEParameter{}, digest_type()} |#'PBES2-params'{}}</code></p> <p><code>public_key() = rsa_public_key() | dsa_public_key() | ec_public_key()</code></p> <p><code>private_key() = rsa_private_key() | dsa_private_key() | ec_private_key()</code></p> @@ -113,6 +113,8 @@ <p><code>rsa_padding() = 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | 'rsa_no_padding'</code></p> + + <p><code>digest_type() - Union of below digest types</code></p> <p><code>rsa_digest_type() = 'md5' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</code></p> @@ -499,7 +501,7 @@ fun(OtpCert :: #'OTPCertificate'{}, <fsummary> Performs CRL validation.</fsummary> <type> <v> OTPCertificate = #'OTPCertificate'{}</v> - <v> DPAndCRLs = [{DP::#'DistributionPoint'{} ,CRL::#'CertificateList'{}}] </v> + <v> DPAndCRLs = [{DP::#'DistributionPoint'{}, {DerCRL::der_encoded(), CRL::#'CertificateList'{}}}] </v> <v> Options = proplists:proplist()</v> <v> CRLStatus() = valid | {bad_cert, revocation_status_undetermined} | {bad_cert, {revoked, crl_reason()}}</v> diff --git a/lib/public_key/src/pubkey_pem.erl b/lib/public_key/src/pubkey_pem.erl index 8d2e97ad77..98881c4a6a 100644 --- a/lib/public_key/src/pubkey_pem.erl +++ b/lib/public_key/src/pubkey_pem.erl @@ -68,7 +68,8 @@ encode(PemEntries) -> %%-------------------------------------------------------------------- -spec decipher({public_key:pki_asn1_type(), DerEncrypted::binary(), - {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{}}}, + {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{} + | {#'PBEParameter'{}, atom()}}}, string()) -> Der::binary(). %% %% Description: Deciphers a decrypted pem entry. @@ -77,7 +78,8 @@ decipher({_, DecryptDer, {Cipher, KeyDevParams}}, Password) -> pubkey_pbe:decode(DecryptDer, Password, Cipher, KeyDevParams). %%-------------------------------------------------------------------- --spec cipher(Der::binary(), {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{}} , +-spec cipher(Der::binary(), {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{} + | {#'PBEParameter'{}, atom()}}, string()) -> binary(). %% %% Description: Ciphers a PEM entry diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index bbe54ad4e1..1bbf4ef416 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -64,9 +64,15 @@ -type der_encoded() :: binary(). -type pki_asn1_type() :: 'Certificate' | 'RSAPrivateKey' | 'RSAPublicKey' | 'DSAPrivateKey' | 'DSAPublicKey' | 'DHParameter' - | 'SubjectPublicKeyInfo' | 'CertificationRequest' | 'CertificateList'. --type pem_entry() :: {pki_asn1_type(), binary(), %% DER or Encrypted DER - not_encrypted | {Cipher :: string(), Salt :: binary()}}. + | 'SubjectPublicKeyInfo' | 'PrivateKeyInfo' | + 'CertificationRequest' | 'CertificateList' | + 'ECPrivateKey' | 'EcpkParameters'. +-type pem_entry() :: {pki_asn1_type(), + binary(), %% DER or Encrypted DER + not_encrypted | {Cipher :: string(), Salt :: binary()} | + {Cipher :: string(), #'PBES2-params'{}} | + {Cipher :: string(), {#'PBEParameter'{}, atom()}} %% hash type + }. -type asn1_type() :: atom(). %% see "OTP-PUB-KEY.hrl -type ssh_file() :: openssh_public_key | rfc4716_public_key | known_hosts | auth_keys. @@ -134,9 +140,9 @@ pem_entry_decode({Asn1Type, CryptDer, {Cipher, #'PBES2-params'{}}} = PemEntry, is_list(Cipher) -> do_pem_entry_decode(PemEntry, Password); pem_entry_decode({Asn1Type, CryptDer, {Cipher, {#'PBEParameter'{},_}}} = PemEntry, - Password) when is_atom(Asn1Type) andalso - is_binary(CryptDer) andalso - is_list(Cipher) -> + Password) when is_atom(Asn1Type) andalso + is_binary(CryptDer) andalso + is_list(Cipher) -> do_pem_entry_decode(PemEntry, Password); pem_entry_decode({Asn1Type, CryptDer, {Cipher, Salt}} = PemEntry, Password) when is_atom(Asn1Type) andalso @@ -174,10 +180,10 @@ pem_entry_encode(Asn1Type, Entity, {{Cipher, #'PBES2-params'{}} = CipherInfo, is_list(Cipher) -> do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password); pem_entry_encode(Asn1Type, Entity, {{Cipher, - {#'PBEParameter'{}, _}} = CipherInfo, - Password}) when is_atom(Asn1Type) andalso - is_list(Password) andalso - is_list(Cipher) -> + {#'PBEParameter'{}, _}} = CipherInfo, + Password}) when is_atom(Asn1Type) andalso + is_list(Password) andalso + is_list(Cipher) -> do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password); pem_entry_encode(Asn1Type, Entity, {{Cipher, Salt} = CipherInfo, Password}) when is_atom(Asn1Type) andalso @@ -620,11 +626,11 @@ pkix_path_validation(#'OTPCertificate'{} = TrustedCert, CertChain, Options) %-------------------------------------------------------------------- -spec pkix_crls_validate(#'OTPCertificate'{}, - [{DP::#'DistributionPoint'{} ,CRL::#'CertificateList'{}}], + [{DP::#'DistributionPoint'{}, {DerCRL::binary(), CRL::#'CertificateList'{}}}], Options :: proplists:proplist()) -> valid | {bad_cert, revocation_status_undetermined} | {bad_cert, {revoked, crl_reason()}}. -%% Description: Performs a basic path validation according to RFC 5280. +%% Description: Performs a CRL validation according to RFC 5280. %%-------------------------------------------------------------------- pkix_crls_validate(OtpCert, [{_,_,_} |_] = DPAndCRLs, Options) -> pkix_crls_validate(OtpCert, DPAndCRLs, DPAndCRLs, diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 876eba598a..9f5d1c003d 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -36,8 +36,8 @@ <list type="bulleted"> <item>SSH requires the crypto and public_key applications.</item> <item>Supported SSH version is 2.0 </item> - <item>Supported MAC algorithms: hmac-sha1</item> - <item>Supported encryption algorithms: aes128-cb and 3des-cbc</item> + <item>Supported MAC algorithms: hmac-sha2-256 and hmac-sha1</item> + <item>Supported encryption algorithms: aes128-ctr, aes128-cb and 3des-cbc</item> <item>Supports unicode filenames if the emulator and the underlaying OS supports it. See the DESCRIPTION section in <seealso marker="kernel:file">file</seealso> for information about this subject</item> <item>Supports unicode in shell and cli</item> </list> diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 743c01a42c..8a8d4bb89e 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -392,7 +392,8 @@ handle_ssh_option({compression, Value} = Opt) when is_atom(Value) -> Opt; handle_ssh_option({exec, {Module, Function, _}} = Opt) when is_atom(Module), is_atom(Function) -> - + Opt; +handle_ssh_option({exec, Function} = Opt) when is_function(Function) -> Opt; handle_ssh_option({auth_methods, Value} = Opt) when is_list(Value) -> Opt; diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index 77453e8fd7..18841e3d2d 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -457,17 +457,17 @@ bin_to_list(I) when is_integer(I) -> start_shell(ConnectionHandler, State) -> Shell = State#state.shell, - ConnectionInfo = ssh_connection_handler:info(ConnectionHandler, + ConnectionInfo = ssh_connection_handler:connection_info(ConnectionHandler, [peer, user]), ShellFun = case is_function(Shell) of true -> - {ok, User} = + User = proplists:get_value(user, ConnectionInfo), case erlang:fun_info(Shell, arity) of {arity, 1} -> fun() -> Shell(User) end; {arity, 2} -> - [{_, PeerAddr}] = + {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo), fun() -> Shell(User, PeerAddr) end; _ -> @@ -485,9 +485,9 @@ start_shell(_ConnectionHandler, Cmd, #state{exec={M, F, A}} = State) -> State#state{group = Group, buf = empty_buf()}; start_shell(ConnectionHandler, Cmd, #state{exec=Shell} = State) when is_function(Shell) -> - ConnectionInfo = ssh_connection_handler:info(ConnectionHandler, + ConnectionInfo = ssh_connection_handler:connection_info(ConnectionHandler, [peer, user]), - {ok, User} = + User = proplists:get_value(user, ConnectionInfo), ShellFun = case erlang:fun_info(Shell, arity) of @@ -496,7 +496,7 @@ start_shell(ConnectionHandler, Cmd, #state{exec=Shell} = State) when is_function {arity, 2} -> fun() -> Shell(Cmd, User) end; {arity, 3} -> - [{_, PeerAddr}] = + {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo), fun() -> Shell(Cmd, User, PeerAddr) end; _ -> diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index b377614949..33849f4527 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -782,9 +782,8 @@ handle_cli_msg(#connection{channel_cache = Cache} = Connection, erlang:monitor(process, Pid), Channel = Channel0#channel{user = Pid}, ssh_channel:cache_update(Cache, Channel), - Reply = {connection_reply, - channel_success_msg(RemoteId)}, - {{replies, [{channel_data, Pid, Reply0}, Reply]}, Connection}; + {Reply, Connection1} = reply_msg(Channel, Connection, Reply0), + {{replies, [Reply]}, Connection1}; _Other -> Reply = {connection_reply, channel_failure_msg(RemoteId)}, diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 27723dc870..ea05c849b7 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -113,15 +113,28 @@ key_init(client, Ssh, Value) -> key_init(server, Ssh, Value) -> Ssh#ssh{s_keyinit = Value}. +available_ssh_algos() -> + Supports = crypto:supports(), + CipherAlgos = [{aes_ctr, "aes128-ctr"}, {aes_cbc128, "aes128-cbc"}, {des3_cbc, "3des-cbc"}], + Ciphers = [SshAlgo || + {CryptoAlgo, SshAlgo} <- CipherAlgos, + lists:member(CryptoAlgo, proplists:get_value(ciphers, Supports, []))], + HashAlgos = [{sha256, "hmac-sha2-256"}, {sha, "hmac-sha1"}], + Hashs = [SshAlgo || + {CryptoAlgo, SshAlgo} <- HashAlgos, + lists:member(CryptoAlgo, proplists:get_value(hashs, Supports, []))], + {Ciphers, Hashs}. + kexinit_messsage(client, Random, Compression, HostKeyAlgs) -> + {CipherAlgs, HashAlgs} = available_ssh_algos(), #ssh_msg_kexinit{ cookie = Random, kex_algorithms = ["diffie-hellman-group1-sha1"], server_host_key_algorithms = HostKeyAlgs, - encryption_algorithms_client_to_server = ["aes128-cbc","3des-cbc"], - encryption_algorithms_server_to_client = ["aes128-cbc","3des-cbc"], - mac_algorithms_client_to_server = ["hmac-sha1"], - mac_algorithms_server_to_client = ["hmac-sha1"], + encryption_algorithms_client_to_server = CipherAlgs, + encryption_algorithms_server_to_client = CipherAlgs, + mac_algorithms_client_to_server = HashAlgs, + mac_algorithms_server_to_client = HashAlgs, compression_algorithms_client_to_server = Compression, compression_algorithms_server_to_client = Compression, languages_client_to_server = [], @@ -129,14 +142,15 @@ kexinit_messsage(client, Random, Compression, HostKeyAlgs) -> }; kexinit_messsage(server, Random, Compression, HostKeyAlgs) -> + {CipherAlgs, HashAlgs} = available_ssh_algos(), #ssh_msg_kexinit{ cookie = Random, kex_algorithms = ["diffie-hellman-group1-sha1"], server_host_key_algorithms = HostKeyAlgs, - encryption_algorithms_client_to_server = ["aes128-cbc","3des-cbc"], - encryption_algorithms_server_to_client = ["aes128-cbc","3des-cbc"], - mac_algorithms_client_to_server = ["hmac-sha1"], - mac_algorithms_server_to_client = ["hmac-sha1"], + encryption_algorithms_client_to_server = CipherAlgs, + encryption_algorithms_server_to_client = CipherAlgs, + mac_algorithms_client_to_server = HashAlgs, + mac_algorithms_server_to_client = HashAlgs, compression_algorithms_client_to_server = Compression, compression_algorithms_server_to_client = Compression, languages_client_to_server = [], @@ -636,7 +650,21 @@ encrypt_init(#ssh{encrypt = 'aes128-cbc', role = server} = Ssh) -> <<K:16/binary>> = hash(Ssh, "D", 128), {ok, Ssh#ssh{encrypt_keys = K, encrypt_block_size = 16, - encrypt_ctx = IV}}. + encrypt_ctx = IV}}; +encrypt_init(#ssh{encrypt = 'aes128-ctr', role = client} = Ssh) -> + IV = hash(Ssh, "A", 128), + <<K:16/binary>> = hash(Ssh, "C", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{encrypt_keys = K, + encrypt_block_size = 16, + encrypt_ctx = State}}; +encrypt_init(#ssh{encrypt = 'aes128-ctr', role = server} = Ssh) -> + IV = hash(Ssh, "B", 128), + <<K:16/binary>> = hash(Ssh, "D", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{encrypt_keys = K, + encrypt_block_size = 16, + encrypt_ctx = State}}. encrypt_final(Ssh) -> {ok, Ssh#ssh{encrypt = none, @@ -658,7 +686,11 @@ encrypt(#ssh{encrypt = 'aes128-cbc', encrypt_ctx = IV0} = Ssh, Data) -> Enc = crypto:block_encrypt(aes_cbc128, K,IV0,Data), IV = crypto:next_iv(aes_cbc, Enc), - {Ssh#ssh{encrypt_ctx = IV}, Enc}. + {Ssh#ssh{encrypt_ctx = IV}, Enc}; +encrypt(#ssh{encrypt = 'aes128-ctr', + encrypt_ctx = State0} = Ssh, Data) -> + {State, Enc} = crypto:stream_encrypt(State0,Data), + {Ssh#ssh{encrypt_ctx = State}, Enc}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -690,7 +722,21 @@ decrypt_init(#ssh{decrypt = 'aes128-cbc', role = server} = Ssh) -> hash(Ssh, "C", 128)}, <<K:16/binary>> = KD, {ok, Ssh#ssh{decrypt_keys = K, decrypt_ctx = IV, - decrypt_block_size = 16}}. + decrypt_block_size = 16}}; +decrypt_init(#ssh{decrypt = 'aes128-ctr', role = client} = Ssh) -> + IV = hash(Ssh, "B", 128), + <<K:16/binary>> = hash(Ssh, "D", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{decrypt_keys = K, + decrypt_block_size = 16, + decrypt_ctx = State}}; +decrypt_init(#ssh{decrypt = 'aes128-ctr', role = server} = Ssh) -> + IV = hash(Ssh, "A", 128), + <<K:16/binary>> = hash(Ssh, "C", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{decrypt_keys = K, + decrypt_block_size = 16, + decrypt_ctx = State}}. decrypt_final(Ssh) -> @@ -711,7 +757,11 @@ decrypt(#ssh{decrypt = 'aes128-cbc', decrypt_keys = Key, decrypt_ctx = IV0} = Ssh, Data) -> Dec = crypto:block_decrypt(aes_cbc128, Key,IV0,Data), IV = crypto:next_iv(aes_cbc, Data), - {Ssh#ssh{decrypt_ctx = IV}, Dec}. + {Ssh#ssh{decrypt_ctx = IV}, Dec}; +decrypt(#ssh{decrypt = 'aes128-ctr', + decrypt_ctx = State0} = Ssh, Data) -> + {State, Enc} = crypto:stream_decrypt(State0,Data), + {Ssh#ssh{decrypt_ctx = State}, Enc}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Compression @@ -846,7 +896,9 @@ mac('hmac-sha1-96', Key, SeqNum, Data) -> mac('hmac-md5', Key, SeqNum, Data) -> crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data]); mac('hmac-md5-96', Key, SeqNum, Data) -> - crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-md5-96')). + crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-md5-96')); +mac('hmac-sha2-256', Key, SeqNum, Data) -> + crypto:hmac(sha256, Key, [<<?UINT32(SeqNum)>>, Data]). %% return N hash bytes (HASH) hash(SSH, Char, Bits) -> @@ -911,12 +963,14 @@ mac_key_size('hmac-sha1') -> 20*8; mac_key_size('hmac-sha1-96') -> 20*8; mac_key_size('hmac-md5') -> 16*8; mac_key_size('hmac-md5-96') -> 16*8; +mac_key_size('hmac-sha2-256')-> 32*8; mac_key_size(none) -> 0. mac_digest_size('hmac-sha1') -> 20; mac_digest_size('hmac-sha1-96') -> 12; mac_digest_size('hmac-md5') -> 20; mac_digest_size('hmac-md5-96') -> 12; +mac_digest_size('hmac-sha2-256') -> 32; mac_digest_size(none) -> 0. peer_name({Host, _}) -> diff --git a/lib/ssh/test/property_test/README b/lib/ssh/test/property_test/README new file mode 100644 index 0000000000..57602bf719 --- /dev/null +++ b/lib/ssh/test/property_test/README @@ -0,0 +1,12 @@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +The test in this directory are written assuming that the user has a QuickCheck license. They are to be run manually. Some may be possible to be run with other tools, e.g. PropEr. + diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server.erl b/lib/ssh/test/property_test/ssh_eqc_client_server.erl new file mode 100644 index 0000000000..3a84acebb3 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server.erl @@ -0,0 +1,602 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. 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_eqc_client_server). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +-ifdef(PROPER). +%% Proper is not supported. +-else. + +-include_lib("eqc/include/eqc.hrl"). +-include_lib("eqc/include/eqc_statem.hrl"). +-eqc_group_commands(true). + +-define(SSH_DIR,"ssh_eqc_client_server_dirs"). + +-define(sec, *1000). +-define(min, *60?sec). + +-record(srvr,{ref, + address, + port + }). + +-record(conn,{ref, + srvr_ref + }). + +-record(chan, {ref, + conn_ref, + subsystem, + client_pid + }). + +-record(state,{ + initialized = false, + servers = [], % [#srvr{}] + clients = [], + connections = [], % [#conn{}] + channels = [], % [#chan{}] + data_dir + }). + +%%%=============================================================== +%%% +%%% Specification of addresses, subsystems and such. +%%% + +-define(MAX_NUM_SERVERS, 3). +-define(MAX_NUM_CLIENTS, 3). + +-define(SUBSYSTEMS, ["echo1", "echo2", "echo3", "echo4"]). + +-define(SERVER_ADDRESS, { {127,1,1,1}, inet_port({127,1,1,1}) }). + +-define(SERVER_EXTRA_OPTIONS, [{parallel_login,bool()}] ). + + +%%%================================================================ +%%% +%%% The properties - one sequantial and one parallel with the same model +%%% +%%% Run as +%%% +%%% $ (cd ..; make) +%%% $ erl -pz .. +%%% +%%% eqc:quickcheck( ssh_eqc_client_server:prop_seq() ). +%%% eqc:quickcheck( ssh_eqc_client_server:prop_parallel() ). +%%% eqc:quickcheck( ssh_eqc_client_server:prop_parallel_multi() ). +%%% + + +%% To be called as eqc:quickcheck( ssh_eqc_client_server:prop_seq() ). +prop_seq() -> + do_prop_seq(?SSH_DIR). + +%% To be called from a common_test test suite +prop_seq(CT_Config) -> + do_prop_seq(full_path(?SSH_DIR, CT_Config)). + + +do_prop_seq(DataDir) -> + ?FORALL(Cmds,commands(?MODULE, #state{data_dir=DataDir}), + begin + {H,Sf,Result} = run_commands(?MODULE,Cmds), + present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) + end). + +full_path(SSHdir, CT_Config) -> + filename:join(proplists:get_value(property_dir, CT_Config), + SSHdir). +%%%---- +prop_parallel() -> + do_prop_parallel(?SSH_DIR). + +%% To be called from a common_test test suite +prop_parallel(CT_Config) -> + do_prop_parallel(full_path(?SSH_DIR, CT_Config)). + +do_prop_parallel(DataDir) -> + ?FORALL(Cmds,parallel_commands(?MODULE, #state{data_dir=DataDir}), + begin + {H,Sf,Result} = run_parallel_commands(?MODULE,Cmds), + present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) + end). + +%%%---- +prop_parallel_multi() -> + do_prop_parallel_multi(?SSH_DIR). + +%% To be called from a common_test test suite +prop_parallel_multi(CT_Config) -> + do_prop_parallel_multi(full_path(?SSH_DIR, CT_Config)). + +do_prop_parallel_multi(DataDir) -> + ?FORALL(Repetitions,?SHRINK(1,[10]), + ?FORALL(Cmds,parallel_commands(?MODULE, #state{data_dir=DataDir}), + ?ALWAYS(Repetitions, + begin + {H,Sf,Result} = run_parallel_commands(?MODULE,Cmds), + present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) + end))). + +%%%================================================================ +%%% State machine spec + +%%% called when using commands/1 +initial_state() -> + S = initial_state(#state{}), + S#state{initialized=true}. + +%%% called when using commands/2 +initial_state(S) -> + application:stop(ssh), + ssh:start(), + setup_rsa(S#state.data_dir). + +%%%---------------- +weight(S, ssh_send) -> 5*length([C || C<-S#state.channels, has_subsyst(C)]); +weight(S, ssh_start_subsyst) -> 3*length([C || C<-S#state.channels, no_subsyst(C)]); +weight(S, ssh_close_channel) -> 2*length([C || C<-S#state.channels, has_subsyst(C)]); +weight(S, ssh_open_channel) -> length(S#state.connections); +weight(_S, _) -> 1. + +%%%---------------- +%%% Initialize + +initial_state_pre(S) -> not S#state.initialized. + +initial_state_args(S) -> [S]. + +initial_state_next(S, _, _) -> S#state{initialized=true}. + +%%%---------------- +%%% Start a new daemon +%%% Precondition: not more than ?MAX_NUM_SERVERS started + +ssh_server_pre(S) -> S#state.initialized andalso + length(S#state.servers) < ?MAX_NUM_SERVERS. + +ssh_server_args(S) -> [?SERVER_ADDRESS, S#state.data_dir, ?SERVER_EXTRA_OPTIONS]. + +ssh_server({IP,Port}, DataDir, ExtraOptions) -> + ok(ssh:daemon(IP, Port, + [ + {system_dir, system_dir(DataDir)}, + {user_dir, user_dir(DataDir)}, + {subsystems, [{SS, {ssh_eqc_subsys, [SS]}} || SS <- ?SUBSYSTEMS]} + | ExtraOptions + ])). + +ssh_server_post(_S, _Args, Result) -> is_ok(Result). + +ssh_server_next(S, Result, [{IP,Port},_,_]) -> + S#state{servers=[#srvr{ref = Result, + address = IP, + port = Port} + | S#state.servers]}. + +%%%---------------- +%%% Start a new client +%%% Precondition: not more than ?MAX_NUM_CLIENTS started + +ssh_client_pre(S) -> S#state.initialized andalso + length(S#state.clients) < ?MAX_NUM_CLIENTS. + +ssh_client_args(_S) -> []. + +ssh_client() -> spawn(fun client_init/0). + +ssh_client_next(S, Pid, _) -> S#state{clients=[Pid|S#state.clients]}. + + +client_init() -> client_loop(). + +client_loop() -> + receive + {please_do,Fun,Ref,Pid} -> + Pid ! {my_pleasure, catch Fun(), Ref}, + client_loop() + end. + +do(Pid, Fun) -> do(Pid, Fun, 30?sec). + +do(Pid, Fun, Timeout) when is_function(Fun,0) -> + Pid ! {please_do,Fun,Ref=make_ref(),self()}, + receive + {my_pleasure, Result, Ref} -> Result + after + Timeout -> {error,do_timeout} + end. + +%%%---------------- +%%% Start a new connection +%%% Precondition: deamon exists + +ssh_open_connection_pre(S) -> S#state.servers /= []. + +ssh_open_connection_args(S) -> [oneof(S#state.servers), S#state.data_dir]. + +ssh_open_connection(#srvr{address=Ip, port=Port}, DataDir) -> + ok(ssh:connect(ensure_string(Ip), Port, + [ + {silently_accept_hosts, true}, + {user_dir, user_dir(DataDir)}, + {user_interaction, false} + ])). + +ssh_open_connection_post(_S, _Args, Result) -> is_ok(Result). + +ssh_open_connection_next(S, ConnRef, [#srvr{ref=SrvrRef},_]) -> + S#state{connections=[#conn{ref=ConnRef, srvr_ref=SrvrRef}|S#state.connections]}. + +%%%---------------- +%%% Stop a new connection +%%% Precondition: connection exists + +ssh_close_connection_pre(S) -> S#state.connections /= []. + +ssh_close_connection_args(S) -> [oneof(S#state.connections)]. + +ssh_close_connection(#conn{ref=ConnectionRef}) -> ssh:close(ConnectionRef). + +ssh_close_connection_next(S, _, [Conn=#conn{ref=ConnRef}]) -> + S#state{connections = S#state.connections--[Conn], + channels = [C || C <- S#state.channels, + C#chan.conn_ref /= ConnRef] + }. + +%%%---------------- +%%% Start a new channel without a sub system +%%% Precondition: connection exists + +ssh_open_channel_pre(S) -> S#state.connections /= []. + +ssh_open_channel_args(S) -> [oneof(S#state.connections)]. + +%%% For re-arrangement in parallel tests. +ssh_open_channel_pre(S,[C]) -> lists:member(C,S#state.connections). + +ssh_open_channel(#conn{ref=ConnectionRef}) -> + ok(ssh_connection:session_channel(ConnectionRef, 20?sec)). + +ssh_open_channel_post(_S, _Args, Result) -> is_ok(Result). + +ssh_open_channel_next(S, ChannelRef, [#conn{ref=ConnRef}]) -> + S#state{channels=[#chan{ref=ChannelRef, + conn_ref=ConnRef} + | S#state.channels]}. + +%%%---------------- +%%% Stop a channel +%%% Precondition: a channel exists, with or without a subsystem + +ssh_close_channel_pre(S) -> S#state.channels /= []. + +ssh_close_channel_args(S) -> [oneof(S#state.channels)]. + +ssh_close_channel(#chan{ref=ChannelRef, conn_ref=ConnectionRef}) -> + ssh_connection:close(ConnectionRef, ChannelRef). + +ssh_close_channel_next(S, _, [C]) -> + S#state{channels = [Ci || Ci <- S#state.channels, + sig(C) /= sig(Ci)]}. + + +sig(C) -> {C#chan.ref, C#chan.conn_ref}. + + +%%%---------------- +%%% Start a sub system on a channel +%%% Precondition: A channel without subsystem exists + +ssh_start_subsyst_pre(S) -> lists:any(fun no_subsyst/1, S#state.channels) andalso + S#state.clients /= []. + +ssh_start_subsyst_args(S) -> [oneof(lists:filter(fun no_subsyst/1, S#state.channels)), + oneof(?SUBSYSTEMS), + oneof(S#state.clients) + ]. + +%% For re-arrangement in parallel tests. +ssh_start_subsyst_pre(S, [C|_]) -> lists:member(C,S#state.channels) + andalso no_subsyst(C). + +ssh_start_subsyst(#chan{ref=ChannelRef, conn_ref=ConnectionRef}, SubSystem, Pid) -> + do(Pid, fun()->ssh_connection:subsystem(ConnectionRef, ChannelRef, SubSystem, 120?sec) end). + +ssh_start_subsyst_post(_S, _Args, Result) -> Result==success. + +ssh_start_subsyst_next(S, _Result, [C,SS,Pid|_]) -> + S#state{channels = [C#chan{subsystem=SS, + client_pid=Pid}|(S#state.channels--[C])] }. + +%%%---------------- +%%% Send a message on a channel +%%% Precondition: a channel exists with a subsystem connected + +ssh_send_pre(S) -> lists:any(fun has_subsyst/1, S#state.channels). + +ssh_send_args(S) -> [oneof(lists:filter(fun has_subsyst/1, S#state.channels)), + choose(0,1), + message()]. + +%% For re-arrangement in parallel tests. +ssh_send_pre(S, [C|_]) -> lists:member(C, S#state.channels). + +ssh_send(C=#chan{conn_ref=ConnectionRef, ref=ChannelRef, client_pid=Pid}, Type, Msg) -> + do(Pid, + fun() -> + case ssh_connection:send(ConnectionRef, ChannelRef, Type, modify_msg(C,Msg), 10?sec) of + ok -> + receive + {ssh_cm,ConnectionRef,{data,ChannelRef,Type,Answer}} -> Answer + after 15?sec -> + %% receive + %% Other -> {error,{unexpected,Other}} + %% after 0 -> + {error,receive_timeout} + %% end + end; + Other -> + Other + end + end). + +ssh_send_blocking(_S, _Args) -> + true. + +ssh_send_post(_S, [C,_,Msg], Response) when is_binary(Response) -> + Expected = ssh_eqc_subsys:response(modify_msg(C,Msg), C#chan.subsystem), + case Response of + Expected -> true; + _ -> {send_failed, size(Response), size(Expected)} + end; + +ssh_send_post(_S, _Args, Response) -> + {error,Response}. + + +modify_msg(_, <<>>) -> <<>>; +modify_msg(#chan{subsystem=SS}, Msg) -> <<(list_to_binary(SS))/binary,Msg/binary>>. + +%%%================================================================ +%%% Misc functions + +message() -> + resize(500, binary()). + + %% binary(). + + %% oneof([binary(), + %% ?LET(Size, choose(0,10000), binary(Size)) + %% ]). + +has_subsyst(C) -> C#chan.subsystem /= undefined. + +no_subsyst(C) -> not has_subsyst(C). + + +ok({ok,X}) -> X; +ok({error,Err}) -> {error,Err}. + +is_ok({error,_}) -> false; +is_ok(_) -> true. + +ensure_string({A,B,C,D}) -> lists:flatten(io_lib:format("~w.~w.~w.~w",[A,B,C,D])); +ensure_string(X) -> X. + +%%%---------------------------------------------------------------- +present_result(_Module, Cmds, _Triple, true) -> + aggregate(with_title("Distribution sequential/parallel"), sequential_parallel(Cmds), + aggregate(with_title("Function calls"), cmnd_names(Cmds), + aggregate(with_title("Message sizes"), empty_msgs(Cmds), + aggregate(print_frequencies(), message_sizes(Cmds), + aggregate(title("Length of command sequences",print_frequencies()), num_calls(Cmds), + true))))); + +present_result(Module, Cmds, Triple, false) -> + pretty_commands(Module, Cmds, Triple, [{show_states,true}], false). + + + +cmnd_names(Cs) -> traverse_commands(fun cmnd_name/1, Cs). +cmnd_name(L) -> [F || {set,_Var,{call,_Mod,F,_As}} <- L]. + +empty_msgs(Cs) -> traverse_commands(fun empty_msg/1, Cs). +empty_msg(L) -> [empty || {set,_,{call,_,ssh_send,[_,_,Msg]}} <- L, + size(Msg)==0]. + +message_sizes(Cs) -> traverse_commands(fun message_size/1, Cs). +message_size(L) -> [size(Msg) || {set,_,{call,_,ssh_send,[_,_,Msg]}} <- L]. + +num_calls(Cs) -> traverse_commands(fun num_call/1, Cs). +num_call(L) -> [length(L)]. + +sequential_parallel(Cs) -> + traverse_commands(fun(L) -> dup_module(L, sequential) end, + fun(L) -> [dup_module(L1, mkmod("parallel",num(L1,L))) || L1<-L] end, + Cs). +dup_module(L, ModName) -> lists:duplicate(length(L), ModName). +mkmod(PfxStr,N) -> list_to_atom(PfxStr++"_"++integer_to_list(N)). + +%% Meta functions for the aggregate functions +traverse_commands(Fun, L) when is_list(L) -> Fun(L); +traverse_commands(Fun, {Seq, ParLs}) -> Fun(lists:append([Seq|ParLs])). + +traverse_commands(Fseq, _Fpar, L) when is_list(L) -> Fseq(L); +traverse_commands(Fseq, Fpar, {Seq, ParLs}) -> lists:append([Fseq(Seq)|Fpar(ParLs)]). + +%%%---------------- +%% PrintMethod([{term(), int()}]) -> any(). +print_frequencies() -> print_frequencies(10). + +print_frequencies(Ngroups) -> fun([]) -> io:format('Empty list!~n',[]); + (L ) -> print_frequencies(L,Ngroups,0,element(1,lists:last(L))) + end. + +print_frequencies(Ngroups, MaxValue) -> fun(L) -> print_frequencies(L,Ngroups,0,MaxValue) end. + +print_frequencies(L, N, Min, Max) when N>Max -> print_frequencies(L++[{N,0}], N, Min, N); +print_frequencies(L, N, Min, Max) -> +%%io:format('L=~p~n',[L]), + try + IntervalUpperLimits = + lists:reverse( + [Max | tl(lists:reverse(lists:seq(Min,Max,round((Max-Min)/N))))] + ), + {Acc0,_} = lists:mapfoldl(fun(Upper,Lower) -> + {{{Lower,Upper},0}, Upper+1} + end, hd(IntervalUpperLimits), tl(IntervalUpperLimits)), + Fs0 = get_frequencies(L, Acc0), + SumVal = lists:sum([V||{_,V}<-Fs0]), + Fs = with_percentage(Fs0, SumVal), + Mean = mean(L), + Median = median(L), + Npos_value = num_digits(SumVal), + Npos_range = num_digits(Max), + io:format("Range~*s: ~s~n",[2*Npos_range-2,"", "Number in range"]), + io:format("~*c:~*c~n",[2*Npos_range+3,$-, max(16,Npos_value+10),$- ]), + [begin + io:format("~*w - ~*w: ~*w ~5.1f%",[Npos_range,Rlow, + Npos_range,Rhigh, + Npos_value,Val, + Percent]), + [io:format(" <-- mean=~.1f",[Mean]) || in_interval(Mean, Interval)], + [io:format(" <-- median=" ++ + if + is_float(Median) -> "~.1f"; + true -> "~p" + end, [Median]) || in_interval(Median, Interval)], + io:nl() + end + || {Interval={Rlow,Rhigh},Val,Percent} <- Fs], + io:format('~*c ~*c~n',[2*Npos_range,32,Npos_value+2,$-]), + io:format('~*c ~*w~n',[2*Npos_range,32,Npos_value,SumVal]) + %%,io:format('L=~p~n',[L]) + catch + C:E -> + io:format('*** Faild printing (~p:~p) for~n~p~n',[C,E,L]) + end. + +get_frequencies([{I,Num}|T], [{{Lower,Upper},Cnt}|Acc]) when Lower=<I,I=<Upper -> + get_frequencies(T, [{{Lower,Upper},Cnt+Num}|Acc]); +get_frequencies(L=[{I,_Num}|_], [Ah={{_Lower,Upper},_Cnt}|Acc]) when I>Upper -> + [Ah | get_frequencies(L,Acc)]; +get_frequencies([], Acc) -> + Acc. + +with_percentage(Fs, Sum) -> + [{Rng,Val,100*Val/Sum} || {Rng,Val} <- Fs]. + + +title(Str, Fun) -> + fun(L) -> + io:format('~s~n',[Str]), + Fun(L) + end. + +num_digits(I) -> 1+trunc(math:log(I)/math:log(10)). + +num(Elem, List) -> length(lists:takewhile(fun(E) -> E /= Elem end, List)) + 1. + +%%%---- Just for naming an operation for readability +is_odd(I) -> (I rem 2) == 1. + +in_interval(Value, {Rlow,Rhigh}) -> + try + Rlow=<round(Value) andalso round(Value)=<Rhigh + catch + _:_ -> false + end. + +%%%================================================================ +%%% Statistical functions + +%%%---- Mean value +mean(L = [X|_]) when is_number(X) -> + lists:sum(L) / length(L); +mean(L = [{_Value,_Weight}|_]) -> + SumOfWeights = lists:sum([W||{_,W}<-L]), + WeightedSum = lists:sum([W*V||{V,W}<-L]), + WeightedSum / SumOfWeights; +mean(_) -> + undefined. + +%%%---- Median +median(L = [X|_]) when is_number(X) -> + case is_odd(length(L)) of + true -> + hd(lists:nthtail(length(L) div 2, L)); + false -> + %% 1) L has at least on element (the when test). + %% 2) Length is even. + %% => Length >= 2 + [M1,M2|_] = lists:nthtail((length(L) div 2)-1, L), + (M1+M2) / 2 + end; +%% integer Weights... +median(L = [{_Value,_Weight}|_]) -> + median( lists:append([lists:duplicate(W,V) || {V,W} <- L]) ); +median(_) -> + undefined. + +%%%================================================================ +%%% The rest is taken and modified from ssh_test_lib.erl +inet_port(IpAddress)-> + {ok, Socket} = gen_tcp:listen(0, [{ip,IpAddress},{reuseaddr,true}]), + {ok, Port} = inet:port(Socket), + gen_tcp:close(Socket), + Port. + +setup_rsa(Dir) -> + erase_dir(system_dir(Dir)), + erase_dir(user_dir(Dir)), + file:make_dir(system_dir(Dir)), + file:make_dir(user_dir(Dir)), + + file:copy(data_dir(Dir,"id_rsa"), user_dir(Dir,"id_rsa")), + file:copy(data_dir(Dir,"ssh_host_rsa_key"), system_dir(Dir,"ssh_host_rsa_key")), + file:copy(data_dir(Dir,"ssh_host_rsa_key"), system_dir(Dir,"ssh_host_rsa_key.pub")), + ssh_test_lib:setup_rsa_known_host(data_dir(Dir), user_dir(Dir)), + ssh_test_lib:setup_rsa_auth_keys(data_dir(Dir), user_dir(Dir)). + +data_dir(Dir, File) -> filename:join(Dir, File). +system_dir(Dir, File) -> filename:join([Dir, "system", File]). +user_dir(Dir, File) -> filename:join([Dir, "user", File]). + +data_dir(Dir) -> Dir. +system_dir(Dir) -> system_dir(Dir,""). +user_dir(Dir) -> user_dir(Dir,""). + +erase_dir(Dir) -> + case file:list_dir(Dir) of + {ok,Files} -> lists:foreach(fun(F) -> file:delete(filename:join(Dir,F)) end, + Files); + _ -> ok + end, + file:del_dir(Dir). + +-endif. diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_dsa b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/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/property_test/ssh_eqc_client_server_dirs/id_rsa b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/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/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/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/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key.pub b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/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/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/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/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key.pub b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/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/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl new file mode 100644 index 0000000000..6ddf2c9972 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl @@ -0,0 +1,381 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. 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_eqc_encode_decode). + +-compile(export_all). + +-ifndef(EQC). +-ifndef(PROPER). +-define(EQC,true). +%%-define(PROPER,true). +-endif. +-endif. + +-ifdef(EQC). +-include_lib("eqc/include/eqc.hrl"). +-define(MOD_eqc,eqc). +-else. +-ifdef(PROPER). +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc,proper). +-endif. +-endif. + + +%%% Properties: + +prop_ssh_decode() -> + ?FORALL(Msg, ssh_msg(), + try ssh_message:decode(Msg) + of + _ -> true + catch + C:E -> io:format('~p:~p~n',[C,E]), + false + end + ). + + +%%% This fails because ssh_message is not symmetric in encode and decode regarding data types +prop_ssh_decode_encode() -> + ?FORALL(Msg, ssh_msg(), + Msg == ssh_message:encode(ssh_message:decode(Msg)) + ). + + +%%%================================================================ +%%% +%%% Scripts to generate message generators +%%% + +%% awk '/^( |\t)+byte( |\t)+SSH/,/^( |\t)*$/{print}' rfc425?.txt | sed 's/^\( \|\\t\)*//' > msgs.txt + +%% awk '/^byte( |\t)+SSH/{print $2","}' < msgs.txt + +%% awk 'BEGIN{print "%%%---- BEGIN GENERATED";prev=0} END{print " >>.\n%%%---- END GENERATED"} /^byte( |\t)+SSH/{if (prev==1) print " >>.\n"; prev=1; printf "%c%s%c",39,$2,39; print "()->\n <<?"$2;next} /^string( |\t)+\"/{print " ,"$2;next} /^string( |\t)+.*address/{print " ,(ssh_string_address())/binary %%",$2,$3,$4,$5,$6;next}/^string( |\t)+.*US-ASCII/{print " ,(ssh_string_US_ASCII())/binary %%",$2,$3,$4,$5,$6;next} /^string( |\t)+.*UTF-8/{print " ,(ssh_string_UTF_8())/binary %% ",$2,$3,$4,$5,$6;next} /^[a-z0-9]+( |\t)/{print " ,(ssh_"$1"())/binary %%",$2,$3,$4,$5,$6;next} /^byte\[16\]( |\t)+/{print" ,(ssh_byte_16())/binary %%",$2,$3,$4,$5,$6;next} /^name-list( |\t)+/{print" ,(ssh_name_list())/binary %%",$2,$3,$4,$5,$6;next} /./{print "?? %%",$0}' < msgs.txt > gen.txt + +%%%================================================================ +%%% +%%% Generators +%%% + +ssh_msg() -> ?LET(M,oneof( +[[msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()], +%%Assym [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )], +%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], +%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], +%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_IGNORE'),gen_string( )], + %% [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()], + %% [msg_code('SSH_MSG_KEXDH_REPLY'),gen_string( ),gen_mpint(),gen_string( )], + %% [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()], + [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()], + [msg_code('SSH_MSG_NEWKEYS')], + [msg_code('SSH_MSG_REQUEST_FAILURE')], + [msg_code('SSH_MSG_REQUEST_SUCCESS')], + [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )], + [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )], + [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()], + [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()], + [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_SUCCESS')] +] + +), list_to_binary(M)). + + +%%%================================================================ +%%% +%%% Generator +%%% + +do() -> + io_lib:format('[~s~n]', + [write_gen( + files(["rfc4254.txt", + "rfc4253.txt", + "rfc4419.txt", + "rfc4252.txt", + "rfc4256.txt"]))]). + + +write_gen(L) when is_list(L) -> + string:join(lists:map(fun write_gen/1, L), ",\n "); +write_gen({MsgName,Args}) -> + lists:flatten(["[",generate_args([MsgName|Args]),"]"]). + +generate_args(As) -> string:join([generate_arg(A) || A <- As], ","). + +generate_arg({<<"string">>, <<"\"",B/binary>>}) -> + S = get_string($",B), + ["gen_string(\"",S,"\")"]; +generate_arg({<<"string">>, _}) -> "gen_string( )"; +generate_arg({<<"byte[",B/binary>>, _}) -> + io_lib:format("gen_byte(~p)",[list_to_integer(get_string($],B))]); +generate_arg({<<"byte">> ,_}) -> "gen_byte()"; +generate_arg({<<"uint16">>,_}) -> "gen_uint16()"; +generate_arg({<<"uint32">>,_}) -> "gen_uint32()"; +generate_arg({<<"uint64">>,_}) -> "gen_uint64()"; +generate_arg({<<"mpint">>,_}) -> "gen_mpint()"; +generate_arg({<<"name-list">>,_}) -> "gen_name_list()"; +generate_arg({<<"boolean">>,<<"FALSE">>}) -> "0"; +generate_arg({<<"boolean">>,<<"TRUE">>}) -> "1"; +generate_arg({<<"boolean">>,_}) -> "gen_boolean()"; +generate_arg({<<"....">>,_}) -> ""; %% FIXME +generate_arg(Name) when is_binary(Name) -> + lists:flatten(["msg_code('",binary_to_list(Name),"')"]). + + +gen_boolean() -> choose(0,1). + +gen_byte() -> choose(0,255). + +gen_uint16() -> gen_byte(2). + +gen_uint32() -> gen_byte(4). + +gen_uint64() -> gen_byte(8). + +gen_byte(N) when N>0 -> [gen_byte() || _ <- lists:seq(1,N)]. + +gen_char() -> choose($a,$z). + +gen_mpint() -> ?LET(Size, choose(1,20), + ?LET(Str, vector(Size, gen_byte()), + gen_string( strip_0s(Str) ) + )). + +strip_0s([0|T]) -> strip_0s(T); +strip_0s(X) -> X. + + +gen_string() -> + ?LET(Size, choose(0,10), + ?LET(Vector,vector(Size, gen_char()), + gen_string(Vector) + )). + +gen_string(S) when is_binary(S) -> gen_string(binary_to_list(S)); +gen_string(S) when is_list(S) -> uint32_to_list(length(S)) ++ S. + +gen_name_list() -> + ?LET(NumNames, choose(0,10), + ?LET(L, [gen_name() || _ <- lists:seq(1,NumNames)], + gen_string( string:join(L,"," ) ) + )). + +gen_name() -> gen_string(). + +uint32_to_list(I) -> binary_to_list(<<I:32/unsigned-big-integer>>). + +%%%---- +get_string(Delim, B) -> + binary_to_list( element(1, split_binary(B, count_string_chars(Delim,B,0))) ). + +count_string_chars(Delim, <<Delim,_/binary>>, Acc) -> Acc; +count_string_chars(Delim, <<_,B/binary>>, Acc) -> count_string_chars(Delim, B, Acc+1). + + +-define(MSG_CODE(Name,Num), +msg_code(Name) -> Num; +msg_code(Num) -> Name +). + +?MSG_CODE('SSH_MSG_USERAUTH_REQUEST', 50); +?MSG_CODE('SSH_MSG_USERAUTH_FAILURE', 51); +?MSG_CODE('SSH_MSG_USERAUTH_SUCCESS', 52); +?MSG_CODE('SSH_MSG_USERAUTH_BANNER', 53); +?MSG_CODE('SSH_MSG_USERAUTH_PK_OK', 60); +?MSG_CODE('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ', 60); +?MSG_CODE('SSH_MSG_DISCONNECT', 1); +?MSG_CODE('SSH_MSG_IGNORE', 2); +?MSG_CODE('SSH_MSG_UNIMPLEMENTED', 3); +?MSG_CODE('SSH_MSG_DEBUG', 4); +?MSG_CODE('SSH_MSG_SERVICE_REQUEST', 5); +?MSG_CODE('SSH_MSG_SERVICE_ACCEPT', 6); +?MSG_CODE('SSH_MSG_KEXINIT', 20); +?MSG_CODE('SSH_MSG_NEWKEYS', 21); +?MSG_CODE('SSH_MSG_GLOBAL_REQUEST', 80); +?MSG_CODE('SSH_MSG_REQUEST_SUCCESS', 81); +?MSG_CODE('SSH_MSG_REQUEST_FAILURE', 82); +?MSG_CODE('SSH_MSG_CHANNEL_OPEN', 90); +?MSG_CODE('SSH_MSG_CHANNEL_OPEN_CONFIRMATION', 91); +?MSG_CODE('SSH_MSG_CHANNEL_OPEN_FAILURE', 92); +?MSG_CODE('SSH_MSG_CHANNEL_WINDOW_ADJUST', 93); +?MSG_CODE('SSH_MSG_CHANNEL_DATA', 94); +?MSG_CODE('SSH_MSG_CHANNEL_EXTENDED_DATA', 95); +?MSG_CODE('SSH_MSG_CHANNEL_EOF', 96); +?MSG_CODE('SSH_MSG_CHANNEL_CLOSE', 97); +?MSG_CODE('SSH_MSG_CHANNEL_REQUEST', 98); +?MSG_CODE('SSH_MSG_CHANNEL_SUCCESS', 99); +?MSG_CODE('SSH_MSG_CHANNEL_FAILURE', 100); +?MSG_CODE('SSH_MSG_USERAUTH_INFO_REQUEST', 60); +?MSG_CODE('SSH_MSG_USERAUTH_INFO_RESPONSE', 61); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST_OLD', 30); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST', 34); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_GROUP', 31); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_INIT', 32); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33). + +%%%============================================================================= +%%%============================================================================= +%%%============================================================================= + +files(Fs) -> + Defs = lists:usort(lists:flatten(lists:map(fun file/1, Fs))), + DefinedIDs = lists:usort([binary_to_list(element(1,D)) || D <- Defs]), + WantedIDs = lists:usort(wanted_messages()), + Missing = WantedIDs -- DefinedIDs, + case Missing of + [] -> ok; + _ -> io:format('%% Warning: missing ~p~n', [Missing]) + end, + Defs. + + +file(F) -> + {ok,B} = file:read_file(F), + hunt_msg_def(B). + + +hunt_msg_def(<<"\n",B/binary>>) -> some_hope(skip_blanks(B)); +hunt_msg_def(<<_, B/binary>>) -> hunt_msg_def(B); +hunt_msg_def(<<>>) -> []. + +some_hope(<<"byte ", B/binary>>) -> try_message(skip_blanks(B)); +some_hope(B) -> hunt_msg_def(B). + +try_message(B = <<"SSH_MSG_",_/binary>>) -> + {ID,Rest} = get_id(B), + case lists:member(binary_to_list(ID), wanted_messages()) of + true -> + {Lines,More} = get_def_lines(skip_blanks(Rest), []), + [{ID,lists:reverse(Lines)} | hunt_msg_def(More)]; + false -> + hunt_msg_def(Rest) + end; +try_message(B) -> hunt_msg_def(B). + + +skip_blanks(<<32, B/binary>>) -> skip_blanks(B); +skip_blanks(<< 9, B/binary>>) -> skip_blanks(B); +skip_blanks(B) -> B. + +get_def_lines(B0 = <<"\n",B/binary>>, Acc) -> + {ID,Rest} = get_id(skip_blanks(B)), + case {size(ID), skip_blanks(Rest)} of + {0,<<"....",More/binary>>} -> + {Text,LineEnd} = get_to_eol(skip_blanks(More)), + get_def_lines(LineEnd, [{<<"....">>,Text}|Acc]); + {0,_} -> + {Acc,B0}; + {_,Rest1} -> + {Text,LineEnd} = get_to_eol(Rest1), + get_def_lines(LineEnd, [{ID,Text}|Acc]) + end; +get_def_lines(B, Acc) -> + {Acc,B}. + + +get_to_eol(B) -> split_binary(B, count_to_eol(B,0)). + +count_to_eol(<<"\n",_/binary>>, Acc) -> Acc; +count_to_eol(<<>>, Acc) -> Acc; +count_to_eol(<<_,B/binary>>, Acc) -> count_to_eol(B,Acc+1). + + +get_id(B) -> split_binary(B, count_id_chars(B,0)). + +count_id_chars(<<C,B/binary>>, Acc) when $A=<C,C=<$Z -> count_id_chars(B,Acc+1); +count_id_chars(<<C,B/binary>>, Acc) when $a=<C,C=<$z -> count_id_chars(B,Acc+1); +count_id_chars(<<C,B/binary>>, Acc) when $0=<C,C=<$9 -> count_id_chars(B,Acc+1); +count_id_chars(<<"_",B/binary>>, Acc) -> count_id_chars(B,Acc+1); +count_id_chars(<<"-",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g name-list +count_id_chars(<<"[",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] +count_id_chars(<<"]",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] +count_id_chars(_, Acc) -> Acc. + +wanted_messages() -> + ["SSH_MSG_CHANNEL_CLOSE", + "SSH_MSG_CHANNEL_DATA", + "SSH_MSG_CHANNEL_EOF", + "SSH_MSG_CHANNEL_EXTENDED_DATA", + "SSH_MSG_CHANNEL_FAILURE", + "SSH_MSG_CHANNEL_OPEN", + "SSH_MSG_CHANNEL_OPEN_CONFIRMATION", + "SSH_MSG_CHANNEL_OPEN_FAILURE", + "SSH_MSG_CHANNEL_REQUEST", + "SSH_MSG_CHANNEL_SUCCESS", + "SSH_MSG_CHANNEL_WINDOW_ADJUST", + "SSH_MSG_DEBUG", + "SSH_MSG_DISCONNECT", + "SSH_MSG_GLOBAL_REQUEST", + "SSH_MSG_IGNORE", + "SSH_MSG_KEXDH_INIT", + "SSH_MSG_KEXDH_REPLY", + "SSH_MSG_KEXINIT", + "SSH_MSG_KEX_DH_GEX_GROUP", + "SSH_MSG_KEX_DH_GEX_REQUEST", + "SSH_MSG_KEX_DH_GEX_REQUEST_OLD", + "SSH_MSG_NEWKEYS", + "SSH_MSG_REQUEST_FAILURE", + "SSH_MSG_REQUEST_SUCCESS", + "SSH_MSG_SERVICE_ACCEPT", + "SSH_MSG_SERVICE_REQUEST", + "SSH_MSG_UNIMPLEMENTED", + "SSH_MSG_USERAUTH_BANNER", + "SSH_MSG_USERAUTH_FAILURE", +%% hard args "SSH_MSG_USERAUTH_INFO_REQUEST", +%% "SSH_MSG_USERAUTH_INFO_RESPONSE", + "SSH_MSG_USERAUTH_PASSWD_CHANGEREQ", + "SSH_MSG_USERAUTH_PK_OK", +%%rfc4252 p12 error "SSH_MSG_USERAUTH_REQUEST", + "SSH_MSG_USERAUTH_SUCCESS"]. + diff --git a/lib/ssh/test/property_test/ssh_eqc_subsys.erl b/lib/ssh/test/property_test/ssh_eqc_subsys.erl new file mode 100644 index 0000000000..e4b6af166f --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_subsys.erl @@ -0,0 +1,63 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. 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_eqc_subsys). + +-behaviour(ssh_daemon_channel). + +-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]). + +-export([response/2]). + +-record(state, {id, + cm, + subsyst + }). + +init([SS]) -> + {ok, #state{subsyst=SS}}. + +handle_msg({ssh_channel_up, ChannelId, ConnectionManager}, State) -> + {ok, State#state{id = ChannelId, + cm = ConnectionManager}}. + +handle_ssh_msg({ssh_cm, CM, {data, ChannelId, Type, Data}}, S) -> + ssh_connection:send(CM, ChannelId, Type, response(Data,S)), + {ok, S}; + +handle_ssh_msg({ssh_cm, _ConnectionManager, {eof, _ChannelId}}, State) -> + {ok, State}; + +handle_ssh_msg({ssh_cm, _, {signal, _, _}}, State) -> + %% Ignore signals according to RFC 4254 section 6.9. + {ok, State}; + +handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, _Error, _}}, State) -> + {stop, ChannelId, State}; + +handle_ssh_msg({ssh_cm, _, {exit_status, ChannelId, _Status}}, State) -> + {stop, ChannelId, State}. + +terminate(_Reason, _State) -> + ok. + + +response(Msg, #state{subsyst=SS}) -> response(Msg, SS); +response(Msg, SS) -> <<"Resp: ",Msg/binary,(list_to_binary(SS))/binary>>. diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index f4f0682b40..c115ccee5f 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -37,7 +37,10 @@ suite() -> all() -> [ {group, openssh_payload}, - interrupted_send + interrupted_send, + start_shell, + start_shell_exec, + start_shell_exec_fun ]. groups() -> [{openssh_payload, [], [simple_exec, @@ -276,6 +279,106 @@ interrupted_send(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +start_shell() -> + [{doc, "Start a shell"}]. + +start_shell(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {shell, fun(U, H) -> start_our_shell(U, H) end} ]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + ok = ssh_connection:shell(ConnectionRef,ChannelId0), + + receive + {ssh_cm,ConnectionRef, {data, ChannelId, 0, <<"Enter command\r\n">>}} -> + ok + after 5000 -> + ct:fail("CLI Timeout") + end, + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). +%%-------------------------------------------------------------------- +start_shell_exec() -> + [{doc, "start shell to exec command"}]. + +start_shell_exec(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {exec, {?MODULE,ssh_exec,[]}} ]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + + success = ssh_connection:exec(ConnectionRef, ChannelId0, + "testing", infinity), + receive + {ssh_cm,ConnectionRef, {data, ChannelId, 0, <<"testing\r\n">>}} -> + ok + after 5000 -> + ct:fail("Exec Timeout") + end, + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- +start_shell_exec_fun() -> + [{doc, "start shell to exec command"}]. + +start_shell_exec_fun(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {exec, fun ssh_exec/1}]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + + success = ssh_connection:exec(ConnectionRef, ChannelId0, + "testing", infinity), + + receive + {ssh_cm,ConnectionRef, {data, ChannelId, 0, <<"testing\r\n">>}} -> + ok + after 5000 -> + ct:fail("Exec Timeout") + end, + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). +%%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- big_cat_rx(ConnectionRef, ChannelId) -> @@ -308,3 +411,16 @@ collect_data(ConnectionRef, ChannelId, Acc) -> after 5000 -> timeout end. + +%%%------------------------------------------------------------------- +% This is taken from the ssh example code. +start_our_shell(_User, _Peer) -> + spawn(fun() -> + io:format("Enter command\n") + %% Don't actually loop, just exit + end). + +ssh_exec(Cmd) -> + spawn(fun() -> + io:format(Cmd ++ "\n") + end). diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl new file mode 100644 index 0000000000..c6c63d7367 --- /dev/null +++ b/lib/ssh/test/ssh_property_test_SUITE.erl @@ -0,0 +1,109 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. 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% +%% +%% + +%%% Run like this: +%%% ct:run_test([{suite,"ssh_property_test_SUITE"}, {logdir,"/ldisk/OTP/LOG"}]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(ssh_property_test_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +all() -> [{group, messages}, + {group, client_server} + ]. + +groups() -> + [{messages, [], [decode, + decode_encode]}, + {client_server, [], [client_server_sequential, + client_server_parallel, + client_server_parallel_multi]} + ]. + + +%%% First prepare Config and compile the property tests for the found tool: +init_per_suite(Config) -> + ct_property_test:init_per_suite(Config). + +%%% One group in this suite happens to support only QuickCheck, so skip it +%%% if we run proper. +init_per_group(client_server, Config) -> + case ?config(property_test_tool,Config) of + proper -> + {skip, "PropEr is not supported"}; + eqc -> + Config + end; +init_per_group(_, Config) -> + Config. + +end_per_group(_, Config) -> + Config. + +%%% Always skip the testcase that is not quite in phase with the +%%% ssh_message.erl code +init_per_testcase(decode_encode, _) -> {skip, "Fails - testcase is not ok"}; +init_per_testcase(_TestCase, Config) -> Config. + +end_per_testcase(_TestCase, Config) -> Config. + +%%%================================================================ +%%% Test suites +%%% +decode(Config) -> + ct_property_test:quickcheck( + ssh_eqc_encode_decode:prop_ssh_decode(), + Config + ). + +decode_encode(Config) -> + ct_property_test:quickcheck( + ssh_eqc_encode_decode:prop_ssh_decode_encode(), + Config + ). + +client_server_sequential(Config) -> + ct_property_test:quickcheck( + ssh_eqc_client_server:prop_seq(Config), + Config + ). + +client_server_parallel(Config) -> + ct_property_test:quickcheck( + ssh_eqc_client_server:prop_parallel(Config), + Config + ). + +client_server_parallel_multi(Config) -> + ct_property_test:quickcheck( + ssh_eqc_client_server:prop_parallel_multi(Config), + Config + ). diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 8b5343cecc..3500bf012b 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -54,7 +54,9 @@ groups() -> ]}, {erlang_server, [], [erlang_server_openssh_client_exec, erlang_server_openssh_client_exec_compressed, - erlang_server_openssh_client_pulic_key_dsa]} + erlang_server_openssh_client_pulic_key_dsa, + erlang_server_openssh_client_cipher_suites, + erlang_server_openssh_client_macs]} ]. init_per_suite(Config) -> @@ -89,6 +91,12 @@ end_per_group(erlang_server, Config) -> end_per_group(_, Config) -> Config. +init_per_testcase(erlang_server_openssh_client_cipher_suites, Config) -> + check_ssh_client_support(Config); + +init_per_testcase(erlang_server_openssh_client_macs, Config) -> + check_ssh_client_support(Config); + init_per_testcase(_TestCase, Config) -> ssh:start(), Config. @@ -221,6 +229,108 @@ erlang_server_openssh_client_exec(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +erlang_server_openssh_client_cipher_suites() -> + [{doc, "Test that we can connect with different cipher suites."}]. + +erlang_server_openssh_client_cipher_suites(Config) when is_list(Config) -> + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}]), + + + ct:sleep(500), + + Supports = crypto:supports(), + Ciphers = proplists:get_value(ciphers, Supports), + Tests = [ + {"3des-cbc", lists:member(des3_cbc, Ciphers)}, + {"aes128-cbc", lists:member(aes_cbc128, Ciphers)}, + {"aes128-ctr", lists:member(aes_ctr, Ciphers)}, + {"aes256-cbc", false} + ], + lists:foreach(fun({Cipher, Expect}) -> + Cmd = "ssh -p " ++ integer_to_list(Port) ++ + " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " " ++ + " -c " ++ Cipher ++ " 1+1.", + + ct:pal("Cmd: ~p~n", [Cmd]), + + SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), + + case Expect of + true -> + receive + {SshPort,{data, <<"2\n">>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive answer") + end; + false -> + receive + {SshPort,{data, <<"no matching cipher found", _/binary>>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive no matching cipher message") + end + end + end, Tests), + + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- +erlang_server_openssh_client_macs() -> + [{doc, "Test that we can connect with different MACs."}]. + +erlang_server_openssh_client_macs(Config) when is_list(Config) -> + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}]), + + + ct:sleep(500), + + Supports = crypto:supports(), + Hashs = proplists:get_value(hashs, Supports), + MACs = [{"hmac-sha1", lists:member(sha, Hashs)}, + {"hmac-sha2-256", lists:member(sha256, Hashs)}, + {"hmac-md5-96", false}, + {"hmac-ripemd160", false}], + lists:foreach(fun({MAC, Expect}) -> + Cmd = "ssh -p " ++ integer_to_list(Port) ++ + " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " " ++ + " -o MACs=" ++ MAC ++ " 1+1.", + + ct:pal("Cmd: ~p~n", [Cmd]), + + SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), + + case Expect of + true -> + receive + {SshPort,{data, <<"2\n">>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive answer") + end; + false -> + receive + {SshPort,{data, <<"no matching mac found", _/binary>>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive no matching mac message") + end + end + end, MACs), + + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- erlang_server_openssh_client_exec_compressed() -> [{doc, "Test that exec command works."}]. @@ -433,3 +543,25 @@ receive_hej() -> ct:pal("Extra info: ~p~n", [Info]), receive_hej() end. + +%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- +%% Check if we have a "newer" ssh client that supports these test cases +%%-------------------------------------------------------------------- +check_ssh_client_support(Config) -> + Port = open_port({spawn, "ssh -Q cipher"}, [exit_status, stderr_to_stdout]), + case check_ssh_client_support2(Port) of + 0 -> % exit status from command (0 == ok) + ssh:start(), + Config; + _ -> + {skip, "test case not supported by ssh client"} + end. + +check_ssh_client_support2(P) -> + receive + {P, {data, _A}} -> + check_ssh_client_support2(P); + {P, {exit_status, E}} -> + E + end. diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 9bef10a366..73bf73971f 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 3.0.4 +SSH_VSN = 3.0.5 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl_protocol.xml b/lib/ssl/doc/src/ssl_protocol.xml index cdfafe224b..80d9cc4ee8 100644 --- a/lib/ssl/doc/src/ssl_protocol.xml +++ b/lib/ssl/doc/src/ssl_protocol.xml @@ -83,7 +83,7 @@ <em>subject</em>. The certificate is signed with the private key of the issuer of the certificate. A chain of trust is build by having the issuer in its turn being - certified by an other certificate and so on until you reach the + certified by another certificate and so on until you reach the so called root certificate that is self signed i.e. issued by itself.</p> diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index ae59d5f44f..6fd6bb888b 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -1075,7 +1075,7 @@ scan_number([$#|Cs]=Cs0, St, Line, Col, Toks, Ncs0) -> Ncs = lists:reverse(Ncs0), case catch list_to_integer(Ncs) of B when B >= 2, B =< 1+$Z-$A+10 -> - Bcs = ?STR(St, Ncs++[$#]), + Bcs = Ncs++[$#], scan_based_int(Cs, St, Line, Col, Toks, {B,[],Bcs}); B -> Len = length(Ncs), @@ -1108,7 +1108,7 @@ scan_based_int(Cs, St, Line, Col, Toks, {B,Ncs0,Bcs}) -> Ncs = lists:reverse(Ncs0), case catch erlang:list_to_integer(Ncs, B) of N when is_integer(N) -> - tok3(Cs, St, Line, Col, Toks, integer, ?STR(St, Bcs++Ncs), N); + tok3(Cs, St, Line, Col, Toks, integer, Bcs++Ncs, N); _ -> Len = length(Bcs)+length(Ncs), Ncol = incr_column(Col, Len), diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index e914f7d0b2..5afe3e8b09 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -594,7 +594,8 @@ reply(Name, {To, Tag}, Reply, Debug, StateName) -> terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> case catch Mod:terminate(Reason, StateName, StateData) of {'EXIT', R} -> - error_info(R, Name, Msg, StateName, StateData, Debug), + FmtStateData = format_status(terminate, Mod, get(), StateData), + error_info(R, Name, Msg, StateName, FmtStateData, Debug), exit(R); _ -> case Reason of @@ -605,17 +606,7 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - FmtStateData = - case erlang:function_exported(Mod, format_status, 2) of - true -> - Args = [get(), StateData], - case catch Mod:format_status(terminate, Args) of - {'EXIT', _} -> StateData; - Else -> Else - end; - _ -> - StateData - end, + FmtStateData = format_status(terminate, Mod, get(), StateData), error_info(Reason,Name,Msg,StateName,FmtStateData,Debug), exit(Reason) end @@ -680,21 +671,29 @@ format_status(Opt, StatusData) -> Header = gen:format_status_header("Status for state machine", Name), Log = sys:get_debug(log, Debug, []), - DefaultStatus = [{data, [{"StateData", StateData}]}], - Specfic = - case erlang:function_exported(Mod, format_status, 2) of - true -> - case catch Mod:format_status(Opt,[PDict,StateData]) of - {'EXIT', _} -> DefaultStatus; - StatusList when is_list(StatusList) -> StatusList; - Else -> [Else] - end; - _ -> - DefaultStatus - end, + Specfic = format_status(Opt, Mod, PDict, StateData), + Specfic = case format_status(Opt, Mod, PDict, StateData) of + S when is_list(S) -> S; + S -> [S] + end, [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}, {"Logged events", Log}, {"StateName", StateName}]} | Specfic]. + +format_status(Opt, Mod, PDict, State) -> + DefStatus = case Opt of + terminate -> State; + _ -> [{data, [{"StateData", State}]}] + end, + case erlang:function_exported(Mod, format_status, 2) of + true -> + case catch Mod:format_status(Opt, [PDict, State]) of + {'EXIT', _} -> DefStatus; + Else -> Else + end; + _ -> + DefStatus + end. diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 202a931fae..dadfe56b3d 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -720,7 +720,8 @@ print_event(Dev, Event, Name) -> terminate(Reason, Name, Msg, Mod, State, Debug) -> case catch Mod:terminate(Reason, State) of {'EXIT', R} -> - error_info(R, Name, Msg, State, Debug), + FmtState = format_status(terminate, Mod, get(), State), + error_info(R, Name, Msg, FmtState, Debug), exit(R); _ -> case Reason of @@ -731,17 +732,7 @@ terminate(Reason, Name, Msg, Mod, State, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - FmtState = - case erlang:function_exported(Mod, format_status, 2) of - true -> - Args = [get(), State], - case catch Mod:format_status(terminate, Args) of - {'EXIT', _} -> State; - Else -> Else - end; - _ -> - State - end, + FmtState = format_status(terminate, Mod, get(), State), error_info(Reason, Name, Msg, FmtState, Debug), exit(Reason) end @@ -875,23 +866,29 @@ name_to_pid(Name) -> %%----------------------------------------------------------------- format_status(Opt, StatusData) -> [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData, - Header = gen:format_status_header("Status for generic server", - Name), + Header = gen:format_status_header("Status for generic server", Name), Log = sys:get_debug(log, Debug, []), - DefaultStatus = [{data, [{"State", State}]}], - Specfic = - case erlang:function_exported(Mod, format_status, 2) of - true -> - case catch Mod:format_status(Opt, [PDict, State]) of - {'EXIT', _} -> DefaultStatus; - StatusList when is_list(StatusList) -> StatusList; - Else -> [Else] - end; - _ -> - DefaultStatus - end, + Specfic = case format_status(Opt, Mod, PDict, State) of + S when is_list(S) -> S; + S -> [S] + end, [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}, {"Logged events", Log}]} | Specfic]. + +format_status(Opt, Mod, PDict, State) -> + DefStatus = case Opt of + terminate -> State; + _ -> [{data, [{"State", State}]}] + end, + case erlang:function_exported(Mod, format_status, 2) of + true -> + case catch Mod:format_status(Opt, [PDict, State]) of + {'EXIT', _} -> DefStatus; + Else -> Else + end; + _ -> + DefStatus + end. diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 35067e8116..9be9f641c8 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -204,20 +204,20 @@ reserved_words() -> [begin ?line {RW, true} = {RW, erl_scan:reserved_word(RW)}, S = atom_to_list(RW), - Ts = [{RW,1}], + Ts = [{RW,{1,1}}], ?line test_string(S, Ts) end || RW <- L], ok. atoms() -> - ?line test_string("a - b", [{atom,1,a},{atom,2,b}]), - ?line test_string("'a b'", [{atom,1,'a b'}]), - ?line test_string("a", [{atom,1,a}]), - ?line test_string("a@2", [{atom,1,a@2}]), - ?line test_string([39,65,200,39], [{atom,1,'AÈ'}]), - ?line test_string("ärlig östen", [{atom,1,ärlig},{atom,1,östen}]), + test_string("a + b", [{atom,{1,1},a},{atom,{2,18},b}]), + test_string("'a b'", [{atom,{1,1},'a b'}]), + test_string("a", [{atom,{1,1},a}]), + test_string("a@2", [{atom,{1,1},a@2}]), + test_string([39,65,200,39], [{atom,{1,1},'AÈ'}]), + test_string("ärlig östen", [{atom,{1,1},ärlig},{atom,{1,7},östen}]), ?line {ok,[{atom,_,'$a'}],{1,6}} = erl_scan:string("'$\\a'", {1,1}), ?line test("'$\\a'"), @@ -230,7 +230,7 @@ punctuations() -> %% One token at a time: [begin W = list_to_atom(S), - Ts = [{W,1}], + Ts = [{W,{1,1}}], ?line test_string(S, Ts) end || S <- L], Three = ["/=:=", "<=:=", "==:=", ">=:="], % three tokens... @@ -246,53 +246,60 @@ punctuations() -> [begin W1 = list_to_atom(S1), W2 = list_to_atom(S2), - Ts = [{W1,1},{W2,1}], + Ts = [{W1,{1,1}},{W2,{1,-L2+1}}], ?line test_string(S, Ts) - end || {S,[{_,S1,S2}|_]} <- SL], + end || {S,[{L2,S1,S2}|_]} <- SL], - PTs1 = [{'!',1},{'(',1},{')',1},{',',1},{';',1},{'=',1},{'[',1}, - {']',1},{'{',1},{'|',1},{'}',1}], + PTs1 = [{'!',{1,1}},{'(',{1,2}},{')',{1,3}},{',',{1,4}},{';',{1,5}}, + {'=',{1,6}},{'[',{1,7}},{']',{1,8}},{'{',{1,9}},{'|',{1,10}}, + {'}',{1,11}}], ?line test_string("!(),;=[]{|}", PTs1), - PTs2 = [{'#',1},{'&',1},{'*',1},{'+',1},{'/',1}, - {':',1},{'<',1},{'>',1},{'?',1},{'@',1}, - {'\\',1},{'^',1},{'`',1},{'~',1}], + PTs2 = [{'#',{1,1}},{'&',{1,2}},{'*',{1,3}},{'+',{1,4}},{'/',{1,5}}, + {':',{1,6}},{'<',{1,7}},{'>',{1,8}},{'?',{1,9}},{'@',{1,10}}, + {'\\',{1,11}},{'^',{1,12}},{'`',{1,13}},{'~',{1,14}}], ?line test_string("#&*+/:<>?@\\^`~", PTs2), - ?line test_string(".. ", [{'..',1}]), - ?line test("1 .. 2"), - ?line test_string("...", [{'...',1}]), + test_string(".. ", [{'..',{1,1}}]), + test_string("1 .. 2", + [{integer,{1,1},1},{'..',{1,3}},{integer,{1,6},2}]), + test_string("...", [{'...',{1,1}}]), ok. comments() -> ?line test("a %%\n b"), ?line {ok,[],1} = erl_scan:string("%"), ?line test("a %%\n b"), - ?line {ok,[{atom,_,a},{atom,_,b}],{2,3}} = + {ok,[{atom,{1,1},a},{atom,{2,2},b}],{2,3}} = erl_scan:string("a %%\n b",{1,1}), - ?line {ok,[{atom,_,a},{comment,_,"%%"},{atom,_,b}],{2,3}} = + {ok,[{atom,{1,1},a},{comment,{1,3},"%%"},{atom,{2,2},b}],{2,3}} = erl_scan:string("a %%\n b",{1,1}, [return_comments]), - ?line {ok,[{atom,_,a}, - {white_space,_," "}, - {white_space,_,"\n "}, - {atom,_,b}], - {2,3}} = + {ok,[{atom,{1,1},a}, + {white_space,{1,2}," "}, + {white_space,{1,5},"\n "}, + {atom,{2,2},b}], + {2,3}} = erl_scan:string("a %%\n b",{1,1},[return_white_spaces]), - ?line {ok,[{atom,_,a}, - {white_space,_," "}, - {comment,_,"%%"}, - {white_space,_,"\n "}, - {atom,_,b}], - {2,3}} = erl_scan:string("a %%\n b",{1,1},[return]), + {ok,[{atom,{1,1},a}, + {white_space,{1,2}," "}, + {comment,{1,3},"%%"}, + {white_space,{1,5},"\n "}, + {atom,{2,2},b}], + {2,3}} = erl_scan:string("a %%\n b",{1,1},[return]), ok. errors() -> ?line {error,{1,erl_scan,{string,$',"qa"}},1} = erl_scan:string("'qa"), %' + {error,{{1,1},erl_scan,{string,$',"qa"}},{1,4}} = %' + erl_scan:string("'qa", {1,1}, []), %' ?line {error,{1,erl_scan,{string,$","str"}},1} = %" erl_scan:string("\"str"), %" + {error,{{1,1},erl_scan,{string,$","str"}},{1,5}} = %" + erl_scan:string("\"str", {1,1}, []), %" ?line {error,{1,erl_scan,char},1} = erl_scan:string("$"), - ?line test_string([34,65,200,34], [{string,1,"AÈ"}]), - ?line test_string("\\", [{'\\',1}]), + {error,{{1,1},erl_scan,char},{1,2}} = erl_scan:string("$", {1,1}, []), + test_string([34,65,200,34], [{string,{1,1},"AÈ"}]), + test_string("\\", [{'\\',{1,1}}]), ?line {'EXIT',_} = (catch {foo, erl_scan:string('$\\a', {1,1})}), % type error ?line {'EXIT',_} = @@ -304,7 +311,7 @@ errors() -> integers() -> [begin I = list_to_integer(S), - Ts = [{integer,1,I}], + Ts = [{integer,{1,1},I}], ?line test_string(S, Ts) end || S <- [[N] || N <- lists:seq($0, $9)] ++ ["2323","000"] ], ok. @@ -313,14 +320,16 @@ base_integers() -> [begin B = list_to_integer(BS), I = erlang:list_to_integer(S, B), - Ts = [{integer,1,I}], + Ts = [{integer,{1,1},I}], ?line test_string(BS++"#"++S, Ts) end || {BS,S} <- [{"2","11"}, {"5","23234"}, {"12","05a"}, {"16","abcdef"}, {"16","ABCDEF"}] ], ?line {error,{1,erl_scan,{base,1}},1} = erl_scan:string("1#000"), + {error,{{1,1},erl_scan,{base,1}},{1,2}} = + erl_scan:string("1#000", {1,1}, []), - ?line test_string("12#bc", [{integer,1,11},{atom,1,c}]), + test_string("12#bc", [{integer,{1,1},11},{atom,{1,5},c}]), [begin Str = BS ++ "#" ++ S, @@ -329,40 +338,53 @@ base_integers() -> end || {BS,S} <- [{"3","3"},{"15","f"}, {"12","c"}] ], ?line {ok,[{integer,1,239},{'@',1}],1} = erl_scan:string("16#ef@"), - ?line {ok,[{integer,1,14},{atom,1,g@}],1} = erl_scan:string("16#eg@"), + {ok,[{integer,{1,1},239},{'@',{1,6}}],{1,7}} = + erl_scan:string("16#ef@", {1,1}, []), + {ok,[{integer,{1,1},14},{atom,{1,5},g@}],{1,7}} = + erl_scan:string("16#eg@", {1,1}, []), ok. floats() -> [begin F = list_to_float(FS), - Ts = [{float,1,F}], + Ts = [{float,{1,1},F}], ?line test_string(FS, Ts) end || FS <- ["1.0","001.17","3.31200","1.0e0","1.0E17", "34.21E-18", "17.0E+14"]], - ?line test_string("1.e2", [{integer,1,1},{'.',1},{atom,1,e2}]), + test_string("1.e2", [{integer,{1,1},1},{'.',{1,2}},{atom,{1,3},e2}]), ?line {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string("1.0e400"), + {error,{{1,1},erl_scan,{illegal,float}},{1,8}} = + erl_scan:string("1.0e400", {1,1}, []), [begin - ?line {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string(S) + {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string(S), + {error,{{1,1},erl_scan,{illegal,float}},{1,_}} = + erl_scan:string(S, {1,1}, []) end || S <- ["1.14Ea"]], ok. dots() -> - Dot = [{".", {ok,[{dot,1}],1}}, - {". ", {ok,[{dot,1}],1}}, - {".\n", {ok,[{dot,1}],2}}, - {".%", {ok,[{dot,1}],1}}, - {".\210",{ok,[{dot,1}],1}}, - {".% öh",{ok,[{dot,1}],1}}, - {".%\n", {ok,[{dot,1}],2}}, - {".$", {error,{1,erl_scan,char},1}}, - {".$\\", {error,{1,erl_scan,char},1}}, - {".a", {ok,[{'.',1},{atom,1,a}],1}} + Dot = [{".", {ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,2}}}, + {". ", {ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,3}}}, + {".\n", {ok,[{dot,1}],2}, {ok,[{dot,{1,1}}],{2,1}}}, + {".%", {ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,3}}}, + {".\210",{ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,3}}}, + {".% öh",{ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,6}}}, + {".%\n", {ok,[{dot,1}],2}, {ok,[{dot,{1,1}}],{2,1}}}, + {".$", {error,{1,erl_scan,char},1}, + {error,{{1,2},erl_scan,char},{1,3}}}, + {".$\\", {error,{1,erl_scan,char},1}, + {error,{{1,2},erl_scan,char},{1,4}}}, + {".a", {ok,[{'.',1},{atom,1,a}],1}, + {ok,[{'.',{1,1}},{atom,{1,2},a}],{1,3}}} ], - ?line [R = erl_scan:string(S) || {S, R} <- Dot], + [begin + R = erl_scan:string(S), + R2 = erl_scan:string(S, {1,1}, []) + end || {S, R, R2} <- Dot], ?line {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text), ?line [{column,1},{length,1},{line,1},{text,"."}] = @@ -379,55 +401,55 @@ dots() -> ?line {error,{{1,2},erl_scan,char},{1,4}} = erl_scan:string(".$\\", {1,1}), - ?line test(". "), - ?line test(". "), - ?line test(".\n"), - ?line test(".\n\n"), - ?line test(".\n\r"), - ?line test(".\n\n\n"), - ?line test(".\210"), - ?line test(".%\n"), - ?line test(".a"), - - ?line test("%. \n. "), + test_string(". ", [{dot,{1,1}}]), + test_string(". ", [{dot,{1,1}}]), + test_string(".\n", [{dot,{1,1}}]), + test_string(".\n\n", [{dot,{1,1}}]), + test_string(".\n\r", [{dot,{1,1}}]), + test_string(".\n\n\n", [{dot,{1,1}}]), + test_string(".\210", [{dot,{1,1}}]), + test_string(".%\n", [{dot,{1,1}}]), + test_string(".a", [{'.',{1,1}},{atom,{1,2},a}]), + + test_string("%. \n. ", [{dot,{2,1}}]), ?line {more,C} = erl_scan:tokens([], "%. ",{1,1}, return), - ?line {done,{ok,[{comment,_,"%. "}, - {white_space,_,"\n"}, - {dot,_}], - {2,3}}, ""} = + {done,{ok,[{comment,{1,1},"%. "}, + {white_space,{1,4},"\n"}, + {dot,{2,1}}], + {2,3}}, ""} = erl_scan:tokens(C, "\n. ", {1,1}, return), % any loc, any options ?line [test_string(S, R) || - {S, R} <- [{".$\n", [{'.',1},{char,1,$\n}]}, - {"$\\\n", [{char,1,$\n}]}, - {"'\\\n'", [{atom,1,'\n'}]}, - {"$\n", [{char,1,$\n}]}] ], + {S, R} <- [{".$\n", [{'.',{1,1}},{char,{1,2},$\n}]}, + {"$\\\n", [{char,{1,1},$\n}]}, + {"'\\\n'", [{atom,{1,1},'\n'}]}, + {"$\n", [{char,{1,1},$\n}]}] ], ok. chars() -> [begin L = lists:flatten(io_lib:format("$\\~.8b", [C])), - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], %% Leading zeroes... [begin L = lists:flatten(io_lib:format("$\\~3.8.0b", [C])), - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], %% $\^\n now increments the line... [begin L = "$\\^" ++ [C], - Ts = [{char,1,C band 2#11111}], + Ts = [{char,{1,1},C band 2#11111}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], [begin L = "$\\" ++ [C], - Ts = [{char,1,V}], + Ts = [{char,{1,1},V}], ?line test_string(L, Ts) end || {C,V} <- [{$n,$\n}, {$r,$\r}, {$t,$\t}, {$v,$\v}, {$b,$\b}, {$f,$\f}, {$e,$\e}, {$s,$\s}, @@ -440,45 +462,45 @@ chars() -> No = EC ++ Ds ++ X ++ New, [begin L = "$\\" ++ [C], - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255) -- No], [begin L = "'$\\" ++ [C] ++ "'", - Ts = [{atom,1,list_to_atom("$"++[C])}], + Ts = [{atom,{1,1},list_to_atom("$"++[C])}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255) -- No], - ?line test_string("\"\\013a\\\n\"", [{string,1,"\va\n"}]), + test_string("\"\\013a\\\n\"", [{string,{1,1},"\va\n"}]), - ?line test_string("'\n'", [{atom,1,'\n'}]), - ?line test_string("\"\n\a\"", [{string,1,"\na"}]), + test_string("'\n'", [{atom,{1,1},'\n'}]), + test_string("\"\n\a\"", [{string,{1,1},"\na"}]), %% No escape [begin L = "$" ++ [C], - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255) -- (No ++ [$\\])], - ?line test_string("$\n", [{char,1,$\n}]), + test_string("$\n", [{char,{1,1},$\n}]), ?line {error,{{1,1},erl_scan,char},{1,4}} = erl_scan:string("$\\^",{1,1}), - ?line test_string("$\\\n", [{char,1,$\n}]), + test_string("$\\\n", [{char,{1,1},$\n}]), %% Robert's scanner returns line 1: - ?line test_string("$\\\n", [{char,1,$\n}]), - ?line test_string("$\n\n", [{char,1,$\n}]), + test_string("$\\\n", [{char,{1,1},$\n}]), + test_string("$\n\n", [{char,{1,1},$\n}]), ?line test("$\n\n"), ok. variables() -> - ?line test_string(" \237_Aouåeiyäö", [{var,1,'_Aouåeiyäö'}]), - ?line test_string("A_b_c@", [{var,1,'A_b_c@'}]), - ?line test_string("V@2", [{var,1,'V@2'}]), - ?line test_string("ABDÀ", [{var,1,'ABDÀ'}]), - ?line test_string("Ärlig Östen", [{var,1,'Ärlig'},{var,1,'Östen'}]), + test_string(" \237_Aouåeiyäö", [{var,{1,7},'_Aouåeiyäö'}]), + test_string("A_b_c@", [{var,{1,1},'A_b_c@'}]), + test_string("V@2", [{var,{1,1},'V@2'}]), + test_string("ABDÀ", [{var,{1,1},'ABDÀ'}]), + test_string("Ärlig Östen", [{var,{1,1},'Ärlig'},{var,{1,7},'Östen'}]), ok. eof() -> @@ -508,11 +530,25 @@ eof() -> ?line {done,{ok,[{atom,1,a}],1},eof} = erl_scan:tokens(C5,eof,1), + %% With column. + {more, C6} = erl_scan:tokens([], "a", {1,1}), + %% An error before R13A. + %% {done,{error,{1,erl_scan,scan},1},eof} = + {done,{ok,[{atom,{1,1},a}],{1,2}},eof} = + erl_scan:tokens(C6,eof,1), + %% A dot followed by eof is special: ?line {more, C} = erl_scan:tokens([], "a.", 1), ?line {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan:tokens(C,eof,1), ?line {ok,[{atom,1,foo},{dot,1}],1} = erl_scan:string("foo."), + %% With column. + {more, CCol} = erl_scan:tokens([], "a.", {1,1}), + {done,{ok,[{atom,{1,1},a},{dot,{1,2}}],{1,3}},eof} = + erl_scan:tokens(CCol,eof,1), + {ok,[{atom,{1,1},foo},{dot,{1,4}}],{1,5}} = + erl_scan:string("foo.", {1,1}, []), + ok. illegal() -> @@ -816,34 +852,34 @@ unicode() -> erl_scan:string([1089]), ?line {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = erl_scan:string([1089], {1,1}), - ?line {error,{1,erl_scan,{illegal,atom}},1} = + {error,{1,erl_scan,{illegal,atom}},1} = erl_scan:string("'a"++[1089]++"b'", 1), - ?line {error,{{1,1},erl_scan,{illegal,atom}},{1,6}} = + {error,{{1,1},erl_scan,{illegal,atom}},{1,6}} = erl_scan:string("'a"++[1089]++"b'", {1,1}), ?line test("\"a"++[1089]++"b\""), - ?line {ok,[{char,1,1}],1} = + {ok,[{char,1,1}],1} = erl_scan:string([$$,$\\,$^,1089], 1), - ?line {error,{1,erl_scan,Error},1} = + {error,{1,erl_scan,Error},1} = erl_scan:string("\"qa\x{aaa}", 1), - ?line "unterminated string starting with \"qa"++[2730]++"\"" = + "unterminated string starting with \"qa"++[2730]++"\"" = erl_scan:format_error(Error), ?line {error,{{1,1},erl_scan,_},{1,11}} = erl_scan:string("\"qa\\x{aaa}",{1,1}), - ?line {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = + {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = erl_scan:string("'qa\\x{aaa}'",{1,1}), - ?line {ok,[{char,1,1089}],1} = + {ok,[{char,1,1089}],1} = erl_scan:string([$$,1089], 1), - ?line {ok,[{char,1,1089}],1} = + {ok,[{char,1,1089}],1} = erl_scan:string([$$,$\\,1089], 1), Qs = "$\\x{aaa}", - ?line {ok,[{char,1,$\x{aaa}}],1} = + {ok,[{char,1,$\x{aaa}}],1} = erl_scan:string(Qs, 1), - ?line {ok,[Q2],{1,9}} = + {ok,[Q2],{1,9}} = erl_scan:string("$\\x{aaa}", {1,1}, [text]), - ?line [{category,char},{column,1},{length,8}, + [{category,char},{column,1},{length,8}, {line,1},{symbol,16#aaa},{text,Qs}] = erl_scan:token_info(Q2), @@ -1164,7 +1200,13 @@ otp_11807(Config) when is_list(Config) -> (catch erl_parse:abstract("string", [{encoding,bad}])), ok. -test_string(String, Expected) -> +test_string(String, ExpectedWithCol) -> + {ok, ExpectedWithCol, _EndWithCol} = erl_scan:string(String, {1, 1}, []), + Expected = [ begin + {L,_C} = element(2, T), + setelement(2, T, L) + end + || T <- ExpectedWithCol ], {ok, Expected, _End} = erl_scan:string(String), test(String). diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index 8aeec07ae8..336065b258 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -31,7 +31,9 @@ -export([shutdown/1]). --export([ sys1/1, call_format_status/1, error_format_status/1, get_state/1, replace_state/1]). +-export([ sys1/1, + call_format_status/1, error_format_status/1, terminate_crash_format/1, + get_state/1, replace_state/1]). -export([hibernate/1,hiber_idle/3,hiber_wakeup/3,hiber_idle/2,hiber_wakeup/2]). @@ -66,7 +68,8 @@ groups() -> start8, start9, start10, start11, start12]}, {abnormal, [], [abnormal1, abnormal2]}, {sys, [], - [sys1, call_format_status, error_format_status, get_state, replace_state]}]. + [sys1, call_format_status, error_format_status, terminate_crash_format, + get_state, replace_state]}]. init_per_suite(Config) -> Config. @@ -403,7 +406,7 @@ error_format_status(Config) when is_list(Config) -> receive {error,_GroupLeader,{Pid, "** State machine"++_, - [Pid,{_,_,badreturn},idle,StateData,_]}} -> + [Pid,{_,_,badreturn},idle,{formatted,StateData},_]}} -> ok; Other -> ?line io:format("Unexpected: ~p", [Other]), @@ -413,6 +416,29 @@ error_format_status(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +terminate_crash_format(Config) when is_list(Config) -> + error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + StateData = crash_terminate, + {ok, Pid} = gen_fsm:start(gen_fsm_SUITE, {state_data, StateData}, []), + stop_it(Pid), + receive + {error,_GroupLeader,{Pid, + "** State machine"++_, + [Pid,{_,_,_},idle,{formatted, StateData},_]}} -> + ok; + Other -> + io:format("Unexpected: ~p", [Other]), + ?t:fail() + after 5000 -> + io:format("Timeout: expected error logger msg", []), + ?t:fail() + end, + [] = ?t:messages_get(), + process_flag(trap_exit, OldFl), + ok. + + get_state(Config) when is_list(Config) -> State = self(), {ok, Pid} = gen_fsm:start(?MODULE, {state_data, State}, []), @@ -867,7 +893,8 @@ init({state_data, StateData}) -> init(_) -> {ok, idle, state_data}. - +terminate(_, _State, crash_terminate) -> + exit({crash, terminate}); terminate({From, stopped}, State, _Data) -> From ! {self(), {stopped, State}}, ok; @@ -1005,6 +1032,6 @@ handle_sync_event({get, _Pid}, _From, State, Data) -> {reply, {state, State, Data}, State, Data}. format_status(terminate, [_Pdict, StateData]) -> - StateData; + {formatted, StateData}; format_status(normal, [_Pdict, _StateData]) -> [format_status_called]. diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 960e7f60e7..42694d8b5d 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -32,7 +32,8 @@ spec_init_local_registered_parent/1, spec_init_global_registered_parent/1, otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1, - error_format_status/1, get_state/1, replace_state/1, call_with_huge_message_queue/1 + error_format_status/1, terminate_crash_format/1, + get_state/1, replace_state/1, call_with_huge_message_queue/1 ]). % spawn export @@ -56,7 +57,8 @@ all() -> call_remote_n3, spec_init, spec_init_local_registered_parent, spec_init_global_registered_parent, otp_5854, hibernate, - otp_7669, call_format_status, error_format_status, + otp_7669, + call_format_status, error_format_status, terminate_crash_format, get_state, replace_state, call_with_huge_message_queue]. @@ -273,7 +275,7 @@ crash(Config) when is_list(Config) -> receive {error,_GroupLeader4,{Pid4, "** Generic server"++_, - [Pid4,crash,state4,crashed]}} -> + [Pid4,crash,{formatted, state4},crashed]}} -> ok; Other4a -> ?line io:format("Unexpected: ~p", [Other4a]), @@ -1024,7 +1026,7 @@ error_format_status(Config) when is_list(Config) -> receive {error,_GroupLeader,{Pid, "** Generic server"++_, - [Pid,crash,State,crashed]}} -> + [Pid,crash,{formatted, State},crashed]}} -> ok; Other -> ?line io:format("Unexpected: ~p", [Other]), @@ -1034,6 +1036,31 @@ error_format_status(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +%% Verify that error when terminating correctly calls our format_status/2 fun +%% +terminate_crash_format(Config) when is_list(Config) -> + error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + State = crash_terminate, + {ok, Pid} = gen_server:start_link(?MODULE, {state, State}, []), + gen_server:call(Pid, stop), + receive {'EXIT', Pid, {crash, terminate}} -> ok end, + receive + {error,_GroupLeader,{Pid, + "** Generic server"++_, + [Pid,stop, {formatted, State},{crash, terminate}]}} -> + ok; + Other -> + io:format("Unexpected: ~p", [Other]), + ?t:fail() + after 5000 -> + io:format("Timeout: expected error logger msg", []), + ?t:fail() + end, + ?t:messages_get(), + process_flag(trap_exit, OldFl), + ok. + %% Verify that sys:get_state correctly returns gen_server state %% get_state(suite) -> @@ -1323,10 +1350,12 @@ terminate({From, stopped}, _State) -> terminate({From, stopped_info}, _State) -> From ! {self(), stopped_info}, ok; +terminate(_, crash_terminate) -> + exit({crash, terminate}); terminate(_Reason, _State) -> ok. format_status(terminate, [_PDict, State]) -> - State; + {formatted, State}; format_status(normal, [_PDict, _State]) -> format_status_called. |