diff options
Diffstat (limited to 'lib')
132 files changed, 3330 insertions, 2094 deletions
diff --git a/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl b/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl index c64774cd4f..0b3f834732 100644 --- a/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl +++ b/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl @@ -74,7 +74,7 @@ test_get_known_variable(_)-> test_localtime_update(_)-> Seconds = 5, LT1 = ct:get_config(localtime), - ct:sleep(Seconds*1000), + timer:sleep(Seconds*1000), % don't want scaling of this timer LT2 = ct:reload_config(localtime), case is_diff_ok(LT1, LT2, Seconds) of {false, Actual, Exp}-> diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl index 065639dd36..f34969683c 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl @@ -123,41 +123,37 @@ init_per_testcase(_Case, Config) -> end_per_testcase(_Case, _Config) -> ok. -init_per_suite() -> - [{timetrap,2*?default_timeout}]. % making dsa files can be slow init_per_suite(Config) -> case catch ssh:start() of Ok when Ok==ok; Ok=={error,{already_started,ssh}} -> ct:log("ssh started",[]), - {ok, _} = netconfc_test_lib:get_id_keys(Config), - netconfc_test_lib:make_dsa_files(Config), - ct:log("dsa files created",[]), - Server = ?NS:start(?config(data_dir,Config)), + SshDir = filename:join(filename:dirname(code:which(?MODULE)), + "ssh_dir"), + Server = ?NS:start(SshDir), ct:log("netconf server started",[]), - [{server,Server}|Config]; + [{netconf_server,Server},{ssh_dir,SshDir}|Config]; Other -> ct:log("could not start ssh: ~p",[Other]), {skip, "SSH could not be started!"} end. end_per_suite(Config) -> - ?NS:stop(?config(server,Config)), + ?NS:stop(?config(netconf_server,Config)), ssh:stop(), crypto:stop(), - netconfc_test_lib:remove_id_keys(Config), Config. hello(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client), ok. hello_from_server_first(Config) -> - DataDir = ?config(data_dir,Config), + SshDir = ?config(ssh_dir,Config), ?NS:hello(1), - {ok,Client} = ct_netconfc:only_open(?DEFAULT_SSH_OPTS(DataDir)), + {ok,Client} = ct_netconfc:only_open(?DEFAULT_SSH_OPTS(SshDir)), ct:sleep(500), ?NS:expect(hello), ?ok = ct_netconfc:hello(Client, [{capability, ["urn:com:ericsson:ebase:1.1.0"]}], infinity), @@ -166,8 +162,8 @@ hello_from_server_first(Config) -> ok. hello_named(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(any_name,DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(any_name,SshDir), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client), ok. @@ -175,8 +171,8 @@ hello_named(Config) -> hello_configured() -> [{require, netconf1}]. hello_configured(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_configured_success(netconf1,DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_configured_success(netconf1,SshDir), ?NS:expect_do_reply('close-session',close,ok), {error, {no_such_name,netconf1}} = ct_netconfc:close_session(netconf1), ?ok = ct_netconfc:close_session(Client), @@ -185,10 +181,10 @@ hello_configured(Config) -> hello_configured_extraopts() -> [{require, netconf1}]. hello_configured_extraopts(Config) -> - DataDir = ?config(data_dir,Config), + SshDir = ?config(ssh_dir,Config), %% Test that the cofiguration overwrites the ExtraOpts parameter %% to ct_netconfc:open/2. - {ok,Client} = open_configured_success(netconf1,DataDir,[{password,"faulty"}]), + {ok,Client} = open_configured_success(netconf1,SshDir,[{password,"faulty"}]), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client), ok. @@ -196,8 +192,8 @@ hello_configured_extraopts(Config) -> hello_required() -> [{require, my_named_connection, netconf1}]. hello_required(Config) -> - DataDir = ?config(data_dir,Config), - {ok,_Client} = open_configured_success(my_named_connection,DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,_Client} = open_configured_success(my_named_connection,SshDir), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(my_named_connection), ok. @@ -205,69 +201,69 @@ hello_required(Config) -> hello_required_exists() -> [{require, my_named_connection, netconf1}]. hello_required_exists(Config) -> - DataDir = ?config(data_dir,Config), - {ok,_Client1} = open_configured_success(my_named_connection,DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,_Client1} = open_configured_success(my_named_connection,SshDir), %% Check that same name can not be used twice {error,{connection_exists,_Client1}} = - ct_netconfc:open(my_named_connection,[{user_dir,DataDir}]), + ct_netconfc:open(my_named_connection,[{user_dir,SshDir}]), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(my_named_connection), ct:sleep(500), %% Then check that it can be used again after the first is closed - {ok,_Client2} = open_configured_success(my_named_connection,DataDir), + {ok,_Client2} = open_configured_success(my_named_connection,SshDir), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(my_named_connection), ok. hello_global_pwd(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir,[{user,"any-user"}, + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir,[{user,"any-user"}, {password,"global-xxx"}]), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client), ok. hello_no_session_id(Config) -> - DataDir = ?config(data_dir,Config), + SshDir = ?config(ssh_dir,Config), ?NS:hello(no_session_id), ?NS:expect(no_session_id,hello), - {error,{incorrect_hello,no_session_id_found}} = open(DataDir), + {error,{incorrect_hello,no_session_id_found}} = open(SshDir), ok. hello_incomp_base_vsn(Config) -> - DataDir = ?config(data_dir,Config), + SshDir = ?config(ssh_dir,Config), ?NS:hello(1,{base,"1.1"}), ?NS:expect(hello), - {error,{incompatible_base_capability_vsn,"1.1"}} = open(DataDir), + {error,{incompatible_base_capability_vsn,"1.1"}} = open(SshDir), ok. hello_no_base_cap(Config) -> - DataDir = ?config(data_dir,Config), + SshDir = ?config(ssh_dir,Config), ?NS:hello(1,no_base), ?NS:expect(hello), - {error,{incorrect_hello,no_base_capability_found}} = open(DataDir), + {error,{incorrect_hello,no_base_capability_found}} = open(SshDir), ok. hello_no_caps(Config) -> - DataDir = ?config(data_dir,Config), + SshDir = ?config(ssh_dir,Config), ?NS:hello(1,no_caps), ?NS:expect(hello), - {error,{incorrect_hello,capabilities_not_found}} = open(DataDir), + {error,{incorrect_hello,capabilities_not_found}} = open(SshDir), ok. no_server_hello(Config) -> - DataDir = ?config(data_dir,Config), + SshDir = ?config(ssh_dir,Config), ?NS:expect(undefined,hello), - {error,{hello_session_failed,timeout}} = open(DataDir,[{timeout,2000}]), + {error,{hello_session_failed,timeout}} = open(SshDir,[{timeout,2000}]), ok. no_client_hello(Config) -> - DataDir = ?config(data_dir,Config), + SshDir = ?config(ssh_dir,Config), ?NS:hello(1), - {ok,Client} = ct_netconfc:only_open(?DEFAULT_SSH_OPTS(DataDir)), + {ok,Client} = ct_netconfc:only_open(?DEFAULT_SSH_OPTS(SshDir)), %% Allow server hello to arrive ct:sleep(500), @@ -280,8 +276,8 @@ no_client_hello(Config) -> ok. get_session_id(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), 1 = ct_netconfc:get_session_id(Client), @@ -290,8 +286,8 @@ get_session_id(Config) -> ok. get_capabilities(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), Caps = ct_netconfc:get_capabilities(Client), BaseCap = ?NETCONF_BASE_CAP ++ ?NETCONF_BASE_CAP_VSN, @@ -302,49 +298,49 @@ get_capabilities(Config) -> ok. faulty_user(Config) -> - DataDir = ?config(data_dir,Config), + SshDir = ?config(ssh_dir,Config), {error,{ssh,could_not_connect_to_server, "Unable to connect using the available authentication methods"}} = - open(DataDir,[{user,"yyy"}]), + open(SshDir,[{user,"yyy"}]), ok. faulty_passwd(Config) -> - DataDir = ?config(data_dir,Config), + SshDir = ?config(ssh_dir,Config), {error,{ssh,could_not_connect_to_server, "Unable to connect using the available authentication methods"}} = - open(DataDir,[{password,"yyy"}]), + open(SshDir,[{password,"yyy"}]), ok. faulty_port(Config) -> - DataDir = ?config(data_dir,Config), + SshDir = ?config(ssh_dir,Config), {error,{ssh,could_not_connect_to_server,econnrefused}} = - open(DataDir,[{port,2062}]), + open(SshDir,[{port,2062}]), ok. no_host(Config) -> - DataDir = ?config(data_dir,Config), - Opts = lists:keydelete(ssh,1,?DEFAULT_SSH_OPTS(DataDir)), + SshDir = ?config(ssh_dir,Config), + Opts = lists:keydelete(ssh,1,?DEFAULT_SSH_OPTS(SshDir)), {error,no_host_address} = ct_netconfc:open(Opts), ok. no_port(Config) -> - DataDir = ?config(data_dir,Config), - Opts = lists:keydelete(port,1,?DEFAULT_SSH_OPTS(DataDir)), + SshDir = ?config(ssh_dir,Config), + Opts = lists:keydelete(port,1,?DEFAULT_SSH_OPTS(SshDir)), {error,no_port} = ct_netconfc:open(Opts), ok. invalid_opt(Config) -> - DataDir = ?config(data_dir,Config), - Opts1 = ?DEFAULT_SSH_OPTS(DataDir) ++ [{timeout,invalidvalue}], + SshDir = ?config(ssh_dir,Config), + Opts1 = ?DEFAULT_SSH_OPTS(SshDir) ++ [{timeout,invalidvalue}], {error,{invalid_option,{timeout,invalidvalue}}} = ct_netconfc:open(Opts1), - Opts2 = ?DEFAULT_SSH_OPTS(DataDir) ++ [{some_other_opt,true}], + Opts2 = ?DEFAULT_SSH_OPTS(SshDir) ++ [{some_other_opt,true}], {error,{ssh,could_not_connect_to_server,{options,_}}} = ct_netconfc:open(Opts2), ok. timeout_close_session(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect('close-session'), true = erlang:is_process_alive(Client), {error,timeout} = ct_netconfc:close_session(Client,1000), @@ -352,8 +348,8 @@ timeout_close_session(Config) -> ok. get(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), Data = [{server,[{xmlns,"myns"}],[{name,[],["myserver"]}]}], ?NS:expect_reply('get',{data,Data}), {ok,Data} = ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]}), @@ -362,8 +358,8 @@ get(Config) -> ok. get_a_lot(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), Descr = lists:append(lists:duplicate(1000,"Description of myserver! ")), Server = {server,[{xmlns,"myns"}],[{name,[],["myserver"]}, {description,[],[Descr]}]}, @@ -375,8 +371,8 @@ get_a_lot(Config) -> ok. timeout_get(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect('get'), {error,timeout} = ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]},1000), ?NS:expect_do_reply('close-session',close,ok), @@ -392,8 +388,8 @@ timeout_get(Config) -> %% Note that we can only hope that the test case triggers the problem %% every now and then, as it is very timing dependent... flush_timeout_get(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), Data = [{server,[{xmlns,"myns"}],[{name,[],["myserver"]}]}], ?NS:expect_reply('get',{data,Data}), timer:sleep(1000), @@ -406,8 +402,8 @@ flush_timeout_get(Config) -> ok. get_xpath(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), Data = [{server,[{xmlns,"myns"}],[{name,[],["myserver"]}]}], ?NS:expect_reply({'get',xpath},{data,Data}), {ok,Data} = ct_netconfc:get(Client,{xpath,"/server"}), @@ -416,8 +412,8 @@ get_xpath(Config) -> ok. get_config(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), Data = [{server,[{xmlns,"myns"}],[{name,[],["myserver"]}]}], ?NS:expect_reply('get-config',{data,Data}), {ok,Data} = ct_netconfc:get_config(Client,running, @@ -427,8 +423,8 @@ get_config(Config) -> ok. get_config_xpath(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), Data = [{server,[{xmlns,"myns"}],[{name,[],["myserver"]}]}], ?NS:expect_reply({'get-config',xpath},{data,Data}), {ok,Data} = ct_netconfc:get_config(Client,running,{xpath,"/server"}), @@ -437,8 +433,8 @@ get_config_xpath(Config) -> ok. edit_config(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect_reply('edit-config',ok), ?ok = ct_netconfc:edit_config(Client,running, {server,[{xmlns,"myns"}], @@ -448,8 +444,8 @@ edit_config(Config) -> ok. edit_config_opt_params(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect_reply({'edit-config',{'default-operation',"none"}},ok), ?ok = ct_netconfc:edit_config(Client,running, {server,[{xmlns,"myns"}], @@ -460,8 +456,8 @@ edit_config_opt_params(Config) -> ok. copy_config(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect_reply('copy-config',ok), ?ok = ct_netconfc:copy_config(Client,startup,running), ?NS:expect_do_reply('close-session',close,ok), @@ -469,8 +465,8 @@ copy_config(Config) -> ok. delete_config(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect_reply('delete-config',ok), ?ok = ct_netconfc:delete_config(Client,startup), ?NS:expect_do_reply('close-session',close,ok), @@ -478,8 +474,8 @@ delete_config(Config) -> ok. lock(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect_reply('lock',ok), ?ok = ct_netconfc:lock(Client,running), ?NS:expect_do_reply('close-session',close,ok), @@ -487,8 +483,8 @@ lock(Config) -> ok. unlock(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect_reply('unlock',ok), ?ok = ct_netconfc:unlock(Client,running), ?NS:expect_do_reply('close-session',close,ok), @@ -496,12 +492,12 @@ unlock(Config) -> ok. kill_session(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:hello(2), ?NS:expect(2,hello), - {ok,_OtherClient} = open(DataDir), + {ok,_OtherClient} = open(SshDir), ?NS:expect_do_reply('kill-session',{kill,2},ok), ?ok = ct_netconfc:kill_session(Client,2), @@ -512,8 +508,8 @@ kill_session(Config) -> ok. get_no_such_client(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client), @@ -529,8 +525,8 @@ get_no_such_client(Config) -> ok. action(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), Data = [{myactionreturn,[{xmlns,"myns"}],["value"]}], %% test either to receive {data,Data} or {ok,Data}, %% both need to be handled @@ -549,8 +545,8 @@ action(Config) -> ok. send_any_rpc(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), Data = [{server,[{xmlns,"myns"}],[{name,[],["myserver"]}]}], GetConf = {'get-config', [{source,["running"]}, @@ -571,8 +567,8 @@ send_any_rpc(Config) -> ok. send_any(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), %% Correct get-config rpc Data = [{server,[{xmlns,"myns"}],[{name,[],["myserver"]}]}], @@ -604,8 +600,8 @@ send_any(Config) -> ok. hide_password(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), Password = "my_very_secret_password", Data = [{passwords,[{xmlns,"myns"}], [{password,[{xmlns,"pwdns"}],[Password]}, @@ -633,8 +629,8 @@ hide_password(Config) -> ok. not_proper_xml(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), NS = list_to_binary(?NETCONF_NAMESPACE), NotProper = <<"<rpc-reply message-id=\"1\" xmlns=\"", NS/binary,"\"><data></rpc-reply>">>, @@ -646,8 +642,8 @@ not_proper_xml(Config) -> ok. prefixed_namespace(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), NS = list_to_binary(?NETCONF_NAMESPACE), %% Test that data element can be properly decoded and that @@ -679,8 +675,8 @@ prefixed_namespace(Config) -> %% i.e. when the complete rpc-reply is not contained in one single ssh %% data message. receive_chunked_data(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), %% Construct the data to return from netconf server Data = [{servers,[{xmlns,"myns"}], @@ -727,8 +723,8 @@ receive_chunked_data(Config) -> %% Same as receive_chunked_data, but timeout waiting for last part. timeout_receive_chunked_data(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), %% Construct the data to return from netconf server Data = [{servers,[{xmlns,"myns"}], @@ -773,8 +769,8 @@ timeout_receive_chunked_data(Config) -> %% Same as receive_chunked_data, but close while waiting for last part. close_while_waiting_for_chunked_data(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), %% Construct the data to return from netconf server Data = [{servers,[{xmlns,"myns"}], @@ -816,8 +812,8 @@ close_while_waiting_for_chunked_data(Config) -> ok. connection_crash(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), %% Test that if the test survives killing the connection %% process. Earlier this caused ct_util_server to terminate, and @@ -828,8 +824,8 @@ connection_crash(Config) -> ok. get_event_streams(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), StreamNames = ["NETCONF","stream1","stream2"], Streams = [{N,[{description,"descr of " ++ N}]} || N <- StreamNames], StreamsXml = [{stream,[{name,[N]}|[{Tag,[Value]} || {Tag,Value} <- Data]]} @@ -849,31 +845,31 @@ get_event_streams(Config) -> ok. create_subscription(Config) -> - DataDir = ?config(data_dir,Config), + SshDir = ?config(ssh_dir,Config), %% All defaults - {ok,Client1} = open_success(DataDir), + {ok,Client1} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream]},ok), ?ok = ct_netconfc:create_subscription(Client1), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client1), %% All defaults with timeout - {ok,Client1a} = open_success(DataDir), + {ok,Client1a} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream]},ok), ?ok = ct_netconfc:create_subscription(Client1a,5000), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client1a), %% All defaults timing out - {ok,Client1b} = open_success(DataDir), + {ok,Client1b} = open_success(SshDir), ?NS:expect({'create-subscription',[stream]}), {error,timeout} = ct_netconfc:create_subscription(Client1b,100), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client1b), %% Stream - {ok,Client2} = open_success(DataDir), + {ok,Client2} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream]},ok), Stream = "some_stream", ?ok = ct_netconfc:create_subscription(Client2,Stream), @@ -881,7 +877,7 @@ create_subscription(Config) -> ?ok = ct_netconfc:close_session(Client2), %% Filter - {ok,Client3} = open_success(DataDir), + {ok,Client3} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream,filter]},ok), Filter = {notification,?NETMOD_NOTIF_NAMESPACE_ATTR, [eventTime]}, @@ -890,28 +886,28 @@ create_subscription(Config) -> ?ok = ct_netconfc:close_session(Client3), %% Filter with timeout - {ok,Client3a} = open_success(DataDir), + {ok,Client3a} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream,filter]},ok), ?ok = ct_netconfc:create_subscription(Client3a,Filter,5000), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client3a), %% Filter timing out - {ok,Client3b} = open_success(DataDir), + {ok,Client3b} = open_success(SshDir), ?NS:expect({'create-subscription',[stream,filter]}), {error,timeout}=ct_netconfc:create_subscription(Client3b,Filter,100), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client3b), %% Stream and filter - {ok,Client4} = open_success(DataDir), + {ok,Client4} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream,filter]},ok), ?ok = ct_netconfc:create_subscription(Client4,Stream,Filter), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client4), %% Start/stop time - {ok,Client5} = open_success(DataDir), + {ok,Client5} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream,startTime,stopTime]},ok), StartTime = xs_datetime({D,{H,M,S}}= calendar:local_time()), StopTime = xs_datetime({D,{H+2,M,S}}), @@ -920,14 +916,14 @@ create_subscription(Config) -> ?ok = ct_netconfc:close_session(Client5), %% Start/stop time with timeout - {ok,Client5a} = open_success(DataDir), + {ok,Client5a} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream,startTime,stopTime]},ok), ?ok = ct_netconfc:create_subscription(Client5a,StartTime,StopTime,5000), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client5a), %% Start/stop time timing out - {ok,Client5b} = open_success(DataDir), + {ok,Client5b} = open_success(SshDir), ?NS:expect({'create-subscription',[stream,startTime,stopTime]}), {error,timeout} = ct_netconfc:create_subscription(Client5b,StartTime,StopTime,100), @@ -935,14 +931,14 @@ create_subscription(Config) -> ?ok = ct_netconfc:close_session(Client5b), %% Stream and start/stop time - {ok,Client6} = open_success(DataDir), + {ok,Client6} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream,startTime,stopTime]},ok), ?ok = ct_netconfc:create_subscription(Client6,Stream,StartTime,StopTime), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client6), %% Filter and start/stop time - {ok,Client7} = open_success(DataDir), + {ok,Client7} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream,filter,startTime,stopTime]}, ok), ?ok = ct_netconfc:create_subscription(Client7,Filter, @@ -951,7 +947,7 @@ create_subscription(Config) -> ?ok = ct_netconfc:close_session(Client7), %% Stream, filter and start/stop time - {ok,Client8} = open_success(DataDir), + {ok,Client8} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream,filter,startTime,stopTime]}, ok), ?ok = ct_netconfc:create_subscription(Client8,Stream,Filter, @@ -960,7 +956,7 @@ create_subscription(Config) -> ?ok = ct_netconfc:close_session(Client8), %% Multiple filters - {ok,Client9} = open_success(DataDir), + {ok,Client9} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream,filter]},ok), MultiFilters = [{event,[{xmlns,"http://my.namespaces.com/event"}], [{eventClass,["fault"]}, @@ -975,8 +971,8 @@ create_subscription(Config) -> ok. receive_one_event(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream]},ok), ?ok = ct_netconfc:create_subscription(Client), @@ -1002,8 +998,8 @@ receive_one_event(Config) -> ok. receive_multiple_events(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream]},ok), ?ok = ct_netconfc:create_subscription(Client), @@ -1043,8 +1039,8 @@ receive_multiple_events(Config) -> ok. receive_event_and_rpc(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream]},ok), ?ok = ct_netconfc:create_subscription(Client), @@ -1103,8 +1099,8 @@ receive_event_and_rpc(Config) -> receive_event_and_rpc_in_chunks(Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(DataDir), + SshDir = ?config(ssh_dir,Config), + {ok,Client} = open_success(SshDir), ?NS:expect_reply({'create-subscription',[stream]},ok), ?ok = ct_netconfc:create_subscription(Client), diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl index 04bfe75187..0a49cdabbb 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl @@ -51,7 +51,7 @@ init_per_testcase(Case, Config) -> stop_node(Case), Config. -end_per_testcase(Case, Config) -> +end_per_testcase(Case, _Config) -> stop_node(Case), ok. @@ -61,16 +61,13 @@ stop_node(Case) -> rpc:call(Node,erlang,halt,[]). -init_per_suite() -> - [{timetrap,2*?default_timeout}]. % making dsa files can be slow init_per_suite(Config) -> case ssh:start() of Ok when Ok==ok; Ok=={error,{already_started,ssh}} -> ct:log("SSH started locally",[]), - {ok, _} = netconfc_test_lib:get_id_keys(Config), - netconfc_test_lib:make_dsa_files(Config), - ct:log("dsa files created",[]), - Config; + SshDir = filename:join(filename:dirname(code:which(?MODULE)), + "ssh_dir"), + [{ssh_dir,SshDir}|Config]; Other -> ct:log("could not start ssh locally: ~p",[Other]), {skip, "SSH could not be started locally!"} @@ -79,7 +76,6 @@ init_per_suite(Config) -> end_per_suite(Config) -> ssh:stop(), crypto:stop(), - netconfc_test_lib:remove_id_keys(Config), Config. %% This test case is related to seq12645 @@ -93,7 +89,7 @@ remote_crash(Config) -> case rpc:call(Node,ssh,start,[]) of Ok when Ok==ok; Ok=={error,{already_started,ssh}} -> ct:log("SSH started remote",[]), - Server = rpc:call(Node,?NS,start,[?config(data_dir,Config)]), + ns(Node,start,[?config(ssh_dir,Config)]), ct:log("netconf server started remote",[]), remote_crash(Node,Config); Other -> @@ -102,8 +98,7 @@ remote_crash(Config) -> end. remote_crash(Node,Config) -> - DataDir = ?config(data_dir,Config), - {ok,Client} = open_success(Node,DataDir), + {ok,Client} = open_success(Node,?config(ssh_dir,Config)), ns(Node,expect_reply,[{'create-subscription',[stream]},ok]), ?ok = ct_netconfc:create_subscription(Client), diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl deleted file mode 100644 index e058bc7600..0000000000 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl +++ /dev/null @@ -1,166 +0,0 @@ --module(netconfc_test_lib). - --export([get_id_keys/1, remove_id_keys/1, make_dsa_files/1]). --include_lib("common_test/include/ct.hrl"). --include_lib("public_key/include/public_key.hrl"). - -%%%----------------------------------------------------------------- -%%% BEGIN SSH key management -%% copy private keys to given dir from ~/.ssh -get_id_keys(Config) -> - DstDir = ?config(priv_dir, Config), - SrcDir = filename:join(os:getenv("HOME"), ".ssh"), - RsaOk = copyfile(SrcDir, DstDir, "id_rsa"), - DsaOk = copyfile(SrcDir, DstDir, "id_dsa"), - case {RsaOk, DsaOk} of - {{ok, _}, {ok, _}} -> {ok, both}; - {{ok, _}, _} -> {ok, rsa}; - {_, {ok, _}} -> {ok, dsa}; - {Error, _} -> Error - end. - -%% Remove later on. Use make_dsa_files instead. -remove_id_keys(Config) -> - Dir = ?config(priv_dir, Config), - file:delete(filename:join(Dir, "id_rsa")), - file:delete(filename:join(Dir, "id_dsa")). - - -make_dsa_files(Config) -> - make_dsa_files(Config, rfc4716_public_key). -make_dsa_files(Config, Type) -> - {DSA, EncodedKey} = gen_dsa(128, 20), - PKey = DSA#'DSAPrivateKey'.y, - P = DSA#'DSAPrivateKey'.p, - Q = DSA#'DSAPrivateKey'.q, - G = DSA#'DSAPrivateKey'.g, - Dss = #'Dss-Parms'{p=P, q=Q, g=G}, - {ok, Hostname} = inet:gethostname(), - {ok, {A, B, C, D}} = inet:getaddr(Hostname, inet), - IP = lists:concat([A, ".", B, ".", C, ".", D]), - Attributes = [], % Could be [{comment,"user@" ++ Hostname}], - HostNames = [{hostnames,[IP, IP]}], - PublicKey = [{{PKey, Dss}, Attributes}], - KnownHosts = [{{PKey, Dss}, HostNames}], - - KnownHostsEnc = public_key:ssh_encode(KnownHosts, known_hosts), - KnownHosts = public_key:ssh_decode(KnownHostsEnc, known_hosts), - - PublicKeyEnc = public_key:ssh_encode(PublicKey, Type), - - SystemTmpDir = ?config(data_dir, Config), - filelib:ensure_dir(SystemTmpDir), - file:make_dir(SystemTmpDir), - - DSAFile = filename:join(SystemTmpDir, "ssh_host_dsa_key.pub"), - file:delete(DSAFile), - - DSAPrivateFile = filename:join(SystemTmpDir, "ssh_host_dsa_key"), - file:delete(DSAPrivateFile), - - KHFile = filename:join(SystemTmpDir, "known_hosts"), - file:delete(KHFile), - - PemBin = public_key:pem_encode([EncodedKey]), - - file:write_file(DSAFile, PublicKeyEnc), - file:write_file(KHFile, KnownHostsEnc), - file:write_file(DSAPrivateFile, PemBin), - ok. - - -%%-------------------------------------------------------------------- -%% @doc Creates a dsa key (OBS: for testing only) -%% the sizes are in bytes -%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} -%% @end -%%-------------------------------------------------------------------- -gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) -> - Key = gen_dsa2(LSize, NSize), - {Key, encode_key(Key)}. - -encode_key(Key = #'DSAPrivateKey'{}) -> - Der = public_key:der_encode('DSAPrivateKey', Key), - {'DSAPrivateKey', Der, not_encrypted}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% DSA key generation (OBS: for testing only) -%% See http://en.wikipedia.org/wiki/Digital_Signature_Algorithm -%% and the fips_186-3.pdf -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -gen_dsa2(LSize, NSize) -> - Q = prime(NSize), %% Choose N-bit prime Q - X0 = prime(LSize), - P0 = prime((LSize div 2) +1), - - %% Choose L-bit prime modulus P such that p-1 is a multiple of q. - case dsa_search(X0 div (2*Q*P0), P0, Q, 1000) of - error -> - gen_dsa2(LSize, NSize); - P -> - G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. - %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used. - - X = prime(20), %% Choose x by some random method, where 0 < x < q. - Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p. - - #'DSAPrivateKey'{version=0, p = P, q = Q, - g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X} - end. - -%% See fips_186-3.pdf -dsa_search(T, P0, Q, Iter) when Iter > 0 -> - P = 2*T*Q*P0 + 1, - case is_prime(P, 50) of - true -> P; - false -> dsa_search(T+1, P0, Q, Iter-1) - end; -dsa_search(_,_,_,_) -> - error. - - -%%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -prime(ByteSize) -> - Rand = odd_rand(ByteSize), - prime_odd(Rand, 0). - -prime_odd(Rand, N) -> - case is_prime(Rand, 50) of - true -> - Rand; - false -> - prime_odd(Rand+2, N+1) - end. - -%% see http://en.wikipedia.org/wiki/Fermat_primality_test -is_prime(_, 0) -> true; -is_prime(Candidate, Test) -> - CoPrime = odd_rand(10000, Candidate), - Result = crypto:mod_pow(CoPrime, Candidate, Candidate) , - is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test). - -is_prime(CoPrime, CoPrime, Candidate, Test) -> - is_prime(Candidate, Test-1); -is_prime(_,_,_,_) -> - false. - -odd_rand(Size) -> - Min = 1 bsl (Size*8-1), - Max = (1 bsl (Size*8))-1, - odd_rand(Min, Max). - -odd_rand(Min,Max) -> - Rand = crypto:rand_uniform(Min,Max), - case Rand rem 2 of - 0 -> - Rand + 1; - _ -> - Rand - end. - -copyfile(SrcDir, DstDir, Fn) -> - file:copy(filename:join(SrcDir, Fn), - filename:join(DstDir, Fn)). - -%%% END SSH key management -%%%----------------------------------------------------------------- diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ssh_dir/ssh_host_dsa_key b/lib/common_test/test/ct_netconfc_SUITE_data/ssh_dir/ssh_host_dsa_key new file mode 100644 index 0000000000..4ee0b8657e --- /dev/null +++ b/lib/common_test/test/ct_netconfc_SUITE_data/ssh_dir/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvQIBAAKBgQDuGhXsDoUC/x98Q1KEgdf+pQjzBXFu0gMf6C2P47FILALVjvzt +HvpXarT8Y0XZb4/i5XndcKazmRArEVmPzRT0Pp7gSJpOclY/f1YrplvtMjeQaZ/Y +eD5JoQFpgIUduiifdRRt0r5gXYejCfACa+ZSFiXTvI+ZXpHC7rH+qRCRdwIVAL6Z +VUd15Rm/C4NrLD/nIL8tnnE3AoGBAOo9qlMBtN1MdmvJZ+Pa/x8O5+VxQvAVNysb +DDIZQtT58ko5r3sRA783zHtUft80FA8pUAhkrnRKnqn+bK42Xrm/IMXJd8Wi9LBy +pN5Pg37B/k6pXs2qzLDYnCCBEW9EBBUn6fyZMK7DDs/BTU7Rf0dCh1/YsxRrm0yJ +reFOd+1gAoGBAJTq0lPrrUB62NXllTbVNAusIQX870BHBHuo3K3OFYGYD85z1gwy +e495snKyYOT9QfkBiuH/VGxP2BgIQH+cr5hTWsFZ/09mdhEC5sj/bVDrhwexklVx +ZeHxpIVmpB97jXomdXVR2ZoP92Gco+qU8tXcBdopQQcybk5j4fUxa+KQAhUAmGWZ +bHhbiRb/ip5oN6edhUe47TU= +-----END DSA PRIVATE KEY----- + diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ssh_dir/ssh_host_dsa_key.pub b/lib/common_test/test/ct_netconfc_SUITE_data/ssh_dir/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..bca37299b0 --- /dev/null +++ b/lib/common_test/test/ct_netconfc_SUITE_data/ssh_dir/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAO4aFewOhQL/H3xDUoSB1/6lCPMFcW7SAx/oLY/jsUgsAtWO +/O0e+ldqtPxjRdlvj+Lled1wprOZECsRWY/NFPQ+nuBImk5yVj9/ViumW+0yN5Bpn9h4 +PkmhAWmAhR26KJ91FG3SvmBdh6MJ8AJr5lIWJdO8j5lekcLusf6pEJF3AAAAFQC+mVVH +deUZvwuDayw/5yC/LZ5xNwAAAIEA6j2qUwG03Ux2a8ln49r/Hw7n5XFC8BU3KxsMMhlC +1PnySjmvexEDvzfMe1R+3zQUDylQCGSudEqeqf5srjZeub8gxcl3xaL0sHKk3k+DfsH+ +TqlezarMsNicIIERb0QEFSfp/JkwrsMOz8FNTtF/R0KHX9izFGubTImt4U537WAAAACB +AJTq0lPrrUB62NXllTbVNAusIQX870BHBHuo3K3OFYGYD85z1gwye495snKyYOT9QfkB +iuH/VGxP2BgIQH+cr5hTWsFZ/09mdhEC5sj/bVDrhwexklVxZeHxpIVmpB97jXomdXVR +2ZoP92Gco+qU8tXcBdopQQcybk5j4fUxa+KQ +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl index 9dc9095f47..985fa40ad2 100644 --- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl @@ -308,8 +308,19 @@ large_string(_) -> VerifyStr = [C || C <- lists:flatten(Data1), C/=$ , C/=$\r, C/=$\n, C/=$>], ok = ct_telnet:send(Handle, "echo_sep "++BigString), - ct:sleep(50), - {ok,Data2} = ct_telnet:get_data(Handle), + %% On some slow machines, 50 ms might not be enough to get the + %% first packet of data. We will therefore keep trying for a + %% second before we give up this... + F = fun RepeatUntilData(N) -> + ct:sleep(50), + case ct_telnet:get_data(Handle) of + {ok,[]} when N>1 -> + RepeatUntilData(N-1); + Other -> + Other + end + end, + {ok,Data2} = F(20), ct:log("[GET DATA #2] Received ~w chars: ~s", [length(lists:flatten(Data2)),Data2]), VerifyStr = [C || C <- lists:flatten(Data2), C/=$ , C/=$\r, C/=$\n, C/=$>], diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl index 107d98d72c..2c33cb268a 100644 --- a/lib/common_test/test/telnet_server.erl +++ b/lib/common_test/test/telnet_server.erl @@ -59,7 +59,7 @@ init(Opts) -> accept(State), ok = gen_tcp:close(LSock), dbg("telnet_server closed the listen socket ~p\n", [LSock]), - ct:sleep(1000), + timer:sleep(1000), ok. listen(0, _Port, _Opts) -> @@ -68,7 +68,7 @@ listen(Retries, Port, Opts) -> case gen_tcp:listen(Port, Opts) of {error,eaddrinuse} -> dbg("Listen port not released, trying again..."), - ct:sleep(5000), + timer:sleep(5000), listen(Retries-1, Port, Opts); Ok = {ok,_LSock} -> Ok; @@ -193,6 +193,9 @@ handle_cmd([?AYT|T],State) -> %% Used when testing 'newline' option in ct_telnet:send and ct_telnet:cmd. send("yes\r\n> ",State), handle_data(T,State); +handle_cmd([?NOP|T],State) -> + %% Used for 'keep alive' + handle_data(T,State); handle_cmd([_H|T],State) -> %% Not responding to this command handle_cmd(T,State); @@ -203,6 +206,9 @@ handle_break_cmd([$q|T],State) -> %% Dummy cmd allowed in break mode - quit break mode send("\r\n> ",State), handle_data(T,State#state{break=false}); +handle_break_cmd([_H|T],State) -> + %% Unknown command i break mode - ignore + handle_break_cmd(T,State); handle_break_cmd([],State) -> {ok,State}. @@ -220,7 +226,7 @@ do_handle_data("echo_sep " ++ Data,State) -> Msgs = string:tokens(Data," "), lists:foreach(fun(Msg) -> send(Msg,State), - ct:sleep(10) + timer:sleep(10) end, Msgs), send("\r\n> ",State), {ok,State}; @@ -245,7 +251,7 @@ do_handle_data("echo_loop " ++ Data,State) -> do_handle_data("echo_delayed_prompt "++Data,State) -> [MsStr|EchoData] = string:tokens(Data, " "), send(string:join(EchoData,"\n"),State), - ct:sleep(list_to_integer(MsStr)), + timer:sleep(list_to_integer(MsStr)), send("\r\n> ",State), {ok,State}; do_handle_data("disconnect_after " ++WaitStr,State) -> @@ -298,7 +304,7 @@ send_loop(T0,T,Data,State) -> ok; true -> send(Data,State), - ct:sleep(500), + timer:sleep(500), send_loop(T0,T,Data,State) end. diff --git a/lib/common_test/test_server/ts_install.erl b/lib/common_test/test_server/ts_install.erl index b906eb21f5..5734bd0787 100644 --- a/lib/common_test/test_server/ts_install.erl +++ b/lib/common_test/test_server/ts_install.erl @@ -332,11 +332,12 @@ platform(Vars) -> LC = lock_checking(), MT = modified_timing(), AsyncThreads = async_threads(), + OffHeapMsgQ = off_heap_msgq(), Debug = debug(), CpuBits = word_size(), Common = lists:concat([Hostname,"/",OsType,"/",CpuType,CpuBits,LinuxDist, Schedulers,BindType,KP,IOTHR,LC,MT,AsyncThreads, - Debug,ExtraLabel]), + OffHeapMsgQ,Debug,ExtraLabel]), PlatformId = lists:concat([ErlType, " ", Version, Common]), PlatformLabel = ErlType ++ Common, PlatformFilename = platform_as_filename(PlatformId), @@ -400,6 +401,12 @@ async_threads() -> _ -> "" end. +off_heap_msgq() -> + case catch erlang:system_info(message_queue_data) of + off_heap -> "/OffHeapMsgQ"; + _ -> "" + end. + schedulers() -> case catch erlang:system_info(smp_support) of true -> diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index dd42add433..b01f58f683 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -262,7 +262,7 @@ backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> To = shortcut_select_label(To0, Reg, Src, D), Jump = {jump,{f,To}}, - case beam_utils:is_killed_at(Reg, To, D) of + case is_killed_at(Reg, To, D) of false -> backward([Move|Is], D, [Jump|Acc]); true -> backward([Jump|Is], D, Acc) end; @@ -420,7 +420,7 @@ comp_op_find_shortcut(To0, Reg, Val, D) -> To0 -> not_possible(); To -> - case beam_utils:is_killed_at(Reg, To, D) of + case is_killed_at(Reg, To, D) of false -> not_possible(); true -> To end @@ -863,3 +863,17 @@ get_literal(nil) -> get_literal({literal,_}=Lit) -> Lit; get_literal({_,_}) -> error. + + +%%% +%%% Removing stores to Y registers is not always safe +%%% if there is an instruction that causes an exception +%%% within a catch. In practice, there are few or no +%%% opportunities for removing stores to Y registers anyway +%%% if sys_core_fold has been run. +%%% + +is_killed_at({x,_}=Reg, Lbl, D) -> + beam_utils:is_killed_at(Reg, Lbl, D); +is_killed_at({y,_}, _, _) -> + false. diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index cb3a6b79de..4a181c1923 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -133,10 +133,12 @@ translate_exception(_, _, _, _) -> no. fix_block(Is, 0) -> reverse(Is); fix_block(Is, Words) -> - fix_block_1(reverse(Is), Words). + reverse(fix_block_1(Is, Words)). -fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is], Words) -> - [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]; +fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) -> + Needed = Needed0 - Words, + true = Needed >= 0, %Assertion. + [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is]; fix_block_1([I|Is], Words) -> [I|fix_block_1(Is, Words)]. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 359248c6af..09cd3aa2d4 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -266,17 +266,17 @@ extract_seq_1(_, _) -> no. %%% (3) (4) (5) (6) Jump and unreachable code optimizations. %%% --record(st, {fc, %Label for function class errors. - entry, %Entry label (must not be moved). - mlbl, %Moved labels. - labels :: cerl_sets:set() %Set of referenced labels. - }). - -opt([{label,Fc}|_]=Is0, CLabel) -> - Lbls = initial_labels(Is0), +-record(st, + { + entry, %Entry label (must not be moved). + mlbl, %Moved labels. + labels :: cerl_sets:set() %Set of referenced labels. + }). + +opt(Is0, CLabel) -> find_fixpoint(fun(Is) -> - St = #st{fc=Fc,entry=CLabel,mlbl=#{}, - labels=Lbls}, + Lbls = initial_labels(Is), + St = #st{entry=CLabel,mlbl=#{},labels=Lbls}, opt(Is, [], St) end, Is0). @@ -327,7 +327,8 @@ opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) -> %% since we will rescan the inserted labels. We MUST rescan. St = St0#st{mlbl=maps:remove(Lbl, Mlbl)}, insert_labels([Lbl|Lbls], Is, Acc, St); - error -> opt(Is, [I|Acc], St0) + error -> + opt(Is, [I|Acc], St0) end; opt([{jump,{f,_}=X}|[{label,_},{jump,X}|_]=Is], Acc, St) -> opt(Is, Acc, St); @@ -362,12 +363,19 @@ opt([I|Is], Acc, #st{labels=Used0}=St0) -> true -> skip_unreachable(Is, [I|Acc], St); false -> opt(Is, [I|Acc], St) end; -opt([], Acc, #st{fc=Fc,mlbl=Mlbl}) -> +opt([], Acc, #st{mlbl=Mlbl}) -> Code = reverse(Acc), - case maps:find(Fc, Mlbl) of - {ok,Lbls} -> insert_fc_labels(Lbls, Mlbl, Code); - error -> Code - end. + insert_fc_labels(Code, Mlbl). + +insert_fc_labels([{label,L}=I|Is0], Mlbl) -> + case maps:find(L, Mlbl) of + error -> + [I|insert_fc_labels(Is0, Mlbl)]; + {ok,Lbls} -> + Is = [{label,Lb} || Lb <- Lbls] ++ Is0, + [I|insert_fc_labels(Is, maps:remove(L, Mlbl))] + end; +insert_fc_labels([_|_]=Is, _) -> Is. maps_append_list(K,Vs,M) -> case M of @@ -375,16 +383,6 @@ maps_append_list(K,Vs,M) -> _ -> M#{K => Vs} end. -insert_fc_labels([L|Ls], Mlbl, Acc0) -> - Acc = [{label,L}|Acc0], - case maps:find(L, Mlbl) of - error -> - insert_fc_labels(Ls, Mlbl, Acc); - {ok,Lbls} -> - insert_fc_labels(Lbls++Ls, Mlbl, Acc) - end; -insert_fc_labels([], _, Acc) -> Acc. - collect_labels(Is, #st{entry=Entry}) -> collect_labels_1(Is, Entry, []). diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index c593184746..89cafe27ce 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -177,7 +177,8 @@ opt_recv([I|Is], D, R0, L0, Acc) -> no; false -> opt_recv(Is, D, R, L, [I|Acc]) - end. + end; +opt_recv([], _, _, _, _) -> no. opt_update_regs({block,Bl}, R, L) -> {opt_update_regs_bl(Bl, R),L}; diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 47703b4aa3..a15ecf633e 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -167,8 +167,7 @@ bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}. %% is_pure_test({test,Op,Fail,Ops}) -> true|false. %% Return 'true' if the test instruction does not modify any -%% registers and/or bit syntax matching state, nor modifies -%% any bit syntax matching state. +%% registers and/or bit syntax matching state. %% is_pure_test({test,is_eq,_,[_,_]}) -> true; is_pure_test({test,is_ne,_,[_,_]}) -> true; @@ -180,6 +179,8 @@ is_pure_test({test,is_nil,_,[_]}) -> true; is_pure_test({test,is_nonempty_list,_,[_]}) -> true; is_pure_test({test,test_arity,_,[_,_]}) -> true; is_pure_test({test,has_map_fields,_,[_|_]}) -> true; +is_pure_test({test,is_bitstr,_,[_]}) -> true; +is_pure_test({test,is_function2,_,[_,_]}) -> true; is_pure_test({test,Op,_,Ops}) -> erl_internal:new_type_test(Op, length(Ops)). @@ -324,8 +325,11 @@ check_liveness(R, [{deallocate,_}|Is], St) -> {y,_} -> {killed,St}; _ -> check_liveness(R, Is, St) end; -check_liveness(R, [return|_], St) -> - check_liveness_live_ret(R, 1, St); +check_liveness({x,_}=R, [return|_], St) -> + case R of + {x,0} -> {used,St}; + {x,_} -> {killed,St} + end; check_liveness(R, [{call,Live,_}|Is], St) -> case R of {x,X} when X < Live -> {used,St}; @@ -534,14 +538,6 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) -> check_liveness_ret(R, R, St) -> {used,St}; check_liveness_ret(_, _, St) -> {killed,St}. -check_liveness_live_ret({x,R}, Live, St) -> - if - R < Live -> {used,St}; - true -> {killed,St} - end; -check_liveness_live_ret({y,_}, _, St) -> - {killed,St}. - check_liveness_fail(_, _, _, 0, St) -> {killed,St}; check_liveness_fail(R, Op, Args, Fail, St) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index faff9940ec..13aa31b7c9 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -161,6 +161,13 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> % in the module (those that start with bs_start_match2). }). +%% Match context type. +-record(ms, + {id=make_ref() :: reference(), %Unique ID. + valid=0 :: non_neg_integer(), %Valid slots + slots=0 :: non_neg_integer() %Number of slots + }). + validate_1(Is, Name, Arity, Entry, Ft) -> validate_2(labels(Is), Name, Arity, Entry, Ft). @@ -274,7 +281,7 @@ valfun_1({bs_context_to_binary,Ctx}, #vst{current=#st{x=Xs}}=Vst) -> case Ctx of {Tag,X} when Tag =:= x; Tag =:= y -> Type = case gb_trees:lookup(X, Xs) of - {value,{match_context,_,_}} -> term; + {value,#ms{}} -> term; _ -> get_term_type(Ctx, Vst) end, set_type_reg(Type, Ctx, Vst); @@ -575,7 +582,7 @@ valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) -> verify_live(Live, Vst0), Vst1 = prune_x_regs(Live, Vst0), BranchVst = case CtxType of - {match_context,_,_} -> + #ms{} -> %% The failure branch will never be taken when Ctx %% is a match context. Therefore, the type for Ctx %% at the failure label must not be match_context @@ -828,7 +835,7 @@ kill_state_1(Vst) -> %% The stackframe must be initialized. %% The instruction will return to the instruction following the call. call(Name, Live, #vst{current=St}=Vst) -> - verify_live(Live, Vst), + verify_call_args(Name, Live, Vst), verify_y_init(Vst), case return_type(Name, Vst) of Type when Type =/= exception -> @@ -840,44 +847,74 @@ call(Name, Live, #vst{current=St}=Vst) -> %% Tail call. %% The stackframe must have a known size and be initialized. %% Does not return to the instruction following the call. -tail_call(Name, Live, Vst) -> +tail_call(Name, Live, Vst0) -> + verify_y_init(Vst0), + Vst = deallocate(Vst0), verify_call_args(Name, Live, Vst), - verify_y_init(Vst), verify_no_ct(Vst), kill_state(Vst). verify_call_args(_, 0, #vst{}) -> ok; verify_call_args({f,Lbl}, Live, Vst) when is_integer(Live)-> - Verify = fun(R) -> - case get_move_term_type(R, Vst) of - {match_context,_,_} -> - verify_call_match_context(Lbl, Vst); - _ -> - ok - end - end, - verify_call_args_1(Live, Verify, Vst); + verify_local_call(Lbl, Live, Vst); verify_call_args(_, Live, Vst) when is_integer(Live)-> - Verify = fun(R) -> get_term_type(R, Vst) end, - verify_call_args_1(Live, Verify, Vst); + verify_call_args_1(Live, Vst); verify_call_args(_, Live, _) -> error({bad_number_of_live_regs,Live}). -verify_call_args_1(0, _, _) -> ok; -verify_call_args_1(N, Verify, Vst) -> +verify_call_args_1(0, _) -> ok; +verify_call_args_1(N, Vst) -> X = N - 1, - Verify({x,X}), - verify_call_args_1(X, Verify, Vst). + get_term_type({x,X}, Vst), + verify_call_args_1(X, Vst). + +verify_local_call(Lbl, Live, Vst) -> + case all_ms_in_x_regs(Live, Vst) of + [{R,Ctx}] -> + %% Verify that there is a suitable bs_start_match2 instruction. + verify_call_match_context(Lbl, R, Vst), + + %% Since the callee has consumed the match context, + %% there must be no additional copies in Y registers. + #ms{id=Id} = Ctx, + case ms_in_y_regs(Id, Vst) of + [] -> + ok; + [_|_]=Ys -> + error({multiple_match_contexts,[R|Ys]}) + end; + [_,_|_]=Xs0 -> + Xs = [R || {R,_} <- Xs0], + error({multiple_match_contexts,Xs}); + [] -> + ok + end. + +all_ms_in_x_regs(0, _Vst) -> + []; +all_ms_in_x_regs(Live0, Vst) -> + Live = Live0 - 1, + R = {x,Live}, + case get_move_term_type(R, Vst) of + #ms{}=M -> + [{R,M}|all_ms_in_x_regs(Live, Vst)]; + _ -> + all_ms_in_x_regs(Live, Vst) + end. + +ms_in_y_regs(Id, #vst{current=#st{y=Ys0}}) -> + Ys = gb_trees:to_list(Ys0), + [Y || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id]. -verify_call_match_context(Lbl, #vst{ft=Ft}) -> +verify_call_match_context(Lbl, Ctx, #vst{ft=Ft}) -> case gb_trees:lookup(Lbl, Ft) of none -> error(no_bs_start_match2); {value,[{test,bs_start_match2,_,_,[Ctx,_],Ctx}|_]} -> ok; - {value,[{test,bs_start_match2,_,_,[Bin,_,_],Ctx}|_]} -> - error({binary_and_context_regs_different,Bin,Ctx}) + {value,[{test,bs_start_match2,_,_,_,_}=I|_]} -> + error({unsuitable_bs_start_match2,I}) end. allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) -> @@ -1009,7 +1046,7 @@ assert_unique_map_keys([_,_|_]=Ls) -> %%% bsm_match_state(Slots) -> - {match_context,0,Slots}. + #ms{slots=Slots}. bsm_validate_context(Reg, Vst) -> _ = bsm_get_context(Reg, Vst), @@ -1017,7 +1054,7 @@ bsm_validate_context(Reg, Vst) -> bsm_get_context({x,X}=Reg, #vst{current=#st{x=Xs}}=_Vst) when is_integer(X) -> case gb_trees:lookup(X, Xs) of - {value,{match_context,_,_}=Ctx} -> Ctx; + {value,#ms{}=Ctx} -> Ctx; _ -> error({no_bsm_context,Reg}) end; bsm_get_context(Reg, _) -> error({bad_source,Reg}). @@ -1029,8 +1066,8 @@ bsm_save(Reg, {atom,start}, Vst) -> Vst; bsm_save(Reg, SavePoint, Vst) -> case bsm_get_context(Reg, Vst) of - {match_context,Bits,Slots} when SavePoint < Slots -> - Ctx = {match_context,Bits bor (1 bsl SavePoint),Slots}, + #ms{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots -> + Ctx = Ctxt0#ms{valid=Bits bor (1 bsl SavePoint),slots=Slots}, set_type_reg(Ctx, Reg, Vst); _ -> error({illegal_save,SavePoint}) end. @@ -1042,7 +1079,7 @@ bsm_restore(Reg, {atom,start}, Vst) -> Vst; bsm_restore(Reg, SavePoint, Vst) -> case bsm_get_context(Reg, Vst) of - {match_context,Bits,Slots} when SavePoint < Slots -> + #ms{valid=Bits,slots=Slots} when SavePoint < Slots -> case Bits band (1 bsl SavePoint) of 0 -> error({illegal_restore,SavePoint,not_set}); _ -> Vst @@ -1123,7 +1160,7 @@ assert_term(Src, Vst) -> %% Thus 'exception' is never stored as type descriptor %% for a register. %% -%% {match_context,_,_} A matching context for bit syntax matching. We do allow +%% #ms{} A match context for bit syntax matching. We do allow %% it to moved/to from stack, but otherwise it must only %% be accessed by bit syntax matching instructions. %% @@ -1230,7 +1267,7 @@ get_term_type(Src, Vst) -> initialized -> error({unassigned,Src}); {catchtag,_} -> error({catchtag,Src}); {trytag,_} -> error({trytag,Src}); - {match_context,_,_} -> error({match_context,Src}); + #ms{} -> error({match_context,Src}); Type -> Type end. @@ -1382,11 +1419,12 @@ merge_types(bool, {atom,A}) -> merge_bool(A); merge_types({atom,A}, bool) -> merge_bool(A); -merge_types({match_context,B0,Slots},{match_context,B1,Slots}) -> - {match_context,B0 bor B1,Slots}; -merge_types({match_context,_,_}=M, _) -> +merge_types(#ms{id=Id,valid=B0,slots=Slots}=M, + #ms{id=Id,valid=B1,slots=Slots}) -> + M#ms{valid=B0 bor B1,slots=Slots}; +merge_types(#ms{}=M, _) -> M; -merge_types(_, {match_context,_,_}=M) -> +merge_types(_, #ms{}=M) -> M; merge_types(T1, T2) when T1 =/= T2 -> %% Too different. All we know is that the type is a 'term'. @@ -1510,7 +1548,6 @@ bif_type(node, [_], _) -> {atom,[]}; bif_type(hd, [_], _) -> term; bif_type(tl, [_], _) -> term; bif_type(get, [_], _) -> term; -bif_type(raise, [_,_], _) -> exception; bif_type(Bif, _, _) when is_atom(Bif) -> term. is_bif_safe('/=', 2) -> true; @@ -1524,6 +1561,7 @@ is_bif_safe('>=', 2) -> true; is_bif_safe(is_atom, 1) -> true; is_bif_safe(is_boolean, 1) -> true; is_bif_safe(is_binary, 1) -> true; +is_bif_safe(is_bitstring, 1) -> true; is_bif_safe(is_float, 1) -> true; is_bif_safe(is_function, 1) -> true; is_bif_safe(is_integer, 1) -> true; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index f531056591..f5f3c73793 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1089,6 +1089,23 @@ protected_cg(Ts, Rs, _Fail, I, Vdb, Bef, St0) -> %% test_cg(TestName, Args, Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}. %% Generate test instruction. Use explicit fail label here. +test_cg(is_map, [A], Fail, I, Vdb, Bef, St) -> + %% We must avoid creating code like this: + %% + %% move x(0) y(0) + %% is_map Fail [x(0)] + %% make_fun => x(0) %% Overwrite x(0) + %% put_map_assoc y(0) ... + %% + %% The code is safe, but beam_validator does not understand that. + %% Extending beam_validator to handle such (rare) code as the + %% above would make it slower for all programs. Instead, change + %% the code generator to always prefer the Y register for is_map() + %% and put_map_assoc() instructions, ensuring that they use the + %% same register. + Arg = cg_reg_arg_prefer_y(A, Bef), + Aft = clear_dead(Bef, I, Vdb), + {[{test,is_map,{f,Fail},[Arg]}],Aft,St}; test_cg(Test, As, Fail, I, Vdb, Bef, St) -> Args = cg_reg_args(As, Bef), Aft = clear_dead(Bef, I, Vdb), @@ -1155,19 +1172,15 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> %% Inside a guard. The only allowed function call is to %% erlang:error/1,2. We will generate the following code: %% - %% jump FailureLabel %% move {atom,ok} DestReg - %% - %% The 'move' instruction will never be executed, but we - %% generate it anyway in case the beam_validator is run - %% on unoptimized code. + %% jump FailureLabel {remote,{atom,erlang},{atom,error}} = Func, %Assertion. [{var,DestVar}] = Rs, Int0 = clear_dead(Bef, Le#l.i, Vdb), Reg = put_reg(DestVar, Int0#sr.reg), Int = Int0#sr{reg=Reg}, Dst = fetch_reg(DestVar, Reg), - {[{jump,{f,Fail}},{move,{atom,ok},Dst}], + {[{move,{atom,ok},Dst},{jump,{f,Fail}}], clear_dead(Int, Le#l.i, Vdb),St0}; #cg{} -> %% Ordinary function call in a function body. @@ -1545,7 +1558,7 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, Fail = {f,Bfail}, {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), - SrcReg = cg_reg_arg(Map,Int0), + SrcReg = cg_reg_arg_prefer_y(Map, Int0), Line = line(Le#l.a), List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)], @@ -1572,7 +1585,7 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, Fail = {f,Bfail}, {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), - SrcReg = cg_reg_arg(Map,Int0), + SrcReg = cg_reg_arg_prefer_y(Map, Int0), Line = line(Le#l.a), %% fetch registers for values to be put into the map @@ -1845,6 +1858,9 @@ cg_reg_args(As, Bef) -> [cg_reg_arg(A, Bef) || A <- As]. cg_reg_arg({var,V}, Bef) -> fetch_var(V, Bef); cg_reg_arg(Literal, _) -> Literal. +cg_reg_arg_prefer_y({var,V}, Bef) -> fetch_var_prefer_y(V, Bef); +cg_reg_arg_prefer_y(Literal, _) -> Literal. + %% cg_setup_call([Arg], Bef, Cur, Vdb) -> {[Instr],Aft}. %% Do the complete setup for a call/enter. @@ -2086,6 +2102,12 @@ fetch_var(V, Sr) -> error -> fetch_stack(V, Sr#sr.stk) end. +fetch_var_prefer_y(V, #sr{reg=Reg,stk=Stk}) -> + case find_stack(V, Stk) of + {ok,R} -> R; + error -> fetch_reg(V, Reg) + end. + load_vars(Vs, Regs) -> foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). @@ -2159,11 +2181,11 @@ fetch_stack(Var, Stk) -> fetch_stack(Var, Stk, 0). fetch_stack(V, [{V}|_], I) -> {yy,I}; fetch_stack(V, [_|Stk], I) -> fetch_stack(V, Stk, I+1). -% find_stack(Var, Stk) -> find_stack(Var, Stk, 0). +find_stack(Var, Stk) -> find_stack(Var, Stk, 0). -% find_stack(V, [{V}|Stk], I) -> {ok,{yy,I}}; -% find_stack(V, [O|Stk], I) -> find_stack(V, Stk, I+1); -% find_stack(V, [], I) -> error. +find_stack(V, [{V}|_], I) -> {ok,{yy,I}}; +find_stack(V, [_|Stk], I) -> find_stack(V, Stk, I+1); +find_stack(_, [], _) -> error. on_stack(V, Stk) -> keymember(V, 1, Stk). diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 203a50db55..f0185acbc7 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -13,9 +13,11 @@ MODULES= \ beam_validator_SUITE \ beam_disasm_SUITE \ beam_except_SUITE \ + beam_jump_SUITE \ beam_reorder_SUITE \ beam_type_SUITE \ beam_utils_SUITE \ + bif_SUITE \ bs_bincomp_SUITE \ bs_bit_binaries_SUITE \ bs_construct_SUITE \ @@ -49,9 +51,11 @@ NO_OPT= \ beam_block \ beam_bool \ beam_except \ + beam_jump \ beam_reorder \ beam_type \ beam_utils \ + bif \ bs_construct \ bs_match \ bs_utf \ diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index 8746e62fb9..47367d6eab 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -21,15 +21,18 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - coverage/1]). + multiple_allocs/1,coverage/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [coverage]. + test_lib:recompile(?MODULE), + [{group,p}]. groups() -> - []. + [{p,[parallel], + [multiple_allocs, + coverage]}]. init_per_suite(Config) -> Config. @@ -43,6 +46,23 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +multiple_allocs(_Config) -> + {'EXIT',{{badmatch,#{true:=[p]}},_}} = + (catch could(pda, 0.0, {false,true}, {p})), + {'EXIT',{function_clause,_}} = (catch place(lee)), + {'EXIT',{{badmatch,wanted},_}} = (catch conditions()), + + ok. + +could(Coupons = pda, Favorite = _pleasure = 0.0, {_, true}, {Presents}) -> + (0 = true) = #{true => [Presents]}. + +place(lee) -> + (pregnancy = presentations) = [hours | [purchase || _ <- 0]] + wine. + +conditions() -> + (talking = going) = storage + [large = wanted]. + coverage(_) -> File = {file,"fake.erl"}, ok = fc(a), diff --git a/lib/compiler/test/beam_jump_SUITE.erl b/lib/compiler/test/beam_jump_SUITE.erl new file mode 100644 index 0000000000..0b13adaff2 --- /dev/null +++ b/lib/compiler/test/beam_jump_SUITE.erl @@ -0,0 +1,59 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(beam_jump_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + undefined_label/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [undefined_label + ]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +undefined_label(_Config) -> + {'EXIT',{function_clause,_}} = (catch flights(0, [], [])), + ok. + +%% Would lose a label when compiled with no_copt. + +flights(0, [], []) when [], 0; 0.0, [], false -> + clark; +flights(_, Reproduction, introduction) when false, Reproduction -> + responsible. diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl index ae813d563b..f6d4a311bb 100644 --- a/lib/compiler/test/beam_utils_SUITE.erl +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -23,7 +23,8 @@ init_per_group/2,end_per_group/2, apply_fun/1,apply_mf/1,bs_init/1,bs_save/1, is_not_killed/1,is_not_used_at/1, - select/1,y_catch/1,otp_8949_b/1,liveopt/1,coverage/1]). + select/1,y_catch/1,otp_8949_b/1,liveopt/1,coverage/1, + y_registers/1]). -export([id/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -44,7 +45,8 @@ groups() -> y_catch, otp_8949_b, liveopt, - coverage + coverage, + y_registers ]}]. init_per_suite(Config) -> @@ -311,6 +313,45 @@ clinic(Damage) -> end, carefully. +y_registers(_Config) -> + {'EXIT',{{badfun,0},_}} = (catch economic(0.0, jim)), + {'EXIT',{{badmatch,apartments},_}} = (catch louisiana()), + {a,b} = (boxes(true))({a,b}), + {'EXIT',{{case_clause,webmaster},_}} = (catch yellow(true)), + ok. + +economic(0.0 = Serves, Existence) -> + case Serves of + Serves -> 0 + end, + Existence = jim, + 0(), + Serves, + Existence. + +louisiana() -> + {catch necessarily, + try + [] == reg, + true = apartments + catch [] -> barbara + end}. + +boxes(Call) -> + case Call of + Call -> approval + end, + Call, + fun id/1. + +yellow(Hill) -> + case webmaster of + station -> eyes; Hill -> + "under" + end, + Hill, + id(42). + %% The identity function. id(I) -> I. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 7c4e88ca3e..263fd2ca7e 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -32,7 +32,7 @@ bad_bin_match/1,bad_dsetel/1, state_after_fault_in_catch/1,no_exception_in_catch/1, undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1, - map_field_lists/1]). + map_field_lists/1,cover_bin_opt/1]). -include_lib("common_test/include/ct.hrl"). @@ -60,7 +60,7 @@ groups() -> freg_state,bad_bin_match,bad_dsetel, state_after_fault_in_catch,no_exception_in_catch, undef_label,illegal_instruction,failing_gc_guard_bif, - map_field_lists]}]. + map_field_lists,cover_bin_opt]}]. init_per_suite(Config) -> Config. @@ -406,8 +406,124 @@ map_field_lists(Config) -> empty_field_list}} ] = Errors. +%% Coverage and smoke test of beam_validator. +cover_bin_opt(_Config) -> + Ms = [beam_utils_SUITE, + bs_match_SUITE, + bs_bincomp_SUITE, + bs_bit_binaries_SUITE, + bs_utf_SUITE], + test_lib:p_run(fun try_bin_opt/1, Ms), + ok. + +try_bin_opt(Mod) -> + try + do_bin_opt(Mod) + catch + Class:Error -> + io:format("~p: ~p ~p\n~p\n", + [Mod,Class,Error,erlang:get_stacktrace()]), + error + end. + +do_bin_opt(Mod) -> + Beam = code:which(Mod), + {ok,{Mod,[{abstract_code, + {raw_abstract_v1,Abstr}}]}} = + beam_lib:chunks(Beam, [abstract_code]), + {ok,Mod,Asm} = compile:forms(Abstr, ['S']), + do_bin_opt(Mod, Asm). + +do_bin_opt(Mod, Asm) -> + do_bin_opt(fun enable_bin_opt/1, Mod, Asm), + do_bin_opt(fun remove_bs_start_match/1, Mod, Asm), + do_bin_opt(fun remove_bs_save/1, Mod, Asm), + do_bin_opt(fun destroy_ctxt/1, Mod, Asm), + do_bin_opt(fun destroy_save_point/1, Mod, Asm), + ok. + +do_bin_opt(Transform, Mod, Asm0) -> + Asm = Transform(Asm0), + case compile:forms(Asm, [from_asm,no_postopt,return]) of + {ok,[],Code,_Warnings} when is_binary(Code) -> + ok; + {error,Errors0,_} -> + %% beam_validator must return errors, not simply crash, + %% when illegal code is found. + ModString = atom_to_list(Mod), + [{ModString,Errors}] = Errors0, + _ = [verify_bin_opt_error(E) || E <- Errors], + ok + end. + +verify_bin_opt_error({beam_validator,_}) -> + ok. + +enable_bin_opt(Module) -> + transform_is(fun enable_bin_opt_body/1, Module). + +enable_bin_opt_body([_,{'%',{no_bin_opt,_Reason,_Anno}}|Is]) -> + enable_bin_opt_body(Is); +enable_bin_opt_body([I|Is]) -> + [I|enable_bin_opt_body(Is)]; +enable_bin_opt_body([]) -> + []. + +remove_bs_start_match(Module) -> + transform_remove(fun({test,bs_start_match2,_,_,_,_}) -> true; + (_) -> false + end, Module). + +remove_bs_save(Module) -> + transform_remove(fun({bs_save2,_,_}) -> true; + (_) -> false + end, Module). + +destroy_save_point(Module) -> + transform_i(fun do_destroy_save_point/1, Module). + +do_destroy_save_point({I,Ctx,_Point}) + when I =:= bs_save2; I =:= bs_restore2 -> + {I,Ctx,42}; +do_destroy_save_point(I) -> + I. + +destroy_ctxt(Module) -> + transform_i(fun do_destroy_ctxt/1, Module). + +do_destroy_ctxt({bs_save2=I,Ctx,Point}) -> + {I,destroy_reg(Ctx),Point}; +do_destroy_ctxt({bs_restore2=I,Ctx,Point}) -> + {I,destroy_reg(Ctx),Point}; +do_destroy_ctxt({bs_context_to_binary=I,Ctx}) -> + {I,destroy_reg(Ctx)}; +do_destroy_ctxt(I) -> + I. + +destroy_reg({Tag,N}) -> + case rand:uniform() of + R when R < 0.6 -> + {Tag,N+1}; + _ -> + {y,N+1} + end. + %%%------------------------------------------------------------------------- +transform_remove(Remove, Module) -> + transform_is(fun(Is) -> [I || I <- Is, not Remove(I)] end, Module). + +transform_i(Transform, Module) -> + transform_is(fun(Is) -> [Transform(I) || I <- Is] end, Module). + +transform_is(Transform, {Mod,Exp,Imp,Fs0,Lc}) -> + Fs = [transform_is_1(Transform, F) || F <- Fs0], + {Mod,Exp,Imp,Fs,Lc}. + +transform_is_1(Transform, {function,N,A,E,Is0}) -> + Is = Transform(Is0), + {function,N,A,E,Is}. + do_val(Mod, Config) -> Data = proplists:get_value(data_dir, Config), Base = atom_to_list(Mod), diff --git a/lib/compiler/test/bif_SUITE.erl b/lib/compiler/test/bif_SUITE.erl new file mode 100644 index 0000000000..51bc71da81 --- /dev/null +++ b/lib/compiler/test/bif_SUITE.erl @@ -0,0 +1,65 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(bif_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + beam_validator/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [beam_validator + ]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +%% Cover code in beam_validator. + +beam_validator(Config) -> + [false,Config] = food(Config), + + true = is_number(42.0), + false = is_port(Config), + + ok. + +food(Curriculum) -> + [try + is_bitstring(functions) + catch _ -> + 0 + end, Curriculum]. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 83298e546e..6302f82f29 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -1835,6 +1835,8 @@ bad_guards(Config) when is_list(Config) -> fc(catch bad_guards_3(not_a_map, [x])), fc(catch bad_guards_3(42, [x])), + fc(catch bad_guards_4()), + ok. %% beam_bool used to produce GC BIF instructions whose @@ -1852,6 +1854,12 @@ bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) -> bad_guards_3(M, [_]) when is_map(M) andalso M#{a := 0, b => 0}, length(M) -> ok. +%% v3_codegen would generate a jump to the failure label, but +%% without initializing x(0). The code at the failure label expected +%% x(0) to be initialized. + +bad_guards_4() when not (error#{}); {not 0.0} -> freedom. + %% Building maps in a guard in a 'catch' would crash v3_codegen. guard_in_catch(_Config) -> diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 14d175b92c..c3c4862794 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -66,7 +66,9 @@ t_export/1, %% errors in 18 - t_register_corruption/1 + t_register_corruption/1, + t_bad_update/1 + ]). suite() -> []. @@ -117,7 +119,8 @@ all() -> t_export, %% errors in 18 - t_register_corruption + t_register_corruption, + t_bad_update ]. groups() -> []. @@ -1922,6 +1925,19 @@ validate_frequency([{T,C}|Fs],Tf) -> validate_frequency([], _) -> ok. +t_bad_update(_Config) -> + {#{0.0:=Id},#{}} = properly(#{}), + 42 = Id(42), + {'EXIT',{{badmap,_},_}} = (catch increase(0)), + ok. + +properly(Item) -> + {Item#{0.0 => fun id/1},Item}. + +increase(Allows) -> + catch fun() -> Allows end#{[] => +Allows, "warranty" => fun id/1}. + + %% aux rand_terms(0) -> []; diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 3c397561fc..8304672558 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -118,8 +118,14 @@ coverage(Config) when is_list(Config) -> 59 = tuple_to_values(infinity, x), 61 = tuple_to_values(999999, x), 0 = tuple_to_values(1, x), + + {'EXIT',{{badmap,[]},_}} = (catch monitor_plus_badmap(self())), + ok. +monitor_plus_badmap(Pid) -> + monitor(process, Pid) + []#{}. + receive_all() -> receive Any -> diff --git a/lib/erl_docgen/priv/css/otp_doc.css b/lib/erl_docgen/priv/css/otp_doc.css index 347782eb1e..219740a557 100644 --- a/lib/erl_docgen/priv/css/otp_doc.css +++ b/lib/erl_docgen/priv/css/otp_doc.css @@ -122,6 +122,11 @@ span.code { font-family: Courier, monospace; font-weight: normal } font-size: 90%; padding: 5px 10px; } + +.quote { + font-style: italic +} + .example { background-color:#eeeeff; padding: 0px 10px; diff --git a/lib/erl_docgen/priv/dtd/common.dtd b/lib/erl_docgen/priv/dtd/common.dtd index 961bcd3fc2..b1578ad9d4 100644 --- a/lib/erl_docgen/priv/dtd/common.dtd +++ b/lib/erl_docgen/priv/dtd/common.dtd @@ -12,7 +12,7 @@ limitations under the License. The Initial Developer of the Original Code is Ericsson AB. - Portions created by Ericsson are Copyright 1999-2007, Ericsson AB. + Portions created by Ericsson are Copyright 1999-2016, Ericsson AB. All Rights Reserved.'' $Id$ @@ -24,7 +24,7 @@ <!ENTITY % block "p|pre|code|list|taglist|codeinclude| erleval" > -<!ENTITY % inline "#PCDATA|c|i|em|term|cite|br|path|seealso| +<!ENTITY % inline "#PCDATA|c|i|em|strong|term|cite|br|path|seealso| url|marker|anno" > <!-- XXX --> <!ELEMENT p (%inline;)* > @@ -40,6 +40,7 @@ <!ELEMENT c (#PCDATA|anno)* > <!ELEMENT i (#PCDATA|c|anno)* > <!ELEMENT em (#PCDATA|c|anno)* > +<!ELEMENT strong (#PCDATA|c|anno)* > <!ELEMENT anno (#PCDATA) > <!-- XXX --> @@ -68,7 +69,7 @@ <!ATTLIST list type (ordered|bulleted) "bulleted" > <!ELEMENT taglist (tag,item+)+ > <!ELEMENT tag (#PCDATA|c|i|em|br|seealso|url|marker|anno)* > -<!ELEMENT item (%inline;|%block;|warning|note|dont|do)* > +<!ELEMENT item (%inline;|%block;|warning|note|dont|do|quote)* > <!-- References --> diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index c2d7d40446..75399992f2 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -785,39 +785,36 @@ <!-- Book --> <xsl:template match="/book"> - - <xsl:apply-templates name="parts"/> - <xsl:apply-templates name="applications"/> - + <xsl:apply-templates select="parts"/> + <xsl:apply-templates select="applications"/> + <xsl:apply-templates select="releasenotes"/> </xsl:template> <!-- Parts --> <xsl:template match="parts"> - <xsl:apply-templates name="part"/> + <xsl:apply-templates select="part"/> </xsl:template> <!-- Applications --> <xsl:template match="applications"> - <xsl:apply-templates name="application"/> + <xsl:apply-templates select="application"/> </xsl:template> - <!-- Header --> - <xsl:template match="header"> - </xsl:template> - - <!-- Section/Title --> - <xsl:template match="section/title"> - </xsl:template> - - <xsl:template match="pagetext"> - </xsl:template> + <xsl:template match="header"/> + + <!-- Section/Title --> + <xsl:template match="section/title"/> + <xsl:template match="pagetext"/> - <!-- Chapter/Section --> + <!-- Chapter/Section, subsection level 1--> <xsl:template match="chapter/section"> <xsl:param name="chapnum"/> <h3> + <xsl:for-each select="marker"> + <xsl:call-template name="marker-before-title"/> + </xsl:for-each> <a name="{generate-id(title)}"> <xsl:value-of select="$chapnum"/>.<xsl:number/>  <xsl:value-of select="title"/> @@ -829,11 +826,14 @@ </xsl:apply-templates> </xsl:template> - <!-- Subsections lvl 3 and ... --> + <!-- Subsections lvl 2 --> <xsl:template match="section/section"> <xsl:param name="chapnum"/> <xsl:param name="sectnum"/> <h4> + <xsl:for-each select="marker"> + <xsl:call-template name="marker-before-title"/> + </xsl:for-each> <!-- xsl:value-of select="$partnum"/>.<xsl:value-of select="$chapnum"/>.<xsl:value-of select="$sectnum"/>.<xsl:number/ --> <xsl:value-of select="title"/> </h4> @@ -842,10 +842,29 @@ </xsl:apply-templates> </xsl:template> + <!-- Subsections lvl 3 and ... --> + <xsl:template match="section/section/section"> + <xsl:param name="chapnum"/> + <xsl:param name="sectnum"/> + <h5> + <xsl:for-each select="marker"> + <xsl:call-template name="marker-before-title"/> + </xsl:for-each> + <!-- xsl:value-of select="$partnum"/>.<xsl:value-of select="$chapnum"/>.<xsl:value-of select="$sectnum"/>.<xsl:number/ --> + <xsl:value-of select="title"/> + </h5> + <xsl:apply-templates> + <xsl:with-param name="chapnum" select="$chapnum"/> + </xsl:apply-templates> + </xsl:template> + <!-- *ref/Section --> <xsl:template match="erlref/section|cref/section|comref/section|fileref/section|appref/section"> <xsl:param name="chapnum"/> <h3> + <xsl:for-each select="marker"> + <xsl:call-template name="marker-before-title"/> + </xsl:for-each> <a name="{generate-id(title)}"> <xsl:value-of select="title"/> </a> @@ -873,7 +892,6 @@ <!-- Lists --> - <xsl:template match="list"> <xsl:param name="chapnum"/> <ul> @@ -981,6 +999,18 @@ </div> </xsl:template> + <!-- Quote --> + <xsl:template match="quote"> + <xsl:param name="chapnum"/> + <div class="quote"> + <p> + <xsl:apply-templates> + <xsl:with-param name="chapnum" select="$chapnum"/> + </xsl:apply-templates> + </p> + </div> + </xsl:template> + <!-- Paragraph --> <xsl:template match="p"> <p> @@ -989,10 +1019,6 @@ </xsl:template> <!-- Inline elements --> - <xsl:template match="b"> - <strong><xsl:apply-templates/></strong> - </xsl:template> - <xsl:template match="i"> <i><xsl:apply-templates/></i> </xsl:template> @@ -1009,6 +1035,10 @@ <strong><xsl:apply-templates/></strong> </xsl:template> + <xsl:template match="strong"> + <strong><xsl:apply-templates/></strong> + </xsl:template> + <!-- Code --> <xsl:template match="code"> <xsl:param name="chapnum"/> @@ -1095,11 +1125,11 @@ <xsl:param name="chapnum"/> <xsl:param name="fignum"/> - <em>Figure + <p><em>Figure <xsl:value-of select="$chapnum"/>.<xsl:value-of select="$fignum"/>:   <xsl:apply-templates/> - </em> + </em></p> </xsl:template> @@ -1286,9 +1316,7 @@ <xsl:with-param name="type">ref_man</xsl:with-param> </xsl:call-template--> - <xsl:document href="{$outdir}/index.html" method="html" encoding="UTF-8" indent="yes" doctype-public="-//W3C//DTD HTML 4.01 Transitional//EN"> - <xsl:call-template name="pagelayout"/> </xsl:document> </xsl:template> @@ -2003,7 +2031,7 @@ </xsl:template> <xsl:template match="seealso"> - <xsl:call-template name="seealso"/> + <xsl:call-template name="seealso"/> </xsl:template> <xsl:template name="seealso"> @@ -2085,16 +2113,27 @@ </xsl:template> - <xsl:template match="url"> <span class="bold_code"><a href="{@href}"><xsl:apply-templates/></a></span> </xsl:template> - <xsl:template match="marker"> - <a name="{@id}"><xsl:apply-templates/></a> + <xsl:choose> + <xsl:when test="not(parent::section and following-sibling::title)"> + <a name="{@id}"><xsl:apply-templates/></a> + </xsl:when> + </xsl:choose> </xsl:template> + <xsl:template name="marker-before-title"> + <xsl:choose> + <xsl:when test="self::marker and parent::section and following-sibling::title"> + <a name="{@id}"><xsl:apply-templates/></a> + </xsl:when> + </xsl:choose> + </xsl:template> + + <xsl:template match="term"> <xsl:value-of select="@id"/> <!-- xsl:choose> @@ -2373,7 +2412,11 @@ <xsl:template name="nl"> <xsl:text> -</xsl:text> + </xsl:text> + </xsl:template> + + <xsl:template match="seealso//text()"> + <xsl:value-of select="normalize-space(.)"/> </xsl:template> </xsl:stylesheet> diff --git a/lib/erl_docgen/priv/xsl/db_man.xsl b/lib/erl_docgen/priv/xsl/db_man.xsl index f75615c105..03b6b0691d 100644 --- a/lib/erl_docgen/priv/xsl/db_man.xsl +++ b/lib/erl_docgen/priv/xsl/db_man.xsl @@ -589,12 +589,6 @@ </xsl:template> <!-- Inline elements --> - <xsl:template match="b"> - <xsl:text>\fB</xsl:text> - <xsl:apply-templates/> - <xsl:text>\fR\& </xsl:text> - </xsl:template> - <xsl:template match="i"> <xsl:text>\fI</xsl:text> <xsl:apply-templates/> @@ -622,6 +616,12 @@ <xsl:text>\fI</xsl:text> <xsl:apply-templates/><xsl:text>\fR\&</xsl:text> </xsl:template> + <xsl:template match="strong"> + <xsl:text>\fB</xsl:text> + <xsl:apply-templates/> + <xsl:text>\fR\& </xsl:text> + </xsl:template> + <xsl:template match="seealso"> <xsl:choose> <xsl:when test="ancestor::head"> diff --git a/lib/erl_docgen/priv/xsl/db_pdf.xsl b/lib/erl_docgen/priv/xsl/db_pdf.xsl index e5e624ac4c..99263847fb 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf.xsl @@ -1171,6 +1171,16 @@ </fo:block> </xsl:template> + <!-- Quote --> + <xsl:template match="quote"> + <xsl:param name="chapnum"/> + <fo:block font-style="italic"> + <xsl:apply-templates> + <xsl:with-param name="chapnum" select="$chapnum"/> + </xsl:apply-templates> + </fo:block> + </xsl:template> + <!-- Paragraph --> <xsl:template match="p"> <fo:block xsl:use-attribute-sets="p"> @@ -1180,14 +1190,8 @@ <!-- Inline elements --> - <xsl:template match="b"> - <fo:inline font-weight="bold"> - <xsl:apply-templates/> - </fo:inline> - </xsl:template> - <xsl:template match="i"> - <fo:inline font-weight="italic"> + <fo:inline font-style="italic"> <xsl:apply-templates/> </fo:inline> </xsl:template> @@ -1203,7 +1207,13 @@ </xsl:template> <xsl:template match="em"> - <fo:inline font-style="italic"> + <fo:inline font-weight="bold"> + <xsl:apply-templates/> + </fo:inline> + </xsl:template> + + <xsl:template match="strong"> + <fo:inline font-weight="bold"> <xsl:apply-templates/> </fo:inline> </xsl:template> diff --git a/lib/hipe/amd64/Makefile b/lib/hipe/amd64/Makefile index 0d81ff4d72..8dc2af2679 100644 --- a/lib/hipe/amd64/Makefile +++ b/lib/hipe/amd64/Makefile @@ -73,7 +73,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += -DHIPE_AMD64 +warn_exported_vars +ERL_COMPILE_FLAGS += -DHIPE_AMD64 -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/arm/Makefile b/lib/hipe/arm/Makefile index 6622680ee1..00b6732afa 100644 --- a/lib/hipe/arm/Makefile +++ b/lib/hipe/arm/Makefile @@ -74,7 +74,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/cerl/Makefile b/lib/hipe/cerl/Makefile index 78930154a9..9f50d6bf91 100644 --- a/lib/hipe/cerl/Makefile +++ b/lib/hipe/cerl/Makefile @@ -66,7 +66,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += -Werror +inline +warn_exported_vars +warn_unused_import +warn_missing_spec #+warn_untyped_record +ERL_COMPILE_FLAGS += +inline -Werror +warn_export_vars +warn_unused_import +warn_missing_spec #+warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index f649c6e599..9453ca6c6f 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -154,6 +154,8 @@ type(M, F, A, Xs) -> erl_types:erl_type(). %%-- erlang ------------------------------------------------------------------- +type(erlang, halt, 0, _, _) -> t_none(); +type(erlang, halt, 1, _, _) -> t_none(); type(erlang, halt, 2, _, _) -> t_none(); type(erlang, exit, 1, _, _) -> t_none(); type(erlang, error, 1, _, _) -> t_none(); @@ -2339,6 +2341,10 @@ arg_types(erlang, bit_size, 1) -> %% Guard bif, needs to be here. arg_types(erlang, byte_size, 1) -> [t_bitstr()]; +arg_types(erlang, halt, 0) -> + []; +arg_types(erlang, halt, 1) -> + [t_sup([t_non_neg_fixnum(), t_atom('abort'), t_string()])]; arg_types(erlang, halt, 2) -> [t_sup([t_non_neg_fixnum(), t_atom('abort'), t_string()]), t_list(t_tuple([t_atom('flush'), t_boolean()]))]; diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index b037a4360c..c383541020 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -1751,14 +1751,14 @@ map_def_val(?map(_,_,DefV)) -> -spec mapdict_store(t_map_pair(), t_map_dict()) -> t_map_dict(). mapdict_store(E={K,_,_}, [{K,_,_}|T]) -> [E|T]; -mapdict_store(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2-> +mapdict_store(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2 -> [E2|mapdict_store(E1, T)]; mapdict_store(E={_,_,_}, T) -> [E|T]. -spec mapdict_insert(t_map_pair(), t_map_dict()) -> t_map_dict(). mapdict_insert(E={K,_,_}, D=[{K,_,_}|_]) -> error(badarg, [E, D]); -mapdict_insert(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2-> +mapdict_insert(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2 -> [E2|mapdict_insert(E1, T)]; mapdict_insert(E={_,_,_}, T) -> [E|T]. @@ -1769,25 +1769,26 @@ mapdict_insert(E={_,_,_}, T) -> [E|T]. t_map_mandatoriness(), erl_type()) -> t_map_pair() | false), erl_type(), erl_type()) -> t_map_dict(). -map_pairwise_merge(F, ?map(APairs, ADefK, ADefV), - ?map(BPairs, BDefK, BDefV)) -> +map_pairwise_merge(F, ?map(APairs, ADefK, ADefV), ?map(BPairs, BDefK, BDefV)) -> map_pairwise_merge(F, APairs, ADefK, ADefV, BPairs, BDefK, BDefV). map_pairwise_merge(_, [], _, _, [], _, _) -> []; map_pairwise_merge(F, As0, ADefK, ADefV, Bs0, BDefK, BDefV) -> - case {As0, Bs0} of - {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} -> ok; - {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> - {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)}; - {As, [{K, BMNess,BV}|Bs]} -> - {AMNess, AV} = {?opt, mapmerge_otherv(K, ADefK, ADefV)}; - {[{K,AMNess,AV}|As], []=Bs} -> - {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)} - end, - MK = K, %% Rename to make clear that we are matching below - case F(K, AMNess, AV, BMNess, BV) of - false -> map_pairwise_merge(F,As,ADefK,ADefV,Bs,BDefK,BDefV); - M={MK,_,_} -> [M|map_pairwise_merge(F,As,ADefK,ADefV,Bs,BDefK,BDefV)] + {K1, AMNess1, AV1, As1, BMNess1, BV1, Bs1} = + case {As0, Bs0} of + {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} -> + {K, AMNess, AV, As, BMNess, BV, Bs}; + {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> + {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs}; + {As, [{K, BMNess,BV}|Bs]} -> + {K, ?opt, mapmerge_otherv(K, ADefK, ADefV), As, BMNess, BV, Bs}; + {[{K,AMNess,AV}|As], []=Bs} -> + {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs} + end, + MK = K1, %% Rename to make clear that we are matching below + case F(K1, AMNess1, AV1, BMNess1, BV1) of + false -> map_pairwise_merge(F,As1,ADefK,ADefV,Bs1,BDefK,BDefV); + {MK,_,_}=M -> [M|map_pairwise_merge(F,As1,ADefK,ADefV,Bs1,BDefK,BDefV)] end. %% Folds over the pairs in two maps simultaneously in reverse key order. Missing @@ -1804,17 +1805,19 @@ map_pairwise_merge_foldr(F, AccIn, ?map(APairs, ADefK, ADefV), map_pairwise_merge_foldr(_, Acc, [], _, _, [], _, _) -> Acc; map_pairwise_merge_foldr(F, AccIn, As0, ADefK, ADefV, Bs0, BDefK, BDefV) -> - case {As0, Bs0} of - {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} -> ok; - {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> - {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)}; - {As, [{K, BMNess,BV}|Bs]} -> - {AMNess, AV} = {?opt, mapmerge_otherv(K, ADefK, ADefV)}; - {[{K,AMNess,AV}|As], []=Bs} -> - {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)} - end, - F(K, AMNess, AV, BMNess, BV, - map_pairwise_merge_foldr(F,AccIn,As,ADefK,ADefV,Bs,BDefK,BDefV)). + {K1, AMNess1, AV1, As1, BMNess1, BV1, Bs1} = + case {As0, Bs0} of + {[{K,AMNess,AV}|As], [{K,BMNess,BV}|Bs]} -> + {K, AMNess, AV, As, BMNess, BV, Bs}; + {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> + {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs}; + {As, [{K,BMNess,BV}|Bs]} -> + {K, ?opt, mapmerge_otherv(K, ADefK, ADefV), As, BMNess, BV, Bs}; + {[{K,AMNess,AV}|As], []=Bs} -> + {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs} + end, + F(K1, AMNess1, AV1, BMNess1, BV1, + map_pairwise_merge_foldr(F,AccIn,As1,ADefK,ADefV,Bs1,BDefK,BDefV)). %% By observing that a missing pair in a map is equivalent to an optional pair, %% with ?none or DefV value, depending on whether K \in DefK, we can simplify diff --git a/lib/hipe/flow/Makefile b/lib/hipe/flow/Makefile index fe1675b7dd..d883eecf36 100644 --- a/lib/hipe/flow/Makefile +++ b/lib/hipe/flow/Makefile @@ -66,7 +66,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec # +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/flow/cfg.hrl b/lib/hipe/flow/cfg.hrl index 641ec102db..2575b9e38a 100644 --- a/lib/hipe/flow/cfg.hrl +++ b/lib/hipe/flow/cfg.hrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -38,8 +38,8 @@ is_closure :: boolean(), closure_arity = none :: 'none' | arity(), is_leaf :: boolean(), - params, % :: list() - info = []}). %% this field seems not needed; take out?? + params :: list(), %% XXX: refine + info = [] :: list()}). %% seems not needed; take out?? -type cfg_info() :: #cfg_info{}. %% diff --git a/lib/hipe/flow/hipe_dominators.erl b/lib/hipe/flow/hipe_dominators.erl index 1b147607c7..72c16b5688 100644 --- a/lib/hipe/flow/hipe_dominators.erl +++ b/lib/hipe/flow/hipe_dominators.erl @@ -59,7 +59,7 @@ -record(domTree, {root :: cfg_lbl(), size = 0 :: non_neg_integer(), nodes = gb_trees:empty() :: gb_trees:tree()}). --type domTree() :: #domTree{}. +-opaque domTree() :: #domTree{}. %%>----------------------------------------------------------------------< %% Procedure : domTree_create/1 diff --git a/lib/hipe/icode/Makefile b/lib/hipe/icode/Makefile index c86562a981..b220bc16a0 100644 --- a/lib/hipe/icode/Makefile +++ b/lib/hipe/icode/Makefile @@ -84,7 +84,7 @@ DOC_FILES= $(DOC_MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_unused_import +warn_exported_vars +warn_missing_spec # +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_unused_import +warn_export_vars +warn_missing_spec # +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl index 07d230491d..78508dff22 100644 --- a/lib/hipe/icode/hipe_icode.erl +++ b/lib/hipe/icode/hipe_icode.erl @@ -610,7 +610,9 @@ %% Exported types %% --export_type([icode/0]). +-export_type([icode/0, params/0]). + +-type params() :: [icode_var()]. %%--------------------------------------------------------------------- %% @@ -618,7 +620,7 @@ %% %%--------------------------------------------------------------------- --spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()], +-spec mk_icode(mfa(), params(), boolean(), boolean(), [icode_instr()], {non_neg_integer(),non_neg_integer()}, {icode_lbl(),icode_lbl()}) -> icode(). mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) -> @@ -629,7 +631,7 @@ mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) -> var_range=VarRange, label_range=LabelRange}. --spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()], +-spec mk_icode(mfa(), params(), boolean(), boolean(), [icode_instr()], hipe_consttab(), {non_neg_integer(),non_neg_integer()}, {icode_lbl(),icode_lbl()}) -> icode(). mk_icode(Fun, Params, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) -> @@ -640,11 +642,11 @@ mk_icode(Fun, Params, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) -> -spec icode_fun(icode()) -> mfa(). icode_fun(#icode{'fun' = MFA}) -> MFA. --spec icode_params(icode()) -> [icode_var()]. +-spec icode_params(icode()) -> params(). icode_params(#icode{params = Params}) -> Params. --spec icode_params_update(icode(), [icode_var()]) -> icode(). -icode_params_update(Icode, Params) -> +-spec icode_params_update(icode(), params()) -> icode(). +icode_params_update(Icode, Params) -> Icode#icode{params = Params}. -spec icode_is_closure(icode()) -> boolean(). diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl index 999c54732b..b2e0d86b28 100644 --- a/lib/hipe/icode/hipe_icode.hrl +++ b/lib/hipe/icode/hipe_icode.hrl @@ -169,7 +169,7 @@ %%--------------------------------------------------------------------- -record(icode, {'fun' :: mfa(), - params :: [icode_var()], + params :: hipe_icode:params(), %% TODO: merge is_closure and closure_arity into one field is_closure :: boolean(), closure_arity = none :: 'none' | arity(), diff --git a/lib/hipe/icode/hipe_icode_cfg.erl b/lib/hipe/icode/hipe_icode_cfg.erl index b9969fa69d..9a602c0283 100644 --- a/lib/hipe/icode/hipe_icode_cfg.erl +++ b/lib/hipe/icode/hipe_icode_cfg.erl @@ -55,6 +55,9 @@ -spec postorder(cfg()) -> [icode_lbl()]. -spec reverse_postorder(cfg()) -> [icode_lbl()]. +-spec params(cfg()) -> hipe_icode:params(). +-spec params_update(cfg(), hipe_icode:params()) -> cfg(). + -spec is_visited(icode_lbl(), gb_sets:set()) -> boolean(). -spec visit(icode_lbl(), gb_sets:set()) -> gb_sets:set(). diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl index 24ffc71237..12ed796690 100644 --- a/lib/hipe/icode/hipe_icode_range.erl +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -89,6 +89,7 @@ ret_type :: range(), lookup_fun :: call_fun(), result_action :: final_fun()}). +-type state() :: #state{}. -define(WIDEN, 1). @@ -172,7 +173,7 @@ analyse(Cfg, Data) -> catch throw:no_input -> ok end. --spec safe_analyse(cfg(), data()) -> #state{}. +-spec safe_analyse(cfg(), data()) -> state(). safe_analyse(CFG, Data={MFA,_,_,_}) -> State = state__init(CFG, Data), @@ -181,14 +182,14 @@ safe_analyse(CFG, Data={MFA,_,_,_}) -> (state__result_action(NewState))(MFA, [state__ret_type(NewState)]), NewState. --spec rewrite_blocks(#state{}) -> #state{}. +-spec rewrite_blocks(state()) -> state(). rewrite_blocks(State) -> CFG = state__cfg(State), Start = hipe_icode_cfg:start_label(CFG), rewrite_blocks([Start], State, [Start]). --spec rewrite_blocks([label()], #state{}, [label()]) -> #state{}. +-spec rewrite_blocks([label()], state(), [label()]) -> state(). rewrite_blocks([Next|Rest], State, Visited) -> Info = state__info_in(State, Next), @@ -201,7 +202,7 @@ rewrite_blocks([Next|Rest], State, Visited) -> rewrite_blocks([], State, _) -> State. --spec analyse_blocks(#state{}, work_list()) -> #state{}. +-spec analyse_blocks(state(), work_list()) -> state(). analyse_blocks(State, Work) -> case get_work(Work) of @@ -218,7 +219,7 @@ analyse_blocks(State, Work) -> analyse_blocks(NewState, NewWork2) end. --spec analyse_block(label(), info(), #state{}, boolean()) -> {#state{}, [label()]}. +-spec analyse_block(label(), info(), state(), boolean()) -> {state(), [label()]}. analyse_block(Label, Info, State, Rewrite) -> BB = state__bb(State, Label), @@ -612,36 +613,32 @@ analyse_if(If, Info, Rewrite) -> {#icode_goto{} | #icode_if{}, [{label(), info()}]}. analyse_sane_if(If, Info, [Arg1, Arg2], [Range1, Range2], Rewrite) -> - case normalize_name(hipe_icode:if_op(If)) of - '>' -> - {TrueRange2, TrueRange1, FalseRange2, FalseRange1} = - range_inequality_propagation(Range2, Range1); - '<' -> - {TrueRange1, TrueRange2, FalseRange1, FalseRange2} = + {TrueRange1, TrueRange2, FalseRange1, FalseRange2} = + case normalize_name(hipe_icode:if_op(If)) of + '>' -> + {TR2, TR1, FR2, FR1} = range_inequality_propagation(Range2, Range1), + {TR1, TR2, FR1, FR2}; + '<' -> range_inequality_propagation(Range1, Range2); - '>=' -> - {FalseRange1, FalseRange2, TrueRange1, TrueRange2} = - range_inequality_propagation(Range1, Range2); - '=<' -> - {FalseRange2, FalseRange1, TrueRange2, TrueRange1} = - range_inequality_propagation(Range2, Range1); - '=:=' -> - {TrueRange1, TrueRange2, FalseRange1, FalseRange2} = - range_equality_propagation(Range1, Range2); - '=/=' -> - {FalseRange1, FalseRange2, TrueRange1, TrueRange2} = - range_equality_propagation(Range1, Range2); - '==' -> - {TempTrueRange1, TempTrueRange2, FalseRange1, FalseRange2} = - range_equality_propagation(Range1, Range2), - TrueRange1 = set_other(TempTrueRange1, other(Range1)), - TrueRange2 = set_other(TempTrueRange2, other(Range2)); - '/=' -> - {TempFalseRange1, TempFalseRange2, TrueRange1, TrueRange2} = - range_equality_propagation(Range1, Range2), - FalseRange1 = set_other(TempFalseRange1, other(Range1)), - FalseRange2 = set_other(TempFalseRange2, other(Range2)) - end, + '>=' -> + {FR1, FR2, TR1, TR2} = range_inequality_propagation(Range1, Range2), + {TR1, TR2, FR1, FR2}; + '=<' -> + {FR2, FR1, TR2, TR1} = range_inequality_propagation(Range2, Range1), + {TR1, TR2, FR1, FR2}; + '=:=' -> + {TR1, TR2, FR1, FR2} = range_equality_propagation(Range1, Range2), + {TR1, TR2, FR1, FR2}; + '=/=' -> + {FR1, FR2, TR1, TR2} = range_equality_propagation(Range1, Range2), + {TR1, TR2, FR1, FR2}; + '==' -> + {TR1, TR2, FR1, FR2} = range_equality_propagation(Range1, Range2), + {set_other(TR1,other(Range1)), set_other(TR2,other(Range2)), FR1, FR2}; + '/=' -> + {FR1, FR2, TR1, TR2} = range_equality_propagation(Range1, Range2), + {TR1, TR2, set_other(FR1,other(Range1)), set_other(FR2,other(Range2))} + end, %% io:format("TR1 = ~w\nTR2 = ~w\n", [TrueRange1, TrueRange2]), True = case lists:all(fun range__is_none/1, [TrueRange1, TrueRange2]) of @@ -694,26 +691,24 @@ normalize_name(Name) -> -spec range_equality_propagation(range(), range()) -> {range(), range(), range(), range()}. -range_equality_propagation(Range_1, Range_2) -> - True_range = inf(Range_1, Range_2), - case {range(Range_1), range(Range_2)} of - {{N,N}, {N,N}} -> - False_range_1 = none_range(), - False_range_2 = none_range(); - {{N1,N1}, {N2,N2}} -> - False_range_1 = Range_1, - False_range_2 = Range_2; - {{N,N}, _} -> - False_range_1 = Range_1, - {_,False_range_2} = compare_with_integer(N, Range_2); - {_, {N,N}} -> - False_range_2 = Range_2, - {_,False_range_1} = compare_with_integer(N, Range_1); - {_, _} -> - False_range_1 = Range_1, - False_range_2 = Range_2 - end, - {True_range, True_range, False_range_1, False_range_2}. +range_equality_propagation(Range1, Range2) -> + TrueRange = inf(Range1, Range2), + {FalseRange1, FalseRange2} = + case {range(Range1), range(Range2)} of + {{N,N}, {N,N}} -> + {none_range(), none_range()}; + {{N1,N1}, {N2,N2}} -> + {Range1, Range2}; + {{N,N}, _} -> + {_,FR2} = compare_with_integer(N, Range2), + {Range1, FR2}; + {_, {N,N}} -> + {_,FR1} = compare_with_integer(N, Range1), + {FR1, Range2}; + {_, _} -> + {Range1, Range2} + end, + {TrueRange, TrueRange, FalseRange1, FalseRange2}. -spec range_inequality_propagation(range(), range()) -> {range(), range(), range(), range()}. @@ -779,18 +774,17 @@ analyse_type(Type, Info, Rewrite) -> TypeTest = hipe_icode:type_test(Type), [Arg|_] = hipe_icode:type_args(Type), OldVarRange = get_range_from_arg(Arg), - case TypeTest of - {integer, N} -> - {TrueRange,FalseRange} = compare_with_integer(N,OldVarRange); - integer -> - TrueRange = inf(any_range(), OldVarRange), - FalseRange = inf(none_range(), OldVarRange); - number -> - TrueRange = FalseRange = OldVarRange; - _ -> - TrueRange = inf(none_range(), OldVarRange), - FalseRange = OldVarRange - end, + {TrueRange, FalseRange} = + case TypeTest of + {integer, N} -> + compare_with_integer(N, OldVarRange); + integer -> + {inf(any_range(), OldVarRange), inf(none_range(), OldVarRange)}; + number -> + {OldVarRange, OldVarRange}; + _ -> + {inf(none_range(), OldVarRange), OldVarRange} + end, TrueLabel = hipe_icode:type_true_label(Type), FalseLabel = hipe_icode:type_false_label(Type), TrueInfo = enter_define({Arg, TrueRange}, Info), @@ -1201,14 +1195,12 @@ basic_type(#unsafe_update_element{}) -> not_analysed. analyse_bs_get_integer(Size, Flags, true) -> Signed = Flags band 4, - if Signed =:= 0 -> - Max = inf_add(inf_bsl(1, Size), -1), - Min = 0; - true -> - Max = inf_add(inf_bsl(1, Size-1), -1), - Min = inf_inv(inf_bsl(1, Size-1)) - end, - {Min, Max}; + case Signed =:= 0 of + true -> + {0, inf_add(inf_bsl(1, Size), -1)}; % return {Min, Max} + false -> + {inf_inv(inf_bsl(1, Size-1)), inf_add(inf_bsl(1, Size-1), -1)} + end; analyse_bs_get_integer(Size, Flags, false) when is_integer(Size), is_integer(Flags) -> any_r(). @@ -1653,7 +1645,7 @@ inf_bsl(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> %% State --spec state__init(cfg(), data()) -> #state{}. +-spec state__init(cfg(), data()) -> state(). state__init(Cfg, {MFA, ArgsFun, CallFun, FinalFun}) -> Start = hipe_icode_cfg:start_label(Cfg), @@ -1676,19 +1668,19 @@ state__init(Cfg, {MFA, ArgsFun, CallFun, FinalFun}) -> lookup_fun=CallFun, result_action=FinalFun} end. --spec state__cfg(#state{}) -> cfg(). +-spec state__cfg(state()) -> cfg(). state__cfg(#state{cfg=Cfg}) -> Cfg. --spec state__bb(#state{}, label()) -> bb(). +-spec state__bb(state(), label()) -> bb(). state__bb(#state{cfg=Cfg}, Label) -> BB = hipe_icode_cfg:bb(Cfg, Label), true = hipe_bb:is_bb(BB), % Just an assert BB. --spec state__bb_add(#state{}, label(), bb()) -> #state{}. +-spec state__bb_add(state(), label(), bb()) -> state(). state__bb_add(S=#state{cfg=Cfg}, Label, BB) -> NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, BB), @@ -1774,14 +1766,12 @@ join_info_in([Var|Left], Info1, Info2, Acc, Changed) -> NewTree = gb_trees:insert(Var, Val, Acc), join_info_in(Left, Info1, Info2, NewTree, Changed); {{value, Val1}, {value, Val2}} -> - NewVal = + {NewChanged, NewVal} = case sup(Val1, Val2) of Val1 -> - NewChanged = Changed, - Val1; + {Changed, Val1}; Val -> - NewChanged = true, - Val + {true, Val} end, NewTree = gb_trees:insert(Var, NewVal, Acc), join_info_in(Left, Info1, Info2, NewTree, NewChanged) diff --git a/lib/hipe/icode/hipe_icode_type.erl b/lib/hipe/icode/hipe_icode_type.erl index 5eae8d440a..794c27ebcc 100644 --- a/lib/hipe/icode/hipe_icode_type.erl +++ b/lib/hipe/icode/hipe_icode_type.erl @@ -105,6 +105,7 @@ ret_type = [t_none()] :: [erl_types:erl_type()], lookupfun :: call_fun(), resultaction :: final_fun()}). +-type state() :: #state{}. %%----------------------------------------------------------------------- %% The main exported function @@ -193,7 +194,7 @@ analyse(Cfg, Data) -> catch throw:no_input -> ok % No need to do anything since we have no input end. --spec safe_analyse(cfg(), data()) -> #state{}. +-spec safe_analyse(cfg(), data()) -> state(). safe_analyse(Cfg, {MFA,_,_,_}=Data) -> State = new_state(Cfg, Data), @@ -461,24 +462,24 @@ integer_range_inequality_propagation(Op, A1, A2, TrueLab, FalseLab, Info) -> NonIntArg1 = t_subtract(Arg1, t_integer()), NonIntArg2 = t_subtract(Arg2, t_integer()), ?ineq_debug("nonintargs", [NonIntArg1,NonIntArg2]), - case t_is_none(IntArg1) or t_is_none(IntArg2) of + case t_is_none(IntArg1) orelse t_is_none(IntArg2) of true -> ?ineq_debug("one is none", [IntArg1,IntArg2]), [{TrueLab, Info}, {FalseLab, Info}]; false -> - case Op of - '>=' -> - {FalseArg1, FalseArg2, TrueArg1, TrueArg2} = - integer_range_less_then_propagator(IntArg1, IntArg2); - '>' -> - {TrueArg2, TrueArg1, FalseArg2, FalseArg1} = - integer_range_less_then_propagator(IntArg2, IntArg1); - '<' -> - {TrueArg1, TrueArg2, FalseArg1, FalseArg2} = - integer_range_less_then_propagator(IntArg1, IntArg2); - '=<' -> - {FalseArg2, FalseArg1, TrueArg2, TrueArg1} = - integer_range_less_then_propagator(IntArg2, IntArg1) + {TrueArg1, TrueArg2, FalseArg1, FalseArg2} = + case Op of + '>=' -> + {FA1, FA2, TA1, TA2} = int_range_lt_propagator(IntArg1, IntArg2), + {TA1, TA2, FA1, FA2}; + '>' -> + {TA2, TA1, FA2, FA1} = int_range_lt_propagator(IntArg2, IntArg1), + {TA1, TA2, FA1, FA2}; + '<' -> + int_range_lt_propagator(IntArg1, IntArg2); + '=<' -> + {FA2, FA1, TA2, TA1} = int_range_lt_propagator(IntArg2, IntArg1), + {TA1, TA2, FA1, FA2} end, ?ineq_debug("int res", [TrueArg1, TrueArg2, FalseArg1, FalseArg2]), False = {FalseLab, enter(A1, t_sup(FalseArg1, NonIntArg1), @@ -488,7 +489,7 @@ integer_range_inequality_propagation(Op, A1, A2, TrueLab, FalseLab, Info) -> [True, False] end. -integer_range_less_then_propagator(IntArg1, IntArg2) -> +int_range_lt_propagator(IntArg1, IntArg2) -> Min1 = number_min(IntArg1), Max1 = number_max(IntArg1), Min2 = number_min(IntArg2), diff --git a/lib/hipe/llvm/Makefile b/lib/hipe/llvm/Makefile index 25b47a580f..88016a7d8b 100644 --- a/lib/hipe/llvm/Makefile +++ b/lib/hipe/llvm/Makefile @@ -52,8 +52,7 @@ endif MODULES = $(HIPE_MODULES) -HRL_FILES= elf_format.hrl elf32_format.hrl elf64_format.hrl \ - hipe_llvm_arch.hrl +HRL_FILES= elf_format.hrl elf32_format.hrl elf64_format.hrl hipe_llvm_arch.hrl ERL_FILES= $(MODULES:%=%.erl) TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) @@ -71,7 +70,7 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) include ../native.mk -ERL_COMPILE_FLAGS += +inline +warn_export_vars #+warn_missing_spec +ERL_COMPILE_FLAGS += -Werror +inline +warn_export_vars #+warn_missing_spec # if in 32 bit backend define BIT32 symbol ARCH = $(shell echo $(TARGET) | sed 's/^\(x86_64\)-.*/64bit/') diff --git a/lib/hipe/main/Makefile b/lib/hipe/main/Makefile index 6b6cad3ed3..8ef31dbb46 100644 --- a/lib/hipe/main/Makefile +++ b/lib/hipe/main/Makefile @@ -70,7 +70,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) include ../native.mk -ERL_COMPILE_FLAGS += +nowarn_shadow_vars +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +nowarn_shadow_vars +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 981265b3e9..6c525dd143 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -449,16 +449,16 @@ compile(Name, File, Opts0) when is_atom(Name) -> true -> case filename:find_src(filename:rootname(File, ".beam")) of {error, _} -> - ?error_msg("Cannot find source code for ~p.",[File]), + ?error_msg("Cannot find source code for ~p.", [File]), ?EXIT({cant_find_source_code}); {Source, CompOpts} -> CoreOpts = [X || X = {core_transform, _} <- Opts], - %%io:format("Using: ~w\n", [CoreOpts]), + %% io:format("Using: ~w\n", [CoreOpts]), case compile:file(Source, CoreOpts ++ [to_core, binary|CompOpts]) of {ok, _, Core} -> compile_core(Name, Core, File, Opts); Error -> - ?error_msg("Error compiling ~p:\n~p.",[File, Error]), + ?error_msg("Error compiling ~p:\n~p.", [File, Error]), ?EXIT({cant_compile_source_code}) end end; @@ -470,7 +470,7 @@ compile(Name, File, Opts0) when is_atom(Name) -> {ok, _, Core} -> compile_core(Name, Core, File, Opts); Error -> - ?error_msg("Error compiling ~p:\n~p\n",[Source, Error]), + ?error_msg("Error compiling ~p:\n~p\n", [Source, Error]), ?EXIT({cant_compile_source_code, Error}) end; Other when Other =:= false; Other =:= undefined -> @@ -573,8 +573,7 @@ file(File, Options) when is_atom(File) -> disasm(File) -> case beam_disasm:file(File) of #beam_file{labeled_exports = LabeledExports, - compile_info = CompInfo, - code = BeamCode} -> + compile_info = CompInfo, code = BeamCode} -> CompOpts = proplists:get_value(options, CompInfo, []), HCompOpts = case lists:keyfind(hipe, 1, CompOpts) of {hipe, L} when is_list(L) -> L; @@ -597,16 +596,16 @@ fix_beam_exports([], Exports) -> Exports. get_beam_icode(Mod, {BeamCode, Exports}, File, Options) -> - ?option_time({ok, Icode} = - (catch {ok, hipe_beam_to_icode:module(BeamCode, Options)}), - "BEAM-to-Icode", Options), + {ok, Icode} = + ?option_time((catch {ok, hipe_beam_to_icode:module(BeamCode, Options)}), + "BEAM-to-Icode", Options), BeamBin = get_beam_code(File), {{Mod, Exports, Icode}, BeamBin}. get_core_icode(Mod, Core, File, Options) -> - ?option_time({ok, Icode} = - (catch {ok, cerl_to_icode:module(Core, Options)}), - "BEAM-to-Icode", Options), + {ok, Icode} = + ?option_time((catch {ok, cerl_to_icode:module(Core, Options)}), + "BEAM-to-Icode", Options), NeedBeamCode = not proplists:get_bool(load, Options), BeamBin = case NeedBeamCode of @@ -619,7 +618,7 @@ get_core_icode(Mod, Core, File, Options) -> get_beam_code(Bin) when is_binary(Bin) -> Bin; get_beam_code(FileName) -> case erl_prim_loader:get_file(FileName) of - {ok,Bin,_} -> + {ok, Bin, _} -> Bin; error -> ?EXIT(no_beam_file) diff --git a/lib/hipe/main/hipe.hrl.src b/lib/hipe/main/hipe.hrl.src index 3be824ac34..53b59f88f0 100644 --- a/lib/hipe/main/hipe.hrl.src +++ b/lib/hipe/main/hipe.hrl.src @@ -152,7 +152,7 @@ STMNT, ?untagged_msg(Msg ++ "~.2f s\n",[hipe_timing:stop_timer(Timer)/1000])). -else. --define(TIME_STMNT(STMNT,Msg,Timer),STMNT). +-define(TIME_STMNT(STMNT,Msg,Timer), STMNT). -endif. -define(start_timer(Text), hipe_timing:start(Text, ?MODULE)). @@ -162,22 +162,24 @@ -define(get_hipe_timer_val(Timer), get(Timer)). -define(set_hipe_timer_val(Timer, Val), put(Timer, Val)). -define(option_time(Stmnt, Text, Options), - if true -> ?when_option(time, Options, ?start_timer(Text)), - fun(R) -> - ?when_option(time, Options, ?stop_timer(Text)), - R - end(Stmnt)end). + begin + ?when_option(time, Options, ?start_timer(Text)), + fun(R) -> + ?when_option(time, Options, ?stop_timer(Text)), + R + end(Stmnt) + end). --define(option_start_time(Text,Options), +-define(option_start_time(Text, Options), ?when_option(time, Options, ?start_timer(Text))). --define(option_stop_time(Text,Options), +-define(option_stop_time(Text, Options), ?when_option(time, Options, ?stop_timer(Text))). -define(opt_start_timer(Text), - hipe_timing:start_optional_timer(Text,?MODULE)). + hipe_timing:start_optional_timer(Text, ?MODULE)). -define(opt_stop_timer(Text), - hipe_timing:stop_optional_timer(Text,?MODULE)). + hipe_timing:stop_optional_timer(Text, ?MODULE)). %% %% Turn on instrumentation of the compiler. @@ -187,15 +189,15 @@ -define(count_pre_ra_instructions(Options, NoInstrs), ?when_option(count_instrs, Options, put(pre_ra_instrs, - get(pre_ra_instrs)+ NoInstrs))). + get(pre_ra_instrs) + NoInstrs))). -define(count_post_ra_instructions(Options, NoInstrs), ?when_option(count_instrs, Options, put(post_ra_instrs, - get(post_ra_instrs)+ NoInstrs))). + get(post_ra_instrs) + NoInstrs))). -define(start_time_regalloc(Options), ?when_option(timeregalloc, Options, - put(regalloctime1,erlang:statistics(runtime)))). + put(regalloctime1, erlang:statistics(runtime)))). -define(stop_time_regalloc(Options), ?when_option(timeregalloc, Options, put(regalloctime, @@ -215,11 +217,11 @@ -define(count_pre_ra_temps(Options, NoTemps), ?when_option(count_temps, Options, put(pre_ra_temps, - get(pre_ra_temps)+ NoTemps))). + get(pre_ra_temps) + NoTemps))). -define(count_post_ra_temps(Options, NoTemps), ?when_option(count_temps, Options, put(post_ra_temps, - get(post_ra_temps)+ NoTemps))). + get(post_ra_temps) + NoTemps))). -define(inc_counter(Counter, Val), case get(Counter) of @@ -255,7 +257,7 @@ ?count_post_ra_instructions(Options, NoInstrs), ?cons_counter(counter_mem_temps, get(counter_mfa_mem_temps)), ?cons_counter(ra_all_iterations_counter, get(ra_iteration_counter)), - put(ra_iteration_counter,0), + put(ra_iteration_counter, 0), ?count_post_ra_temps(Options, NoTemps) end). @@ -264,12 +266,12 @@ put(spilledtemps, get(spilledtemps) + NoSpills))). -define(optional_start_timer(Timer, Options), - case lists:member(Timer, proplists:get_value(timers,Options++[{timers,[]}])) of + case lists:member(Timer, proplists:get_value(timers, Options++[{timers,[]}])) of true -> ?start_hipe_timer(Timer); false -> true end). -define(optional_stop_timer(Timer, Options), - case lists:member(Timer, proplists:get_value(timers,Options++[{timers,[]}])) of + case lists:member(Timer, proplists:get_value(timers, Options++[{timers,[]}])) of true -> ?stop_hipe_timer(Timer); false -> true end). @@ -316,4 +318,4 @@ 'unknown' | {'reg' | 'fp_reg' | 'spill', non_neg_integer()}}]. -type hipe_temp_map() :: tuple(). --type hipe_spill_map() :: [{non_neg_integer(), {'spill',non_neg_integer()}}]. +-type hipe_spill_map() :: [{non_neg_integer(), {'spill', non_neg_integer()}}]. diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl index b9d783d20a..4b89feb48a 100644 --- a/lib/hipe/main/hipe_main.erl +++ b/lib/hipe/main/hipe_main.erl @@ -296,7 +296,7 @@ icode_ssa_convert(IcodeCfg, Options) -> icode_ssa_const_prop(IcodeSSA, Options) -> case proplists:get_bool(icode_ssa_const_prop, Options) of true -> - ?option_time(Tmp=hipe_icode_ssa_const_prop:propagate(IcodeSSA), + Tmp = ?option_time(hipe_icode_ssa_const_prop:propagate(IcodeSSA), "Icode SSA sparse conditional constant propagation", Options), ?option_time(hipe_icode_ssa:remove_dead_code(Tmp), "Icode SSA dead code elimination pass 1", Options); diff --git a/lib/hipe/misc/Makefile b/lib/hipe/misc/Makefile index 60d2861c62..72cfff21a8 100644 --- a/lib/hipe/misc/Makefile +++ b/lib/hipe/misc/Makefile @@ -69,7 +69,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/opt/Makefile b/lib/hipe/opt/Makefile index ec0d01b42e..684d6f45b4 100644 --- a/lib/hipe/opt/Makefile +++ b/lib/hipe/opt/Makefile @@ -64,7 +64,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec # +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec # +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/ppc/Makefile b/lib/hipe/ppc/Makefile index 576c089f15..1901dfa671 100644 --- a/lib/hipe/ppc/Makefile +++ b/lib/hipe/ppc/Makefile @@ -76,7 +76,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/regalloc/Makefile b/lib/hipe/regalloc/Makefile index 2b94f5ecfe..aaa4418f37 100644 --- a/lib/hipe/regalloc/Makefile +++ b/lib/hipe/regalloc/Makefile @@ -77,7 +77,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars# +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars #+warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/rtl/Makefile b/lib/hipe/rtl/Makefile index e0ff225a25..b4cdf8b1f2 100644 --- a/lib/hipe/rtl/Makefile +++ b/lib/hipe/rtl/Makefile @@ -75,7 +75,7 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) include ../native.mk -ERL_COMPILE_FLAGS += -Werror +inline +warn_unused_import +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +inline +warn_unused_import +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl index 1d627ed024..0726827299 100644 --- a/lib/hipe/rtl/hipe_rtl.erl +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -366,7 +366,7 @@ -export([subst_uses_llvm/2]). --export_type([alub_cond/0]). +-export_type([alub_cond/0, rtl/0]). %% %% RTL @@ -384,6 +384,7 @@ label_range, %% {Min,Max} First and last name used for labels info=[] %% A keylist with arbitrary information. }). +-opaque rtl() :: #rtl{}. mk_rtl(Fun, ArgList, Closure, Leaf, Code, Data, VarRange, LabelRange) -> #rtl{'fun'=Fun, arglist=ArgList, code=Code, @@ -414,7 +415,9 @@ rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}. %% move %% -mk_move(Dst, Src) -> false = is_fpreg(Dst), false = is_fpreg(Src), #move{dst=Dst, src=Src}. +mk_move(Dst, Src) -> + false = is_fpreg(Dst), false = is_fpreg(Src), + #move{dst=Dst, src=Src}. move_dst(#move{dst=Dst}) -> Dst. move_dst_update(M, NewDst) -> false = is_fpreg(NewDst), M#move{dst=NewDst}. move_src(#move{src=Src}) -> Src. diff --git a/lib/hipe/rtl/hipe_rtl_arith.inc b/lib/hipe/rtl/hipe_rtl_arith.inc index 645bc83f9f..0c396c8e76 100644 --- a/lib/hipe/rtl/hipe_rtl_arith.inc +++ b/lib/hipe/rtl/hipe_rtl_arith.inc @@ -47,73 +47,80 @@ eval_alu(Op, Arg1, Arg2) Res = (Arg1 - Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), - V = (Sign1 and (not Sign2) and (not N)) + V = (Sign1 andalso (not Sign2) andalso (not N)) or - ((not Sign1) and Sign2 and N), - C = ((not Sign1) and Sign2) + ((not Sign1) andalso Sign2 andalso N), + C = ((not Sign1) andalso Sign2) or - (N and ((not Sign1) or Sign2)); + (N andalso ((not Sign1) orelse Sign2)), + {Res, N, Z, V, C}; 'add' -> Res = (Arg1 + Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), - V = (Sign1 and Sign2 and (not N)) + V = (Sign1 andalso Sign2 andalso (not N)) or - ((not Sign1) and (not Sign2) and N), - C = (Sign1 and Sign2) + ((not Sign1) andalso (not Sign2) andalso N), + C = (Sign1 andalso Sign2) or - ((not N) and (Sign1 or Sign2)); + ((not N) andalso (Sign1 orelse Sign2)), + {Res, N, Z, V, C}; 'mul' -> FullRes = Arg1 * Arg2, Res = FullRes band ?WORDMASK, ResHi = FullRes bsr ?BITS, N = sign_bit(Res), Z = zero(Res), - V = (N and (ResHi =/= -1)) or ((not N) and (ResHi =/= 0)), - C = V; + V = (N andalso (ResHi =/= -1)) orelse ((not N) andalso (ResHi =/= 0)), + C = V, + {Res, N, Z, V, C}; 'sra' -> Res = (Arg1 bsr Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'srl' -> Res = (Arg1 bsr Arg2) band shiftmask(Arg2), N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'sll' -> Res = (Arg1 bsl Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'or' -> Res = (Arg1 bor Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'and' -> Res = (Arg1 band Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'xor' -> Res = (Arg1 bxor Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; Op -> - Res = N = Z = V = C = 0, ?EXIT({"unknown alu op", Op}) - end, - {Res, N, Z, V, C}; + end; eval_alu(Op, Arg1, Arg2) -> - ?EXIT({argument_overflow,Op,Arg1,Arg2}). + ?EXIT({argument_overflow, Op, Arg1, Arg2}). %% Björn & Bjarni: %% We need to be able to do evaluations based only on the bits, since @@ -130,9 +137,9 @@ eval_cond_bits(Cond, N, Z, V, C) -> 'ne' -> not Z; 'gt' -> - not (Z or (N xor V)); + not (Z orelse (N xor V)); 'gtu' -> - not (C or Z); + not (C orelse Z); 'ge' -> not (N xor V); 'geu'-> @@ -142,9 +149,9 @@ eval_cond_bits(Cond, N, Z, V, C) -> 'ltu'-> C; 'le' -> - Z or (N xor V); + Z orelse (N xor V); 'leu'-> - C or Z; + C orelse Z; 'overflow' -> V; 'not_overflow' -> diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 4403aa552f..367d76b24d 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,25 +19,21 @@ %% %CopyrightEnd% %% %% ==================================================================== -%% Module : hipe_rtl_inline_bs_ops +%% Module : hipe_rtl_binary_construct %% Purpose : %% Notes : -%% History : * 2001-06-14 Erik Johansson ([email protected]): Created. +%% History : Written mostly by Per Gustafsson %% ==================================================================== %% Exports : %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -module(hipe_rtl_binary_construct). + -export([gen_rtl/7]). --import(hipe_tagscheme, [set_field_from_term/3, - get_field_from_term/3, - set_field_from_pointer/3, - get_field_from_pointer/3]). - --import(hipe_rtl_binary, [floorlog2/1, - get_word_integer/4, - make_size/4]). + +-import(hipe_rtl_binary, [get_word_integer/4]). + %%------------------------------------------------------------------------- -include("../main/hipe.hrl"). @@ -50,7 +46,6 @@ -define(BYTE_SIZE, 8). -define(MAX_BINSIZE, ((1 bsl ((hipe_rtl_arch:word_size()*?BYTE_SIZE)-3)) - 1)). - %% ------------------------------------------------------------------------- %% The code is generated as a list of lists, it will be flattened later. %% @@ -61,12 +56,12 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab {bs_put_string, String, SizeInBytes} -> [NewOffset] = get_real(Dst), [Base, Offset] = Args, - put_string(NewOffset, ConstTab, String, SizeInBytes, Base, Offset, + put_string(NewOffset, ConstTab, String, SizeInBytes, Base, Offset, TrueLblName); - _ -> - Code = + _ -> + Code = case BsOP of - {bs_init, Size, _Flags} -> + {bs_init, Size, _Flags} -> [] = Args, [Dst0, Base, Offset] = Dst, case is_illegal_const(Size bsl 3) of @@ -75,14 +70,14 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab false -> const_init2(Size, Dst0, Base, Offset, TrueLblName) end; - - {bs_init, _Flags} -> + + {bs_init, _Flags} -> [Size] = Args, [Dst0, Base, Offset] = Dst, - var_init2(Size, Dst0, Base, Offset, TrueLblName, + var_init2(Size, Dst0, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName); - {bs_init_bits, Size, _Flags} -> + {bs_init_bits, Size, _Flags} -> [] = Args, [Dst0, Base, Offset] = Dst, case is_illegal_const(Size) of @@ -91,19 +86,19 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab false -> const_init_bits(Size, Dst0, Base, Offset, TrueLblName) end; - - {bs_init_bits, _Flags} -> + + {bs_init_bits, _Flags} -> [Size] = Args, [Dst0, Base, Offset] = Dst, - var_init_bits(Size, Dst0, Base, Offset, TrueLblName, + var_init_bits(Size, Dst0, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName); - + {bs_put_binary_all, Unit, _Flags} -> [Src, Base, Offset] = Args, [NewOffset] = get_real(Dst), put_binary_all(NewOffset, Src, Base, Offset, Unit, TrueLblName, FalseLblName); - + {bs_put_binary, Size, _Flags} -> case is_illegal_const(Size) of true -> @@ -112,19 +107,19 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [NewOffset] = get_real(Dst), case Args of [Src, Base, Offset] -> - put_static_binary(NewOffset, Src, Size, Base, Offset, + put_static_binary(NewOffset, Src, Size, Base, Offset, TrueLblName, FalseLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, - SystemLimitLblName, - FalseLblName), - InCode = put_dynamic_binary(NewOffset, Src, SizeReg, Base, + {SizeCode, SizeReg} = + hipe_rtl_binary:make_size(Size, Bits, SystemLimitLblName, + FalseLblName), + InCode = put_dynamic_binary(NewOffset, Src, SizeReg, Base, Offset, TrueLblName, FalseLblName), SizeCode ++ InCode end end; - - {bs_put_float, Size, Flags, ConstInfo} -> + + {bs_put_float, Size, Flags, ConstInfo} -> [NewOffset] = get_real(Dst), Aligned = aligned(Flags), LittleEndian = littleendian(Flags), @@ -134,106 +129,108 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab false -> case Args of [Src, Base, Offset] -> - CCode = static_float_c_code(NewOffset, Src, Base, Offset, Size, Flags, + CCode = static_float_c_code(NewOffset, Src, Base, Offset, Size, Flags, TrueLblName, FalseLblName), - put_float(NewOffset, Src, Base, Offset, Size, CCode, Aligned, + put_float(NewOffset, Src, Base, Offset, Size, CCode, Aligned, LittleEndian, ConstInfo, TrueLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, - SystemLimitLblName, - FalseLblName), - InCode = float_c_code(NewOffset, Src, Base, Offset, SizeReg, + {SizeCode, SizeReg} = + hipe_rtl_binary:make_size(Size, Bits, SystemLimitLblName, + FalseLblName), + InCode = float_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName), SizeCode ++ InCode end end; - {bs_put_integer, Size, Flags, ConstInfo} -> - Aligned = aligned(Flags), + {bs_put_integer, Size, Flags, ConstInfo} -> + Aligned = aligned(Flags), LittleEndian = littleendian(Flags), [NewOffset] = get_real(Dst), case is_illegal_const(Size) of true -> [hipe_rtl:mk_goto(FalseLblName)]; false -> - case ConstInfo of + case ConstInfo of fail -> [hipe_rtl:mk_goto(FalseLblName)]; - _ -> - case Args of - [Src, Base, Offset] -> + _ -> + case Args of + [Src, Base, Offset] -> CCode = static_int_c_code(NewOffset, Src, - Base, Offset, Size, - Flags, TrueLblName, + Base, Offset, Size, + Flags, TrueLblName, FalseLblName), - put_static_int(NewOffset, Src, Base, Offset, Size, - CCode, Aligned, LittleEndian, TrueLblName); - [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, + put_static_int(NewOffset, Src, Base, Offset, Size, + CCode, Aligned, LittleEndian, TrueLblName); + [Src, Bits, Base, Offset] -> + {SizeCode, SizeReg} = + hipe_rtl_binary:make_size(Size, Bits, SystemLimitLblName, FalseLblName), CCode = int_c_code(NewOffset, Src, Base, - Offset, SizeReg, Flags, - TrueLblName, FalseLblName), + Offset, SizeReg, Flags, + TrueLblName, FalseLblName), InCode = - put_dynamic_int(NewOffset, Src, Base, Offset, + put_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, - LittleEndian, TrueLblName), - SizeCode ++ InCode - end - end + LittleEndian, TrueLblName), + SizeCode ++ InCode + end + end end; - - {unsafe_bs_put_integer, 0, _Flags, _ConstInfo} -> - [NewOffset] = get_real(Dst), + + {unsafe_bs_put_integer, 0, _Flags, _ConstInfo} -> + [NewOffset] = get_real(Dst), case Args of [_Src, _Base, Offset] -> [hipe_rtl:mk_move(NewOffset,Offset), - hipe_rtl:mk_goto(TrueLblName)]; - [_Src, _Bits, _Base, Offset] -> + hipe_rtl:mk_goto(TrueLblName)]; + [_Src, _Bits, _Base, Offset] -> [hipe_rtl:mk_move(NewOffset,Offset), - hipe_rtl:mk_goto(TrueLblName)] - end; - - {unsafe_bs_put_integer, Size, Flags, ConstInfo} -> + hipe_rtl:mk_goto(TrueLblName)] + end; + + {unsafe_bs_put_integer, Size, Flags, ConstInfo} -> case is_illegal_const(Size) of true -> [hipe_rtl:mk_goto(FalseLblName)]; false -> Aligned = aligned(Flags), - LittleEndian = littleendian(Flags), - [NewOffset] = get_real(Dst), - case ConstInfo of + LittleEndian = littleendian(Flags), + [NewOffset] = get_real(Dst), + case ConstInfo of fail -> - [hipe_rtl:mk_goto(FalseLblName)]; - _ -> - case Args of - [Src, Base, Offset] -> + [hipe_rtl:mk_goto(FalseLblName)]; + _ -> + case Args of + [Src, Base, Offset] -> CCode = static_int_c_code(NewOffset, Src, - Base, Offset, Size, - Flags, TrueLblName, + Base, Offset, Size, + Flags, TrueLblName, FalseLblName), - put_unsafe_static_int(NewOffset, Src, Base, + put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, - CCode, Aligned, LittleEndian, - TrueLblName); - [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, - SystemLimitLblName, - FalseLblName), + CCode, Aligned, LittleEndian, + TrueLblName); + [Src, Bits, Base, Offset] -> + {SizeCode, SizeReg} = + hipe_rtl_binary:make_size(Size, Bits, + SystemLimitLblName, + FalseLblName), CCode = int_c_code(NewOffset, Src, Base, - Offset, SizeReg, Flags, - TrueLblName, FalseLblName), + Offset, SizeReg, Flags, + TrueLblName, FalseLblName), InCode = - put_unsafe_dynamic_int(NewOffset, Src, Base, - Offset, SizeReg, CCode, - Aligned, LittleEndian, + put_unsafe_dynamic_int(NewOffset, Src, Base, + Offset, SizeReg, CCode, + Aligned, LittleEndian, TrueLblName), - SizeCode ++ InCode - end + SizeCode ++ InCode + end end - end; - + end; + bs_utf8_size -> case Dst of [_DstVar] -> @@ -276,13 +273,13 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [hipe_rtl:mk_call([], bs_validate_unicode, Args, TrueLblName, FalseLblName, not_remote)]; - bs_final -> + bs_final -> Zero = hipe_rtl:mk_imm(0), - [Src, Offset] = Args, + [Src, Offset] = Args, [BitSize, ByteSize] = create_regs(2), [ShortLbl, LongLbl] = create_lbls(2), - case Dst of - [DstVar] -> + case Dst of + [DstVar] -> [hipe_rtl:mk_alub(BitSize, Offset, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(ShortLbl), hipe_rtl:label_name(LongLbl)), ShortLbl, @@ -292,11 +289,11 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab hipe_rtl:mk_alu(ByteSize, Offset, 'srl', ?BYTE_SHIFT), hipe_tagscheme:mk_sub_binary(DstVar, ByteSize, Zero, BitSize, Zero, Src), - hipe_rtl:mk_goto(TrueLblName)]; + hipe_rtl:mk_goto(TrueLblName)]; [] -> - [hipe_rtl:mk_goto(TrueLblName)] - end; - + [hipe_rtl:mk_goto(TrueLblName)] + end; + bs_init_writable -> Zero = hipe_rtl:mk_imm(0), [Size] = Args, @@ -306,29 +303,29 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE + ?SUB_BIN_WORDSIZE), get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), allocate_writable(DstVar, Base, SizeReg, Zero, Zero), - hipe_rtl:mk_goto(TrueLblName)]; - + hipe_rtl:mk_goto(TrueLblName)]; + {bs_private_append, _U, _F} -> - [Size, Bin] = Args, + [Size, Bin] = Args, [DstVar, Base, Offset] = Dst, [ProcBin] = create_vars(1), [SubSize, SizeReg, EndSubSize, EndSubBitSize] = create_regs(4), SubBinSize = {sub_binary, binsize}, - [get_field_from_term({sub_binary, orig}, Bin, ProcBin), - get_field_from_term(SubBinSize, Bin, SubSize), + [hipe_tagscheme:get_field_from_term({sub_binary, orig}, Bin, ProcBin), + hipe_tagscheme:get_field_from_term(SubBinSize, Bin, SubSize), get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), realloc_binary(SizeReg, ProcBin, Base), calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), - set_field_from_term(SubBinSize, Bin, EndSubSize), - set_field_from_term({sub_binary, bitsize}, Bin, EndSubBitSize), + hipe_tagscheme:set_field_from_term(SubBinSize, Bin, EndSubSize), + hipe_tagscheme:set_field_from_term({sub_binary, bitsize}, Bin, EndSubBitSize), hipe_rtl:mk_move(DstVar, Bin), hipe_rtl:mk_goto(TrueLblName)]; {bs_append, _U, _F, Unit, _Bla} -> - [Size, Bin] = Args, - [DstVar, Base, Offset] = Dst, + [Size, Bin] = Args, + [DstVar, Base, Offset] = Dst, [ProcBin] = create_vars(1), - [Flags, SizeReg, IsWritable, EndSubSize, EndSubBitSize] = + [Flags, SizeReg, IsWritable, EndSubSize, EndSubBitSize] = create_regs(5), [ContLbl,ContLbl2,ContLbl3,ContLbl4,WritableLbl,NotWritableLbl] = Lbls = create_lbls(6), @@ -339,24 +336,24 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab SubIsWritable = {sub_binary, is_writable}, [hipe_rtl:mk_gctest(?SUB_BIN_WORDSIZE + ?PROC_BIN_WORDSIZE), get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), - hipe_tagscheme:test_bitstr(Bin, ContLblName, FalseLblName, 0.99), - ContLbl, - hipe_tagscheme:test_subbinary(Bin,ContLbl2Name, NotWritable), + hipe_tagscheme:test_bitstr(Bin, ContLblName, FalseLblName, 0.99), + ContLbl, + hipe_tagscheme:test_subbinary(Bin,ContLbl2Name, NotWritable), ContLbl2, - get_field_from_term(SubIsWritable, Bin, IsWritable), + hipe_tagscheme:get_field_from_term(SubIsWritable, Bin, IsWritable), hipe_rtl:mk_branch(IsWritable, 'ne', Zero, ContLbl3Name, NotWritable), ContLbl3, - get_field_from_term({sub_binary, orig}, Bin, ProcBin), - get_field_from_term({proc_bin, flags}, ProcBin, Flags), + hipe_tagscheme:get_field_from_term({sub_binary, orig}, Bin, ProcBin), + hipe_tagscheme:get_field_from_term({proc_bin, flags}, ProcBin, Flags), hipe_rtl:mk_alub(Flags, Flags, 'and', - hipe_rtl:mk_imm(?PB_IS_WRITABLE), + hipe_rtl:mk_imm(?PB_IS_WRITABLE), eq, NotWritable, ContLbl4Name, 0.01), ContLbl4, calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), is_divisible(Offset, Unit, Writable, FalseLblName), WritableLbl, - set_field_from_term(SubIsWritable, Bin, Zero), + hipe_tagscheme:set_field_from_term(SubIsWritable, Bin, Zero), realloc_binary(SizeReg, ProcBin, Base), hipe_tagscheme:mk_sub_binary(DstVar, EndSubSize, Zero, EndSubBitSize, Zero, @@ -394,7 +391,7 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit, allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize), put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), Unit, TrueLblName, FalseLblName)]. - + allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> Zero = hipe_rtl:mk_imm(0), [NextLbl] = create_lbls(1), @@ -411,7 +408,7 @@ allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> hipe_tagscheme:mk_sub_binary(Dst, EndSubSize, Zero, EndSubBitSize, Zero, hipe_rtl:mk_imm(1), ProcBin)]. -realloc_binary(SizeReg, ProcBin, Base) -> +realloc_binary(SizeReg, ProcBin, Base) -> [NoReallocLbl, ReallocLbl, NextLbl, ContLbl] = Lbls = create_lbls(4), [NoReallocLblName, ReallocLblName, NextLblName, ContLblName] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], @@ -422,36 +419,36 @@ realloc_binary(SizeReg, ProcBin, Base) -> ProcBinValTag = {proc_bin, val}, ProcBinBytesTag = {proc_bin, bytes}, BinOrigSizeTag = {binary, orig_size}, - [get_field_from_term(ProcBinSizeTag, ProcBin, PBSize), + [hipe_tagscheme:get_field_from_term(ProcBinSizeTag, ProcBin, PBSize), hipe_rtl:mk_alu(Tmp, SizeReg, 'add', ?LOW_BITS), hipe_rtl:mk_alu(ByteSize, Tmp, 'srl', ?BYTE_SHIFT), hipe_rtl:mk_alu(ResultingSize, ByteSize, 'add', PBSize), - set_field_from_term(ProcBinSizeTag, ProcBin, ResultingSize), - get_field_from_term(ProcBinFlagsTag, ProcBin, Flags), + hipe_tagscheme:set_field_from_term(ProcBinSizeTag, ProcBin, ResultingSize), + hipe_tagscheme:get_field_from_term(ProcBinFlagsTag, ProcBin, Flags), hipe_rtl:mk_alu(Flags, Flags, 'or', hipe_rtl:mk_imm(?PB_ACTIVE_WRITER)), - set_field_from_term(ProcBinFlagsTag, ProcBin, Flags), - get_field_from_term(ProcBinValTag, ProcBin, BinPointer), - get_field_from_pointer(BinOrigSizeTag, BinPointer, OrigSize), + hipe_tagscheme:set_field_from_term(ProcBinFlagsTag, ProcBin, Flags), + hipe_tagscheme:get_field_from_term(ProcBinValTag, ProcBin, BinPointer), + hipe_tagscheme:get_field_from_pointer(BinOrigSizeTag, BinPointer, OrigSize), hipe_rtl:mk_branch(OrigSize, 'ltu', ResultingSize, ReallocLblName, NoReallocLblName), NoReallocLbl, - get_field_from_term(ProcBinBytesTag, ProcBin, Base), + hipe_tagscheme:get_field_from_term(ProcBinBytesTag, ProcBin, Base), hipe_rtl:mk_goto(ContLblName), ReallocLbl, hipe_rtl:mk_alu(NewSize, ResultingSize, 'sll', hipe_rtl:mk_imm(1)), - hipe_rtl:mk_call([BinPointer], bs_reallocate, [BinPointer, NewSize], + hipe_rtl:mk_call([BinPointer], bs_reallocate, [BinPointer, NewSize], NextLblName, [], not_remote), NextLbl, - set_field_from_pointer(BinOrigSizeTag, BinPointer, NewSize), - set_field_from_term(ProcBinValTag, ProcBin, BinPointer), + hipe_tagscheme:set_field_from_pointer(BinOrigSizeTag, BinPointer, NewSize), + hipe_tagscheme:set_field_from_term(ProcBinValTag, ProcBin, BinPointer), hipe_tagscheme:extract_binary_bytes(BinPointer, Base), - set_field_from_term(ProcBinBytesTag, ProcBin, Base), + hipe_tagscheme:set_field_from_term(ProcBinBytesTag, ProcBin, Base), ContLbl]. calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize) -> [SubSize, SubBitSize, EndSize] = create_regs(3), - [get_field_from_term({sub_binary, binsize}, Bin, SubSize), - get_field_from_term({sub_binary, bitsize}, Bin, SubBitSize), + [hipe_tagscheme:get_field_from_term({sub_binary, binsize}, Bin, SubSize), + hipe_tagscheme:get_field_from_term({sub_binary, bitsize}, Bin, SubBitSize), hipe_rtl:mk_alu(Offset, SubSize, 'sll', ?BYTE_SHIFT), hipe_rtl:mk_alu(Offset, Offset, 'add', SubBitSize), hipe_rtl:mk_alu(EndSize, Offset, 'add', SizeReg), @@ -492,7 +489,7 @@ static_int_c_code(NewOffset, Src, Base, Offset, Size, Flags, int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName) -> - put_c_code(bs_put_big_integer, NewOffset, Src, Base, Offset, SizeReg, + put_c_code(bs_put_big_integer, NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName). binary_c_code(NewOffset, Src, Base, Offset, Size, TrueLblName) -> @@ -500,8 +497,8 @@ binary_c_code(NewOffset, Src, Base, Offset, Size, TrueLblName) -> [SizeReg, FlagsReg] = create_regs(2), [hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(0)), hipe_rtl:mk_move(SizeReg, Size), - hipe_rtl:mk_call([], bs_put_bits, [Src, SizeReg, Base, Offset, FlagsReg], - hipe_rtl:label_name(PassedLbl),[],not_remote), + hipe_rtl:mk_call([], bs_put_bits, [Src, SizeReg, Base, Offset, FlagsReg], + hipe_rtl:label_name(PassedLbl), [], not_remote), PassedLbl, hipe_rtl:mk_alu(NewOffset, Offset, add, SizeReg), hipe_rtl:mk_goto(TrueLblName)]. @@ -511,7 +508,7 @@ put_c_code(Func, NewOffset, Src, Base, Offset, SizeReg, Flags, PassedLbl = hipe_rtl:mk_new_label(), [FlagsReg] = create_regs(1), [hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)), - gen_test_sideffect_bs_call(Func, [Src, SizeReg, Base, Offset, FlagsReg], + gen_test_sideffect_bs_call(Func, [Src, SizeReg, Base, Offset, FlagsReg], hipe_rtl:label_name(PassedLbl), FalseLblName), PassedLbl, hipe_rtl:mk_alu(NewOffset, Offset, add, SizeReg), @@ -523,7 +520,7 @@ gen_test_sideffect_bs_call(Name, Args, TrueLblName, FalseLblName) -> [hipe_rtl:mk_call([Tmp1], Name, Args, hipe_rtl:label_name(RetLbl), [], not_remote), RetLbl, - hipe_rtl:mk_branch(Tmp1, eq, hipe_rtl:mk_imm(0), + hipe_rtl:mk_branch(Tmp1, eq, hipe_rtl:mk_imm(0), FalseLblName, TrueLblName, 0.01)]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -544,7 +541,7 @@ create_unsafe_regs(0) -> create_vars(X) when X > 0 -> [hipe_rtl:mk_new_var()|create_vars(X-1)]; -create_vars(0) -> +create_vars(0) -> []. create_lbls(X) when X > 0 -> @@ -582,7 +579,7 @@ get_real(Dst) -> %% The following functions are called from the translation switch: %% %% - put_string/7 creates code to copy a string to a binary -%% starting at base+offset and ending at base+newoffset +%% starting at base+offset and ending at base+newoffset %% %% - const_init2/6 initializes the creation of a binary of constant size %% @@ -609,10 +606,9 @@ put_string(NewOffset, ConstTab, String, SizeInBytes, Base, Offset, TLName) -> [StringBase] = create_regs(1), {NewTab, Lbl} = hipe_consttab:insert_block(ConstTab, byte, String), {[hipe_rtl:mk_load_address(StringBase, Lbl, constant)| - copy_string(StringBase, SizeInBytes, Base, Offset, - NewOffset, TLName)], + copy_string(StringBase, SizeInBytes, Base, Offset, NewOffset, TLName)], NewTab}. - + const_init2(Size, Dst, Base, Offset, TrueLblName) -> Log2WordSize = hipe_rtl_arch:log2_word_size(), WordSize = hipe_rtl_arch:word_size(), @@ -642,27 +638,29 @@ const_init_bits(Size, Dst, Base, Offset, TrueLblName) -> TmpDst = hipe_rtl:mk_new_var(), Zero = hipe_rtl:mk_imm(0), {ExtraSpace, SubBinCode} = - if (Size rem ?BYTE_SIZE) =:= 0 -> - {0,[hipe_rtl:mk_move(Dst, TmpDst)]}; - true -> + case (Size rem ?BYTE_SIZE) =:= 0 of + true -> + {0, [hipe_rtl:mk_move(Dst, TmpDst)]}; + false -> {?SUB_BIN_WORDSIZE, - hipe_tagscheme:mk_sub_binary(Dst, hipe_rtl:mk_imm(Size bsr 3), Zero, + hipe_tagscheme:mk_sub_binary(Dst, hipe_rtl:mk_imm(Size bsr 3), Zero, hipe_rtl:mk_imm(Size band ?LOW_BITS_INT), Zero, TmpDst)} end, BaseBinCode = - if Size =< (?MAX_HEAP_BIN_SIZE * 8) -> - ByteSize = (Size + 7) div 8, - [hipe_rtl:mk_gctest(((ByteSize+ 3*WordSize-1) bsr Log2WordSize)+ ExtraSpace), + case Size =< (?MAX_HEAP_BIN_SIZE * 8) of + true -> + ByteSize = (Size + 7) div 8, + [hipe_rtl:mk_gctest(((ByteSize + 3*WordSize-1) bsr Log2WordSize) + ExtraSpace), hipe_tagscheme:create_heap_binary(Base, ByteSize, TmpDst), hipe_rtl:mk_move(Offset, Zero)]; - true -> + false -> ByteSize = hipe_rtl:mk_new_reg(), [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE+ExtraSpace), hipe_rtl:mk_move(Offset, Zero), hipe_rtl:mk_move(ByteSize, hipe_rtl:mk_imm((Size+7) bsr 3)), hipe_rtl:mk_call([Base], bs_allocate, [ByteSize], - hipe_rtl:label_name(NextLbl),[],not_remote), + hipe_rtl:label_name(NextLbl), [], not_remote), NextLbl, hipe_tagscheme:create_refc_binary(Base, ByteSize, TmpDst)] end, @@ -671,12 +669,12 @@ const_init_bits(Size, Dst, Base, Offset, TrueLblName) -> var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) -> Log2WordSize = hipe_rtl_arch:log2_word_size(), WordSize = hipe_rtl_arch:word_size(), - [ContLbl,HeapLbl,REFCLbl,NextLbl] = create_lbls(4), - [USize,Tmp] = create_unsafe_regs(2), + [ContLbl, HeapLbl, REFCLbl, NextLbl] = create_lbls(4), + [USize, Tmp] = create_unsafe_regs(2), [get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_BINSIZE), - hipe_rtl:label_name(ContLbl), - SystemLimitLblName), + hipe_rtl:label_name(ContLbl), + SystemLimitLblName), ContLbl, hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), @@ -698,20 +696,20 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName hipe_rtl:mk_goto(TrueLblName)]. var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) -> - [HeapLbl,REFCLbl,NextLbl,NoSubLbl,SubLbl, + [HeapLbl, REFCLbl, NextLbl, NoSubLbl, SubLbl, NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(9), - [USize,ByteSize,TotByteSize,OffsetBits] = create_regs(4), + [USize, ByteSize, TotByteSize, OffsetBits] = create_regs(4), [TmpDst] = create_unsafe_regs(1), Log2WordSize = hipe_rtl_arch:log2_word_size(), WordSize = hipe_rtl_arch:word_size(), - MaximumWords = + MaximumWords = erlang:max((?MAX_HEAP_BIN_SIZE + 3*WordSize) bsr Log2WordSize, ?PROC_BIN_WORDSIZE) + ?SUB_BIN_WORDSIZE, Zero = hipe_rtl:mk_imm(0), [hipe_rtl:mk_gctest(MaximumWords), get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), hipe_rtl:mk_alu(ByteSize, USize, srl, ?BYTE_SHIFT), - hipe_rtl:mk_alub(OffsetBits, USize, 'and', ?LOW_BITS, eq, + hipe_rtl:mk_alub(OffsetBits, USize, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(NoSubLbl), hipe_rtl:label_name(SubLbl)), NoSubLbl, @@ -721,20 +719,20 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl hipe_rtl:mk_alu(TotByteSize, ByteSize, 'add', hipe_rtl:mk_imm(1)), JoinLbl, hipe_rtl:mk_branch(TotByteSize, 'leu', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), - hipe_rtl:label_name(HeapLbl), + hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, hipe_tagscheme:create_heap_binary(Base, TotByteSize, TmpDst), hipe_rtl:mk_goto(hipe_rtl:label_name(JoinLbl2)), REFCLbl, hipe_rtl:mk_call([Base], bs_allocate, [TotByteSize], - hipe_rtl:label_name(NextLbl),[],not_remote), + hipe_rtl:label_name(NextLbl), [], not_remote), NextLbl, hipe_tagscheme:create_refc_binary(Base, TotByteSize, TmpDst), JoinLbl2, hipe_rtl:mk_move(Offset, Zero), hipe_rtl:mk_branch(OffsetBits, 'eq', Zero, - hipe_rtl:label_name(NoCreateSubBin), + hipe_rtl:label_name(NoCreateSubBin), hipe_rtl:label_name(CreateSubBin)), CreateSubBin, hipe_tagscheme:mk_sub_binary(Dst, ByteSize, Zero, OffsetBits, Zero, TmpDst), @@ -744,10 +742,10 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl hipe_rtl:mk_goto(TrueLblName)]. put_binary_all(NewOffset, Src, Base, Offset, Unit, TLName, FLName) -> - [SrcBase,SrcOffset,NumBits] = create_regs(3), + [SrcBase, SrcOffset, NumBits] = create_regs(3), [ContLbl] = create_lbls(1), CCode = binary_c_code(NewOffset, Src, Base, Offset, NumBits, TLName), - AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, NumBits, Base, Offset, + AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, NumBits, Base, Offset, NewOffset, TLName), [get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName), is_divisible(NumBits, Unit, hipe_rtl:label_name(ContLbl), FLName), @@ -755,11 +753,11 @@ put_binary_all(NewOffset, Src, Base, Offset, Unit, TLName, FLName) -> |test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode)]. test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) -> - [Tmp] = create_regs(1), - [AlignedLbl,CLbl] = create_lbls(2), + [Tmp] = create_regs(1), + [AlignedLbl, CLbl] = create_lbls(2), [hipe_rtl:mk_alu(Tmp, SrcOffset, 'or', NumBits), hipe_rtl:mk_alu(Tmp, Tmp, 'or', Offset), - hipe_rtl:mk_alub(Tmp, Tmp, 'and', ?LOW_BITS, 'eq', + hipe_rtl:mk_alub(Tmp, Tmp, 'and', ?LOW_BITS, 'eq', hipe_rtl:label_name(AlignedLbl), hipe_rtl:label_name(CLbl)), AlignedLbl, @@ -768,12 +766,12 @@ test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) -> CCode]. put_static_binary(NewOffset, Src, Size, Base, Offset, TLName, FLName) -> - [SrcBase] = create_unsafe_regs(1), + [SrcBase] = create_unsafe_regs(1), [SrcOffset, SrcSize] = create_regs(2), case Size of 0 -> get_base_offset_size(Src, SrcBase, SrcOffset, SrcSize, FLName) ++ - [hipe_rtl:mk_move(NewOffset, Offset), + [hipe_rtl:mk_move(NewOffset, Offset), hipe_rtl:mk_goto(TLName)]; _ -> SizeImm = hipe_rtl:mk_imm(Size), @@ -789,13 +787,13 @@ put_dynamic_binary(NewOffset, Src, SizeReg, Base, Offset, TLName, FLName) -> [SrcBase] = create_unsafe_regs(1), [SrcOffset, SrcSize] = create_regs(2), CCode = binary_c_code(NewOffset, Src, Base, Offset, SizeReg, TLName), - AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, SizeReg, Base, Offset, + AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, SizeReg, Base, Offset, NewOffset, TLName), get_base_offset_size(Src, SrcBase, SrcOffset, SrcSize, FLName) ++ small_check(SizeReg, SrcSize, FLName) ++ test_alignment(SrcOffset, SizeReg, Offset, AlignedCode, CCode). -put_float(NewOffset, Src, Base, Offset, 64, CCode, Aligned, LittleEndian, +put_float(NewOffset, Src, Base, Offset, 64, CCode, Aligned, LittleEndian, ConstInfo, TrueLblName) -> [CLbl] = create_lbls(1), case {Aligned, LittleEndian} of @@ -829,12 +827,12 @@ put_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned, {false, true} -> CCode; {false, false} -> - Init ++ + Init ++ copy_offset_int_big(Base, Offset, NewOffset, Size, UntaggedSrc) ++ End end. -put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned, +put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned, LittleEndian, TrueLblName) -> {Init, End, UntaggedSrc} = make_init_end(Src, TrueLblName), case {Aligned, LittleEndian} of @@ -849,7 +847,7 @@ put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned, {false, true} -> CCode; {false, false} -> - Init ++ + Init ++ copy_offset_int_big(Base, Offset, NewOffset, Size, UntaggedSrc) ++ End end. @@ -861,7 +859,7 @@ put_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, true -> case LittleEndian of true -> - Init ++ + Init ++ copy_int_little(Base, Offset, NewOffset, SizeReg, UntaggedSrc) ++ End; false -> @@ -880,7 +878,7 @@ put_unsafe_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, true -> case LittleEndian of true -> - Init ++ + Init ++ copy_int_little(Base, Offset, NewOffset, SizeReg, UntaggedSrc) ++ End; false -> @@ -891,7 +889,7 @@ put_unsafe_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, false -> CCode end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @@ -902,7 +900,7 @@ put_unsafe_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, make_init_end(Src, CCode, TrueLblName) -> [CLbl, SuccessLbl] = create_lbls(2), [UntaggedSrc] = create_regs(1), - Init = [hipe_tagscheme:test_fixnum(Src, hipe_rtl:label_name(SuccessLbl), + Init = [hipe_tagscheme:test_fixnum(Src, hipe_rtl:label_name(SuccessLbl), hipe_rtl:label_name(CLbl), 0.99), SuccessLbl, hipe_tagscheme:untag_fixnum(UntaggedSrc,Src)], @@ -915,28 +913,28 @@ make_init_end(Src, TrueLblName) -> End = [hipe_rtl:mk_goto(TrueLblName)], {Init, End, UntaggedSrc}. -get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) -> +get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) -> [JoinLbl, EndLbl, SuccessLbl, SubLbl, OtherLbl, HeapLbl, REFCLbl] = Lbls = create_lbls(7), - [JoinLblName, EndLblName, SuccessLblName, SubLblName, + [JoinLblName, EndLblName, SuccessLblName, SubLblName, OtherLblName, HeapLblName, REFCLblName] = get_label_names(Lbls), - [BitSize,BitOffset] = create_regs(2), + [BitSize, BitOffset] = create_regs(2), [Orig] = create_vars(1), [hipe_tagscheme:test_bitstr(Binary, SuccessLblName, FLName, 0.99), SuccessLbl, - get_field_from_term({sub_binary,binsize}, Binary, SrcSize), + hipe_tagscheme:get_field_from_term({sub_binary,binsize}, Binary, SrcSize), hipe_rtl:mk_alu(SrcSize, SrcSize, sll, ?BYTE_SHIFT), hipe_tagscheme:test_subbinary(Binary, SubLblName, OtherLblName), SubLbl, - get_field_from_term({sub_binary,bitsize}, Binary, BitSize), - get_field_from_term({sub_binary,offset}, Binary, SrcOffset), + hipe_tagscheme:get_field_from_term({sub_binary,bitsize}, Binary, BitSize), + hipe_tagscheme:get_field_from_term({sub_binary,offset}, Binary, SrcOffset), hipe_rtl:mk_alu(SrcSize, SrcSize, add, BitSize), - get_field_from_term({sub_binary,bitoffset}, Binary, BitOffset), + hipe_tagscheme:get_field_from_term({sub_binary,bitoffset}, Binary, BitOffset), hipe_rtl:mk_alu(SrcOffset, SrcOffset, sll, ?BYTE_SHIFT), hipe_rtl:mk_alu(SrcOffset, SrcOffset, add, BitOffset), - get_field_from_term({sub_binary,orig}, Binary, Orig), + hipe_tagscheme:get_field_from_term({sub_binary,orig}, Binary, Orig), hipe_rtl:mk_goto(JoinLblName), - OtherLbl, + OtherLbl, hipe_rtl:mk_move(SrcOffset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_move(Orig, Binary), JoinLbl, @@ -945,29 +943,29 @@ get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) -> hipe_rtl:mk_alu(SrcBase, Orig, add, hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)), hipe_rtl:mk_goto(EndLblName), REFCLbl, - get_field_from_term({proc_bin,bytes}, Orig, SrcBase), + hipe_tagscheme:get_field_from_term({proc_bin,bytes}, Orig, SrcBase), EndLbl]. copy_aligned_bytes(CopyBase, CopyOffset, Size, Base, Offset, NewOffset, TrueLblName) -> [BaseDst, BaseSrc] = create_unsafe_regs(2), [Iter, Extra, BothOffset] = create_regs(3), initializations(BaseSrc, BaseDst, BothOffset, CopyOffset, Offset, CopyBase, Base) ++ - [hipe_rtl:mk_alu(Extra, Size, 'and', ?LOW_BITS), - hipe_rtl:mk_alu(Iter, Size, srl, ?BYTE_SHIFT), + [hipe_rtl:mk_alu(Extra, Size, 'and', ?LOW_BITS), + hipe_rtl:mk_alu(Iter, Size, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(NewOffset, Offset, 'add', Size)] ++ easy_loop(BaseSrc, BaseDst, BothOffset, Iter, Extra, TrueLblName). copy_string(StringBase, StringSize, BinBase, BinOffset, NewOffset, TrueLblName) -> [TmpOffset,BothOffset,InitOffs] = create_regs(3), [NewBinBase] = create_unsafe_regs(1), - [EasyLbl,HardLbl] = create_lbls(2), + [EasyLbl, HardLbl] = create_lbls(2), [hipe_rtl:mk_alu(TmpOffset, BinOffset, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(NewBinBase, BinBase, add, TmpOffset), hipe_rtl:mk_move(BothOffset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_alub(InitOffs, BinOffset, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(EasyLbl), hipe_rtl:label_name(HardLbl)), EasyLbl, - hipe_rtl:mk_alu(NewOffset, BinOffset, add, + hipe_rtl:mk_alu(NewOffset, BinOffset, add, hipe_rtl:mk_imm(?bytes_to_bits(StringSize)))] ++ easy_loop(StringBase, NewBinBase, BothOffset, hipe_rtl:mk_imm(StringSize), hipe_rtl:mk_imm(0), TrueLblName) ++ @@ -983,9 +981,9 @@ small_check(SizeVar, CopySize, FalseLblName) -> hipe_rtl:label_name(SuccessLbl), FalseLblName), SuccessLbl]. -easy_loop(BaseSrc, BaseDst, BothOffset, Iterations, Extra, TrueLblName) -> - [Tmp1,Shift] = create_regs(2), - [LoopLbl,TopLbl,EndLbl,ExtraLbl] = create_lbls(4), +easy_loop(BaseSrc, BaseDst, BothOffset, Iterations, Extra, TrueLblName) -> + [Tmp1, Shift] = create_regs(2), + [LoopLbl, TopLbl, EndLbl, ExtraLbl] = create_lbls(4), [TopLbl, hipe_rtl:mk_branch(BothOffset, ne, Iterations, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl), 0.99), @@ -1005,17 +1003,17 @@ easy_loop(BaseSrc, BaseDst, BothOffset, Iterations, Extra, TrueLblName) -> hipe_rtl:mk_store(BaseDst, BothOffset, Tmp1, byte), hipe_rtl:mk_goto(TrueLblName)]. -hard_loop(BaseSrc, BaseDst, BothOffset, Iterations, +hard_loop(BaseSrc, BaseDst, BothOffset, Iterations, InitOffset, TrueLblName) -> [Tmp1, Tmp2, OldByte, NewByte, SaveByte] = create_regs(5), - [LoopLbl,EndLbl,TopLbl] = create_lbls(3), + [LoopLbl, EndLbl, TopLbl] = create_lbls(3), [hipe_rtl:mk_load(OldByte, BaseDst, BothOffset, byte, unsigned), - hipe_rtl:mk_alu(Tmp1, hipe_rtl:mk_imm(?BYTE_SIZE), sub, InitOffset), + hipe_rtl:mk_alu(Tmp1, hipe_rtl:mk_imm(?BYTE_SIZE), sub, InitOffset), TopLbl, - hipe_rtl:mk_branch(BothOffset, ne, Iterations, - hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(BothOffset, ne, Iterations, + hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), - LoopLbl, + LoopLbl, hipe_rtl:mk_load(NewByte, BaseSrc, BothOffset, byte, unsigned), hipe_rtl:mk_alu(Tmp2, NewByte, srl, InitOffset), hipe_rtl:mk_alu(SaveByte, OldByte, 'or', Tmp2), @@ -1037,12 +1035,12 @@ initializations(BaseTmp1, BaseTmp2, BothOffset, CopyOffset, Offset, CopyBase, Ba copy_int_little(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> [Tmp2,TmpOffset] = create_regs(2), - ByteSize = Size div ?BYTE_SIZE, - [hipe_rtl:mk_alu(TmpOffset, Offset, srl, ?BYTE_SHIFT), - hipe_rtl:mk_alu(Tmp2, hipe_rtl:mk_imm(ByteSize), 'add', TmpOffset)] ++ - + ByteSize = Size div ?BYTE_SIZE, + [hipe_rtl:mk_alu(TmpOffset, Offset, srl, ?BYTE_SHIFT), + hipe_rtl:mk_alu(Tmp2, hipe_rtl:mk_imm(ByteSize), 'add', TmpOffset)] ++ + little_loop(Tmp1, Tmp2, TmpOffset, Base) ++ - + case Size band 7 of 0 -> [hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))]; @@ -1051,18 +1049,16 @@ copy_int_little(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))] end; - copy_int_little(Base, Offset, NewOffset, Size, Tmp1) -> [Tmp2, Tmp3, Tmp4, TmpOffset] = create_regs(4), - [hipe_rtl:mk_alu(Tmp2, Size, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(TmpOffset, Offset, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(Tmp3, Tmp2, 'add', TmpOffset)] ++ - + little_loop(Tmp1, Tmp3, TmpOffset, Base) ++ - + [hipe_rtl:mk_alu(Tmp4, Size, 'and', ?LOW_BITS), - hipe_rtl:mk_alu(Tmp4, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp4), + hipe_rtl:mk_alu(Tmp4, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp4), hipe_rtl:mk_alu(Tmp1, Tmp1, sll, Tmp4), hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), hipe_rtl:mk_alu(NewOffset, Offset, 'add', Size)]. @@ -1097,37 +1093,37 @@ copy_int_big(_Base, Offset, NewOffset, 0, _Tmp1) -> [hipe_rtl:mk_move(NewOffset, Offset)]; copy_int_big(Base, Offset, NewOffset, ?BYTE_SIZE, Tmp1) -> TmpOffset = hipe_rtl:mk_new_reg(), - [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(8))]; + [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(8))]; copy_int_big(Base, Offset, NewOffset, 2*?BYTE_SIZE, Tmp1) -> TmpOffset = hipe_rtl:mk_new_reg(), - [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'add', hipe_rtl:mk_imm(1)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_alu(Tmp1, Tmp1, 'sra', hipe_rtl:mk_imm(8)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(16))]; + [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'add', hipe_rtl:mk_imm(1)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), + hipe_rtl:mk_alu(Tmp1, Tmp1, 'sra', hipe_rtl:mk_imm(8)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(16))]; copy_int_big(Base, Offset, NewOffset, 3*?BYTE_SIZE, Tmp1) -> - TmpOffset = hipe_rtl:mk_new_reg(), - [hipe_rtl:mk_alu(TmpOffset, Offset, srl, hipe_rtl:mk_imm(3)), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, add, hipe_rtl:mk_imm(2)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(NewOffset, Offset, add, hipe_rtl:mk_imm(24))]; + TmpOffset = hipe_rtl:mk_new_reg(), + [hipe_rtl:mk_alu(TmpOffset, Offset, srl, hipe_rtl:mk_imm(3)), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, add, hipe_rtl:mk_imm(2)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), + hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), + hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(NewOffset, Offset, add, hipe_rtl:mk_imm(24))]; copy_int_big(Base, Offset,NewOffset, 4*?BYTE_SIZE, Tmp1) -> copy_big_word(Base, Offset, NewOffset, Tmp1); copy_int_big(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> [OldOffset, TmpOffset, Bits] = create_regs(3), ByteSize = (Size + 7) div ?BYTE_SIZE, - case Size band 7 of - 0 -> + case Size band 7 of + 0 -> [hipe_rtl:mk_alu(OldOffset, Offset, sra, hipe_rtl:mk_imm(3)), hipe_rtl:mk_alu(TmpOffset, OldOffset, add, hipe_rtl:mk_imm(ByteSize))]; Rest -> @@ -1138,7 +1134,7 @@ copy_int_big(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(Rest))] end ++ big_loop(Tmp1, OldOffset, TmpOffset, Base) ++ - [hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))]; + [hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))]; copy_int_big(Base, Offset, NewOffset, Size, Tmp1) -> Tmp2 = hipe_rtl:mk_new_reg(), Tmp3 = hipe_rtl:mk_new_reg(), @@ -1151,7 +1147,7 @@ copy_int_big(Base, Offset, NewOffset, Size, Tmp1) -> [hipe_rtl:mk_alu(Tmp2, Size, 'srl', hipe_rtl:mk_imm(3)), hipe_rtl:mk_alu(Tmp3, Offset, 'srl', hipe_rtl:mk_imm(3)), hipe_rtl:mk_alu(TmpOffset, Tmp2, 'add', Tmp3), - hipe_rtl:mk_alub(Tmp4, Size, 'and', hipe_rtl:mk_imm(7), 'eq', + hipe_rtl:mk_alub(Tmp4, Size, 'and', hipe_rtl:mk_imm(7), 'eq', hipe_rtl:label_name(EvenLbl), hipe_rtl:label_name(OddLbl)), OddLbl, hipe_rtl:mk_alu(Tmp6, hipe_rtl:mk_imm(8), 'sub', Tmp4), @@ -1159,9 +1155,7 @@ copy_int_big(Base, Offset, NewOffset, Size, Tmp1) -> hipe_rtl:mk_store(Base, TmpOffset, Tmp5, byte), EvenLbl, hipe_rtl:mk_alu(Tmp1, Tmp1, srl, Tmp4)] ++ - big_loop(Tmp1, Tmp3, TmpOffset, Base) ++ - [hipe_rtl:mk_alu(NewOffset, Offset, 'add', Size)]. copy_big_word(Base, Offset, NewOffset, Word) -> @@ -1224,8 +1218,8 @@ copy_offset_int_big(Base, Offset, NewOffset, Size, Tmp1) hipe_rtl:mk_alu(Tmp6, Tmp6, 'and', ?LOW_BITS), hipe_rtl:mk_alu(Tmp4, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp6), hipe_rtl:mk_move(Tmp5, Tmp1), - hipe_rtl:mk_alu(Tmp1, Tmp1, 'sll', Tmp6), - hipe_rtl:mk_branch(TmpOffset, 'ne', Tmp3, hipe_rtl:label_name(NextLbl), + hipe_rtl:mk_alu(Tmp1, Tmp1, 'sll', Tmp6), + hipe_rtl:mk_branch(TmpOffset, 'ne', Tmp3, hipe_rtl:label_name(NextLbl), hipe_rtl:label_name(EndLbl)), NextLbl, hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), @@ -1272,7 +1266,7 @@ copy_float_big(_Base, _Offset, _NewOffset, _Src, FalseLblName, _TrueLblName, fai copy_float_big(Base, Offset, NewOffset, Src, _FalseLblName, TrueLblName,pass) -> FloatLo = hipe_rtl:mk_new_reg(), FloatHi = hipe_rtl:mk_new_reg(), - TmpOffset =hipe_rtl:mk_new_reg(), + TmpOffset = hipe_rtl:mk_new_reg(), hipe_tagscheme:unsafe_load_float(FloatLo, FloatHi, Src) ++ copy_big_word(Base, Offset, TmpOffset, FloatHi) ++ copy_big_word(Base, TmpOffset, NewOffset, FloatLo) ++ @@ -1285,7 +1279,7 @@ copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, var) -> is_divisible(_Dividend, 1, SuccLbl, _FailLbl) -> [hipe_rtl:mk_goto(SuccLbl)]; is_divisible(Dividend, Divisor, SuccLbl, FailLbl) -> - Log2 = floorlog2(Divisor), + Log2 = hipe_rtl_binary:floorlog2(Divisor), case Divisor =:= 1 bsl Log2 of true -> %% Divisor is a power of 2 %% Test that the Log2-1 lowest bits are clear diff --git a/lib/hipe/rtl/hipe_rtl_lcm.erl b/lib/hipe/rtl/hipe_rtl_lcm.erl index ef866d0843..71bd06c0df 100644 --- a/lib/hipe/rtl/hipe_rtl_lcm.erl +++ b/lib/hipe/rtl/hipe_rtl_lcm.erl @@ -63,10 +63,10 @@ rtl_lcm(CFG, Options) -> pp_debug("-------------------------------------------------~n",[]), %% pp_debug( "~w~n", [MFA]), - + %% A check if we should pretty print the result. case proplists:get_bool(pp_rtl_lcm, Options) of - true-> + true -> pp_debug("-------------------------------------------------~n",[]), %% pp_debug("AllExpr: ~w~n", [AllExpr]), pp_debug("AllExpr:~n", []), @@ -76,21 +76,21 @@ rtl_lcm(CFG, Options) -> _ -> ok end, - + pp_debug("-------------------------------------------------~n",[]), - ?option_time({CFG1, MoveSet} = perform_lcm(CFG, NodeInfo, EdgeInfo, ExprMap, - IdMap, AllExpr, mk_edge_bb_map(), + {CFG1, MoveSet} = ?option_time(perform_lcm(CFG, NodeInfo, EdgeInfo, ExprMap, + IdMap, AllExpr, mk_edge_bb_map(), ?SETS:new(), Labels), - "RTL LCM perform_lcm", Options), + "RTL LCM perform_lcm", Options), %% Scan through list of moved expressions and replace their %% assignments with the new temporary created for that expression MoveList = ?SETS:to_list(MoveSet), - ?option_time(CFG2 = moved_expr_replace_assignments(CFG1, ExprMap, IdMap, + CFG2 = ?option_time(moved_expr_replace_assignments(CFG1, ExprMap, IdMap, MoveList), - "RTL LCM moved_expr_replace_assignments", Options), + "RTL LCM moved_expr_replace_assignments", Options), pp_debug("-------------------------------------------------~n~n",[]), - + CFG2. %%============================================================================= @@ -466,10 +466,10 @@ expr_clear_dst(I) -> %% easy access later. lcm_precalc(CFG, Options) -> %% Calculate use map and expression map. - ?option_time({ExprMap, IdMap} = mk_expr_map(CFG), - "RTL LCM mk_expr_map", Options), - ?option_time(UseMap = mk_use_map(CFG, ExprMap), - "RTL LCM mk_use_map", Options), + {ExprMap, IdMap} = ?option_time(mk_expr_map(CFG), + "RTL LCM mk_expr_map", Options), + UseMap = ?option_time(mk_use_map(CFG, ExprMap), + "RTL LCM mk_use_map", Options), %% Labels = hipe_rtl_cfg:reverse_postorder(CFG), Labels = hipe_rtl_cfg:labels(CFG), %% StartLabel = hipe_rtl_cfg:start_label(CFG), @@ -477,28 +477,28 @@ lcm_precalc(CFG, Options) -> AllExpr = ?SETS:from_list(gb_trees:keys(IdMap)), %% Calculate the data sets. - ?option_time(NodeInfo0 = mk_node_info(Labels), "RTL LCM mk_node_info", - Options), + NodeInfo0 = ?option_time(mk_node_info(Labels), + "RTL LCM mk_node_info", Options), %% ?option_time(EdgeInfo0 = mk_edge_info(), "RTL LCM mk_edge_info", %% Options), EdgeInfo0 = mk_edge_info(), - ?option_time(NodeInfo1 = calc_up_exp(CFG, ExprMap, NodeInfo0, Labels), - "RTL LCM calc_up_exp", Options), - ?option_time(NodeInfo2 = calc_down_exp(CFG, ExprMap, NodeInfo1, Labels), - "RTL LCM calc_down_exp", Options), - ?option_time(NodeInfo3 = calc_killed_expr(CFG, NodeInfo2, UseMap, AllExpr, + NodeInfo1 = ?option_time(calc_up_exp(CFG, ExprMap, NodeInfo0, Labels), + "RTL LCM calc_up_exp", Options), + NodeInfo2 = ?option_time(calc_down_exp(CFG, ExprMap, NodeInfo1, Labels), + "RTL LCM calc_down_exp", Options), + NodeInfo3 = ?option_time(calc_killed_expr(CFG, NodeInfo2, UseMap, AllExpr, IdMap, Labels), - "RTL LCM calc_killed_exp", Options), - ?option_time(NodeInfo4 = calc_avail(CFG, NodeInfo3), - "RTL LCM calc_avail", Options), - ?option_time(NodeInfo5 = calc_antic(CFG, NodeInfo4, AllExpr), - "RTL LCM calc_antic", Options), - ?option_time(EdgeInfo1 = calc_earliest(CFG, NodeInfo5, EdgeInfo0, Labels), - "RTL LCM calc_earliest", Options), - ?option_time({NodeInfo6, EdgeInfo2} = calc_later(CFG, NodeInfo5, EdgeInfo1), - "RTL LCM calc_later", Options), - ?option_time(NodeInfo7 = calc_delete(CFG, NodeInfo6, Labels), - "RTL LCM calc_delete", Options), + "RTL LCM calc_killed_exp", Options), + NodeInfo4 = ?option_time(calc_avail(CFG, NodeInfo3), + "RTL LCM calc_avail", Options), + NodeInfo5 = ?option_time(calc_antic(CFG, NodeInfo4, AllExpr), + "RTL LCM calc_antic", Options), + EdgeInfo1 = ?option_time(calc_earliest(CFG, NodeInfo5, EdgeInfo0, Labels), + "RTL LCM calc_earliest", Options), + {NodeInfo6, EdgeInfo2} = ?option_time(calc_later(CFG, NodeInfo5, EdgeInfo1), + "RTL LCM calc_later", Options), + NodeInfo7 = ?option_time(calc_delete(CFG, NodeInfo6, Labels), + "RTL LCM calc_delete", Options), {NodeInfo7, EdgeInfo2, AllExpr, ExprMap, IdMap, Labels}. %%%%%%%%%%%%%%%%%%% AVAILABLE IN/OUT FLOW ANALYSIS %%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -941,15 +941,16 @@ calc_insert_edge(NodeInfo, EdgeInfo, From, To) -> calc_delete(_, NodeInfo, []) -> NodeInfo; calc_delete(CFG, NodeInfo, [Label|Labels]) -> - case Label =:= hipe_rtl_cfg:start_label(CFG) of - true -> - NewNodeInfo = set_delete(NodeInfo, Label, ?SETS:new()); - false -> - UpExp = up_exp(NodeInfo, Label), - LaterIn = later_in(NodeInfo, Label), - Delete = ?SETS:subtract(UpExp, LaterIn), - NewNodeInfo = set_delete(NodeInfo, Label, Delete) - end, + NewNodeInfo = + case Label =:= hipe_rtl_cfg:start_label(CFG) of + true -> + set_delete(NodeInfo, Label, ?SETS:new()); + false -> + UpExp = up_exp(NodeInfo, Label), + LaterIn = later_in(NodeInfo, Label), + Delete = ?SETS:subtract(UpExp, LaterIn), + set_delete(NodeInfo, Label, Delete) + end, calc_delete(CFG, NewNodeInfo, Labels). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/hipe/rtl/hipe_rtl_ssapre.erl b/lib/hipe/rtl/hipe_rtl_ssapre.erl index e248457806..df1a4b9376 100644 --- a/lib/hipe/rtl/hipe_rtl_ssapre.erl +++ b/lib/hipe/rtl/hipe_rtl_ssapre.erl @@ -107,7 +107,7 @@ rtl_ssapre(RtlSSACfg, Options) -> case XsiList of [] -> %% No Xsi - ?option_time(?pp_debug("~n~n################ No Xsi Inserted ################~n",[]),"RTL A-SSAPRE No Xsi inserted (skip Downsafety and Will Be Available)",Options), + ?pp_debug("~n~n################ No Xsi Inserted ################~n",[]), ok; _ -> ?pp_debug("~n############ Downsafety ##########~n",[]), @@ -126,7 +126,7 @@ rtl_ssapre(RtlSSACfg, Options) -> ?pp_debug("~n~n################ Xsi CFG ################~n",[]),pp_cfg(CFG2,XsiGraph), init_redundancy_count(), - ?option_time(FinalCFG=perform_code_motion(Labels,CFG2,XsiGraph),"RTL A-SSAPRE Code Motion",Options), + FinalCFG = ?option_time(perform_code_motion(Labels,CFG2,XsiGraph),"RTL A-SSAPRE Code Motion",Options), ?pp_debug("\n############ No more need for the Xsi Graph....Deleting...",[]),?GRAPH:delete(XsiGraph), @@ -146,7 +146,7 @@ perform_Xsi_insertion(Cfg, Options) -> init_counters(), %% Init counters for Bottoms and Temps DigraphOpts = [cyclic, private], XsiGraph = digraph:new(DigraphOpts), - %% Be carefull, the digraph component is NOT garbage collected, + %% Be careful, the digraph component is NOT garbage collected, %% so don't create 20 millions of instances! %% finds the longest depth %% Depth-first, preorder traversal over Basic Blocks. @@ -154,13 +154,13 @@ perform_Xsi_insertion(Cfg, Options) -> Labels = ?CFG:preorder(Cfg), ?pp_debug("~n~n############# Finding definitions for computation~n~n",[]), - ?option_time({Cfg2,XsiGraph} = find_definition_for_computations(Labels,Cfg,XsiGraph),"RTL A-SSAPRE Xsi Insertion, searching from instructions",Options), + {Cfg2,XsiGraph} = ?option_time(find_definition_for_computations(Labels,Cfg,XsiGraph),"RTL A-SSAPRE Xsi Insertion, searching from instructions",Options), %% Active List creation GeneratorXsiList = lists:sort(?GRAPH:vertices(XsiGraph)), ?pp_debug("~n~n############# Inserted Xsis ~w",[GeneratorXsiList]), ?pp_debug("~n~n############# Finding operands~n",[]), - ?option_time({Cfg3,XsiGraph} = find_operands(Cfg2,XsiGraph,GeneratorXsiList,0),"RTL A-SSAPRE Xsi Insertion, finding operands",Options), + {Cfg3,XsiGraph} = ?option_time(find_operands(Cfg2,XsiGraph,GeneratorXsiList,0),"RTL A-SSAPRE Xsi Insertion, finding operands",Options), %% Creating the CFGGraph ?pp_debug("~n~n############# Creating CFG Graph",[]), @@ -170,9 +170,9 @@ perform_Xsi_insertion(Cfg, Options) -> ?pp_debug("~nAdding a vertex for the start label: ~w",[StartLabel]), ?GRAPH:add_vertex(CFGGraph, StartLabel, #block{type = top}), % Doing the others - ?option_time(MPs=create_cfggraph(Others,Cfg3,CFGGraph,[],[],[],XsiGraph),"RTL A-SSAPRE Xsi Insertion, creating intermediate 'SSAPRE Graph'",Options), + MPs = ?option_time(create_cfggraph(Others,Cfg3,CFGGraph,[],[],[],XsiGraph),"RTL A-SSAPRE Xsi Insertion, creating intermediate 'SSAPRE Graph'",Options), - %% Return the bloody collected information + %% Return the collected information {Cfg3,XsiGraph,CFGGraph,MPs}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -221,22 +221,21 @@ find_definition_for_computations_in_block(BlockLabel,[Inst|Rest],Cfg, ?pp_debug(" Inserting Xsi: ",[]),pp_xsi(Xsi), Label = Xsi#xsi.label, - case BlockLabel =:= Label of - false -> - %% Insert the Xsi in the appropriate block - Code = hipe_bb:code(?CFG:bb(Cfg,Label)), - {BeforeCode,AfterCode} = split_for_xsi(lists:reverse(Code),[]), - NewCode = BeforeCode++[XsiLink|AfterCode], - NewBB = hipe_bb:mk_bb(NewCode), - NewCfg = ?CFG:bb_add(Cfg,Label,NewBB), - NewVisited = [NewInst|VisitedInstructions]; - _-> - {BeforeCode,AfterCode} = split_for_xsi(VisitedInstructions,[]), - TempVisited = BeforeCode++[XsiLink|AfterCode], - TempVisited2 = lists:reverse(TempVisited), - NewVisited = [NewInst|TempVisited2], - NewCfg = Cfg - end, + {NewCfg, NewVisited} = + case BlockLabel =:= Label of + false -> + %% Insert the Xsi in the appropriate block + Code = hipe_bb:code(?CFG:bb(Cfg,Label)), + {BeforeCode,AfterCode} = split_for_xsi(lists:reverse(Code),[]), + NewCode = BeforeCode++[XsiLink|AfterCode], + NewBB = hipe_bb:mk_bb(NewCode), + {?CFG:bb_add(Cfg,Label,NewBB), [NewInst|VisitedInstructions]}; + _-> + {BeforeCode,AfterCode} = split_for_xsi(VisitedInstructions,[]), + TempVisited = BeforeCode++[XsiLink|AfterCode], + TempVisited2 = lists:reverse(TempVisited), + {Cfg, [NewInst|TempVisited2]} + end, find_definition_for_computations_in_block(BlockLabel, Rest, NewCfg, NewVisited, XsiGraph) end; @@ -787,14 +786,15 @@ create_cfggraph([Label|Ls],Cfg,CFGGraph,ToBeFactorizedAcc,MPAcc,LateEdges,XsiGra Defs = get_defs_in_non_merge_block(Code, []), ?pp_debug("~nAdding a vertex for ~w", [Label]), Succs = ?CFG:succ(Cfg, Label), - case Succs of - [] -> %% Exit point - ?GRAPH:add_vertex(CFGGraph, Label, #block{type = exit}), - NewToBeFactorizedAcc = ToBeFactorizedAcc; - _ -> %% Split point - ?GRAPH:add_vertex(CFGGraph,Label,#block{type=not_mp,attributes={P,Succs}}), - NewToBeFactorizedAcc = [Label|ToBeFactorizedAcc] - end, + NewToBeFactorizedAcc = + case Succs of + [] -> %% Exit point + ?GRAPH:add_vertex(CFGGraph, Label, #block{type = exit}), + ToBeFactorizedAcc; + _ -> %% Split point + ?GRAPH:add_vertex(CFGGraph,Label,#block{type=not_mp,attributes={P,Succs}}), + [Label|ToBeFactorizedAcc] + end, ?pp_debug("~nAdding an edge ~w -> ~w (~w)",[P,Label,Defs]), case ?GRAPH:add_edge(CFGGraph,P,Label,Defs) of {error,Reason} -> @@ -862,56 +862,53 @@ add_edges_for_mp([P|Ps], Label, LateEdges) -> %% Doesn't do anything so far add_map_and_uses([], _Key, Maps, Uses) -> - {Maps,Uses}; + {Maps, Uses}; add_map_and_uses([XsiOp|Ops], Key, Maps, Uses) -> - case XsiOp#xsi_op.op of - #bottom{} -> - Set = case gb_trees:lookup(XsiOp,Maps) of - {value, V} -> - ?SETS:add_element(Key,V); - none -> - ?SETS:from_list([Key]) - end, - NewMaps = gb_trees:enter(XsiOp,Set,Maps), - NewUses = Uses; - #temp{} -> - Set = case gb_trees:lookup(XsiOp,Maps) of - {value, V} -> - ?SETS:add_element(Key,V); - none -> - ?SETS:from_list([Key]) - end, - NewMaps = gb_trees:enter(XsiOp,Set,Maps), - Pred = XsiOp#xsi_op.pred, - OOP = XsiOp#xsi_op.op, - SSet = case gb_trees:lookup(Pred,Uses) of - {value, VV} -> - ?SETS:add_element(OOP#temp.key,VV); - none -> - ?SETS:from_list([OOP#temp.key]) - end, - NewUses = gb_trees:enter(Pred,SSet,Uses); - #eop{} -> - Set = case gb_trees:lookup(XsiOp,Maps) of - {value, V} -> - ?SETS:add_element(Key,V); - none -> - ?SETS:from_list([Key]) - end, - NewMaps = gb_trees:enter(XsiOp,Set,Maps), - Pred = XsiOp#xsi_op.pred, - Op = XsiOp#xsi_op.op, - SSet = case gb_trees:lookup(Pred,Uses) of - {value, VV} -> - ?SETS:add_element(Op#eop.stopped_by,VV); - none -> - ?SETS:from_list([Op#eop.stopped_by]) - end, - NewUses = gb_trees:enter(Pred,SSet,Uses); - _-> - NewMaps = Maps, - NewUses = Uses - end, + {NewMaps, NewUses} = + case XsiOp#xsi_op.op of + #bottom{} -> + Set = case gb_trees:lookup(XsiOp, Maps) of + {value, V} -> + ?SETS:add_element(Key, V); + none -> + ?SETS:from_list([Key]) + end, + {gb_trees:enter(XsiOp, Set, Maps), Uses}; + #temp{} -> + Set = case gb_trees:lookup(XsiOp, Maps) of + {value, V} -> + ?SETS:add_element(Key, V); + none -> + ?SETS:from_list([Key]) + end, + Pred = XsiOp#xsi_op.pred, + OOP = XsiOp#xsi_op.op, + SSet = case gb_trees:lookup(Pred, Uses) of + {value, VV} -> + ?SETS:add_element(OOP#temp.key, VV); + none -> + ?SETS:from_list([OOP#temp.key]) + end, + {gb_trees:enter(XsiOp, Set, Maps), gb_trees:enter(Pred, SSet, Uses)}; + #eop{} -> + Set = case gb_trees:lookup(XsiOp, Maps) of + {value, V} -> + ?SETS:add_element(Key, V); + none -> + ?SETS:from_list([Key]) + end, + Pred = XsiOp#xsi_op.pred, + Op = XsiOp#xsi_op.op, + SSet = case gb_trees:lookup(Pred, Uses) of + {value, VV} -> + ?SETS:add_element(Op#eop.stopped_by, VV); + none -> + ?SETS:from_list([Op#eop.stopped_by]) + end, + {gb_trees:enter(XsiOp, Set, Maps), gb_trees:enter(Pred, SSet, Uses)}; + _-> + {Maps, Uses} + end, add_map_and_uses(Ops, Key, NewMaps, NewUses). post_process([], _CFGGraph) -> ok; @@ -1162,37 +1159,38 @@ code_motion_in_block(L,[Inst|Insts],Cfg,XsiG,Visited,InsertionsAcc) -> #pre_candidate{} -> Def = Inst#pre_candidate.def, Alu = Inst#pre_candidate.alu, - case Def of - bottom -> - InstToAdd = Alu; - #temp{} -> - Key = Def#temp.key, - {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), - case Xsi#xsi.wba of - true -> - %% Turn into a move - Dst = ?RTL:alu_dst(Alu), - Move = ?RTL:mk_move(Dst,Def#temp.var), - pp_instr(Inst#pre_candidate.alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil), - %% Counting redundancies - redundancy_add(), - InstToAdd = Move; - _ -> - InstToAdd = Alu - end; - _ -> %% Def is a real variable - %% Turn into a move - Dst = ?RTL:alu_dst(Alu), - Move = ?RTL:mk_move(Dst,Def), - pp_instr(Alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil), - %% Counting redundancies - redundancy_add(), - InstToAdd = Move - end, + InstToAdd = + case Def of + bottom -> + Alu; + #temp{} -> + Key = Def#temp.key, + {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), + case Xsi#xsi.wba of + true -> + %% Turn into a move + Dst = ?RTL:alu_dst(Alu), + Move = ?RTL:mk_move(Dst,Def#temp.var), + pp_instr(Inst#pre_candidate.alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil), + %% Counting redundancies + redundancy_add(), + Move; + _ -> + Alu + end; + _ -> %% Def is a real variable + %% Turn into a move + Dst = ?RTL:alu_dst(Alu), + Move = ?RTL:mk_move(Dst,Def), + pp_instr(Alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil), + %% Counting redundancies + redundancy_add(), + Move + end, code_motion_in_block(L,Insts,Cfg,XsiG,[InstToAdd|Visited],InsertionsAcc); #xsi_link{} -> Key = Inst#xsi_link.num, - {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), + {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), case Xsi#xsi.wba of true -> %% Xsi is a WBA, it might trigger insertions @@ -1235,139 +1233,133 @@ get_insertions([],OpAcc,InsertionsAcc,_Visited,_Expr,_XsiG) -> get_insertions([XsiOp|Ops],OpAcc,InsertionsAcc,Visited,Expr,XsiG) -> Pred = XsiOp#xsi_op.pred, Op = XsiOp#xsi_op.op, - case Op of - #bottom{} -> - case gb_trees:lookup(Pred,InsertionsAcc) of - {value,Insertion} -> - From = Insertion#insertion.from, - case lists:keyfind(Op, 1, From) of - false -> - ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), - Dst = Op#bottom.var, - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - Code = Insertion#insertion.code, - NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]}, - NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc); - {_, Val} -> - ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), - Dst = Val, - NewInsertionsAcc = InsertionsAcc - end; - none -> - ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), - Dst = Op#bottom.var, - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]}, - NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc) - end; - #const_expr{} -> - case gb_trees:lookup(Pred,InsertionsAcc) of - {value,Insertion} -> - From = Insertion#insertion.from, - case lists:keyfind(Op, 1, From) of - false -> - ?pp_debug("~nThere have been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), - Dst = Op#const_expr.var, - Val = Op#const_expr.value, - Inst = ?RTL:mk_move(Dst,Val), - Code = Insertion#insertion.code, - NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]}, - NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc); - {_, Val} -> - ?pp_debug("~nThere have been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), - Dst = Val, - NewInsertionsAcc = InsertionsAcc - end; - none -> - ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), - Dst = Op#const_expr.var, - Val = Op#const_expr.value, - Inst = ?RTL:mk_move(Dst,Val), - NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]}, - NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc) - end; - #eop{} -> - %% We treat expressions like bottoms - %% The value must be recomputed, and therefore not available... - case gb_trees:lookup(Pred,InsertionsAcc) of - {value,Insertion} -> - From = Insertion#insertion.from, - case lists:keyfind(Op, 1, From) of - false -> - ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), - Dst = Op#eop.var, - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - Code = Insertion#insertion.code, - NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]}, - NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc); - {_, Val} -> - ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), - Dst = Val, - NewInsertionsAcc = InsertionsAcc - end; - none -> - ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), - Dst = Op#eop.var, - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]}, - NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc) - end; - #temp{} -> - case gb_trees:lookup(Pred,InsertionsAcc) of - {value,Insertion} -> - From = Insertion#insertion.from, - case lists:keyfind(Op, 1, From) of - false -> - ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), - Key = Op#temp.key, - {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), - case Xsi#xsi.wba of - true -> - ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]), - Dst = Op#temp.var, - NewInsertionsAcc = InsertionsAcc; - _ -> - ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]), - Dst = ?RTL:mk_new_var(), - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - Code = Insertion#insertion.code, - NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]}, - NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc) - end; - {_, Val} -> - ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too (Op=~w)",[Pred,Op]), - ?pp_debug("~nThis means, this temp is a WBA Xsi's definition",[]), - Dst = Val, - NewInsertionsAcc = InsertionsAcc - end; - none -> - ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course | Op=",[Pred]),pp_arg(Op), - Key = Op#temp.key, - {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), - case Xsi#xsi.wba of - true -> - ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]), - Dst = Op#temp.var, - NewInsertionsAcc = InsertionsAcc; - _ -> - ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]), - Dst = ?RTL:mk_new_var(), - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]}, - NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc) - end - end; - _ -> - ?pp_debug("~nThe operand (Op=",[]),pp_arg(Op),?pp_debug(") is a real variable, no need for insertion along L~w",[Pred]), - Dst = Op, - NewInsertionsAcc = InsertionsAcc - end, + {Dst, NewInsertionsAcc} = + case Op of + #bottom{} -> + case gb_trees:lookup(Pred,InsertionsAcc) of + {value,Insertion} -> + From = Insertion#insertion.from, + case lists:keyfind(Op, 1, From) of + false -> + ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), + D = Op#bottom.var, + Expr2 = ?RTL:alu_dst_update(Expr,D), + Inst = manufacture_computation(Pred,Expr2,Visited), + Code = Insertion#insertion.code, + NewInsertion = Insertion#insertion{from=[{Op,D}|From],code=[Inst|Code]}, + {D, gb_trees:update(Pred, NewInsertion, InsertionsAcc)}; + {_, Val} -> + ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), + {Val, InsertionsAcc} + end; + none -> + ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), + D = Op#bottom.var, + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + NewInsertion = #insertion{from=[{Op,D}],code=[Inst]}, + {D, gb_trees:insert(Pred,NewInsertion, InsertionsAcc)} + end; + #const_expr{} -> + case gb_trees:lookup(Pred,InsertionsAcc) of + {value,Insertion} -> + From = Insertion#insertion.from, + case lists:keyfind(Op, 1, From) of + false -> + ?pp_debug("~nThere have been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), + D = Op#const_expr.var, + Val = Op#const_expr.value, + Inst = ?RTL:mk_move(D, Val), + Code = Insertion#insertion.code, + NewInsertion = Insertion#insertion{from=[{Op,D}|From],code=[Inst|Code]}, + {D, gb_trees:update(Pred,NewInsertion,InsertionsAcc)}; + {_, Val} -> + ?pp_debug("~nThere have been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), + {Val, InsertionsAcc} + end; + none -> + ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), + D = Op#const_expr.var, + Val = Op#const_expr.value, + Inst = ?RTL:mk_move(D, Val), + NewInsertion = #insertion{from=[{Op,D}],code=[Inst]}, + {D, gb_trees:insert(Pred,NewInsertion, InsertionsAcc)} + end; + #eop{} -> + %% We treat expressions like bottoms + %% The value must be recomputed, and therefore not available... + case gb_trees:lookup(Pred,InsertionsAcc) of + {value,Insertion} -> + From = Insertion#insertion.from, + case lists:keyfind(Op, 1, From) of + false -> + ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), + D = Op#eop.var, + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + Code = Insertion#insertion.code, + NewInsertion = Insertion#insertion{from=[{Op,D}|From],code=[Inst|Code]}, + {D, gb_trees:update(Pred,NewInsertion, InsertionsAcc)}; + {_, Val} -> + ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), + {Val, InsertionsAcc} + end; + none -> + ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), + D = Op#eop.var, + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + NewInsertion = #insertion{from=[{Op,D}],code=[Inst]}, + {D, gb_trees:insert(Pred, NewInsertion, InsertionsAcc)} + end; + #temp{} -> + case gb_trees:lookup(Pred,InsertionsAcc) of + {value,Insertion} -> + From = Insertion#insertion.from, + case lists:keyfind(Op, 1, From) of + false -> + ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), + Key = Op#temp.key, + {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), + case Xsi#xsi.wba of + true -> + ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]), + {Op#temp.var, InsertionsAcc}; + _ -> + ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]), + D = ?RTL:mk_new_var(), + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + Code = Insertion#insertion.code, + NewInsertion = Insertion#insertion{from=[{Op,D}|From],code=[Inst|Code]}, + {D, gb_trees:update(Pred, NewInsertion, InsertionsAcc)} + end; + {_, Val} -> + ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too (Op=~w)",[Pred,Op]), + ?pp_debug("~nThis means, this temp is a WBA Xsi's definition",[]), + {Val, InsertionsAcc} + end; + none -> + ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course | Op=",[Pred]),pp_arg(Op), + Key = Op#temp.key, + {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), + case Xsi#xsi.wba of + true -> + ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]), + {Op#temp.var, InsertionsAcc}; + _ -> + ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]), + D = ?RTL:mk_new_var(), + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + NewInsertion = #insertion{from=[{Op,D}],code=[Inst]}, + {D, gb_trees:insert(Pred, NewInsertion, InsertionsAcc)} + end + end; + _ -> + ?pp_debug("~nThe operand (Op=",[]),pp_arg(Op),?pp_debug(") is a real variable, no need for insertion along L~w",[Pred]), + {Op, InsertionsAcc} + end, NewXsiOp = XsiOp#xsi_op{op=Dst}, get_insertions(Ops, [NewXsiOp|OpAcc], NewInsertionsAcc, Visited, Expr, XsiG). diff --git a/lib/hipe/sparc/Makefile b/lib/hipe/sparc/Makefile index 9fea887ebd..0e36a43d8e 100644 --- a/lib/hipe/sparc/Makefile +++ b/lib/hipe/sparc/Makefile @@ -76,7 +76,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/tools/Makefile b/lib/hipe/tools/Makefile index 4e3b93d464..7a62896c31 100644 --- a/lib/hipe/tools/Makefile +++ b/lib/hipe/tools/Makefile @@ -65,7 +65,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/util/Makefile b/lib/hipe/util/Makefile index 32135d60dd..66e9421c25 100644 --- a/lib/hipe/util/Makefile +++ b/lib/hipe/util/Makefile @@ -69,7 +69,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/x86/Makefile b/lib/hipe/x86/Makefile index e8a73bbc42..93f8b955dd 100644 --- a/lib/hipe/x86/Makefile +++ b/lib/hipe/x86/Makefile @@ -84,7 +84,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml index 8bd94892ad..b75d42d198 100644 --- a/lib/kernel/doc/src/gen_tcp.xml +++ b/lib/kernel/doc/src/gen_tcp.xml @@ -172,6 +172,14 @@ do_recv(Sock, Bs) -> <item><p>Sets up the socket for IPv4.</p></item> <tag><c>inet6</c></tag> <item><p>Sets up the socket for IPv6.</p></item> + <tag><c>local</c></tag> + <item> + <p> + Sets up the socket for local address family. This option is only + valid together with <c>{fd, integer()}</c> when the file descriptor + is of local address family (e.g. a Unix Domain Socket) + </p> + </item> <tag><c>{port, Port}</c></tag> <item><p>Specifies which local port number to use.</p></item> <tag><c>{tcp_module, module()}</c></tag> diff --git a/lib/kernel/doc/src/gen_udp.xml b/lib/kernel/doc/src/gen_udp.xml index 3db291600d..ca9d9c978c 100644 --- a/lib/kernel/doc/src/gen_udp.xml +++ b/lib/kernel/doc/src/gen_udp.xml @@ -104,6 +104,14 @@ <item><p>Sets up the socket for IPv6.</p></item> <tag><c>inet</c></tag> <item><p>Sets up the socket for IPv4.</p></item> + <tag><c>local</c></tag> + <item> + <p> + Sets up the socket for local address family. This option is only + valid together with <c>{fd, integer()}</c> when the file descriptor + is of local address family (e.g. a Unix Domain Socket) + </p> + </item> <tag><c>{udp_module, module()}</c></tag> <item><p>Overrides which callback module is used. Defaults to <c>inet_udp</c> for IPv4 and <c>inet6_udp</c> for IPv6.</p></item> diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 8bf02afec9..2b72f78dcf 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -104,6 +104,8 @@ MODULES = \ inet_sctp \ kernel \ kernel_config \ + local_udp \ + local_tcp \ net \ net_adm \ net_kernel \ @@ -244,6 +246,8 @@ $(EBIN)/inet_tcp.beam: inet_int.hrl $(EBIN)/inet_udp_dist.beam: ../include/net_address.hrl ../include/dist.hrl ../include/dist_util.hrl $(EBIN)/inet_udp.beam: inet_int.hrl $(EBIN)/inet_sctp.beam: inet_int.hrl ../include/inet_sctp.hrl +$(EBIN)/local_udp.beam: inet_int.hrl +$(EBIN)/local_tcp.beam: inet_int.hrl $(EBIN)/net_kernel.beam: ../include/net_address.hrl $(EBIN)/os.beam: ../include/file.hrl $(EBIN)/ram_file.beam: ../include/file.hrl diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index d00ed828a7..b133e6fed4 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.erl @@ -124,8 +124,8 @@ open() -> SockType :: seqpacket | stream, Socket :: sctp_socket(). -open(Opts) when is_list(Opts) -> - Mod = mod(Opts, undefined), +open(Opts0) when is_list(Opts0) -> + {Mod, Opts} = inet:sctp_module(Opts0), case Mod:open(Opts) of {error,badarg} -> erlang:error(badarg, [Opts]); @@ -445,32 +445,3 @@ controlling_process(S, Pid) when is_port(S), is_pid(Pid) -> inet:udp_controlling_process(S, Pid); controlling_process(S, Pid) -> erlang:error(badarg, [S,Pid]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Utilites -%% - -%% Get the SCTP module, but IPv6 address overrides default IPv4 -mod(Address) -> - case inet_db:sctp_module() of - inet_sctp when tuple_size(Address) =:= 8 -> - inet6_sctp; - Mod -> - Mod - end. - -%% Get the SCTP module, but option sctp_module|inet|inet6 overrides -mod([{sctp_module,Mod}|_], _Address) -> - Mod; -mod([inet|_], _Address) -> - inet_sctp; -mod([inet6|_], _Address) -> - inet6_sctp; -mod([{ip, Address}|Opts], _) -> - mod(Opts, Address); -mod([{ifaddr, Address}|Opts], _) -> - mod(Opts, Address); -mod([_|Opts], Address) -> - mod(Opts, Address); -mod([], Address) -> - mod(Address). diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index 1f0d44b8e1..2b3afcd44c 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -151,8 +151,8 @@ connect(Address, Port, Opts, Time) -> Error -> Error end. -connect1(Address,Port,Opts,Timer) -> - Mod = mod(Opts, Address), +connect1(Address, Port, Opts0, Timer) -> + {Mod, Opts} = inet:tcp_module(Opts0, Address), case Mod:getaddrs(Address,Timer) of {ok,IPs} -> case Mod:getserv(Port) of @@ -185,8 +185,8 @@ try_connect([], _Port, _Opts, _Timer, _Mod, Err) -> ListenSocket :: socket(), Reason :: system_limit | inet:posix(). -listen(Port, Opts) -> - Mod = mod(Opts, undefined), +listen(Port, Opts0) -> + {Mod, Opts} = inet:tcp_module(Opts0), case Mod:getserv(Port) of {ok,TP} -> Mod:listen(TP, Opts); @@ -335,32 +335,6 @@ controlling_process(S, NewOwner) -> %% %% Create a port/socket from a file descriptor %% -fdopen(Fd, Opts) -> - Mod = mod(Opts, undefined), +fdopen(Fd, Opts0) -> + {Mod, Opts} = inet:tcp_module(Opts0), Mod:fdopen(Fd, Opts). - -%% Get the tcp_module, but IPv6 address overrides default IPv4 -mod(Address) -> - case inet_db:tcp_module() of - inet_tcp when tuple_size(Address) =:= 8 -> - inet6_tcp; - Mod -> - Mod - end. - -%% Get the tcp_module, but option tcp_module|inet|inet6 overrides -mod([{tcp_module,Mod}|_], _Address) -> - Mod; -mod([inet|_], _Address) -> - inet_tcp; -mod([inet6|_], _Address) -> - inet6_tcp; -mod([{ip, Address}|Opts], _) -> - mod(Opts, Address); -mod([{ifaddr, Address}|Opts], _) -> - mod(Opts, Address); -mod([_|Opts], Address) -> - mod(Opts, Address); -mod([], Address) -> - mod(Address). - diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index 5e85c61dd9..2227bb3562 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -101,9 +101,9 @@ open(Port) -> Socket :: socket(), Reason :: inet:posix(). -open(Port, Opts) -> - Mod = mod(Opts, undefined), - {ok,UP} = Mod:getserv(Port), +open(Port, Opts0) -> + {Mod, Opts} = inet:udp_module(Opts0), + {ok, UP} = Mod:getserv(Port), Mod:open(UP, Opts). -spec close(Socket) -> ok when @@ -203,32 +203,6 @@ controlling_process(S, NewOwner) -> %% %% Create a port/socket from a file descriptor %% -fdopen(Fd, Opts) -> - Mod = mod(Opts, undefined), +fdopen(Fd, Opts0) -> + {Mod,Opts} = inet:udp_module(Opts0), Mod:fdopen(Fd, Opts). - - -%% Get the udp_module, but IPv6 address overrides default IPv4 -mod(Address) -> - case inet_db:udp_module() of - inet_udp when tuple_size(Address) =:= 8 -> - inet6_udp; - Mod -> - Mod - end. - -%% Get the udp_module, but option udp_module|inet|inet6 overrides -mod([{udp_module,Mod}|_], _Address) -> - Mod; -mod([inet|_], _Address) -> - inet_udp; -mod([inet6|_], _Address) -> - inet6_udp; -mod([{ip, Address}|Opts], _) -> - mod(Opts, Address); -mod([{ifaddr, Address}|Opts], _) -> - mod(Opts, Address); -mod([_|Opts], Address) -> - mod(Opts, Address); -mod([], Address) -> - mod(Address). diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index 713a9cf725..de43ea792b 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -37,6 +37,7 @@ parse_ipv6strict_address/1, parse_address/1, parse_strict_address/1, ntoa/1]). -export([connect_options/2, listen_options/2, udp_options/2, sctp_options/2]). +-export([udp_module/1, tcp_module/1, tcp_module/2, sctp_module/1]). -export([i/0, i/1, i/2]). @@ -133,9 +134,11 @@ 'running' | 'multicast' | 'loopback']} | {'hwaddr', ether_address()}. --type address_family() :: 'inet' | 'inet6'. +-type address_family() :: 'inet' | 'inet6' | 'local'. -type socket_protocol() :: 'tcp' | 'udp' | 'sctp'. -type socket_type() :: 'stream' | 'dgram' | 'seqpacket'. +-type socket_address() :: + ip_address() | {address_family(), any()} | 'any' | 'loopback'. -type stat_option() :: 'recv_cnt' | 'recv_max' | 'recv_avg' | 'recv_oct' | 'recv_dvi' | 'send_cnt' | 'send_max' | 'send_avg' | 'send_oct' | 'send_pend'. @@ -681,7 +684,7 @@ connect_options() -> low_msgq_watermark, send_timeout, send_timeout_close, delay_send, raw, show_econnreset]. -connect_options(Opts, Family) -> +connect_options(Opts, Mod) -> BaseOpts = case application:get_env(kernel, inet_default_connect_options) of {ok,List} when is_list(List) -> @@ -698,7 +701,7 @@ connect_options(Opts, Family) -> {ok, R} -> {ok, R#connect_opts { opts = lists:reverse(R#connect_opts.opts), - ifaddr = translate_ip(R#connect_opts.ifaddr, Family) + ifaddr = Mod:translate_ip(R#connect_opts.ifaddr) }}; Error -> Error end. @@ -713,9 +716,6 @@ con_opt([Opt | Opts], #connect_opts{} = R, As) -> {fd,Fd} -> con_opt(Opts, R#connect_opts { fd = Fd }, As); binary -> con_add(mode, binary, R, Opts, As); list -> con_add(mode, list, R, Opts, As); - {tcp_module,_} -> con_opt(Opts, R, As); - inet -> con_opt(Opts, R, As); - inet6 -> con_opt(Opts, R, As); {netns,NS} -> BinNS = filename2binary(NS), case prim_inet:is_sockopt_val(netns, BinNS) of @@ -752,7 +752,7 @@ listen_options() -> low_msgq_watermark, send_timeout, send_timeout_close, delay_send, packet_size, raw, show_econnreset]. -listen_options(Opts, Family) -> +listen_options(Opts, Mod) -> BaseOpts = case application:get_env(kernel, inet_default_listen_options) of {ok,List} when is_list(List) -> @@ -769,7 +769,7 @@ listen_options(Opts, Family) -> {ok, R} -> {ok, R#listen_opts { opts = lists:reverse(R#listen_opts.opts), - ifaddr = translate_ip(R#listen_opts.ifaddr, Family) + ifaddr = Mod:translate_ip(R#listen_opts.ifaddr) }}; Error -> Error end. @@ -785,9 +785,6 @@ list_opt([Opt | Opts], #listen_opts{} = R, As) -> {backlog,BL} -> list_opt(Opts, R#listen_opts { backlog = BL }, As); binary -> list_add(mode, binary, R, Opts, As); list -> list_add(mode, list, R, Opts, As); - {tcp_module,_} -> list_opt(Opts, R, As); - inet -> list_opt(Opts, R, As); - inet6 -> list_opt(Opts, R, As); {netns,NS} -> BinNS = filename2binary(NS), case prim_inet:is_sockopt_val(netns, BinNS) of @@ -812,6 +809,19 @@ list_add(Name, Val, #listen_opts{} = R, Opts, As) -> Error -> Error end. +tcp_module(Opts) -> + tcp_module_1(Opts, undefined). + +tcp_module(Opts, Addr) -> + Address = {undefined,Addr}, + %% Address has to be a 2-tuple but the first element is ignored + tcp_module_1(Opts, Address). + +tcp_module_1(Opts, Address) -> + mod( + Opts, tcp_module, Address, + #{inet => inet_tcp, inet6 => inet6_tcp, local => local_tcp}). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Available options for udp:open %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -823,12 +833,12 @@ udp_options() -> high_msgq_watermark, low_msgq_watermark]. -udp_options(Opts, Family) -> +udp_options(Opts, Mod) -> case udp_opt(Opts, #udp_opts { }, udp_options()) of {ok, R} -> {ok, R#udp_opts { opts = lists:reverse(R#udp_opts.opts), - ifaddr = translate_ip(R#udp_opts.ifaddr, Family) + ifaddr = Mod:translate_ip(R#udp_opts.ifaddr) }}; Error -> Error end. @@ -843,9 +853,6 @@ udp_opt([Opt | Opts], #udp_opts{} = R, As) -> {fd,Fd} -> udp_opt(Opts, R#udp_opts { fd = Fd }, As); binary -> udp_add(mode, binary, R, Opts, As); list -> udp_add(mode, list, R, Opts, As); - {udp_module,_} -> udp_opt(Opts, R, As); - inet -> udp_opt(Opts, R, As); - inet6 -> udp_opt(Opts, R, As); {netns,NS} -> BinNS = filename2binary(NS), case prim_inet:is_sockopt_val(netns, BinNS) of @@ -870,6 +877,11 @@ udp_add(Name, Val, #udp_opts{} = R, Opts, As) -> Error -> Error end. +udp_module(Opts) -> + mod( + Opts, udp_module, undefined, + #{inet => inet_udp, inet6 => inet6_udp, local => local_udp}). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Available options for sctp:open %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -926,9 +938,6 @@ sctp_opt([Opt|Opts], Mod, #sctp_opts{} = R, As) -> sctp_opt(Opts, Mod, R#sctp_opts{type=Type}, As); binary -> sctp_opt (Opts, Mod, R, As, mode, binary); list -> sctp_opt (Opts, Mod, R, As, mode, list); - {sctp_module,_} -> sctp_opt (Opts, Mod, R, As); % Done with - inet -> sctp_opt (Opts, Mod, R, As); % Done with - inet6 -> sctp_opt (Opts, Mod, R, As); % Done with {netns,NS} -> BinNS = filename2binary(NS), case prim_inet:is_sockopt_val(netns, BinNS) of @@ -970,6 +979,11 @@ sctp_opt_ifaddr(Opts, Mod, #sctp_opts{ifaddr=IfAddr}=R, As, Addr) -> _ -> [IP,IfAddr] end}, As). +sctp_module(Opts) -> + mod( + Opts, sctp_module, undefined, + #{inet => inet_sctp, inet6 => inet6_sctp}). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Util to check and insert option in option list %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1028,6 +1042,53 @@ translate_ip(any, inet6) -> {0,0,0,0,0,0,0,0}; translate_ip(loopback, inet6) -> {0,0,0,0,0,0,0,1}; translate_ip(IP, _) -> IP. +mod(Opts, Tag, Address, Map) -> + mod(Opts, Tag, Address, Map, undefined, []). +%% +mod([{Tag, M}|Opts], Tag, Address, Map, Mod, Acc) -> + mod(Opts, Tag, Address, Map, Mod, Acc, M); +mod([{T, _} = Opt|Opts], Tag, _Address, Map, Mod, Acc) + when T =:= ip; T =:= ifaddr-> + mod(Opts, Tag, Opt, Map, Mod, [Opt|Acc]); +mod([Family|Opts], Tag, Address, Map, Mod, Acc) when is_atom(Family) -> + case Map of + #{Family := M} -> + mod(Opts, Tag, Address, Map, Mod, Acc, M); + #{} -> + mod(Opts, Tag, Address, Map, Mod, [Family|Acc]) + end; +mod([Opt|Opts], Tag, Address, Map, Mod, Acc) -> + mod(Opts, Tag, Address, Map, Mod, [Opt|Acc]); +mod([], Tag, Address, Map, undefined, Acc) -> + {case Address of + {_, {local, _}} -> + case Map of + #{local := Mod} -> + Mod; + #{} -> + inet_db:Tag() + end; + {_, IP} when tuple_size(IP) =:= 8 -> + #{inet := IPv4Mod} = Map, + %% Get the mod, but IPv6 address overrides default IPv4 + case inet_db:Tag() of + IPv4Mod -> + #{inet6 := IPv6Mod} = Map, + IPv6Mod; + Mod -> + Mod + end; + _ -> + inet_db:Tag() + end, lists:reverse(Acc)}; +mod([], _Tag, _Address, _Map, Mod, Acc) -> + {Mod, lists:reverse(Acc)}. +%% +mod(Opts, Tag, Address, Map, undefined, Acc, M) -> + mod(Opts, Tag, Address, Map, M, Acc); +mod(Opts, Tag, Address, Map, Mod, Acc, _M) -> + mod(Opts, Tag, Address, Map, Mod, Acc). + getaddrs_tm({A,B,C,D} = IP, Fam, _) -> %% Only "syntactic" validation and check of family. @@ -1235,7 +1296,7 @@ gethostbyaddr_tm_native(Addr, Timer, Opts) -> end. -spec open(Fd_or_OpenOpts :: integer() | list(), - Addr :: ip_address(), + Addr :: socket_address(), Port :: port_number(), Opts :: [socket_setopt()], Protocol :: socket_protocol(), diff --git a/lib/kernel/src/inet6_sctp.erl b/lib/kernel/src/inet6_sctp.erl index cc98bc0ccb..a5503f6f54 100644 --- a/lib/kernel/src/inet6_sctp.erl +++ b/lib/kernel/src/inet6_sctp.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 2007-2016. All Rights Reserved. -%% +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,13 +14,12 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% %% SCTP protocol contribution by Leonid Timochouk and Serge Aleynikov. %% See also: $ERL_TOP/lib/kernel/AUTHORS %% -%% -module(inet6_sctp). %% This module provides functions for communicating with @@ -31,6 +30,7 @@ -include("inet_sctp.hrl"). -include("inet_int.hrl"). +-define(PROTO, sctp). -define(FAMILY, inet6). -export([getserv/1,getaddr/1,getaddr/2,translate_ip/1]). -export([open/1,close/1,listen/2,peeloff/2,connect/5]). @@ -39,25 +39,19 @@ getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> - inet:getservbyname(Name, sctp); -getserv(_) -> - {error,einval}. - -getaddr(Address) -> - inet:getaddr(Address, ?FAMILY). -getaddr(Address, Timer) -> - inet:getaddr_tm(Address, ?FAMILY, Timer). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO); +getserv(_) -> {error,einval}. -translate_ip(IP) -> - inet:translate_ip(IP, ?FAMILY). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr_tm(Address, ?FAMILY, Timer). +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). open(Opts) -> case inet:sctp_options(Opts, ?MODULE) of {ok,#sctp_opts{fd=Fd,ifaddr=Addr,port=Port,type=Type,opts=SOs}} -> - inet:open(Fd, Addr, Port, SOs, sctp, ?FAMILY, Type, ?MODULE); + inet:open(Fd, Addr, Port, SOs, ?PROTO, ?FAMILY, Type, ?MODULE); Error -> Error end. diff --git a/lib/kernel/src/inet6_tcp.erl b/lib/kernel/src/inet6_tcp.erl index 3dfe5dfc86..a0d5d3df70 100644 --- a/lib/kernel/src/inet6_tcp.erl +++ b/lib/kernel/src/inet6_tcp.erl @@ -25,13 +25,18 @@ -export([controlling_process/2]). -export([fdopen/2]). --export([family/0, mask/2, parse_address/1]). +-export([family/0, mask/2, parse_address/1]). % inet_tcp_dist -export([getserv/1, getaddr/1, getaddr/2, getaddrs/1, getaddrs/2]). +-export([translate_ip/1]). -include("inet_int.hrl"). +-define(FAMILY, inet6). +-define(PROTO, tcp). +-define(TYPE, stream). + %% my address family -family() -> inet6. +family() -> ?FAMILY. %% Apply netmask on address mask({M1,M2,M3,M4,M5,M6,M7,M8}, {IP1,IP2,IP3,IP4,IP5,IP6,IP7,IP8}) -> @@ -50,15 +55,18 @@ parse_address(Host) -> %% inet_tcp port lookup getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,tcp). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO). %% inet_tcp address lookup -getaddr(Address) -> inet:getaddr(Address, inet6). -getaddr(Address,Timer) -> inet:getaddr_tm(Address, inet6, Timer). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr_tm(Address, ?FAMILY, Timer). %% inet_tcp address lookup -getaddrs(Address) -> inet:getaddrs(Address, inet6). -getaddrs(Address,Timer) -> inet:getaddrs_tm(Address,inet6,Timer). +getaddrs(Address) -> inet:getaddrs(Address, ?FAMILY). +getaddrs(Address, Timer) -> inet:getaddrs_tm(Address, ?FAMILY, Timer). + +%% inet_udp special this side addresses +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). %% %% Send data on a socket @@ -73,11 +81,6 @@ recv(Socket, Length) -> prim_inet:recv(Socket, Length). recv(Socket, Length, Timeout) -> prim_inet:recv(Socket, Length, Timeout). unrecv(Socket, Data) -> prim_inet:unrecv(Socket, Data). -%% -%% Close a socket (async) -%% -close(Socket) -> - inet:tcp_close(Socket). %% %% Shutdown one end of a socket @@ -86,6 +89,12 @@ shutdown(Socket, How) -> prim_inet:shutdown(Socket, How). %% +%% Close a socket (async) +%% +close(Socket) -> + inet:tcp_close(Socket). + +%% %% Set controlling process %% FIXME: move messages to new owner!!! %% @@ -100,24 +109,28 @@ connect(Address, Port, Opts) -> connect(Address, Port, Opts, infinity) -> do_connect(Address, Port, Opts, infinity); -connect(Address, Port, Opts, Timeout) when is_integer(Timeout), - Timeout >= 0 -> +connect(Address, Port, Opts, Timeout) + when is_integer(Timeout), Timeout >= 0 -> do_connect(Address, Port, Opts, Timeout). -do_connect(Addr = {A,B,C,D,E,F,G,H}, Port, Opts, Time) when - ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> - case inet:connect_options(Opts, inet6) of +do_connect(Addr = {A,B,C,D,E,F,G,H}, Port, Opts, Time) + when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> + case inet:connect_options(Opts, ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #connect_opts{fd=Fd, - ifaddr=BAddr={Ab,Bb,Cb,Db,Eb,Fb,Gb,Hb}, - port=BPort, - opts=SockOpts}} + {ok, + #connect_opts{ + fd = Fd, + ifaddr = BAddr = {Ab,Bb,Cb,Db,Eb,Fb,Gb,Hb}, + port = BPort, + opts = SockOpts}} when ?ip6(Ab,Bb,Cb,Db,Eb,Fb,Gb,Hb), ?port(BPort) -> - case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet6,stream,?MODULE) of + case inet:open( + Fd, BAddr, BPort, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of {ok, S} -> case prim_inet:connect(S, Addr, Port, Time) of - ok -> {ok,S}; - Error -> prim_inet:close(S), Error + ok -> {ok,S}; + Error -> prim_inet:close(S), Error end; Error -> Error end; @@ -128,14 +141,18 @@ do_connect(Addr = {A,B,C,D,E,F,G,H}, Port, Opts, Time) when %% Listen %% listen(Port, Opts) -> - case inet:listen_options([{port,Port} | Opts], inet6) of + case inet:listen_options([{port,Port} | Opts], ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #listen_opts{fd=Fd, - ifaddr=BAddr={A,B,C,D,E,F,G,H}, - port=BPort, - opts=SockOpts}=R} + {ok, + #listen_opts{ + fd = Fd, + ifaddr = BAddr = {A,B,C,D,E,F,G,H}, + port = BPort, + opts = SockOpts} = R} when ?ip6(A,B,C,D,E,F,G,H), ?port(BPort) -> - case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet6,stream,?MODULE) of + case inet:open( + Fd, BAddr, BPort, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of {ok, S} -> case prim_inet:listen(S, R#listen_opts.backlog) of ok -> {ok, S}; @@ -156,18 +173,17 @@ accept(L) -> {ok,S}; Error -> Error end. - -accept(L,Timeout) -> - case prim_inet:accept(L,Timeout) of + +accept(L, Timeout) -> + case prim_inet:accept(L, Timeout) of {ok, S} -> inet_db:register_socket(S, ?MODULE), {ok,S}; Error -> Error end. - + %% %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, Opts, tcp, inet6, stream, ?MODULE). - + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/inet6_udp.erl b/lib/kernel/src/inet6_udp.erl index eb6945f60a..71db0357cd 100644 --- a/lib/kernel/src/inet6_udp.erl +++ b/lib/kernel/src/inet6_udp.erl @@ -24,29 +24,44 @@ -export([controlling_process/2]). -export([fdopen/2]). --export([getserv/1, getaddr/1, getaddr/2]). +-export([getserv/1, getaddr/1, getaddr/2, translate_ip/1]). -include("inet_int.hrl"). +-define(FAMILY, inet6). +-define(PROTO, udp). +-define(TYPE, dgram). + + %% inet_udp port lookup getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,udp). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO). %% inet_udp address lookup -getaddr(Address) -> inet:getaddr(Address, inet6). -getaddr(Address,Timer) -> inet:getaddr(Address, inet6, Timer). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr(Address, ?FAMILY, Timer). + +%% inet_udp special this side addresses +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). +-spec open(_) -> {ok, inet:socket()} | {error, atom()}. open(Port) -> open(Port, []). +-spec open(_, _) -> {ok, inet:socket()} | {error, atom()}. open(Port, Opts) -> - case inet:udp_options([{port,Port} | Opts], inet6) of + case inet:udp_options( + [{port,Port} | Opts], + ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #udp_opts{fd=Fd, - ifaddr=BAddr={A,B,C,D,E,F,G,H}, - port=BPort, - opts=SockOpts}} + {ok, + #udp_opts{ + fd = Fd, + ifaddr = BAddr = {A,B,C,D,E,F,G,H}, + port = BPort, + opts = SockOpts}} when ?ip6(A,B,C,D,E,F,G,H), ?port(BPort) -> - inet:open(Fd,BAddr,BPort,SockOpts,udp,inet6,dgram,?MODULE); + inet:open( + Fd, BAddr, BPort, SockOpts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE); {ok, _} -> exit(badarg) end. @@ -61,12 +76,13 @@ connect(S, Addr = {A,B,C,D,E,F,G,H}, P) when ?ip6(A,B,C,D,E,F,G,H), ?port(P) -> prim_inet:connect(S, Addr, P). -recv(S,Len) -> +recv(S, Len) -> prim_inet:recvfrom(S, Len). -recv(S,Len,Time) -> +recv(S, Len, Time) -> prim_inet:recvfrom(S, Len, Time). +-spec close(inet:socket()) -> ok. close(S) -> inet:udp_close(S). @@ -85,4 +101,4 @@ controlling_process(Socket, NewOwner) -> %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, Opts, udp, inet6, dgram, ?MODULE). + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl index 65d78b66c9..32d09fb63c 100644 --- a/lib/kernel/src/inet_int.hrl +++ b/lib/kernel/src/inet_int.hrl @@ -29,6 +29,8 @@ -define(INET_AF_INET6, 2). -define(INET_AF_ANY, 3). % Fake for ANY in any address family -define(INET_AF_LOOPBACK, 4). % Fake for LOOPBACK in any address family +-define(INET_AF_LOCAL, 5). % For Unix Domain address family +-define(INET_AF_UNDEFINED, 6). % For any unknown address family %% type codes to open and gettype - INET_REQ_GETTYPE -define(INET_TYPE_STREAM, 1). @@ -378,7 +380,7 @@ { ifaddr = any, %% bind to interface address port = 0, %% bind to port (default is dynamic port) - fd = -1, %% fd >= 0 => already bound + fd = -1, %% fd >= 0 => already bound opts = [] %% [{active,true}] added in inet:connect_options }). diff --git a/lib/kernel/src/inet_sctp.erl b/lib/kernel/src/inet_sctp.erl index 60677cb7de..8569cacb29 100644 --- a/lib/kernel/src/inet_sctp.erl +++ b/lib/kernel/src/inet_sctp.erl @@ -30,6 +30,7 @@ -include("inet_sctp.hrl"). -include("inet_int.hrl"). +-define(PROTO, sctp). -define(FAMILY, inet). -export([getserv/1,getaddr/1,getaddr/2,translate_ip/1]). -export([open/1,close/1,listen/2,peeloff/2,connect/5]). @@ -38,25 +39,19 @@ getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> - inet:getservbyname(Name, sctp); -getserv(_) -> - {error,einval}. +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO); +getserv(_) -> {error,einval}. -getaddr(Address) -> - inet:getaddr(Address, ?FAMILY). -getaddr(Address, Timer) -> - inet:getaddr_tm(Address, ?FAMILY, Timer). - -translate_ip(IP) -> - inet:translate_ip(IP, ?FAMILY). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr_tm(Address, ?FAMILY, Timer). +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). open(Opts) -> case inet:sctp_options(Opts, ?MODULE) of {ok,#sctp_opts{fd=Fd,ifaddr=Addr,port=Port,type=Type,opts=SOs}} -> - inet:open(Fd, Addr, Port, SOs, sctp, ?FAMILY, Type, ?MODULE); + inet:open(Fd, Addr, Port, SOs, ?PROTO, ?FAMILY, Type, ?MODULE); Error -> Error end. diff --git a/lib/kernel/src/inet_tcp.erl b/lib/kernel/src/inet_tcp.erl index ee885af3b0..dac6b3119d 100644 --- a/lib/kernel/src/inet_tcp.erl +++ b/lib/kernel/src/inet_tcp.erl @@ -27,13 +27,18 @@ -export([controlling_process/2]). -export([fdopen/2]). --export([family/0, mask/2, parse_address/1]). +-export([family/0, mask/2, parse_address/1]). % inet_tcp_dist -export([getserv/1, getaddr/1, getaddr/2, getaddrs/1, getaddrs/2]). +-export([translate_ip/1]). -include("inet_int.hrl"). +-define(FAMILY, inet). +-define(PROTO, tcp). +-define(TYPE, stream). + %% my address family -family() -> inet. +family() -> ?FAMILY. %% Apply netmask on address mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) -> @@ -48,16 +53,19 @@ parse_address(Host) -> %% inet_tcp port lookup getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,tcp). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO). %% inet_tcp address lookup -getaddr(Address) -> inet:getaddr(Address, inet). -getaddr(Address,Timer) -> inet:getaddr_tm(Address, inet, Timer). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr_tm(Address, ?FAMILY, Timer). %% inet_tcp address lookup -getaddrs(Address) -> inet:getaddrs(Address, inet). -getaddrs(Address,Timer) -> inet:getaddrs_tm(Address,inet,Timer). - +getaddrs(Address) -> inet:getaddrs(Address, ?FAMILY). +getaddrs(Address, Timer) -> inet:getaddrs_tm(Address, ?FAMILY, Timer). + +%% inet_udp special this side addresses +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). + %% %% Send data on a socket %% @@ -77,7 +85,7 @@ unrecv(Socket, Data) -> prim_inet:unrecv(Socket, Data). %% shutdown(Socket, How) -> prim_inet:shutdown(Socket, How). - + %% %% Close a socket (async) %% @@ -88,7 +96,7 @@ close(Socket) -> %% Set controlling process %% controlling_process(Socket, NewOwner) -> - inet:tcp_controlling_process(Socket, NewOwner). + inet:tcp_controlling_process(Socket, NewOwner). %% %% Connect @@ -98,23 +106,28 @@ connect(Address, Port, Opts) -> connect(Address, Port, Opts, infinity) -> do_connect(Address, Port, Opts, infinity); -connect(Address, Port, Opts, Timeout) when is_integer(Timeout), - Timeout >= 0 -> +connect(Address, Port, Opts, Timeout) + when is_integer(Timeout), Timeout >= 0 -> do_connect(Address, Port, Opts, Timeout). -do_connect({A,B,C,D}, Port, Opts, Time) when ?ip(A,B,C,D), ?port(Port) -> - case inet:connect_options(Opts, inet) of +do_connect(Addr = {A,B,C,D}, Port, Opts, Time) + when ?ip(A,B,C,D), ?port(Port) -> + case inet:connect_options(Opts, ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #connect_opts{fd=Fd, - ifaddr=BAddr={Ab,Bb,Cb,Db}, - port=BPort, - opts=SockOpts}} + {ok, + #connect_opts{ + fd = Fd, + ifaddr = BAddr = {Ab,Bb,Cb,Db}, + port = BPort, + opts = SockOpts}} when ?ip(Ab,Bb,Cb,Db), ?port(BPort) -> - case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet,stream,?MODULE) of + case inet:open( + Fd, BAddr, BPort, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of {ok, S} -> - case prim_inet:connect(S, {A,B,C,D}, Port, Time) of - ok -> {ok,S}; - Error -> prim_inet:close(S), Error + case prim_inet:connect(S, Addr, Port, Time) of + ok -> {ok,S}; + Error -> prim_inet:close(S), Error end; Error -> Error end; @@ -125,14 +138,18 @@ do_connect({A,B,C,D}, Port, Opts, Time) when ?ip(A,B,C,D), ?port(Port) -> %% Listen %% listen(Port, Opts) -> - case inet:listen_options([{port,Port} | Opts], inet) of - {error,Reason} -> exit(Reason); - {ok, #listen_opts{fd=Fd, - ifaddr=BAddr={A,B,C,D}, - port=BPort, - opts=SockOpts}=R} + case inet:listen_options([{port,Port} | Opts], ?MODULE) of + {error, Reason} -> exit(Reason); + {ok, + #listen_opts{ + fd = Fd, + ifaddr = BAddr = {A,B,C,D}, + port = BPort, + opts = SockOpts} = R} when ?ip(A,B,C,D), ?port(BPort) -> - case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet,stream,?MODULE) of + case inet:open( + Fd, BAddr, BPort, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of {ok, S} -> case prim_inet:listen(S, R#listen_opts.backlog) of ok -> {ok, S}; @@ -146,23 +163,24 @@ listen(Port, Opts) -> %% %% Accept %% -accept(L) -> +accept(L) -> case prim_inet:accept(L) of {ok, S} -> inet_db:register_socket(S, ?MODULE), {ok,S}; Error -> Error end. - -accept(L,Timeout) -> - case prim_inet:accept(L,Timeout) of + +accept(L, Timeout) -> + case prim_inet:accept(L, Timeout) of {ok, S} -> inet_db:register_socket(S, ?MODULE), {ok,S}; Error -> Error end. + %% %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, Opts, tcp, inet, stream, ?MODULE). + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/inet_udp.erl b/lib/kernel/src/inet_udp.erl index 7e8d9cdb72..8a8aa8ecca 100644 --- a/lib/kernel/src/inet_udp.erl +++ b/lib/kernel/src/inet_udp.erl @@ -24,21 +24,26 @@ -export([controlling_process/2]). -export([fdopen/2]). --export([getserv/1, getaddr/1, getaddr/2]). +-export([getserv/1, getaddr/1, getaddr/2, translate_ip/1]). -include("inet_int.hrl"). +-define(FAMILY, inet). +-define(PROTO, udp). +-define(TYPE, dgram). -define(RECBUF, (8*1024)). - %% inet_udp port lookup getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,udp). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO). %% inet_udp address lookup -getaddr(Address) -> inet:getaddr(Address, inet). -getaddr(Address,Timer) -> inet:getaddr_tm(Address, inet, Timer). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr(Address, ?FAMILY, Timer). + +%% inet_udp special this side addresses +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). -spec open(_) -> {ok, inet:socket()} | {error, atom()}. open(Port) -> open(Port, []). @@ -47,33 +52,38 @@ open(Port) -> open(Port, []). open(Port, Opts) -> case inet:udp_options( [{port,Port}, {recbuf, ?RECBUF} | Opts], - inet) of + ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #udp_opts{fd=Fd, - ifaddr=BAddr={A,B,C,D}, - port=BPort, - opts=SockOpts}} when ?ip(A,B,C,D), ?port(BPort) -> - inet:open(Fd,BAddr,BPort,SockOpts,udp,inet,dgram,?MODULE); + {ok, + #udp_opts{ + fd = Fd, + ifaddr = BAddr = {A,B,C,D}, + port = BPort, + opts = SockOpts}} + when ?ip(A,B,C,D), ?port(BPort) -> + inet:open( + Fd, BAddr, BPort, SockOpts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE); {ok, _} -> exit(badarg) end. -send(S,{A,B,C,D},P,Data) when ?ip(A,B,C,D), ?port(P) -> - prim_inet:sendto(S, {A,B,C,D}, P, Data). +send(S, {A,B,C,D} = Addr, P, Data) + when ?ip(A,B,C,D), ?port(P) -> + prim_inet:sendto(S, Addr, P, Data). send(S, Data) -> prim_inet:sendto(S, {0,0,0,0}, 0, Data). -connect(S, {A,B,C,D}, P) when ?ip(A,B,C,D), ?port(P) -> - prim_inet:connect(S, {A,B,C,D}, P). +connect(S, Addr = {A,B,C,D}, P) + when ?ip(A,B,C,D), ?port(P) -> + prim_inet:connect(S, Addr, P). -recv(S,Len) -> +recv(S, Len) -> prim_inet:recvfrom(S, Len). -recv(S,Len,Time) -> +recv(S, Len, Time) -> prim_inet:recvfrom(S, Len, Time). -spec close(inet:socket()) -> ok. - close(S) -> inet:udp_close(S). @@ -92,9 +102,9 @@ controlling_process(Socket, NewOwner) -> %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, - optuniquify([{recbuf, ?RECBUF} | Opts]), - udp, inet, dgram, ?MODULE). + inet:fdopen( + Fd, optuniquify([{recbuf, ?RECBUF} | Opts]), + ?PROTO, ?FAMILY, ?TYPE, ?MODULE). %% Remove all duplicate options from an option list. diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 15e0ec02a9..56d1699656 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -55,6 +55,8 @@ inet_tcp_dist, kernel, kernel_config, + local_tcp, + local_udp, net, net_adm, net_kernel, @@ -116,6 +118,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-8.0", "stdlib-2.6", "sasl-2.6"]} + {runtime_dependencies, ["erts-8.0", "stdlib-3.0", "sasl-3.0"]} ] }. diff --git a/lib/kernel/src/local_tcp.erl b/lib/kernel/src/local_tcp.erl new file mode 100644 index 0000000000..64085ec42e --- /dev/null +++ b/lib/kernel/src/local_tcp.erl @@ -0,0 +1,172 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(local_tcp). + +%% Socket server for TCP/IP + +-export([connect/3, connect/4, listen/2, accept/1, accept/2, close/1]). +-export([send/2, send/3, recv/2, recv/3, unrecv/2]). +-export([shutdown/2]). +-export([controlling_process/2]). +-export([fdopen/2]). + +-export([getserv/1, getaddr/1, getaddr/2, getaddrs/1, getaddrs/2]). +-export([translate_ip/1]). + +-include("inet_int.hrl"). + +-define(FAMILY, local). +-define(PROTO, tcp). +-define(TYPE, stream). + +%% port lookup +getserv(0) -> {ok, 0}. + +%% no address lookup +getaddr({?FAMILY, _} = Address) -> {ok, Address}. +getaddr({?FAMILY, _} = Address, _Timer) -> {ok, Address}. + +%% no address lookup +getaddrs({?FAMILY, _} = Address) -> {ok, [Address]}. +getaddrs({?FAMILY, _} = Address, _Timer) -> {ok, [Address]}. + +%% special this side addresses +translate_ip(IP) -> IP. + +%% +%% Send data on a socket +%% +send(Socket, Packet, Opts) -> prim_inet:send(Socket, Packet, Opts). +send(Socket, Packet) -> prim_inet:send(Socket, Packet, []). + +%% +%% Receive data from a socket (inactive only) +%% +recv(Socket, Length) -> prim_inet:recv(Socket, Length). +recv(Socket, Length, Timeout) -> prim_inet:recv(Socket, Length, Timeout). + +unrecv(Socket, Data) -> prim_inet:unrecv(Socket, Data). + +%% +%% Shutdown one end of a socket +%% +shutdown(Socket, How) -> + prim_inet:shutdown(Socket, How). + +%% +%% Close a socket (async) +%% +close(Socket) -> + inet:tcp_close(Socket). + +%% +%% Set controlling process +%% FIXME: move messages to new owner!!! +%% +controlling_process(Socket, NewOwner) -> + inet:tcp_controlling_process(Socket, NewOwner). + +%% +%% Connect +%% +connect(Address, Port, Opts) -> + do_connect(Address, Port, Opts, infinity). +%% +connect(Address, Port, Opts, infinity) -> + do_connect(Address, Port, Opts, infinity); +connect(Address, Port, Opts, Timeout) + when is_integer(Timeout), Timeout >= 0 -> + do_connect(Address, Port, Opts, Timeout). + +do_connect(Addr = {?FAMILY, _}, 0, Opts, Time) -> + case inet:connect_options(Opts, ?MODULE) of + {error, Reason} -> exit(Reason); + {ok, + #connect_opts{ + fd = Fd, + ifaddr = BAddr, + port = 0, + opts = SockOpts}} + when tuple_size(BAddr) =:= 2, element(1, BAddr) =:= ?FAMILY; + BAddr =:= any -> + case inet:open( + Fd, BAddr, 0, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of + {ok, S} -> + case prim_inet:connect(S, Addr, 0, Time) of + ok -> {ok,S}; + Error -> prim_inet:close(S), Error + end; + Error -> Error + end; + {ok, _} -> exit(badarg) + end. + +%% +%% Listen +%% +listen(0, Opts) -> + case inet:listen_options([{port,0} | Opts], ?MODULE) of + {error, Reason} -> exit(Reason); + {ok, + #listen_opts{ + fd = Fd, + ifaddr = BAddr, + port = 0, + opts = SockOpts} = R} + when tuple_size(BAddr) =:= 2, element(1, BAddr) =:= ?FAMILY; + BAddr =:= any -> + case inet:open( + Fd, BAddr, 0, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of + {ok, S} -> + case prim_inet:listen(S, R#listen_opts.backlog) of + ok -> {ok, S}; + Error -> prim_inet:close(S), Error + end; + Error -> Error + end; + {ok, _} -> exit(badarg) + end. + +%% +%% Accept +%% +accept(L) -> + case prim_inet:accept(L) of + {ok, S} -> + inet_db:register_socket(S, ?MODULE), + {ok,S}; + Error -> Error + end. +%% +accept(L, Timeout) -> + case prim_inet:accept(L, Timeout) of + {ok, S} -> + inet_db:register_socket(S, ?MODULE), + {ok,S}; + Error -> Error + end. + +%% +%% Create a port/socket from a file descriptor +%% +fdopen(Fd, Opts) -> + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/local_udp.erl b/lib/kernel/src/local_udp.erl new file mode 100644 index 0000000000..ebb4d2b33f --- /dev/null +++ b/lib/kernel/src/local_udp.erl @@ -0,0 +1,99 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(local_udp). + +-export([open/1, open/2, close/1]). +-export([send/2, send/4, recv/2, recv/3, connect/3]). +-export([controlling_process/2]). +-export([fdopen/2]). + +-export([getserv/1, getaddr/1, getaddr/2, translate_ip/1]). + +-include("inet_int.hrl"). + +-define(FAMILY, local). +-define(PROTO, udp). +-define(TYPE, dgram). + + +%% port lookup +getserv(0) -> {ok, 0}. + +%% no address lookup +getaddr({?FAMILY, _} = Address) -> {ok, Address}. +getaddr({?FAMILY, _} = Address, _Timer) -> {ok, Address}. + +%% special this side addresses +translate_ip(IP) -> IP. + +open(0) -> open(0, []). +%% +open(0, Opts) -> + case inet:udp_options( + [{port,0} | Opts], + ?MODULE) of + {error, Reason} -> exit(Reason); + {ok, + #udp_opts{ + fd = Fd, + ifaddr = BAddr, + port = 0, + opts = SockOpts}} + when tuple_size(BAddr) =:= 2, element(1, BAddr) =:= ?FAMILY; + BAddr =:= any -> + inet:open( + Fd, BAddr, 0, SockOpts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE); + {ok, _} -> exit(badarg) + end. + +send(S, Addr = {?FAMILY,_}, 0, Data) -> + prim_inet:sendto(S, Addr, 0, Data). +%% +send(S, Data) -> + prim_inet:sendto(S, {?FAMILY,<<>>}, 0, Data). + +connect(S, Addr = {?FAMILY,_}, 0) -> + prim_inet:connect(S, Addr, 0). + +recv(S, Len) -> + prim_inet:recvfrom(S, Len). +%% +recv(S, Len, Time) -> + prim_inet:recvfrom(S, Len, Time). + +close(S) -> + inet:udp_close(S). + +%% +%% Set controlling process: +%% 1) First sync socket into a known state +%% 2) Move all messages onto the new owners message queue +%% 3) Commit the owner +%% 4) Wait for ack of new Owner (since socket does some link and unlink) +%% + +controlling_process(Socket, NewOwner) -> + inet:udp_controlling_process(Socket, NewOwner). + +%% +%% Create a port/socket from a file descriptor +%% +fdopen(Fd, Opts) -> + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index c93b10fa1c..6248d7478c 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -1002,12 +1002,12 @@ getifaddrs(Config) when is_list (Config) -> [check_addr(Addr) || Addr <- Addrs], ok. -check_addr(Addr) +check_addr({addr,Addr}) when tuple_size(Addr) =:= 8, element(1, Addr) band 16#FFC0 =:= 16#FE80 -> io:format("Addr: ~p link local; SKIPPED!~n", [Addr]), ok; -check_addr(Addr) -> +check_addr({addr,Addr}) -> io:format("Addr: ~p.~n", [Addr]), Ping = "ping", Pong = "pong", @@ -1021,74 +1021,82 @@ check_addr(Addr) -> ok = gen_tcp:close(S1), {ok,Pong} = gen_tcp:recv(S2, length(Pong)), ok = gen_tcp:close(S2), - ok = gen_tcp:close(L), - ok. + ok = gen_tcp:close(L). -record(ifopts, {name,flags,addrs=[],hwaddr}). ifaddrs([]) -> []; ifaddrs([{If,Opts}|IOs]) -> - #ifopts{flags=Flags} = Ifopts = - check_ifopts(Opts, #ifopts{name=If}), - case Flags =/= undefined andalso lists:member(up, Flags) of - true -> - Ifopts#ifopts.addrs; - false -> - [] - end++ifaddrs(IOs). + #ifopts{flags=F} = Ifopts = check_ifopts(Opts, #ifopts{name=If}), + case F of + {flags,Flags} -> + case lists:member(up, Flags) of + true -> + Ifopts#ifopts.addrs; + false -> + [] + end ++ ifaddrs(IOs); + undefined -> + ifaddrs(IOs) + end. -check_ifopts([], #ifopts{name=If,flags=Flags,addrs=Raddrs}=Ifopts) -> +check_ifopts([], #ifopts{flags=F,addrs=Raddrs}=Ifopts) -> Addrs = lists:reverse(Raddrs), R = Ifopts#ifopts{addrs=Addrs}, io:format("~p.~n", [R]), %% See how we did... - if is_list(Flags) -> ok; - true -> - ct:fail({flags_undefined,If}) - end, + {flags,Flags} = F, case lists:member(broadcast, Flags) of true -> [case A of - {_,_,_} -> A; - {T,_} when tuple_size(T) =:= 8 -> A; - _ -> - ct:fail({broaddr_missing,If,A}) + {{addr,_},{netmask,_},{broadaddr,_}} -> + A; + {{addr,T},{netmask,_}} when tuple_size(T) =:= 8 -> + A end || A <- Addrs]; false -> - [case A of {_,_} -> A; - _ -> - ct:fail({should_have_netmask,If,A}) - end || A <- Addrs] + case lists:member(pointtopoint, Flags) of + true -> + [case A of + {{addr,_},{netmask,_},{dstaddr,_}} -> + A + end || A <- Addrs]; + false -> + [case A of + {{addr,_},{netmask,_}} -> + A + end || A <- Addrs] + end end, R; -check_ifopts([{flags,Flags}|Opts], #ifopts{flags=undefined}=Ifopts) -> - check_ifopts(Opts, Ifopts#ifopts{flags=Flags}); -check_ifopts([{flags,Fs}|Opts], #ifopts{flags=Flags}=Ifopts) -> - case Fs of +check_ifopts([{flags,_}=F|Opts], #ifopts{flags=undefined}=Ifopts) -> + check_ifopts(Opts, Ifopts#ifopts{flags=F}); +check_ifopts([{flags,_}=F|Opts], #ifopts{flags=Flags}=Ifopts) -> + case F of Flags -> - check_ifopts(Opts, Ifopts#ifopts{}); + check_ifopts(Opts, Ifopts); _ -> - ct:fail({multiple_flags,Fs,Ifopts}) + ct:fail({multiple_flags,F,Ifopts}) end; check_ifopts( - [{addr,Addr},{netmask,Netmask},{broadaddr,Broadaddr}|Opts], + [{addr,_}=A,{netmask,_}=N,{dstaddr,_}=D|Opts], #ifopts{addrs=Addrs}=Ifopts) -> - check_ifopts(Opts, Ifopts#ifopts{addrs=[{Addr,Netmask,Broadaddr}|Addrs]}); + check_ifopts(Opts, Ifopts#ifopts{addrs=[{A,N,D}|Addrs]}); check_ifopts( - [{addr,Addr},{netmask,Netmask},{dstaddr,_}|Opts], + [{addr,_}=A,{netmask,_}=N,{broadaddr,_}=B|Opts], #ifopts{addrs=Addrs}=Ifopts) -> - check_ifopts(Opts, Ifopts#ifopts{addrs=[{Addr,Netmask}|Addrs]}); + check_ifopts(Opts, Ifopts#ifopts{addrs=[{A,N,B}|Addrs]}); check_ifopts( - [{addr,Addr},{netmask,Netmask}|Opts], + [{addr,_}=A,{netmask,_}=N|Opts], #ifopts{addrs=Addrs}=Ifopts) -> - check_ifopts(Opts, Ifopts#ifopts{addrs=[{Addr,Netmask}|Addrs]}); -check_ifopts([{addr,Addr}|Opts], #ifopts{addrs=Addrs}=Ifopts) -> - check_ifopts(Opts, Ifopts#ifopts{addrs=[{Addr}|Addrs]}); -check_ifopts([{hwaddr,Hwaddr}|Opts], #ifopts{hwaddr=undefined}=Ifopts) + check_ifopts(Opts, Ifopts#ifopts{addrs=[{A,N}|Addrs]}); +check_ifopts([{addr,_}=A|Opts], #ifopts{addrs=Addrs}=Ifopts) -> + check_ifopts(Opts, Ifopts#ifopts{addrs=[{A}|Addrs]}); +check_ifopts([{hwaddr,Hwaddr}=H|Opts], #ifopts{hwaddr=undefined}=Ifopts) when is_list(Hwaddr) -> - check_ifopts(Opts, Ifopts#ifopts{hwaddr=Hwaddr}); -check_ifopts([{hwaddr,HwAddr}|_], #ifopts{}=Ifopts) -> - ct:fail({multiple_hwaddrs,HwAddr,Ifopts}). + check_ifopts(Opts, Ifopts#ifopts{hwaddr=H}); +check_ifopts([{hwaddr,_}=H|_], #ifopts{}=Ifopts) -> + ct:fail({multiple_hwaddrs,H,Ifopts}). %% Works just like lists:member/2, except that any {127,_,_,_} tuple %% matches any other {127,_,_,_}. We do this to handle Linux systems diff --git a/lib/megaco/src/app/megaco.appup.src b/lib/megaco/src/app/megaco.appup.src index 93bf1d980c..46da79cfe3 100644 --- a/lib/megaco/src/app/megaco.appup.src +++ b/lib/megaco/src/app/megaco.appup.src @@ -192,34 +192,11 @@ {"%VSN%", [ - {"3.17.3", [{restart_application,megaco}]}, - {"3.17.2", []}, - {"3.17.1", [{restart_application,megaco}]}, - {"3.17.0.3", [{restart_application,megaco}]}, - {"3.17.0.2", []}, - {"3.17.0.1", []}, - {"3.17", []}, - {"3.16.0.3", - [ - {update, megaco_flex_scanner_handler, {advanced, upgrade_from_pre_3_17}, - soft_purge, soft_purge, []} - ] - } + {<<"3\\..*">>, [{restart_application, megaco}]} ], + [ - {"3.17.3", [{restart_application,megaco}]}, - {"3.17.2", []}, - {"3.17.1", [{restart_application,megaco}]}, - {"3.17.0.3", [{restart_application,megaco}]}, - {"3.17.0.2", []}, - {"3.17.0.1", []}, - {"3.17", []}, - {"3.16.0.3", - [ - {update, megaco_flex_scanner_handler, {advanced, downgrade_to_pre_3_17}, - soft_purge, soft_purge, []} - ] - } + {<<"3\\..*">>, [{restart_application, megaco}]} ] }. diff --git a/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl b/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl index e6c147b003..07707c6a12 100644 --- a/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl +++ b/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl @@ -247,10 +247,16 @@ t_call_silent(Config) when is_list(Config) -> t_receive(Config) when is_list(Config) -> ok = lttng_start_event("com_ericsson_dyntrace:message_receive", Config), _ = erlang:trace(new, true, [{tracer, dyntrace, []},'receive']), + timer:sleep(20), + + Pid1 = spawn_link(fun() -> waiter() end), + Pid1 ! {self(), ok}, + ok = receive {Pid1,ok} -> ok end, + + Pid2 = spawn_link(fun() -> waiter() end), + Pid2 ! {self(), ok}, + ok = receive {Pid2,ok} -> ok end, - Pid = spawn_link(fun() -> waiter() end), - Pid ! {self(), ok}, - ok = receive {Pid,ok} -> ok end, timer:sleep(10), _ = erlang:trace(all, false, ['receive']), Res = lttng_stop_and_view(Config), diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src index 9c912fb8c3..4ee8a7d6c8 100644 --- a/lib/sasl/src/sasl.app.src +++ b/lib/sasl/src/sasl.app.src @@ -45,6 +45,6 @@ {env, [{sasl_error_logger, tty}, {errlog_type, all}]}, {mod, {sasl, []}}, - {runtime_dependencies, ["tools-2.6.14","stdlib-2.8","kernel-4.1", - "erts-6.0"]}]}. + {runtime_dependencies, ["tools-2.6.14","stdlib-3.0","kernel-5.0", + "erts-8.0"]}]}. diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index ff2d6e082a..bd330e479f 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -124,9 +124,11 @@ </func> <func> + <name>connect(TcpSocket, Options) -> </name> + <name>connect(TcpSocket, Options, Timeout) -> </name> <name>connect(Host, Port, Options) -> </name> - <name>connect(Host, Port, Options, Timeout) -> {ok, - ssh_connection_ref()} | {error, Reason}</name> + <name>connect(Host, Port, Options, Timeout) -> + {ok, ssh_connection_ref()} | {error, Reason}</name> <fsummary>Connects to an SSH server.</fsummary> <type> <v>Host = string()</v> @@ -137,6 +139,8 @@ <v>Timeout = infinity | integer()</v> <d>Negotiation time-out in milli-seconds. The default value is <c>infinity</c>. For connection time-out, use option <c>{connect_timeout, timeout()}</c>.</d> + <v>TcpSocket = port()</v> + <d>The socket is supposed to be from <c>gen_tcp:connect</c> with option <c>{active,false}</c></d> </type> <desc> <p>Connects to an SSH server. No channel is started. This is done diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml index 071d46ec57..67531b7d99 100644 --- a/lib/ssh/doc/src/ssh_sftp.xml +++ b/lib/ssh/doc/src/ssh_sftp.xml @@ -526,16 +526,24 @@ </func> <func> + <name>start_channel(TcpSocket) -></name> + <name>start_channel(TcpSocket, Options) -> + {ok, Pid, ConnectionRef} | {error, reason()|term()}</name> + <name>start_channel(ConnectionRef) -></name> - <name>start_channel(ConnectionRef, Options) -></name> + <name>start_channel(ConnectionRef, Options) -> + {ok, Pid} | {error, reason()|term()}</name> + <name>start_channel(Host, Options) -></name> - <name>start_channel(Host, Port, Options) -> {ok, Pid} | {ok, Pid, ConnectionRef} | - {error, reason()|term()}</name> + <name>start_channel(Host, Port, Options) -> + {ok, Pid, ConnectionRef} | {error, reason()|term()}</name> <fsummary>Starts an SFTP client.</fsummary> <type> <v>Host = string()</v> <v>ConnectionRef = ssh_connection_ref()</v> <v>Port = integer()</v> + <v>TcpSocket = port()</v> + <d>The socket is supposed to be from <c>gen_tcp:connect</c> with option <c>{active,false}</c></d> <v>Options = [{Option, Value}]</v> </type> <desc> diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 09b07b7a2a..50dfe55798 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -27,7 +27,9 @@ -include_lib("public_key/include/public_key.hrl"). -include_lib("kernel/include/file.hrl"). --export([start/0, start/1, stop/0, connect/3, connect/4, close/1, connection_info/2, +-export([start/0, start/1, stop/0, + connect/2, connect/3, connect/4, + close/1, connection_info/2, channel_info/3, daemon/1, daemon/2, daemon/3, daemon_info/1, @@ -70,13 +72,46 @@ stop() -> application:stop(ssh). %%-------------------------------------------------------------------- --spec connect(string(), integer(), proplists:proplist()) -> {ok, pid()} | {error, term()}. +-spec connect(port(), proplists:proplist()) -> {ok, pid()} | {error, term()}. + +-spec connect(port(), proplists:proplist(), timeout()) -> {ok, pid()} | {error, term()} + ; (string(), integer(), proplists:proplist()) -> {ok, pid()} | {error, term()}. + -spec connect(string(), integer(), proplists:proplist(), timeout()) -> {ok, pid()} | {error, term()}. %% %% Description: Starts an ssh connection. %%-------------------------------------------------------------------- -connect(Host, Port, Options) -> +connect(Socket, Options) -> + connect(Socket, Options, infinity). + +connect(Socket, Options, Timeout) when is_port(Socket) -> + case handle_options(Options) of + {error, _Reason} = Error -> + Error; + {_SocketOptions, SshOptions} -> + case proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}) of + {tcp,_,_} -> + %% Is the socket a valid tcp socket? + case {{ok,[]} =/= inet:getopts(Socket, [delay_send]), + {ok,[{active,false}]} == inet:getopts(Socket, [active]) + } + of + {true, true} -> + {ok, {Host,_Port}} = inet:sockname(Socket), + Opts = [{user_pid,self()}, {host,fmt_host(Host)} | SshOptions], + ssh_connection_handler:start_connection(client, Socket, Opts, Timeout); + {true, false} -> + {error, not_passive_mode}; + _ -> + {error, not_tcp_socket} + end; + {L4,_,_} -> + {error, {unsupported,L4}} + end + end; +connect(Host, Port, Options) when is_integer(Port), Port>0 -> connect(Host, Port, Options, infinity). + connect(Host, Port, Options, Timeout) -> case handle_options(Options) of {error, _Reason} = Error -> @@ -199,8 +234,8 @@ stop_daemon(Address, Port) -> stop_daemon(Address, Port, Profile) -> ssh_system_sup:stop_system(Address, Port, Profile). %%-------------------------------------------------------------------- --spec shell(string()) -> _. --spec shell(string(), proplists:proplist()) -> _. +-spec shell(port() | string()) -> _. +-spec shell(port() | string(), proplists:proplist()) -> _. -spec shell(string(), integer(), proplists:proplist()) -> _. %% Host = string() @@ -212,27 +247,34 @@ stop_daemon(Address, Port, Profile) -> %% and will not return until the remote shell is ended.(e.g. on %% exit from the shell) %%-------------------------------------------------------------------- +shell(Socket) when is_port(Socket) -> + shell(Socket, []); shell(Host) -> shell(Host, ?SSH_DEFAULT_PORT, []). + +shell(Socket, Options) when is_port(Socket) -> + start_shell( connect(Socket, Options) ); shell(Host, Options) -> shell(Host, ?SSH_DEFAULT_PORT, Options). + shell(Host, Port, Options) -> - case connect(Host, Port, Options) of - {ok, ConnectionRef} -> - case ssh_connection:session_channel(ConnectionRef, infinity) of - {ok,ChannelId} -> - success = ssh_connection:ptty_alloc(ConnectionRef, ChannelId, []), - Args = [{channel_cb, ssh_shell}, - {init_args,[ConnectionRef, ChannelId]}, - {cm, ConnectionRef}, {channel_id, ChannelId}], - {ok, State} = ssh_channel:init([Args]), - ssh_channel:enter_loop(State); - Error -> - Error - end; + start_shell( connect(Host, Port, Options) ). + + +start_shell({ok, ConnectionRef}) -> + case ssh_connection:session_channel(ConnectionRef, infinity) of + {ok,ChannelId} -> + success = ssh_connection:ptty_alloc(ConnectionRef, ChannelId, []), + Args = [{channel_cb, ssh_shell}, + {init_args,[ConnectionRef, ChannelId]}, + {cm, ConnectionRef}, {channel_id, ChannelId}], + {ok, State} = ssh_channel:init([Args]), + ssh_channel:enter_loop(State); Error -> Error - end. + end; +start_shell(Error) -> + Error. %%-------------------------------------------------------------------- %%-------------------------------------------------------------------- @@ -835,3 +877,8 @@ handle_user_pref_pubkey_algs([H|T], Acc) -> false -> false end. + +fmt_host({A,B,C,D}) -> + lists:concat([A,".",B,".",C,".",D]); +fmt_host(T={_,_,_,_,_,_,_,_}) -> + lists:flatten(string:join([io_lib:format("~.16B",[A]) || A <- tuple_to_list(T)], ":")). diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl index 4f76dbe6f0..129f85a3e0 100644 --- a/lib/ssh/src/ssh_acceptor_sup.erl +++ b/lib/ssh/src/ssh_acceptor_sup.erl @@ -36,6 +36,8 @@ -define(DEFAULT_TIMEOUT, 50000). +-spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . + %%%========================================================================= %%% API %%%========================================================================= diff --git a/lib/ssh/src/ssh_channel_sup.erl b/lib/ssh/src/ssh_channel_sup.erl index 8eaa85f795..6b01dc334d 100644 --- a/lib/ssh/src/ssh_channel_sup.erl +++ b/lib/ssh/src/ssh_channel_sup.erl @@ -43,6 +43,8 @@ start_child(Sup, ChildSpec) -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= +-spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . + init(_Args) -> RestartStrategy = one_for_one, MaxR = 10, diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index 2d60008de6..74cd2e081a 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -47,6 +47,21 @@ %%==================================================================== %% ssh_channel callbacks %%==================================================================== +-spec init(Args :: term()) -> + {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. + +-spec terminate(Reason :: (normal | shutdown | {shutdown, term()} | + term()), + State :: term()) -> + term(). + +-spec handle_msg(Msg ::term(), State :: term()) -> + {ok, State::term()} | {stop, ChannelId::integer(), State::term()}. +-spec handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()}, + State::term()) -> {ok, State::term()} | + {stop, ChannelId::integer(), + State::term()}. %%-------------------------------------------------------------------- %% Function: init(Args) -> {ok, State} diff --git a/lib/ssh/src/ssh_client_key_api.erl b/lib/ssh/src/ssh_client_key_api.erl index 039a7dea9b..6e994ff292 100644 --- a/lib/ssh/src/ssh_client_key_api.erl +++ b/lib/ssh/src/ssh_client_key_api.erl @@ -23,14 +23,26 @@ -include_lib("public_key/include/public_key.hrl"). -include("ssh.hrl"). --callback is_host_key(PublicKey :: #'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term() , Host :: string(), - Algorithm :: 'ssh-rsa'| 'ssh-dss'| atom(), ConnectOptions :: proplists:proplist()) -> +-export_type([algorithm/0]). + +-type algorithm() :: 'ssh-rsa' + | 'ssh-dss' + | 'ecdsa-sha2-nistp256' + | 'ecdsa-sha2-nistp384' + | 'ecdsa-sha2-nistp521' + . + +-callback is_host_key(PublicKey :: public_key:public_key(), + Host :: string(), + Algorithm :: algorithm(), + ConnectOptions :: proplists:proplist()) -> boolean(). --callback user_key(Algorithm :: 'ssh-rsa'| 'ssh-dss'| atom(), ConnectOptions :: proplists:proplist()) -> - {ok, PrivateKey :: #'RSAPrivateKey'{}| #'DSAPrivateKey'{} | term()} | {error, string()}. +-callback user_key(Algorithm :: algorithm(), + ConnectOptions :: proplists:proplist()) -> + {ok, PrivateKey::public_key:private_key()} | {error, term()}. --callback add_host_key(Host :: string(), PublicKey :: #'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term(), - Options :: list()) -> +-callback add_host_key(Host :: string(), PublicKey :: public_key:public_key(), + Options :: proplists:proplist()) -> ok | {error, Error::term()}. diff --git a/lib/ssh/src/ssh_connection_sup.erl b/lib/ssh/src/ssh_connection_sup.erl index 8c7628e909..0f54053f52 100644 --- a/lib/ssh/src/ssh_connection_sup.erl +++ b/lib/ssh/src/ssh_connection_sup.erl @@ -45,6 +45,8 @@ start_child(Sup, Args) -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= +-spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . + init(_) -> RestartStrategy = simple_one_for_one, MaxR = 0, diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index 4486d36fe4..216f65f33a 100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl @@ -43,7 +43,28 @@ -define(PERM_644, 8#644). -%% API +%%% API + +%%% client +-spec add_host_key(string(), + public_key:public_key(), + proplists:proplist()) -> ok | {error,term()}. + +-spec is_host_key(public_key:public_key(), + string(), + ssh_client_key_api:algorithm(), + proplists:proplist()) -> boolean(). + +-spec user_key(ssh_client_key_api:algorithm(), + proplists:proplist()) -> {ok, public_key:private_key()} | {error,term()}. + +%%% server +-spec host_key(ssh_server_key_api:algorithm(), + proplists:proplist()) -> {ok, public_key:private_key()} | {error,term()}. + +-spec is_auth_key(public_key:public_key(), + string(), proplists:proplist()) -> boolean(). + %% Used by server host_key(Algorithm, Opts) -> diff --git a/lib/ssh/src/ssh_server_key_api.erl b/lib/ssh/src/ssh_server_key_api.erl index c1d43a486c..3f1b886fa7 100644 --- a/lib/ssh/src/ssh_server_key_api.erl +++ b/lib/ssh/src/ssh_server_key_api.erl @@ -23,9 +23,16 @@ -include_lib("public_key/include/public_key.hrl"). -include("ssh.hrl"). --callback host_key(Algorithm :: 'ssh-rsa'| 'ssh-dss'| atom(), DaemonOptions :: proplists:proplist()) -> - {ok, PrivateKey :: #'RSAPrivateKey'{}| #'DSAPrivateKey'{} | term()} | {error, string()}. +-export_type([algorithm/0]). --callback is_auth_key(PublicKey :: #'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term(), - User :: string(), DaemonOptions :: proplists:proplist()) -> +-type algorithm() :: ssh_client_key_api:algorithm(). + + +-callback host_key(Algorithm :: algorithm(), + DaemonOptions :: proplists:proplist()) -> + {ok, PrivateKey :: public_key:private_key()} | {error, term()}. + +-callback is_auth_key(PublicKey :: public_key:public_key(), + User :: string(), + DaemonOptions :: proplists:proplist()) -> boolean(). diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index b03652a136..afc2fb88ff 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -95,8 +95,31 @@ %%==================================================================== start_channel(Cm) when is_pid(Cm) -> start_channel(Cm, []); +start_channel(Socket) when is_port(Socket) -> + start_channel(Socket, []); start_channel(Host) when is_list(Host) -> start_channel(Host, []). + +start_channel(Socket, Options) when is_port(Socket) -> + Timeout = + %% A mixture of ssh:connect and ssh_sftp:start_channel: + case proplists:get_value(connect_timeout, Options, undefined) of + undefined -> + proplists:get_value(timeout, Options, infinity); + TO -> + TO + end, + case ssh:connect(Socket, Options, Timeout) of + {ok,Cm} -> + case start_channel(Cm, Options) of + {ok, Pid} -> + {ok, Pid, Cm}; + Error -> + Error + end; + Error -> + Error + end; start_channel(Cm, Opts) when is_pid(Cm) -> Timeout = proplists:get_value(timeout, Opts, infinity), {_, ChanOpts, SftpOpts} = handle_options(Opts, [], [], []), diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index 819cba697e..dca018f20f 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -57,6 +57,22 @@ %%==================================================================== %% API %%==================================================================== +-spec init(Args :: term()) -> + {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. + +-spec terminate(Reason :: (normal | shutdown | {shutdown, term()} | + term()), + State :: term()) -> + term(). + +-spec handle_msg(Msg ::term(), State :: term()) -> + {ok, State::term()} | {stop, ChannelId::integer(), State::term()}. +-spec handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()}, + State::term()) -> {ok, State::term()} | + {stop, ChannelId::integer(), + State::term()}. + subsystem_spec(Options) -> {"sftp", {?MODULE, Options}}. diff --git a/lib/ssh/src/ssh_shell.erl b/lib/ssh/src/ssh_shell.erl index d31d5a297d..17224b6ef4 100644 --- a/lib/ssh/src/ssh_shell.erl +++ b/lib/ssh/src/ssh_shell.erl @@ -45,6 +45,21 @@ %%==================================================================== %% ssh_channel callbacks %%==================================================================== +-spec init(Args :: term()) -> + {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. + +-spec terminate(Reason :: (normal | shutdown | {shutdown, term()} | + term()), + State :: term()) -> + term(). + +-spec handle_msg(Msg ::term(), State :: term()) -> + {ok, State::term()} | {stop, ChannelId::integer(), State::term()}. +-spec handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()}, + State::term()) -> {ok, State::term()} | + {stop, ChannelId::integer(), + State::term()}. %%-------------------------------------------------------------------- %% Function: init(Args) -> {ok, State} diff --git a/lib/ssh/src/ssh_subsystem_sup.erl b/lib/ssh/src/ssh_subsystem_sup.erl index 11e02491c4..637f5f398f 100644 --- a/lib/ssh/src/ssh_subsystem_sup.erl +++ b/lib/ssh/src/ssh_subsystem_sup.erl @@ -51,6 +51,8 @@ channel_supervisor(SupPid) -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= +-spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . + init([Opts]) -> RestartStrategy = one_for_all, MaxR = 0, diff --git a/lib/ssh/src/ssh_sup.erl b/lib/ssh/src/ssh_sup.erl index f827594717..8b57387589 100644 --- a/lib/ssh/src/ssh_sup.erl +++ b/lib/ssh/src/ssh_sup.erl @@ -31,6 +31,8 @@ %%%========================================================================= %%% Supervisor callback %%%========================================================================= +-spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . + init([]) -> SupFlags = {one_for_one, 10, 3600}, Children = children(), diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index 9a9786a914..5035bc8f80 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -125,6 +125,8 @@ restart_acceptor(Address, Port, Profile) -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= +-spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . + init([ServerOpts]) -> RestartStrategy = one_for_one, MaxR = 0, diff --git a/lib/ssh/src/sshc_sup.erl b/lib/ssh/src/sshc_sup.erl index 71b5c2c46a..15858f36e1 100644 --- a/lib/ssh/src/sshc_sup.erl +++ b/lib/ssh/src/sshc_sup.erl @@ -51,6 +51,8 @@ stop_child(Client) -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= +-spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . + init(Args) -> RestartStrategy = simple_one_for_one, MaxR = 0, diff --git a/lib/ssh/src/sshd_sup.erl b/lib/ssh/src/sshd_sup.erl index ac9e232b3a..04d2df30f7 100644 --- a/lib/ssh/src/sshd_sup.erl +++ b/lib/ssh/src/sshd_sup.erl @@ -75,6 +75,8 @@ system_name(SysSup) -> %%%========================================================================= %%% Supervisor callback %%%========================================================================= +-spec init( [term()] ) -> {ok,{supervisor:sup_flags(),[supervisor:child_spec()]}} | ignore . + init([Servers]) -> RestartStrategy = one_for_one, MaxR = 10, diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 6894f83547..ed9e7aacaa 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -111,7 +111,7 @@ init_per_group(Group, Config) -> false -> %% An algorithm group Tag = proplists:get_value(name, - hd(?config(tc_group_path, Config))), + hd(proplists:get_value(tc_group_path, Config))), Alg = Group, PA = case split(Alg) of @@ -128,10 +128,10 @@ init_per_group(Group, Config) -> end. end_per_group(_Alg, Config) -> - case ?config(srvr_pid,Config) of + case proplists:get_value(srvr_pid,Config) of Pid when is_pid(Pid) -> ssh:stop_daemon(Pid), - ct:log("stopped ~p",[?config(srvr_addr,Config)]); + ct:log("stopped ~p",[proplists:get_value(srvr_addr,Config)]); _ -> ok end. @@ -139,17 +139,16 @@ end_per_group(_Alg, Config) -> init_per_testcase(sshc_simple_exec_os_cmd, Config) -> - start_pubkey_daemon([?config(pref_algs,Config)], Config); - + start_pubkey_daemon([proplists:get_value(pref_algs,Config)], Config); init_per_testcase(_TC, Config) -> Config. end_per_testcase(sshc_simple_exec_os_cmd, Config) -> - case ?config(srvr_pid,Config) of + case proplists:get_value(srvr_pid,Config) of Pid when is_pid(Pid) -> ssh:stop_daemon(Pid), - ct:log("stopped ~p",[?config(srvr_addr,Config)]); + ct:log("stopped ~p",[proplists:get_value(srvr_addr,Config)]); _ -> ok end; @@ -161,13 +160,13 @@ end_per_testcase(_TC, Config) -> %%-------------------------------------------------------------------- %% A simple sftp transfer simple_sftp(Config) -> - {Host,Port} = ?config(srvr_addr, Config), + {Host,Port} = proplists:get_value(srvr_addr, Config), ssh_test_lib:std_simple_sftp(Host, Port, Config). %%-------------------------------------------------------------------- %% A simple exec call simple_exec(Config) -> - {Host,Port} = ?config(srvr_addr, Config), + {Host,Port} = proplists:get_value(srvr_addr, Config), ssh_test_lib:std_simple_exec(Host, Port, Config). %%-------------------------------------------------------------------- @@ -378,8 +377,8 @@ start_pubkey_daemon(Opts0, Config) -> setup_pubkey(Config) -> - DataDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_dsa(DataDir, UserDir), ssh_test_lib:setup_rsa(DataDir, UserDir), ssh_test_lib:setup_ecdsa("256", DataDir, UserDir), @@ -389,7 +388,7 @@ setup_pubkey(Config) -> simple_exec_group(I, Config) when is_integer(I) -> simple_exec_group({I,I,I}, Config); simple_exec_group({Min,I,Max}, Config) -> - {Host,Port} = ?config(srvr_addr, Config), + {Host,Port} = proplists:get_value(srvr_addr, Config), ssh_test_lib:std_simple_exec(Host, Port, Config, [{dh_gex_limits,{Min,I,Max}}]). diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 0fa44ded4f..4991816850 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -137,21 +137,21 @@ end_per_suite(_Config) -> %%-------------------------------------------------------------------- init_per_group(dsa_key, Config) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_dsa(DataDir, PrivDir), Config; init_per_group(rsa_key, Config) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_rsa(DataDir, PrivDir), Config; init_per_group(ecdsa_sha2_nistp256_key, Config) -> case lists:member('ecdsa-sha2-nistp256', ssh_transport:default_algorithms(public_key)) of true -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_ecdsa("256", DataDir, PrivDir), Config; false -> @@ -161,8 +161,8 @@ init_per_group(ecdsa_sha2_nistp384_key, Config) -> case lists:member('ecdsa-sha2-nistp384', ssh_transport:default_algorithms(public_key)) of true -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_ecdsa("384", DataDir, PrivDir), Config; false -> @@ -172,28 +172,28 @@ init_per_group(ecdsa_sha2_nistp521_key, Config) -> case lists:member('ecdsa-sha2-nistp521', ssh_transport:default_algorithms(public_key)) of true -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_ecdsa("521", DataDir, PrivDir), Config; false -> {skip, unsupported_pub_key} end; init_per_group(rsa_pass_key, Config) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_rsa_pass_pharse(DataDir, PrivDir, "Password"), [{pass_phrase, {rsa_pass_phrase, "Password"}}| Config]; init_per_group(dsa_pass_key, Config) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_dsa_pass_pharse(DataDir, PrivDir, "Password"), [{pass_phrase, {dsa_pass_phrase, "Password"}}| Config]; init_per_group(host_user_key_differs, Config) -> - Data = ?config(data_dir, Config), - Sys = filename:join(?config(priv_dir, Config), system_rsa), + Data = proplists:get_value(data_dir, Config), + Sys = filename:join(proplists:get_value(priv_dir, Config), system_rsa), SysUsr = filename:join(Sys, user), - Usr = filename:join(?config(priv_dir, Config), user_ecdsa_256), + Usr = filename:join(proplists:get_value(priv_dir, Config), user_ecdsa_256), file:make_dir(Sys), file:make_dir(SysUsr), file:make_dir(Usr), @@ -205,18 +205,18 @@ init_per_group(host_user_key_differs, Config) -> ssh_test_lib:setup_rsa_known_host(Sys, Usr), Config; init_per_group(key_cb, Config) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_dsa(DataDir, PrivDir), Config; init_per_group(internal_error, Config) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_dsa(DataDir, PrivDir), file:delete(filename:join(PrivDir, "system/ssh_host_dsa_key")), Config; init_per_group(dir_options, Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), %% Make unreadable dir: Dir_unreadable = filename:join(PrivDir, "unread"), ok = file:make_dir(Dir_unreadable), @@ -261,27 +261,27 @@ init_per_group(_, Config) -> Config. end_per_group(dsa_key, Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:clean_dsa(PrivDir), Config; end_per_group(rsa_key, Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:clean_rsa(PrivDir), Config; end_per_group(dsa_pass_key, Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:clean_dsa(PrivDir), Config; end_per_group(rsa_pass_key, Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:clean_rsa(PrivDir), Config; end_per_group(key_cb, Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:clean_dsa(PrivDir), Config; end_per_group(internal_error, Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:clean_dsa(PrivDir), Config; @@ -290,9 +290,9 @@ end_per_group(_, Config) -> %%-------------------------------------------------------------------- init_per_testcase(TC, Config) when TC==shell_no_unicode ; TC==shell_unicode_string -> - PrivDir = ?config(priv_dir, Config), - UserDir = ?config(priv_dir, Config), - SysDir = ?config(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), + SysDir = proplists:get_value(data_dir, Config), ssh:start(), Sftpd = {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, @@ -321,12 +321,12 @@ init_per_testcase(_TestCase, Config) -> end_per_testcase(TestCase, Config) when TestCase == server_password_option; TestCase == server_userpassword_option -> - UserDir = filename:join(?config(priv_dir, Config), nopubkey), + UserDir = filename:join(proplists:get_value(priv_dir, Config), nopubkey), ssh_test_lib:del_dirs(UserDir), end_per_testcase(Config); end_per_testcase(TC, Config) when TC==shell_no_unicode ; TC==shell_unicode_string -> - case ?config(sftpd, Config) of + case proplists:get_value(sftpd, Config) of {Pid, _, _} -> ssh:stop_daemon(Pid), ssh:stop(); @@ -355,8 +355,8 @@ appup_test(Config) when is_list(Config) -> %%% some options not yet present are not decided if we should support or %%% if they need thier own test case. misc_ssh_options(Config) when is_list(Config) -> - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), CMiscOpt0 = [{connect_timeout, 1000}, {user_dir, UserDir}], CMiscOpt1 = [{connect_timeout, infinity}, {user_dir, UserDir}], @@ -369,8 +369,8 @@ misc_ssh_options(Config) when is_list(Config) -> %%-------------------------------------------------------------------- %%% Test configuring IPv4 inet_option(Config) when is_list(Config) -> - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), ClientOpts = [{silently_accept_hosts, true}, {user_dir, UserDir}, @@ -385,8 +385,8 @@ inet_option(Config) when is_list(Config) -> %%-------------------------------------------------------------------- %%% Test configuring IPv6 inet6_option(Config) when is_list(Config) -> - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), ClientOpts = [{silently_accept_hosts, true}, {user_dir, UserDir}, @@ -402,8 +402,8 @@ inet6_option(Config) when is_list(Config) -> %%% Test api function ssh_connection:exec exec(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, @@ -449,8 +449,8 @@ exec_compressed(Config) when is_list(Config) -> true -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, {preferred_algorithms,[{compression, [zlib]}]}, @@ -478,8 +478,8 @@ exec_compressed(Config) when is_list(Config) -> %%-------------------------------------------------------------------- %%% Idle timeout test idle_time(Config) -> - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, @@ -501,8 +501,8 @@ idle_time(Config) -> %%% Test that ssh:shell/2 works shell(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, {failfun, fun ssh_test_lib:failfun/2}]), @@ -536,9 +536,9 @@ exec_key_differs(Config, UserPKAlgs) -> of [] -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system_rsa), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system_rsa), SystemUserDir = filename:join(SystemDir, user), - UserDir = filename:join(?config(priv_dir, Config), user_ecdsa_256), + UserDir = filename:join(proplists:get_value(priv_dir, Config), user_ecdsa_256), {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, SystemUserDir}, @@ -570,9 +570,9 @@ exec_key_differs(Config, UserPKAlgs) -> %%-------------------------------------------------------------------- exec_key_differs_fail(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system_rsa), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system_rsa), SystemUserDir = filename:join(SystemDir, user), - UserDir = filename:join(?config(priv_dir, Config), user_ecdsa_256), + UserDir = filename:join(proplists:get_value(priv_dir, Config), user_ecdsa_256), {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, SystemUserDir}, @@ -597,10 +597,10 @@ exec_key_differs_fail(Config) when is_list(Config) -> %%-------------------------------------------------------------------- cli(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), - TmpDir = filename:join(?config(priv_dir,Config), "tmp"), + TmpDir = filename:join(proplists:get_value(priv_dir,Config), "tmp"), ok = ssh_test_lib:del_dirs(TmpDir), ok = file:make_dir(TmpDir), @@ -639,8 +639,8 @@ cli(Config) when is_list(Config) -> %%% Test that get correct error message if you try to start a daemon %%% on an adress that already runs a daemon see also seq10667 daemon_already_started(Config) when is_list(Config) -> - SystemDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), + SystemDir = proplists:get_value(data_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), {Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, @@ -654,8 +654,8 @@ daemon_already_started(Config) when is_list(Config) -> %%-------------------------------------------------------------------- %%% check that known_hosts is updated correctly known_hosts(Config) when is_list(Config) -> - SystemDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + SystemDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{user_dir, PrivDir},{system_dir, SystemDir}, {failfun, fun ssh_test_lib:failfun/2}]), @@ -681,9 +681,9 @@ known_hosts(Config) when is_list(Config) -> %%% Test that we can use keyes protected by pass phrases pass_phrase(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), - PhraseArg = ?config(pass_phrase, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), + PhraseArg = proplists:get_value(pass_phrase, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, @@ -700,8 +700,8 @@ pass_phrase(Config) when is_list(Config) -> %%% Test that we can use key callback key_callback(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), NoPubKeyDir = filename:join(UserDir, "nopubkey"), file:make_dir(NoPubKeyDir), @@ -724,8 +724,8 @@ key_callback(Config) when is_list(Config) -> %%% Test that we can use key callback with callback options key_callback_options(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), NoPubKeyDir = filename:join(UserDir, "nopubkey"), file:make_dir(NoPubKeyDir), @@ -751,8 +751,8 @@ key_callback_options(Config) when is_list(Config) -> %%% Test that client does not hang if disconnects due to internal error internal_error(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, @@ -768,8 +768,8 @@ internal_error(Config) when is_list(Config) -> %%% Test ssh_connection:send/3 send(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, @@ -788,8 +788,8 @@ send(Config) when is_list(Config) -> %%% Test ssh:connection_info([peername, sockname]) peername_sockname(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, @@ -838,8 +838,8 @@ ips(Name) when is_list(Name) -> %%% Client receives close when server closes close(Config) when is_list(Config) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), {Server, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, @@ -861,8 +861,8 @@ close(Config) when is_list(Config) -> %%-------------------------------------------------------------------- %%% Simulate that we try to close an already closed connection double_close(Config) when is_list(Config) -> - SystemDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + SystemDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), @@ -881,8 +881,8 @@ double_close(Config) when is_list(Config) -> %%-------------------------------------------------------------------- daemon_opt_fd(Config) -> - SystemDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + SystemDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), @@ -908,8 +908,8 @@ daemon_opt_fd(Config) -> %%-------------------------------------------------------------------- multi_daemon_opt_fd(Config) -> - SystemDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + SystemDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), @@ -943,8 +943,8 @@ multi_daemon_opt_fd(Config) -> %%-------------------------------------------------------------------- packet_size_zero(Config) -> - SystemDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + SystemDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), @@ -974,7 +974,7 @@ packet_size_zero(Config) -> %%-------------------------------------------------------------------- shell_no_unicode(Config) -> - new_do_shell(?config(io,Config), + new_do_shell(proplists:get_value(io,Config), [new_prompt, {type,"io:format(\"hej ~p~n\",[42])."}, {expect,"hej 42"}, @@ -985,7 +985,7 @@ shell_no_unicode(Config) -> %%-------------------------------------------------------------------- shell_unicode_string(Config) -> - new_do_shell(?config(io,Config), + new_do_shell(proplists:get_value(io,Config), [new_prompt, {type,"io:format(\"こにちわ~ts~n\",[\"四二\"])."}, {expect,"こにちわ四二"}, @@ -1002,8 +1002,8 @@ openssh_zlib_basic_test(Config) -> {skip, io_lib:format("~p compression is not supported",[L])}; true -> - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {user_dir, UserDir}, @@ -1023,11 +1023,11 @@ openssh_zlib_basic_test(Config) -> %%-------------------------------------------------------------------- ssh_info_print(Config) -> %% Just check that ssh_print:info() crashes - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), PrintFile = filename:join(PrivDir,info), UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), - SysDir = ?config(data_dir, Config), + SysDir = proplists:get_value(data_dir, Config), Parent = self(), UnexpFun = fun(Msg,_Peer) -> @@ -1103,8 +1103,8 @@ check_error(Error) -> ct:fail(Error). basic_test(Config) -> - ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), + ClientOpts = proplists:get_value(client_opts, Config), + ServerOpts = proplists:get_value(server_opts, Config), {Pid, Host, Port} = ssh_test_lib:daemon(ServerOpts), {ok, CM} = ssh:connect(Host, Port, ClientOpts), diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index 5d8c94be73..c2bfc48449 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -29,7 +29,9 @@ -include_lib("ssh/src/ssh_userauth.hrl"). -suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. +suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}, + {timetrap,{minutes,3}} + ]. %%suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [{group, opensshc_erld} @@ -63,8 +65,8 @@ end_per_suite(_Config) -> init_per_group(opensshc_erld, Config) -> case ssh_test_lib:ssh_type() of openSSH -> - DataDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_dsa(DataDir, UserDir), ssh_test_lib:setup_rsa(DataDir, UserDir), ssh_test_lib:setup_ecdsa("256", DataDir, UserDir), @@ -97,7 +99,7 @@ end_per_testcase(_Func, _Conf) -> init_sftp_dirs(Config) -> - UserDir = ?config(priv_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), SrcDir = filename:join(UserDir, "sftp_src"), ok = file:make_dir(SrcDir), SrcFile = "big_data", @@ -127,8 +129,8 @@ openssh_client_shell(Config) -> openssh_client_shell(Config, Options) -> - SystemDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), + SystemDir = proplists:get_value(data_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), KnownHosts = filename:join(UserDir, "known_hosts"), {ok, TracerPid} = erlang_trace(), @@ -200,11 +202,11 @@ openssh_client_sftp(Config) -> openssh_client_sftp(Config, Options) -> - SystemDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), - SftpSrcDir = ?config(sftp_src_dir, Config), - SrcFile = ?config(src_file, Config), - SrcSize = ?config(sftp_size, Config), + SystemDir = proplists:get_value(data_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), + SftpSrcDir = proplists:get_value(sftp_src_dir, Config), + SrcFile = proplists:get_value(src_file, Config), + SrcSize = proplists:get_value(sftp_size, Config), KnownHosts = filename:join(UserDir, "known_hosts"), {ok, TracerPid} = erlang_trace(), @@ -275,7 +277,7 @@ variants(Tag, Config) -> [A|_] when is_atom(A) -> two_way end, [ [{Tag,tag_value(TagType,Alg)}] - || Alg <- proplists:get_value(Tag, ?config(common_algs,Config)) + || Alg <- proplists:get_value(Tag, proplists:get_value(common_algs,Config)) ]. tag_value(two_way, Alg) -> [Alg]; diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index 0f757a0322..c9a321fbbd 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -47,6 +47,7 @@ all() -> start_shell, start_shell_exec, start_shell_exec_fun, + start_shell_sock_exec_fun, gracefull_invalid_version, gracefull_invalid_start, gracefull_invalid_long_start, @@ -60,6 +61,9 @@ groups() -> payload() -> [simple_exec, + simple_exec_sock, + connect_sock_not_tcp, + connect_sock_not_passive, small_cat, big_cat, send_after_exit]. @@ -111,6 +115,18 @@ simple_exec() -> simple_exec(Config) when is_list(Config) -> ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, {user_interaction, false}]), + do_simple_exec(ConnectionRef). + + +simple_exec_sock(Config) -> + {ok, Sock} = gen_tcp:connect("localhost", ?SSH_DEFAULT_PORT, [{active,false}]), + {ok, ConnectionRef} = ssh:connect(Sock, [{silently_accept_hosts, true}, + {user_interaction, false}]), + do_simple_exec(ConnectionRef). + + + +do_simple_exec(ConnectionRef) -> {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), success = ssh_connection:exec(ConnectionRef, ChannelId0, "echo testing", infinity), @@ -143,6 +159,18 @@ simple_exec(Config) when is_list(Config) -> end. %%-------------------------------------------------------------------- +connect_sock_not_tcp(Config) -> + {ok,Sock} = gen_udp:open(0, []), + {error, not_tcp_socket} = ssh:connect(Sock, []), + gen_udp:close(Sock). + +%%-------------------------------------------------------------------- +connect_sock_not_passive(Config) -> + {ok,Sock} = gen_tcp:connect("localhost", ?SSH_DEFAULT_PORT, []), + {error, not_passive_mode} = ssh:connect(Sock, []), + gen_tcp:close(Sock). + +%%-------------------------------------------------------------------- small_cat() -> [{doc, "Use 'cat' to echo small data block back to us."}]. @@ -316,10 +344,10 @@ ptty_alloc_pixel(Config) when is_list(Config) -> %%-------------------------------------------------------------------- interrupted_send(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, {password, "morot"}, @@ -359,10 +387,10 @@ start_shell() -> [{doc, "Start a shell"}]. start_shell(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, {password, "morot"}, @@ -391,10 +419,10 @@ start_shell_exec() -> [{doc, "start shell to exec command"}]. start_shell_exec(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, {password, "morot"}, @@ -425,10 +453,10 @@ start_shell_exec_fun() -> [{doc, "start shell to exec command"}]. start_shell_exec_fun(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, {password, "morot"}, @@ -456,12 +484,48 @@ start_shell_exec_fun(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +start_shell_sock_exec_fun() -> + [{doc, "start shell on tcp-socket to exec command"}]. + +start_shell_sock_exec_fun(Config) when is_list(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = proplists:get_value(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {exec, fun ssh_exec/1}]), + + {ok, Sock} = gen_tcp:connect(Host, Port, [{active,false}]), + {ok,ConnectionRef} = ssh:connect(Sock, [{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). + +%%-------------------------------------------------------------------- gracefull_invalid_version(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, @@ -481,10 +545,10 @@ gracefull_invalid_version(Config) when is_list(Config) -> end. gracefull_invalid_start(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, {password, "morot"}]), @@ -503,10 +567,10 @@ gracefull_invalid_start(Config) when is_list(Config) -> end. gracefull_invalid_long_start(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, {password, "morot"}]), @@ -526,10 +590,10 @@ gracefull_invalid_long_start(Config) when is_list(Config) -> gracefull_invalid_long_start_no_nl(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, {password, "morot"}]), @@ -551,10 +615,10 @@ stop_listener() -> [{doc, "start ssh daemon, setup connections, stop listener, restart listner"}]. stop_listener(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {Pid0, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, @@ -610,10 +674,10 @@ stop_listener(Config) when is_list(Config) -> end. start_subsystem_on_closed_channel(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, {password, "morot"}, @@ -639,10 +703,10 @@ max_channels_option() -> [{doc, "Test max_channels option"}]. max_channels_option(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, {password, "morot"}, diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 4ca6a473fa..d1e3d6cb0e 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -133,12 +133,12 @@ end_per_suite(_Config) -> %%-------------------------------------------------------------------- init_per_group(hardening_tests, Config) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_dsa(DataDir, PrivDir), Config; init_per_group(dir_options, Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), %% Make unreadable dir: Dir_unreadable = filename:join(PrivDir, "unread"), ok = file:make_dir(Dir_unreadable), @@ -193,7 +193,7 @@ end_per_testcase(TestCase, Config) when TestCase == server_password_option; TestCase == server_userpassword_option; TestCase == server_pwdfun_option; TestCase == server_pwdfun_4_option -> - UserDir = filename:join(?config(priv_dir, Config), nopubkey), + UserDir = filename:join(proplists:get_value(priv_dir, Config), nopubkey), ssh_test_lib:del_dirs(UserDir), end_per_testcase(Config); end_per_testcase(_TestCase, Config) -> @@ -210,10 +210,10 @@ end_per_testcase(_Config) -> %%% validate to server that uses the 'password' option server_password_option(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, {password, "morot"}]), @@ -243,10 +243,10 @@ server_password_option(Config) when is_list(Config) -> %%% validate to server that uses the 'password' option server_userpassword_option(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, PrivDir}, {user_passwords, [{"vego", "morot"}]}]), @@ -278,10 +278,10 @@ server_userpassword_option(Config) when is_list(Config) -> %%-------------------------------------------------------------------- %%% validate to server that uses the 'pwdfun' option server_pwdfun_option(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), CHKPWD = fun("foo",Pwd) -> Pwd=="bar"; (_,_) -> false end, @@ -316,10 +316,10 @@ server_pwdfun_option(Config) -> %%-------------------------------------------------------------------- %%% validate to server that uses the 'pwdfun/4' option server_pwdfun_4_option(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), PWDFUN = fun("foo",Pwd,{_,_},undefined) -> Pwd=="bar"; ("fie",Pwd,{_,_},undefined) -> {Pwd=="bar",new_state}; ("bandit",_,_,_) -> disconnect; @@ -376,10 +376,10 @@ server_pwdfun_4_option(Config) -> %%-------------------------------------------------------------------- server_pwdfun_4_option_repeat(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), %% Test that the state works Parent = self(), PWDFUN = fun("foo",P="bar",_,S) -> Parent!{P,S},true; @@ -471,10 +471,10 @@ user_dir_option(Config) -> %%-------------------------------------------------------------------- %%% validate client that uses the 'ssh_msg_debug_fun' option ssh_msg_debug_fun_option_client(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, UserDir}, @@ -511,10 +511,10 @@ ssh_msg_debug_fun_option_client(Config) -> %%-------------------------------------------------------------------- connectfun_disconnectfun_server(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), Parent = self(), Ref = make_ref(), @@ -549,10 +549,10 @@ connectfun_disconnectfun_server(Config) -> %%-------------------------------------------------------------------- connectfun_disconnectfun_client(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), Parent = self(), Ref = make_ref(), @@ -580,10 +580,10 @@ connectfun_disconnectfun_client(Config) -> %%-------------------------------------------------------------------- %%% validate client that uses the 'ssh_msg_debug_fun' option ssh_msg_debug_fun_option_server(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), Parent = self(), DbgFun = fun(ConnRef,Displ,Msg,Lang) -> Parent ! {msg_dbg,{ConnRef,Displ,Msg,Lang}} end, @@ -624,10 +624,10 @@ ssh_msg_debug_fun_option_server(Config) -> %%-------------------------------------------------------------------- disconnectfun_option_server(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), Parent = self(), DisConnFun = fun(Reason) -> Parent ! {disconnect,Reason} end, @@ -659,10 +659,10 @@ disconnectfun_option_server(Config) -> %%-------------------------------------------------------------------- disconnectfun_option_client(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), Parent = self(), DisConnFun = fun(Reason) -> Parent ! {disconnect,Reason} end, @@ -693,10 +693,10 @@ disconnectfun_option_client(Config) -> %%-------------------------------------------------------------------- unexpectedfun_option_server(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), Parent = self(), ConnFun = fun(_,_,_) -> Parent ! {connection_pid,self()} end, @@ -736,10 +736,10 @@ unexpectedfun_option_server(Config) -> %%-------------------------------------------------------------------- unexpectedfun_option_client(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(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), + SysDir = proplists:get_value(data_dir, Config), Parent = self(), UnexpFun = fun(Msg,Peer) -> @@ -859,8 +859,8 @@ ms_passed(T0) -> %%-------------------------------------------------------------------- ssh_daemon_minimal_remote_max_packet_size_option(Config) -> - SystemDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + SystemDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), @@ -957,8 +957,8 @@ ssh_connect_negtimeout_sequential(Config) -> ssh_connect_negtimeout(Config,false ssh_connect_negtimeout(Config, Parallel) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), NegTimeOut = 2000, % ms ct:log("Parallel: ~p",[Parallel]), @@ -990,8 +990,8 @@ ssh_connect_nonegtimeout_connected_sequential(Config) -> ssh_connect_nonegtimeout_connected(Config, Parallel) -> process_flag(trap_exit, true), - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), NegTimeOut = 2000, % ms ct:log("Parallel: ~p",[Parallel]), @@ -1067,7 +1067,7 @@ connect_fun(ssh__connect, Config) -> fun(Host,Port) -> ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, - {user_dir, ?config(priv_dir,Config)}, + {user_dir, proplists:get_value(priv_dir,Config)}, {user_interaction, false}, {user, "carni"}, {password, "meat"} @@ -1092,8 +1092,8 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> ct:log("Connect(~p,~p) -> ~p",[Host,Port,R]), R end, - SystemDir = filename:join(?config(priv_dir, Config), system), - UserDir = ?config(priv_dir, Config), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), + UserDir = proplists:get_value(priv_dir, Config), MaxSessions = 5, {Pid, Host, Port} = ssh_test_lib:daemon([ {system_dir, SystemDir}, diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl index c5cc36c45e..c8aabcedb7 100644 --- a/lib/ssh/test/ssh_property_test_SUITE.erl +++ b/lib/ssh/test/ssh_property_test_SUITE.erl @@ -57,7 +57,7 @@ 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 + case proplists:get_value(property_test_tool,Config) of eqc -> Config; X -> {skip, lists:concat([X," is not supported"])} end; diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 57404f40db..41faf951e1 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -107,11 +107,11 @@ init_per_testcase(TC, Config) when TC == gex_client_init_option_groups ; gex_client_init_option_groups -> [{dh_gex_groups, [{2345, 3, 41}]}]; gex_client_init_option_groups_file -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), F = filename:join(DataDir, "dh_group_test"), [{dh_gex_groups, {file,F}}]; gex_client_init_option_groups_moduli_file -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), F = filename:join(DataDir, "dh_group_test.moduli"), [{dh_gex_groups, {ssh_moduli_file,F}}]; _ when TC == gex_server_gex_limit ; @@ -589,21 +589,21 @@ stop_apps(_Config) -> setup_dirs(Config) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_rsa(DataDir, PrivDir), Config. -system_dir(Config) -> filename:join(?config(priv_dir, Config), system). +system_dir(Config) -> filename:join(proplists:get_value(priv_dir, Config), system). -user_dir(Config) -> ?config(priv_dir, Config). +user_dir(Config) -> proplists:get_value(priv_dir, Config). %%%---------------------------------------------------------------- start_std_daemon(Config) -> start_std_daemon(Config, []). start_std_daemon(Config, ExtraOpts) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), UserPasswords = [{"user1","pwd1"}], diff --git a/lib/ssh/test/ssh_renegotiate_SUITE.erl b/lib/ssh/test/ssh_renegotiate_SUITE.erl index f1a909cbd0..300816276a 100644 --- a/lib/ssh/test/ssh_renegotiate_SUITE.erl +++ b/lib/ssh/test/ssh_renegotiate_SUITE.erl @@ -108,10 +108,10 @@ rekey(Config) -> rekey_limit() -> [{timetrap,{seconds,400}}]. rekey_limit(Config) -> - UserDir = ?config(priv_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), DataFile = filename:join(UserDir, "rekey.data"), - Algs = ?config(preferred_algorithms, Config), + Algs = proplists:get_value(preferred_algorithms, Config), {Pid, Host, Port} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0}, {preferred_algorithms,Algs}]), @@ -154,10 +154,10 @@ rekey_limit(Config) -> %%% Test rekeying with simulataneous send request renegotiate1(Config) -> - UserDir = ?config(priv_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), DataFile = filename:join(UserDir, "renegotiate1.data"), - Algs = ?config(preferred_algorithms, Config), + Algs = proplists:get_value(preferred_algorithms, Config), {Pid, Host, DPort} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0}, {preferred_algorithms,Algs}]), @@ -194,10 +194,10 @@ renegotiate1(Config) -> %%% Test rekeying with inflight messages from peer renegotiate2(Config) -> - UserDir = ?config(priv_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), DataFile = filename:join(UserDir, "renegotiate2.data"), - Algs = ?config(preferred_algorithms, Config), + Algs = proplists:get_value(preferred_algorithms, Config), {Pid, Host, DPort} = ssh_test_lib:std_daemon(Config,[{max_random_length_padding,0}, {preferred_algorithms,Algs}]), diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index 26fe0935e1..4d40b4647c 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -86,13 +86,14 @@ groups() -> write_file, write_file_iolist, write_big_file, sftp_read_big_file, rename_file, mk_rm_dir, remove_file, links, retrieve_attributes, set_attributes, async_read, - async_write, position, pos_read, pos_write + async_write, position, pos_read, pos_write, + start_channel_sock ]} ]. init_per_group(not_unicode, Config) -> ct:comment("Begin ~p",[grps(Config)]), - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), [{user, "Alladin"}, {passwd, "Sesame"}, {data, <<"Hello world!">>}, @@ -110,7 +111,7 @@ init_per_group(unicode, Config) -> of true -> ct:comment("Begin ~p",[grps(Config)]), - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), NewConfig = [{user, "åke高兴"}, {passwd, "ärlig日本じん"}, @@ -131,7 +132,7 @@ init_per_group(unicode, Config) -> ] ) ], - FN = fn(?config(tar_F1_txt,NewConfig), NewConfig), + FN = fn(proplists:get_value(tar_F1_txt,NewConfig), NewConfig), case catch file:read_file(FN) of {ok,FN_contents} -> ct:log("Readable file:read_file(~tp) ->~n~tp",[FN,FN_contents]), @@ -147,10 +148,10 @@ init_per_group(unicode, Config) -> init_per_group(erlang_server, Config) -> ct:comment("Begin ~p",[grps(Config)]), - PrivDir = ?config(priv_dir, Config), - SysDir = ?config(data_dir, Config), - User = ?config(user, Config), - Passwd = ?config(passwd, Config), + PrivDir = proplists:get_value(priv_dir, Config), + SysDir = proplists:get_value(data_dir, Config), + User = proplists:get_value(user, Config), + Passwd = proplists:get_value(passwd, Config), Sftpd = {_, HostX, PortX} = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, PrivDir}, @@ -176,12 +177,12 @@ init_per_group(openssh_server, Config) -> init_per_group(remote_tar, Config) -> ct:comment("Begin ~p",[grps(Config)]), - {Host,Port} = ?config(peer, Config), - ct:log("Server (~p) at ~p:~p",[?config(group,Config),Host,Port]), - User = ?config(user, Config), - Passwd = ?config(passwd, Config), + {Host,Port} = proplists:get_value(peer, Config), + ct:log("Server (~p) at ~p:~p",[proplists:get_value(group,Config),Host,Port]), + User = proplists:get_value(user, Config), + Passwd = proplists:get_value(passwd, Config), {ok, Connection} = - case ?config(group, Config) of + case proplists:get_value(group, Config) of erlang_server -> ssh:connect(Host, Port, [{user, User}, @@ -216,10 +217,10 @@ end_per_group(_, Config) -> %%-------------------------------------------------------------------- init_per_testcase(sftp_nonexistent_subsystem, Config) -> - PrivDir = ?config(priv_dir, Config), - SysDir = ?config(data_dir, Config), - User = ?config(user, Config), - Passwd = ?config(passwd, Config), + PrivDir = proplists:get_value(priv_dir, Config), + SysDir = proplists:get_value(data_dir, Config), + User = proplists:get_value(user, Config), + Passwd = proplists:get_value(passwd, Config), Sftpd = ssh_test_lib:daemon([{system_dir, SysDir}, {user_dir, PrivDir}, {subsystems, []}, @@ -233,9 +234,9 @@ init_per_testcase(version_option, Config0) -> TmpConfig0 = lists:keydelete(watchdog, 1, Config), TmpConfig = lists:keydelete(sftp, 1, TmpConfig0), Dog = ct:timetrap(?default_timeout), - {_,Host, Port} = ?config(sftpd, Config), - User = ?config(user, Config), - Passwd = ?config(passwd, Config), + {_,Host, Port} = proplists:get_value(sftpd, Config), + User = proplists:get_value(user, Config), + Passwd = proplists:get_value(passwd, Config), {ok, ChannelPid, Connection} = ssh_sftp:start_channel(Host, Port, [{sftp_vsn, 3}, @@ -251,13 +252,13 @@ init_per_testcase(Case, Config00) -> Config1 = lists:keydelete(watchdog, 1, Config0), Config2 = lists:keydelete(sftp, 1, Config1), Dog = ct:timetrap(2 * ?default_timeout), - User = ?config(user, Config0), - Passwd = ?config(passwd, Config0), + User = proplists:get_value(user, Config0), + Passwd = proplists:get_value(passwd, Config0), Config = - case ?config(group,Config2) of + case proplists:get_value(group,Config2) of erlang_server -> - {_,Host, Port} = ?config(sftpd, Config2), + {_,Host, Port} = proplists:get_value(sftpd, Config2), {ok, ChannelPid, Connection} = ssh_sftp:start_channel(Host, Port, [{user, User}, @@ -283,7 +284,7 @@ init_per_testcase(Case, Config00) -> %% The 'catch' is for the case of Config={skip,...} true -> %% Provide a ChannelPid independent of the sftp-channel already opened. - {ok,ChPid2} = ssh_sftp:start_channel(?config(connection,Config)), + {ok,ChPid2} = ssh_sftp:start_channel(proplists:get_value(connection,Config)), [{channel_pid2,ChPid2} | Config]; _ -> Config @@ -292,16 +293,16 @@ init_per_testcase(Case, Config00) -> end_per_testcase(sftp_nonexistent_subsystem, Config) -> Config; end_per_testcase(rename_file, Config) -> - NewFileName = ?config(testfile, Config), + NewFileName = proplists:get_value(testfile, Config), file:delete(NewFileName), end_per_testcase(Config); end_per_testcase(_, Config) -> end_per_testcase(Config). end_per_testcase(Config) -> - {Sftp, Connection} = ?config(sftp, Config), + {Sftp, Connection} = proplists:get_value(sftp, Config), ok = ssh_sftp:stop_channel(Sftp), - catch ssh_sftp:stop_channel(?config(channel_pid2, Config)), + catch ssh_sftp:stop_channel(proplists:get_value(channel_pid2, Config)), ok = ssh:close(Connection). %%-------------------------------------------------------------------- @@ -310,9 +311,9 @@ end_per_testcase(Config) -> open_close_file() -> [{doc, "Test API functions open/3 and close/2"}]. open_close_file(Config) when is_list(Config) -> - FileName = ?config(filename, Config), + FileName = proplists:get_value(filename, Config), - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = proplists:get_value(sftp, Config), ok = open_close_file(Sftp, FileName, [read]), ok = open_close_file(Sftp, FileName, [write]), @@ -329,9 +330,9 @@ open_close_file(Server, File, Mode) -> open_close_dir() -> [{doc, "Test API functions opendir/2 and close/2"}]. open_close_dir(Config) when is_list(Config) -> - PrivDir = ?config(sftp_priv_dir, Config), - {Sftp, _} = ?config(sftp, Config), - FileName = ?config(filename, Config), + PrivDir = proplists:get_value(sftp_priv_dir, Config), + {Sftp, _} = proplists:get_value(sftp, Config), + FileName = proplists:get_value(filename, Config), {ok, Handle} = ssh_sftp:opendir(Sftp, PrivDir), ok = ssh_sftp:close(Sftp, Handle), @@ -341,8 +342,8 @@ open_close_dir(Config) when is_list(Config) -> read_file() -> [{doc, "Test API funtion read_file/2"}]. read_file(Config) when is_list(Config) -> - FileName = ?config(filename, Config), - {Sftp, _} = ?config(sftp, Config), + FileName = proplists:get_value(filename, Config), + {Sftp, _} = proplists:get_value(sftp, Config), {ok, Data} = ssh_sftp:read_file(Sftp, FileName), {ok, Data} = ssh_sftp:read_file(Sftp, FileName), {ok, Data} = file:read_file(FileName). @@ -351,8 +352,8 @@ read_file(Config) when is_list(Config) -> read_dir() -> [{doc,"Test API function list_dir/2"}]. read_dir(Config) when is_list(Config) -> - PrivDir = ?config(sftp_priv_dir, Config), - {Sftp, _} = ?config(sftp, Config), + PrivDir = proplists:get_value(sftp_priv_dir, Config), + {Sftp, _} = proplists:get_value(sftp, Config), {ok, Files} = ssh_sftp:list_dir(Sftp, PrivDir), ct:log("sftp list dir: ~p~n", [Files]). @@ -360,8 +361,8 @@ read_dir(Config) when is_list(Config) -> write_file() -> [{doc, "Test API function write_file/2"}]. write_file(Config) when is_list(Config) -> - FileName = ?config(filename, Config), - {Sftp, _} = ?config(sftp, Config), + FileName = proplists:get_value(filename, Config), + {Sftp, _} = proplists:get_value(sftp, Config), Data = list_to_binary("Hej hopp!"), ok = ssh_sftp:write_file(Sftp, FileName, [Data]), @@ -371,8 +372,8 @@ write_file(Config) when is_list(Config) -> write_file_iolist() -> [{doc, "Test API function write_file/2 with iolists"}]. write_file_iolist(Config) when is_list(Config) -> - FileName = ?config(filename, Config), - {Sftp, _} = ?config(sftp, Config), + FileName = proplists:get_value(filename, Config), + {Sftp, _} = proplists:get_value(sftp, Config), Data = list_to_binary("Hej hopp!"), lists:foreach( @@ -392,8 +393,8 @@ write_file_iolist(Config) when is_list(Config) -> write_big_file() -> [{doc, "Test API function write_file/2 with big data"}]. write_big_file(Config) when is_list(Config) -> - FileName = ?config(filename, Config), - {Sftp, _} = ?config(sftp, Config), + FileName = proplists:get_value(filename, Config), + {Sftp, _} = proplists:get_value(sftp, Config), Data = list_to_binary(lists:duplicate(750000,"a")), ok = ssh_sftp:write_file(Sftp, FileName, [Data]), @@ -403,8 +404,8 @@ write_big_file(Config) when is_list(Config) -> sftp_read_big_file() -> [{doc, "Test API function read_file/2 with big data"}]. sftp_read_big_file(Config) when is_list(Config) -> - FileName = ?config(filename, Config), - {Sftp, _} = ?config(sftp, Config), + FileName = proplists:get_value(filename, Config), + {Sftp, _} = proplists:get_value(sftp, Config), Data = list_to_binary(lists:duplicate(750000,"a")), ct:log("Data size to write is ~p bytes",[size(Data)]), @@ -415,9 +416,9 @@ sftp_read_big_file(Config) when is_list(Config) -> remove_file() -> [{doc,"Test API function delete/2"}]. remove_file(Config) when is_list(Config) -> - PrivDir = ?config(sftp_priv_dir, Config), - FileName = ?config(filename, Config), - {Sftp, _} = ?config(sftp, Config), + PrivDir = proplists:get_value(sftp_priv_dir, Config), + FileName = proplists:get_value(filename, Config), + {Sftp, _} = proplists:get_value(sftp, Config), {ok, Files} = ssh_sftp:list_dir(Sftp, PrivDir), true = lists:member(filename:basename(FileName), Files), @@ -429,11 +430,11 @@ remove_file(Config) when is_list(Config) -> rename_file() -> [{doc, "Test API function rename_file/2"}]. rename_file(Config) when is_list(Config) -> - PrivDir = ?config(sftp_priv_dir, Config), - FileName = ?config(filename, Config), - NewFileName = ?config(testfile, Config), + PrivDir = proplists:get_value(sftp_priv_dir, Config), + FileName = proplists:get_value(filename, Config), + NewFileName = proplists:get_value(testfile, Config), - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = proplists:get_value(sftp, Config), {ok, Files} = ssh_sftp:list_dir(Sftp, PrivDir), ct:log("FileName: ~p, Files: ~p~n", [FileName, Files]), true = lists:member(filename:basename(FileName), Files), @@ -449,8 +450,8 @@ rename_file(Config) when is_list(Config) -> mk_rm_dir() -> [{doc,"Test API functions make_dir/2, del_dir/2"}]. mk_rm_dir(Config) when is_list(Config) -> - PrivDir = ?config(sftp_priv_dir, Config), - {Sftp, _} = ?config(sftp, Config), + PrivDir = proplists:get_value(sftp_priv_dir, Config), + {Sftp, _} = proplists:get_value(sftp, Config), DirName = filename:join(PrivDir, "test"), ok = ssh_sftp:make_dir(Sftp, DirName), @@ -467,9 +468,9 @@ links(Config) when is_list(Config) -> {win32, _} -> {skip, "Links are not fully supported by windows"}; _ -> - {Sftp, _} = ?config(sftp, Config), - FileName = ?config(filename, Config), - LinkFileName = ?config(linktest, Config), + {Sftp, _} = proplists:get_value(sftp, Config), + FileName = proplists:get_value(filename, Config), + LinkFileName = proplists:get_value(linktest, Config), ok = ssh_sftp:make_symlink(Sftp, LinkFileName, FileName), {ok, FileName} = ssh_sftp:read_link(Sftp, LinkFileName) @@ -479,9 +480,9 @@ links(Config) when is_list(Config) -> retrieve_attributes() -> [{doc, "Test API function read_file_info/3"}]. retrieve_attributes(Config) when is_list(Config) -> - FileName = ?config(filename, Config), + FileName = proplists:get_value(filename, Config), - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = proplists:get_value(sftp, Config), {ok, FileInfo} = ssh_sftp:read_file_info(Sftp, FileName), {ok, NewFileInfo} = file:read_file_info(FileName), @@ -492,9 +493,9 @@ retrieve_attributes(Config) when is_list(Config) -> set_attributes() -> [{doc,"Test API function write_file_info/3"}]. set_attributes(Config) when is_list(Config) -> - FileName = ?config(testfile, Config), + FileName = proplists:get_value(testfile, Config), - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = proplists:get_value(sftp, Config), {ok,Fd} = file:open(FileName, write), io:put_chars(Fd,"foo"), ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#400}), @@ -507,9 +508,9 @@ set_attributes(Config) when is_list(Config) -> async_read() -> [{doc,"Test API aread/3"}]. async_read(Config) when is_list(Config) -> - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = proplists:get_value(sftp, Config), - FileName = ?config(filename, Config), + FileName = proplists:get_value(filename, Config), {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read]), {async, Ref} = ssh_sftp:aread(Sftp, Handle, 20), @@ -526,8 +527,8 @@ async_read(Config) when is_list(Config) -> async_write() -> [{doc,"Test API awrite/3"}]. async_write(Config) when is_list(Config) -> - {Sftp, _} = ?config(sftp, Config), - FileName = ?config(testfile, Config), + {Sftp, _} = proplists:get_value(sftp, Config), + FileName = proplists:get_value(testfile, Config), {ok, Handle} = ssh_sftp:open(Sftp, FileName, [write]), Data = list_to_binary("foobar"), {async, Ref} = ssh_sftp:awrite(Sftp, Handle, Data), @@ -544,8 +545,8 @@ async_write(Config) when is_list(Config) -> position() -> [{doc, "Test API functions position/3"}]. position(Config) when is_list(Config) -> - FileName = ?config(testfile, Config), - {Sftp, _} = ?config(sftp, Config), + FileName = proplists:get_value(testfile, Config), + {Sftp, _} = proplists:get_value(sftp, Config), Data = list_to_binary("1234567890"), ok = ssh_sftp:write_file(Sftp, FileName, [Data]), @@ -573,8 +574,8 @@ position(Config) when is_list(Config) -> pos_read() -> [{doc,"Test API functions pread/3 and apread/3"}]. pos_read(Config) when is_list(Config) -> - FileName = ?config(testfile, Config), - {Sftp, _} = ?config(sftp, Config), + FileName = proplists:get_value(testfile, Config), + {Sftp, _} = proplists:get_value(sftp, Config), Data = list_to_binary("Hej hopp!"), ok = ssh_sftp:write_file(Sftp, FileName, [Data]), @@ -600,8 +601,8 @@ pos_read(Config) when is_list(Config) -> pos_write() -> [{doc,"Test API functions pwrite/4 and apwrite/4"}]. pos_write(Config) when is_list(Config) -> - FileName = ?config(testfile, Config), - {Sftp, _} = ?config(sftp, Config), + FileName = proplists:get_value(testfile, Config), + {Sftp, _} = proplists:get_value(sftp, Config), {ok, Handle} = ssh_sftp:open(Sftp, FileName, [write]), @@ -625,12 +626,64 @@ pos_write(Config) when is_list(Config) -> {ok, NewData1} = ssh_sftp:read_file(Sftp, FileName). %%-------------------------------------------------------------------- +start_channel_sock(Config) -> + LoginOpts = + case proplists:get_value(group,Config) of + erlang_server -> + [{user, proplists:get_value(user, Config)}, + {password, proplists:get_value(passwd, Config)}]; + openssh_server -> + [] % Use public key + end, + + Opts = [{user_interaction, false}, + {silently_accept_hosts, true} + | LoginOpts], + + {Host,Port} = proplists:get_value(peer, Config), + + %% Get a tcp socket + {ok, Sock} = gen_tcp:connect(Host, Port, [{active,false}]), + + %% and open one channel on one new Connection + {ok, ChPid1, Conn} = ssh_sftp:start_channel(Sock, Opts), + + %% Test that the channel is usable + FileName = proplists:get_value(filename, Config), + ok = open_close_file(ChPid1, FileName, [read]), + ok = open_close_file(ChPid1, FileName, [write]), + + %% Try to open a second channel on the Connection + {ok, ChPid2} = ssh_sftp:start_channel(Conn, Opts), + ok = open_close_file(ChPid1, FileName, [read]), + ok = open_close_file(ChPid2, FileName, [read]), + + %% Test that the second channel still works after closing the first one + ok = ssh_sftp:stop_channel(ChPid1), + ok = open_close_file(ChPid2, FileName, [write]), + + %% Test the Connection survives that all channels are closed + ok = ssh_sftp:stop_channel(ChPid2), + {ok, ChPid3} = ssh_sftp:start_channel(Conn, Opts), + ok = open_close_file(ChPid3, FileName, [write]), + + %% Test that a closed channel really is closed + {error, closed} = ssh_sftp:open(ChPid2, FileName, [write]), + ok = ssh_sftp:stop_channel(ChPid3), + + %% Test that the socket is closed when the Connection closes + ok = ssh:close(Conn), + {error,einval} = inet:getopts(Sock, [active]), + + ok. + +%%-------------------------------------------------------------------- sftp_nonexistent_subsystem() -> [{doc, "Try to execute sftp subsystem on a server that does not support it"}]. sftp_nonexistent_subsystem(Config) when is_list(Config) -> - {_,Host, Port} = ?config(sftpd, Config), - User = ?config(user, Config), - Passwd = ?config(passwd, Config), + {_,Host, Port} = proplists:get_value(sftpd, Config), + User = proplists:get_value(user, Config), + Passwd = proplists:get_value(passwd, Config), {error,"server failed to start sftp subsystem"} = ssh_sftp:start_channel(Host, Port, [{user_interaction, false}, @@ -646,20 +699,20 @@ version_option(Config) when is_list(Config) -> %%-------------------------------------------------------------------- create_empty_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), - TarFileName = ?config(tar_filename, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]), erl_tar:close(Handle), - {ChPid,_} = ?config(sftp,Config), + {ChPid,_} = proplists:get_value(sftp,Config), {ok, #file_info{type=regular}} = ssh_sftp:read_file_info(ChPid, TarFileName). %%-------------------------------------------------------------------- files_to_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), - TarFileName = ?config(tar_filename, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]), - F1 = ?config(tar_F1_txt, Config), + F1 = proplists:get_value(tar_F1_txt, Config), ok = erl_tar:add(Handle, fn(F1,Config), F1, [verbose]), ok = erl_tar:add(Handle, fn("f2.txt",Config), "f2.txt", [verbose]), ok = erl_tar:close(Handle), @@ -667,8 +720,8 @@ files_to_tar(Config) -> %%-------------------------------------------------------------------- ascii_filename_ascii_contents_to_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), - TarFileName = ?config(tar_filename, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]), ok = erl_tar:add(Handle, fn("f2.txt",Config), "f2.txt", [verbose]), ok = erl_tar:close(Handle), @@ -676,12 +729,12 @@ ascii_filename_ascii_contents_to_tar(Config) -> %%-------------------------------------------------------------------- ascii_filename_unicode_contents_to_tar(Config) -> - case ?config(tar_F3_txt, Config) of + case proplists:get_value(tar_F3_txt, Config) of undefined -> {skip, "Unicode test"}; Fn -> - ChPid2 = ?config(channel_pid2, Config), - TarFileName = ?config(tar_filename, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]), ok = erl_tar:add(Handle, fn(Fn,Config), Fn, [verbose]), ok = erl_tar:close(Handle), @@ -690,12 +743,12 @@ ascii_filename_unicode_contents_to_tar(Config) -> %%-------------------------------------------------------------------- unicode_filename_ascii_contents_to_tar(Config) -> - case ?config(tar_F4_txt, Config) of + case proplists:get_value(tar_F4_txt, Config) of undefined -> {skip, "Unicode test"}; Fn -> - ChPid2 = ?config(channel_pid2, Config), - TarFileName = ?config(tar_filename, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]), ok = erl_tar:add(Handle, fn(Fn,Config), Fn, [verbose]), ok = erl_tar:close(Handle), @@ -704,8 +757,8 @@ unicode_filename_ascii_contents_to_tar(Config) -> %%-------------------------------------------------------------------- big_file_to_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), - TarFileName = ?config(tar_filename, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]), ok = erl_tar:add(Handle, fn("big.txt",Config), "big.txt", [verbose]), ok = erl_tar:close(Handle), @@ -714,18 +767,18 @@ big_file_to_tar(Config) -> %%-------------------------------------------------------------------- files_chunked_to_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), - TarFileName = ?config(tar_filename, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]), - F1 = ?config(tar_F1_txt, Config), + F1 = proplists:get_value(tar_F1_txt, Config), ok = erl_tar:add(Handle, fn(F1,Config), F1, [verbose,{chunks,2}]), ok = erl_tar:close(Handle), chk_tar([F1], Config). %%-------------------------------------------------------------------- directory_to_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), - TarFileName = ?config(tar_filename, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]), ok = erl_tar:add(Handle, fn("d1",Config), "d1", [verbose]), ok = erl_tar:close(Handle), @@ -733,8 +786,8 @@ directory_to_tar(Config) -> %%-------------------------------------------------------------------- binaries_to_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), - TarFileName = ?config(tar_filename, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]), Bin = <<"A binary">>, ok = erl_tar:add(Handle, Bin, "b1", [verbose]), @@ -743,15 +796,15 @@ binaries_to_tar(Config) -> %%-------------------------------------------------------------------- null_crypto_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), Cinit = fun() -> {ok, no_state, _SendSize=5} end, Cenc = fun(Bin,CState) -> {ok,Bin,CState,_SendSize=5} end, Cend = fun(Bin,_CState) -> {ok,Bin} end, C = {Cinit,Cenc,Cend}, - TarFileName = ?config(tar_filename, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write,{crypto,C}]), Bin = <<"A binary">>, - F1 = ?config(tar_F1_txt, Config), + F1 = proplists:get_value(tar_F1_txt, Config), ok = erl_tar:add(Handle, Bin, "b1", [verbose]), ok = erl_tar:add(Handle, fn(F1,Config), F1, [verbose,{chunks,2}]), ok = erl_tar:add(Handle, fn("big.txt",Config), "big.txt", [verbose,{chunks,15000}]), @@ -760,16 +813,16 @@ null_crypto_tar(Config) -> %%-------------------------------------------------------------------- simple_crypto_tar_small(Config) -> - ChPid2 = ?config(channel_pid2, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), Cinit = fun() -> {ok, no_state, _Size=6} end, Cenc = fun(Bin,CState) -> {ok,stuff(Bin),CState,_SendSize=5} end, Cdec = fun(Bin,CState) -> {ok,unstuff(Bin),CState,_Size=4} end, Cend = fun(Bin,_CState) -> {ok,stuff(Bin)} end, C = {Cinit,Cenc,Cend}, - TarFileName = ?config(tar_filename, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write,{crypto,C}]), Bin = <<"A binary">>, - F1 = ?config(tar_F1_txt, Config), + F1 = proplists:get_value(tar_F1_txt, Config), ok = erl_tar:add(Handle, Bin, "b1", [verbose]), ok = erl_tar:add(Handle, fn(F1,Config), F1, [verbose,{chunks,2}]), ok = erl_tar:close(Handle), @@ -777,16 +830,16 @@ simple_crypto_tar_small(Config) -> %%-------------------------------------------------------------------- simple_crypto_tar_big(Config) -> - ChPid2 = ?config(channel_pid2, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), Cinit = fun() -> {ok, no_state, _SendSize=6} end, Cenc = fun(Bin,CState) -> {ok,stuff(Bin),CState,_SendSize=5} end, Cdec = fun(Bin,CState) -> {ok,unstuff(Bin),CState,_SendSize=4} end, Cend = fun(Bin,_CState) -> {ok,stuff(Bin)} end, C = {Cinit,Cenc,Cend}, - TarFileName = ?config(tar_filename, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write,{crypto,C}]), Bin = <<"A binary">>, - F1 = ?config(tar_F1_txt, Config), + F1 = proplists:get_value(tar_F1_txt, Config), ok = erl_tar:add(Handle, Bin, "b1", [verbose]), ok = erl_tar:add(Handle, fn(F1,Config), F1, [verbose,{chunks,2}]), ok = erl_tar:add(Handle, fn("big.txt",Config), "big.txt", [verbose,{chunks,15000}]), @@ -799,12 +852,12 @@ unstuff(Bin) -> << <<C>> || <<C,C>> <= Bin >>. %%-------------------------------------------------------------------- read_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), NameBins = lists:sort( [{"b1",<<"A binary">>}, {"b2",list_to_binary(lists:duplicate(750000,"a"))} ]), - TarFileName = ?config(tar_filename, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,HandleWrite} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]), [ok = erl_tar:add(HandleWrite, Bin, Name, [verbose]) || {Name,Bin} <- NameBins], @@ -814,7 +867,7 @@ read_tar(Config) -> %%-------------------------------------------------------------------- read_null_crypto_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), NameBins = lists:sort( [{"b1",<<"A binary">>}, {"b2",list_to_binary(lists:duplicate(750000,"a"))} @@ -827,7 +880,7 @@ read_null_crypto_tar(Config) -> Cw = {Cinitw,Cenc,Cendw}, Cr = {Cinitr,Cdec}, - TarFileName = ?config(tar_filename, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,HandleWrite} = ssh_sftp:open_tar(ChPid2, TarFileName, [write,{crypto,Cw}]), [ok = erl_tar:add(HandleWrite, Bin, Name, [verbose]) || {Name,Bin} <- NameBins], @@ -837,7 +890,7 @@ read_null_crypto_tar(Config) -> %%-------------------------------------------------------------------- read_crypto_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), NameBins = lists:sort( [{"b1",<<"A binary">>}, {"b2",list_to_binary(lists:duplicate(750000,"a"))} @@ -851,7 +904,7 @@ read_crypto_tar(Config) -> Cw = {Cinitw,Cenc,Cendw}, Cr = {Cinitr,Cdec}, - TarFileName = ?config(tar_filename, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,HandleWrite} = ssh_sftp:open_tar(ChPid2, TarFileName, [write,{crypto,Cw}]), [ok = erl_tar:add(HandleWrite, Bin, Name, [verbose]) || {Name,Bin} <- NameBins], @@ -861,7 +914,7 @@ read_crypto_tar(Config) -> %%-------------------------------------------------------------------- aes_cbc256_crypto_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), NameBins = lists:sort( [{"b1",<<"A binary">>}, {"b2",list_to_binary(lists:duplicate(750000,"a"))}, @@ -891,7 +944,7 @@ aes_cbc256_crypto_tar(Config) -> end, Cw = {Cinitw,Cenc,Cendw}, - TarFileName = ?config(tar_filename, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,HandleWrite} = ssh_sftp:open_tar(ChPid2, TarFileName, [write,{crypto,Cw}]), [ok = erl_tar:add(HandleWrite, Bin, Name, [verbose]) || {Name,Bin} <- NameBins], ok = erl_tar:close(HandleWrite), @@ -906,7 +959,7 @@ pad(BlockSize, Bin) -> %%-------------------------------------------------------------------- aes_ctr_stream_crypto_tar(Config) -> - ChPid2 = ?config(channel_pid2, Config), + ChPid2 = proplists:get_value(channel_pid2, Config), NameBins = lists:sort( [{"b1",<<"A binary">>}, {"b2",list_to_binary(lists:duplicate(750000,"a"))}, @@ -934,7 +987,7 @@ aes_ctr_stream_crypto_tar(Config) -> end, Cw = {Cinitw,Cenc,Cendw}, - TarFileName = ?config(tar_filename, Config), + TarFileName = proplists:get_value(tar_filename, Config), {ok,HandleWrite} = ssh_sftp:open_tar(ChPid2, TarFileName, [write,{crypto,Cw}]), [ok = erl_tar:add(HandleWrite, Bin, Name, [verbose]) || {Name,Bin} <- NameBins], ok = erl_tar:close(HandleWrite), @@ -946,11 +999,11 @@ aes_ctr_stream_crypto_tar(Config) -> %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- oldprep(Config) -> - DataDir = ?config(data_dir, Config), - TestFile = ?config(filename, Config), - TestFile1 = ?config(testfile, Config), - TestLink = ?config(linktest, Config), - TarFileName = ?config(tar_filename, Config), + DataDir = proplists:get_value(data_dir, Config), + TestFile = proplists:get_value(filename, Config), + TestFile1 = proplists:get_value(testfile, Config), + TestLink = proplists:get_value(linktest, Config), + TarFileName = proplists:get_value(tar_filename, Config), file:delete(TestFile), file:delete(TestFile1), @@ -999,12 +1052,12 @@ chk_tar(Items, Config) -> chk_tar(Items, Config, []). chk_tar(Items, Config, Opts) -> - TarFileName = ?config(tar_filename, Config), + TarFileName = proplists:get_value(tar_filename, Config), chk_tar(Items, TarFileName, Config, Opts). chk_tar(Items, TarFileName, Config, Opts) when is_list(Opts) -> tar_size(TarFileName, Config), - {ChPid,_} = ?config(sftp,Config), + {ChPid,_} = proplists:get_value(sftp,Config), {ok,HandleRead} = ssh_sftp:open_tar(ChPid, TarFileName, [read|Opts]), {ok,NameValueList} = erl_tar:extract(HandleRead,[memory,verbose]), ok = erl_tar:close(HandleRead), @@ -1046,7 +1099,7 @@ analyze_report([], []) -> "". tar_size(TarFileName, Config) -> - {ChPid,_} = ?config(sftp,Config), + {ChPid,_} = proplists:get_value(sftp,Config), {ok,Data} = ssh_sftp:read_file(ChPid, TarFileName), io:format('Tar file ~p is~n ~p bytes.~n',[TarFileName, size(Data)]). @@ -1073,7 +1126,7 @@ read_item_contents(ItemName, FileName) -> end. fn(Name, Config) -> - Dir = ?config(datadir_tar, Config), + Dir = proplists:get_value(datadir_tar, Config), filename:join(Dir,Name). fmt_host({A,B,C,D}) -> lists:concat([A,".",B,".",C,".",D]); diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index 9385bd127d..4a69fd36b3 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -72,19 +72,19 @@ groups() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_dsa(DataDir, PrivDir), %% to make sure we don't use public-key-auth %% this should be tested by other test suites - UserDir = filename:join(?config(priv_dir, Config), nopubkey), + UserDir = filename:join(proplists:get_value(priv_dir, Config), nopubkey), file:make_dir(UserDir), Config. end_per_suite(Config) -> - SysDir = ?config(priv_dir, Config), + SysDir = proplists:get_value(priv_dir, Config), ssh_test_lib:clean_dsa(SysDir), - UserDir = filename:join(?config(priv_dir, Config), nopubkey), + UserDir = filename:join(proplists:get_value(priv_dir, Config), nopubkey), file:del_dir(UserDir), ssh:stop(). @@ -101,9 +101,9 @@ end_per_group(_GroupName, Config) -> init_per_testcase(TestCase, Config) -> ssh:start(), prep(Config), - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), ClientUserDir = filename:join(PrivDir, nopubkey), - SystemDir = filename:join(?config(priv_dir, Config), system), + SystemDir = filename:join(proplists:get_value(priv_dir, Config), system), Options = [{system_dir, SystemDir}, {user_dir, PrivDir}, @@ -154,8 +154,8 @@ init_per_testcase(TestCase, Config) -> [{sftp, {Cm, Channel}}, {sftpd, Sftpd }| Config]. end_per_testcase(_TestCase, Config) -> - ssh_sftpd:stop(?config(sftpd, Config)), - {Cm, Channel} = ?config(sftp, Config), + ssh_sftpd:stop(proplists:get_value(sftpd, Config)), + {Cm, Channel} = proplists:get_value(sftp, Config), ssh_connection:close(Cm, Channel), ssh:close(Cm), ssh:stop(). @@ -166,9 +166,9 @@ end_per_testcase(_TestCase, Config) -> open_close_file() -> [{doc, "Test SSH_FXP_OPEN and SSH_FXP_CLOSE commands"}]. open_close_file(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), - {Cm, Channel} = ?config(sftp, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), ReqId = 0, {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = @@ -196,9 +196,9 @@ open_close_file(Config) when is_list(Config) -> ver3_open_flags() -> [{doc, "Test open flags"}]. ver3_open_flags(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileName = filename:join(PrivDir, "not_exist.txt"), - {Cm, Channel} = ?config(sftp, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), ReqId = 0, {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = @@ -230,8 +230,8 @@ ver3_open_flags(Config) when is_list(Config) -> open_close_dir() -> [{doc,"Test SSH_FXP_OPENDIR and SSH_FXP_CLOSE commands"}]. open_close_dir(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), - {Cm, Channel} = ?config(sftp, Config), + PrivDir = proplists:get_value(priv_dir, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), FileName = filename:join(PrivDir, "test.txt"), ReqId = 0, @@ -257,11 +257,11 @@ open_close_dir(Config) when is_list(Config) -> read_file() -> [{doc, "Test SSH_FXP_READ command"}]. read_file(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), ReqId = 0, - {Cm, Channel} = ?config(sftp, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = open_file(FileName, Cm, Channel, ReqId, @@ -280,8 +280,8 @@ read_file(Config) when is_list(Config) -> read_dir() -> [{doc,"Test SSH_FXP_READDIR command"}]. read_dir(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), - {Cm, Channel} = ?config(sftp, Config), + PrivDir = proplists:get_value(priv_dir, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), ReqId = 0, {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = open_dir(PrivDir, Cm, Channel, ReqId), @@ -291,11 +291,11 @@ read_dir(Config) when is_list(Config) -> write_file() -> [{doc, "Test SSH_FXP_WRITE command"}]. write_file(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), ReqId = 0, - {Cm, Channel} = ?config(sftp, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = open_file(FileName, Cm, Channel, ReqId, @@ -315,10 +315,10 @@ write_file(Config) when is_list(Config) -> remove_file() -> [{doc, "Test SSH_FXP_REMOVE command"}]. remove_file(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), ReqId = 0, - {Cm, Channel} = ?config(sftp, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), ?UINT32(?SSH_FX_OK), _/binary>>, _} = @@ -336,11 +336,11 @@ remove_file(Config) when is_list(Config) -> rename_file() -> [{doc, "Test SSH_FXP_RENAME command"}]. rename_file(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), NewFileName = filename:join(PrivDir, "test1.txt"), ReqId = 0, - {Cm, Channel} = ?config(sftp, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), ?UINT32(?SSH_FX_OK), _/binary>>, _} = @@ -373,8 +373,8 @@ rename_file(Config) when is_list(Config) -> mk_rm_dir() -> [{doc, "Test SSH_FXP_MKDIR and SSH_FXP_RMDIR command"}]. mk_rm_dir(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), - {Cm, Channel} = ?config(sftp, Config), + PrivDir = proplists:get_value(priv_dir, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), DirName = filename:join(PrivDir, "test"), ReqId = 0, {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), ?UINT32(?SSH_FX_OK), @@ -401,8 +401,8 @@ real_path(Config) when is_list(Config) -> {skip, "Not a relevant test on windows"}; _ -> ReqId = 0, - {Cm, Channel} = ?config(sftp, Config), - PrivDir = ?config(priv_dir, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), + PrivDir = proplists:get_value(priv_dir, Config), TestDir = filename:join(PrivDir, "ssh_test"), ok = file:make_dir(TestDir), @@ -427,8 +427,8 @@ links(Config) when is_list(Config) -> {skip, "Links are not fully supported by windows"}; _ -> ReqId = 0, - {Cm, Channel} = ?config(sftp, Config), - PrivDir = ?config(priv_dir, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), LinkFileName = filename:join(PrivDir, "link_test.txt"), @@ -451,10 +451,10 @@ links(Config) when is_list(Config) -> retrieve_attributes() -> [{"Test SSH_FXP_STAT, SSH_FXP_LSTAT AND SSH_FXP_FSTAT commands"}]. retrieve_attributes(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), ReqId = 0, - {Cm, Channel} = ?config(sftp, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), {ok, FileInfo} = file:read_file_info(FileName), @@ -520,10 +520,10 @@ set_attributes(Config) when is_list(Config) -> {win32, _} -> {skip, "Known error bug in erts file:read_file_info"}; _ -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), ReqId = 0, - {Cm, Channel} = ?config(sftp, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), {ok, FileInfo} = file:read_file_info(FileName), @@ -574,11 +574,11 @@ set_attributes(Config) when is_list(Config) -> ver3_rename() -> [{doc, "Test that ver3 rename message is handled OTP 6352"}]. ver3_rename(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), NewFileName = filename:join(PrivDir, "test1.txt"), ReqId = 0, - {Cm, Channel} = ?config(sftp, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), ?UINT32(?SSH_FX_OK), _/binary>>, _} = @@ -589,7 +589,7 @@ relpath() -> [{doc, "Check that realpath works ok seq10670"}]. relpath(Config) when is_list(Config) -> ReqId = 0, - {Cm, Channel} = ?config(sftp, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), case os:type() of {win32, _} -> @@ -611,11 +611,11 @@ relpath(Config) when is_list(Config) -> sshd_read_file() -> [{doc,"Test SSH_FXP_READ command, using sshd-server"}]. sshd_read_file(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), ReqId = 0, - {Cm, Channel} = ?config(sftp, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = open_file(FileName, Cm, Channel, ReqId, @@ -633,9 +633,9 @@ sshd_read_file(Config) when is_list(Config) -> ver6_basic() -> [{doc, "Test SFTP Version 6"}]. ver6_basic(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), %FileName = filename:join(PrivDir, "test.txt"), - {Cm, Channel} = ?config(sftp, Config), + {Cm, Channel} = proplists:get_value(sftp, Config), ReqId = 0, {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), % Ver 6 we have 5 ?UINT32(?SSH_FX_FILE_IS_A_DIRECTORY), _/binary>>, _} = @@ -646,7 +646,7 @@ ver6_basic(Config) when is_list(Config) -> %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- prep(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), TestFile = filename:join(PrivDir, "test.txt"), TestFile1 = filename:join(PrivDir, "test1.txt"), @@ -654,7 +654,7 @@ prep(Config) -> file:delete(TestFile1), %% Initial config - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), FileName = filename:join(DataDir, "test.txt"), file:copy(FileName, TestFile), Mode = 8#00400 bor 8#00200 bor 8#00040, % read & write owner, read group diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl index 355ce6a8f5..75b5090c2b 100644 --- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl @@ -54,8 +54,8 @@ groups() -> init_per_suite(Config) -> catch ssh:stop(), - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileAlt = filename:join(DataDir, "ssh_sftpd_file_alt.erl"), c:c(FileAlt), FileName = filename:join(DataDir, "test.txt"), @@ -66,9 +66,9 @@ init_per_suite(Config) -> Config. end_per_suite(Config) -> - UserDir = filename:join(?config(priv_dir, Config), nopubkey), + UserDir = filename:join(proplists:get_value(priv_dir, Config), nopubkey), file:del_dir(UserDir), - SysDir = ?config(priv_dir, Config), + SysDir = proplists:get_value(priv_dir, Config), ssh_test_lib:clean_dsa(SysDir), ok. @@ -83,7 +83,7 @@ end_per_group(_GroupName, Config) -> init_per_testcase(TestCase, Config) -> ssh:start(), - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), SystemDir = filename:join(PrivDir, system), Options = @@ -96,7 +96,7 @@ init_per_testcase(TestCase, Config) -> {user_dir, PrivDir}, {subsystems, [Spec]}]; "root_dir" -> - Privdir = ?config(priv_dir, Config), + Privdir = proplists:get_value(priv_dir, Config), Root = filename:join(Privdir, root), file:make_dir(Root), Spec = ssh_sftpd:subsystem_spec([{root,Root}]), @@ -132,8 +132,8 @@ init_per_testcase(TestCase, Config) -> [{port, Port}, {sftp, {ChannelPid, Connection}}, {sftpd, Sftpd} | NewConfig]. end_per_testcase(_TestCase, Config) -> - catch ssh_sftpd:stop(?config(sftpd, Config)), - {Sftp, Connection} = ?config(sftp, Config), + catch ssh_sftpd:stop(proplists:get_value(sftpd, Config)), + {Sftp, Connection} = proplists:get_value(sftp, Config), catch ssh_sftp:stop_channel(Sftp), catch ssh:close(Connection), ssh:stop(). @@ -146,10 +146,10 @@ close_file() -> "transfer OTP-6350"}]. close_file(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), FileName = filename:join(DataDir, "test.txt"), - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = proplists:get_value(sftp, Config), NumOfPorts = length(erlang:ports()), @@ -167,12 +167,12 @@ quit() -> "client hanging. OTP-6349"}]. quit(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), FileName = filename:join(DataDir, "test.txt"), - UserDir = ?config(priv_dir, Config), - Port = ?config(port, Config), + UserDir = proplists:get_value(priv_dir, Config), + Port = proplists:get_value(port, Config), - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = proplists:get_value(sftp, Config), {ok, <<_/binary>>} = ssh_sftp:read_file(Sftp, FileName), @@ -198,13 +198,13 @@ file_cb() -> " the sftpds filehandling. OTP-6356"}]. file_cb(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FileName = filename:join(DataDir, "test.txt"), register(sftpd_file_alt_tester, self()), - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = proplists:get_value(sftp, Config), {ok, Bin} = ssh_sftp:read_file(Sftp, FileName), alt_file_handler_check(alt_open), @@ -242,7 +242,7 @@ file_cb(Config) when is_list(Config) -> %%-------------------------------------------------------------------- root_dir(Config) when is_list(Config) -> - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = proplists:get_value(sftp, Config), FileName = "test.txt", Bin = <<"Test file for root dir option">>, ok = ssh_sftp:write_file(Sftp, FileName, Bin), @@ -253,7 +253,7 @@ root_dir(Config) when is_list(Config) -> %%-------------------------------------------------------------------- list_dir_limited(Config) when is_list(Config) -> - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = proplists:get_value(sftp, Config), {ok, Listing} = ssh_sftp:list_dir(Sftp, "."), ct:log("Listing: ~p~n", [Listing]). @@ -262,9 +262,9 @@ list_dir_limited(Config) when is_list(Config) -> ver6_basic() -> [{doc, "Test some version 6 features"}]. ver6_basic(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), NewDir = filename:join(PrivDir, "testdir2"), - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = proplists:get_value(sftp, Config), ok = ssh_sftp:make_dir(Sftp, NewDir), %%Test file_is_a_directory {error, file_is_a_directory} = ssh_sftp:delete(Sftp, NewDir). diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl index f8929b30ff..574564f6e9 100644 --- a/lib/ssh/test/ssh_sup_SUITE.erl +++ b/lib/ssh/test/ssh_sup_SUITE.erl @@ -54,7 +54,7 @@ end_per_group(_GroupName, Config) -> init_per_suite(Config) -> Port = ssh_test_lib:inet_port(node()), - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), [{userdir, UserDir},{port, Port}, {host, "localhost"}, {host_ip, any} | Config]. @@ -64,7 +64,7 @@ end_per_suite(_) -> init_per_testcase(sshc_subtree, Config) -> ssh:start(), - SystemDir = ?config(data_dir, Config), + SystemDir = proplists:get_value(data_dir, Config), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {failfun, fun ssh_test_lib:failfun/2}, {user_passwords, @@ -75,7 +75,7 @@ init_per_testcase(Case, Config) -> ssh:start(), Config. end_per_testcase(sshc_subtree, Config) -> - {Pid,_,_} = ?config(server, Config), + {Pid,_,_} = proplists:get_value(server, Config), ssh:stop_daemon(Pid), ssh:stop(); end_per_testcase(_, _Config) -> @@ -100,8 +100,8 @@ default_tree(Config) when is_list(Config) -> sshc_subtree() -> [{doc, "Make sure the sshc subtree is correct"}]. sshc_subtree(Config) when is_list(Config) -> - {_Pid, Host, Port} = ?config(server, Config), - UserDir = ?config(userdir, Config), + {_Pid, Host, Port} = proplists:get_value(server, Config), + UserDir = proplists:get_value(userdir, Config), ?wait_match([], supervisor:which_children(sshc_sup)), @@ -128,9 +128,9 @@ sshc_subtree(Config) when is_list(Config) -> sshd_subtree() -> [{doc, "Make sure the sshd subtree is correct"}]. sshd_subtree(Config) when is_list(Config) -> - HostIP = ?config(host_ip, Config), - Port = ?config(port, Config), - SystemDir = ?config(data_dir, Config), + HostIP = proplists:get_value(host_ip, Config), + Port = proplists:get_value(port, Config), + SystemDir = proplists:get_value(data_dir, Config), ssh:daemon(HostIP, Port, [{system_dir, SystemDir}, {failfun, fun ssh_test_lib:failfun/2}, {user_passwords, @@ -149,10 +149,10 @@ sshd_subtree(Config) when is_list(Config) -> sshd_subtree_profile() -> [{doc, "Make sure the sshd subtree using profile option is correct"}]. sshd_subtree_profile(Config) when is_list(Config) -> - HostIP = ?config(host_ip, Config), - Port = ?config(port, Config), - Profile = ?config(profile, Config), - SystemDir = ?config(data_dir, Config), + HostIP = proplists:get_value(host_ip, Config), + Port = proplists:get_value(port, Config), + Profile = proplists:get_value(profile, Config), + SystemDir = proplists:get_value(data_dir, Config), {ok, _} = ssh:daemon(HostIP, Port, [{system_dir, SystemDir}, {failfun, fun ssh_test_lib:failfun/2}, @@ -171,9 +171,9 @@ sshd_subtree_profile(Config) when is_list(Config) -> check_sshd_system_tree(Daemon, Config) -> - Host = ?config(host, Config), - Port = ?config(port, Config), - UserDir = ?config(userdir, Config), + Host = proplists:get_value(host, Config), + Port = proplists:get_value(port, Config), + UserDir = proplists:get_value(userdir, Config), {ok, Client} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, {user_interaction, false}, {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index a1291146e4..6233680dce 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -71,7 +71,7 @@ daemon_port(Port, _) -> Port. std_daemon(Config, ExtraOpts) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth file:make_dir(UserDir), std_daemon1(Config, @@ -80,13 +80,13 @@ std_daemon(Config, ExtraOpts) -> {user_passwords, [{"usr1","pwd1"}]}]). std_daemon1(Config, ExtraOpts) -> - SystemDir = ?config(data_dir, Config), + SystemDir = proplists:get_value(data_dir, Config), {_Server, _Host, _Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {failfun, fun ssh_test_lib:failfun/2} | ExtraOpts]). std_connect(Config, Host, Port, ExtraOpts) -> - UserDir = ?config(priv_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), _ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, {user_dir, UserDir}, @@ -99,7 +99,7 @@ std_simple_sftp(Host, Port, Config) -> std_simple_sftp(Host, Port, Config, []). std_simple_sftp(Host, Port, Config, Opts) -> - UserDir = ?config(priv_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), DataFile = filename:join(UserDir, "test.data"), ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, Opts), {ok, ChannelRef} = ssh_sftp:start_channel(ConnectionRef), diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 2be75fd7f3..f96a2cc62b 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -73,8 +73,8 @@ end_per_suite(_Config) -> ok. init_per_group(erlang_server, Config) -> - DataDir = ?config(data_dir, Config), - UserDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), ssh_test_lib:setup_dsa_known_host(DataDir, UserDir), ssh_test_lib:setup_rsa_known_host(DataDir, UserDir), Config; @@ -87,7 +87,7 @@ init_per_group(_, Config) -> Config. end_per_group(erlang_server, Config) -> - UserDir = ?config(priv_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), ssh_test_lib:clean_dsa(UserDir), ssh_test_lib:clean_rsa(UserDir), Config; @@ -222,7 +222,7 @@ erlang_client_openssh_server_kexs() -> [{doc, "Test that we can connect with different KEXs."}]. erlang_client_openssh_server_kexs(Config) when is_list(Config) -> - KexAlgos = try proplists:get_value(kex, ?config(common_algs,Config)) + KexAlgos = try proplists:get_value(kex, proplists:get_value(common_algs,Config)) catch _:_ -> [] end, comment(KexAlgos), @@ -366,8 +366,8 @@ erlang_server_openssh_client_public_key_rsa(Config) when is_list(Config) -> erlang_server_openssh_client_public_key_X(Config, PubKeyAlg) -> - SystemDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + SystemDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), KnownHosts = filename:join(PrivDir, "known_hosts"), {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {public_key_alg, PubKeyAlg}, @@ -387,7 +387,7 @@ erlang_client_openssh_server_password() -> [{doc, "Test client password option"}]. erlang_client_openssh_server_password(Config) when is_list(Config) -> %% to make sure we don't public-key-auth - UserDir = ?config(data_dir, Config), + UserDir = proplists:get_value(data_dir, Config), {error, Reason0} = ssh:connect(any, ?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, {user, "foo"}, diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl index 06bef2455e..9d9b2b78fb 100644 --- a/lib/ssh/test/ssh_upgrade_SUITE.erl +++ b/lib/ssh/test/ssh_upgrade_SUITE.erl @@ -59,7 +59,7 @@ init_per_suite(Config0) -> end_per_suite(Config) -> ct_release_test:cleanup(Config), ssh:stop(), - UserDir = ?config(priv_dir, Config), + UserDir = proplists:get_value(priv_dir, Config), ssh_test_lib:clean_rsa(UserDir). init_per_testcase(_TestCase, Config) -> @@ -138,8 +138,8 @@ test_soft(State0, FileName) -> setup_server_client(#state{config=Config} = State) -> - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), FtpRootDir = filename:join(PrivDir, "ftp_root"), catch file:make_dir(FtpRootDir), diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml index 7c00b4eae2..495e02d271 100644 --- a/lib/ssl/doc/src/ssl_distribution.xml +++ b/lib/ssl/doc/src/ssl_distribution.xml @@ -196,6 +196,9 @@ Eshell V5.0 (abort with ^G) <item><c>password</c></item> <item><c>cacertfile</c></item> <item><c>verify</c></item> + <item><c>verify_fun</c> (write as <c>{Module, Function, InitialUserState}</c>)</item> + <item><c>crl_check</c></item> + <item><c>crl_cache</c> (write as Erlang term)</item> <item><c>reuse_sessions</c></item> <item><c>secure_renegotiate</c></item> <item><c>depth</c></item> @@ -203,6 +206,10 @@ Eshell V5.0 (abort with ^G) <item><c>ciphers</c> (use old string format)</item> </list> + <p>Note that <c>verify_fun</c> needs to be written in a different + form than the corresponding SSL option, since funs are not + accepted on the command line.</p> + <p>The server can also take the options <c>dhfile</c> and <c>fail_if_no_peer_cert</c> (also prefixed).</p> @@ -210,10 +217,6 @@ Eshell V5.0 (abort with ^G) initiates a connection to another node. <c>server_</c>-prefixed options are used when accepting a connection from a remote node.</p> - <p>More complex options, such as <c>verify_fun</c>, are currently not - available, but a mechanism to handle such options may be added in - a future release.</p> - <p>Raw socket options, such as <c>packet</c> and <c>size</c> must not be specified on the command line.</p> diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 1a2bf90ccf..937a3b1bd1 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -54,7 +54,7 @@ {applications, [crypto, public_key, kernel, stdlib]}, {env, []}, {mod, {ssl_app, []}}, - {runtime_dependencies, ["stdlib-2.0","public_key-1.0","kernel-3.0", + {runtime_dependencies, ["stdlib-3.0","public_key-1.0","kernel-3.0", "erts-7.0","crypto-3.3", "inets-5.10.7"]}]}. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 5dc2e583a5..33d5c1c6d6 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -97,7 +97,7 @@ connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions, infinity). connect(Socket, SslOptions0, Timeout) when is_port(Socket), - (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0, {gen_tcp, tcp, tcp_closed, tcp_error}), EmulatedOptions = ssl_socket:emulated_options(), @@ -123,7 +123,7 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket), connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). -connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> +connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> try handle_options(Options, client) of {ok, Config} -> do_connect(Host,Port,Config,Timeout) @@ -173,7 +173,7 @@ transport_accept(#sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_, _} =CbInfo, connection_cb = ConnectionCb, ssl = SslOpts, - emulated = Tracker}}}, Timeout) when (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> + emulated = Tracker}}}, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> case Transport:accept(ListenSocket, Timeout) of {ok, Socket} -> {ok, EmOpts} = ssl_socket:get_emulated_opts(Tracker), @@ -206,25 +206,25 @@ transport_accept(#sslsocket{pid = {ListenSocket, ssl_accept(ListenSocket) -> ssl_accept(ListenSocket, infinity). -ssl_accept(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> +ssl_accept(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:handshake(Socket, Timeout); - -ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> + +ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(ListenSocket, SslOptions, infinity). -ssl_accept(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity)-> +ssl_accept(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> ssl_accept(#sslsocket{} = Socket, Timeout); -ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts0, Timeout) when - (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity)-> - try - {ok, EmOpts, InheritedSslOpts} = ssl_socket:get_all_opts(Tracker), +ssl_accept(#sslsocket{fd = {_, _, _, Tracker}} = Socket, SslOpts0, Timeout) when + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> + try + {ok, EmOpts, InheritedSslOpts} = ssl_socket:get_all_opts(Tracker), SslOpts = handle_options(SslOpts0, InheritedSslOpts), ssl_connection:handshake(Socket, {SslOpts, emulated_socket_options(EmOpts, #socket_options{})}, Timeout) catch Error = {error, _Reason} -> Error end; ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket), - (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}), EmulatedOptions = ssl_socket:emulated_options(), @@ -252,17 +252,17 @@ close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _} Transport:close(ListenSocket). %%-------------------------------------------------------------------- --spec close(#sslsocket{}, integer() | {pid(), integer()}) -> term(). +-spec close(#sslsocket{}, timeout() | {pid(), integer()}) -> term(). %% %% Description: Close an ssl connection %%-------------------------------------------------------------------- -close(#sslsocket{pid = TLSPid}, - {Pid, Timeout} = DownGrade) when is_pid(TLSPid), - is_pid(Pid), - (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> +close(#sslsocket{pid = TLSPid}, + {Pid, Timeout} = DownGrade) when is_pid(TLSPid), + is_pid(Pid), + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:close(TLSPid, {close, DownGrade}); -close(#sslsocket{pid = TLSPid}, Timeout) when is_pid(TLSPid), - (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity) -> +close(#sslsocket{pid = TLSPid}, Timeout) when is_pid(TLSPid), + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:close(TLSPid, {close, Timeout}); close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}}}}, _) -> Transport:close(ListenSocket). @@ -286,7 +286,7 @@ send(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport, _, _, _} recv(Socket, Length) -> recv(Socket, Length, infinity). recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid), - (is_integer(Timeout) andalso Timeout > 0) or (Timeout == infinity)-> + (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> ssl_connection:recv(Pid, Length, Timeout); recv(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}, _,_) when is_port(Listen)-> diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 22d107ff9c..b45c5c8fc6 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -786,12 +786,24 @@ downgrade(Type, Event, State, Connection) -> %% Event handling functions called by state functions to handle %% common or unexpected events for the state. %%-------------------------------------------------------------------- +handle_common_event(internal, {handshake, {#hello_request{} = Handshake, _}}, connection = StateName, + #state{role = client} = State, _) -> + %% Should not be included in handshake history + {next_state, StateName, State#state{renegotiation = {true, peer}}, [{next_event, internal, Handshake}]}; +handle_common_event(internal, {handshake, {#hello_request{}, _}}, StateName, #state{role = client}, _) + when StateName =/= connection -> + {keep_state_and_data}; +handle_common_event(internal, {handshake, {Handshake, Raw}}, StateName, + #state{tls_handshake_history = Hs0} = State0, Connection) -> + %% This function handles client SNI hello extension when Handshake is + %% a client_hello, which needs to be determined by the connection callback. + %% In other cases this is a noop + State = Connection:handle_sni_extension(Handshake, State0), + HsHist = ssl_handshake:update_handshake_history(Hs0, Raw), + {next_state, StateName, State#state{tls_handshake_history = HsHist}, + [{next_event, internal, Handshake}]}; handle_common_event(internal, {tls_record, TLSRecord}, StateName, State, Connection) -> Connection:handle_common_event(internal, TLSRecord, StateName, State); -handle_common_event(internal, #hello_request{}, StateName, #state{role = client} = State0, Connection) - when StateName =:= connection -> - {Record, State} = Connection:next_record(State0), - Connection:next_event(StateName, Record, State); handle_common_event(timeout, hibernate, _, _, _) -> {keep_state_and_data, [hibernate]}; handle_common_event(internal, {application_data, Data}, StateName, State0, Connection) -> diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index e7b118de10..fde92035a2 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -53,7 +53,8 @@ -define(NUM_OF_SESSION_ID_BYTES, 32). % TSL 1.1 & SSL 3 -define(NUM_OF_PREMASTERSECRET_BYTES, 48). -define(DEFAULT_DIFFIE_HELLMAN_GENERATOR, 2). --define(DEFAULT_DIFFIE_HELLMAN_PRIME, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE65381FFFFFFFFFFFFFFFF). +-define(DEFAULT_DIFFIE_HELLMAN_PRIME, + 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AACAA68FFFFFFFFFFFFFFFF). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Handsake protocol - RFC 4346 section 7.4 diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl index 2e308a15b7..a920f54ed2 100644 --- a/lib/ssl/src/ssl_tls_dist_proxy.erl +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -402,6 +402,18 @@ ssl_options(server, ["server_verify", Value|T]) -> [{verify, atomize(Value)} | ssl_options(server,T)]; ssl_options(client, ["client_verify", Value|T]) -> [{verify, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_verify_fun", Value|T]) -> + [{verify_fun, verify_fun(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_verify_fun", Value|T]) -> + [{verify_fun, verify_fun(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_crl_check", Value|T]) -> + [{crl_check, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_crl_check", Value|T]) -> + [{crl_check, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, ["server_crl_cache", Value|T]) -> + [{crl_cache, termify(Value)} | ssl_options(server,T)]; +ssl_options(client, ["client_crl_cache", Value|T]) -> + [{crl_cache, termify(Value)} | ssl_options(client,T)]; ssl_options(server, ["server_reuse_sessions", Value|T]) -> [{reuse_sessions, atomize(Value)} | ssl_options(server,T)]; ssl_options(client, ["client_reuse_sessions", Value|T]) -> @@ -426,14 +438,28 @@ ssl_options(server, ["server_dhfile", Value|T]) -> [{dhfile, Value} | ssl_options(server,T)]; ssl_options(server, ["server_fail_if_no_peer_cert", Value|T]) -> [{fail_if_no_peer_cert, atomize(Value)} | ssl_options(server,T)]; -ssl_options(_,_) -> - exit(malformed_ssl_dist_opt). +ssl_options(Type, Opts) -> + error(malformed_ssl_dist_opt, [Type, Opts]). atomize(List) when is_list(List) -> list_to_atom(List); atomize(Atom) when is_atom(Atom) -> Atom. +termify(String) when is_list(String) -> + {ok, Tokens, _} = erl_scan:string(String ++ "."), + {ok, Term} = erl_parse:parse_term(Tokens), + Term. + +verify_fun(Value) -> + case termify(Value) of + {Mod, Func, State} when is_atom(Mod), is_atom(Func) -> + Fun = fun Mod:Func/3, + {Fun, State}; + _ -> + error(malformed_ssl_dist_opt, [Value]) + end. + flush_old_controller(Pid, Socket) -> receive {tcp, Socket, Data} -> diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 91903b4a1f..56e516bce2 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -50,7 +50,7 @@ %% Handshake handling -export([renegotiate/2, send_handshake/2, send_change_cipher/2, - reinit_handshake_data/1]). + reinit_handshake_data/1, handle_sni_extension/2]). %% Alert and close handling -export([send_alert/2, handle_own_alert/4, handle_close_alert/3, @@ -228,16 +228,16 @@ error(_, _, _) -> gen_statem:state_function_result(). %%-------------------------------------------------------------------- hello(internal, #client_hello{client_version = ClientVersion, - extensions = #hello_extensions{ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves}} = Hello, - State = #state{connection_states = ConnectionStates0, - port = Port, session = #session{own_certificate = Cert} = Session0, - renegotiation = {Renegotiation, _}, - session_cache = Cache, - session_cache_cb = CacheCb, - negotiated_protocol = CurrentProtocol, - key_algorithm = KeyExAlg, - ssl_options = SslOpts}) -> + extensions = #hello_extensions{ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves}} = Hello, + #state{connection_states = ConnectionStates0, + port = Port, session = #session{own_certificate = Cert} = Session0, + renegotiation = {Renegotiation, _}, + session_cache = Cache, + session_cache_cb = CacheCb, + negotiated_protocol = CurrentProtocol, + key_algorithm = KeyExAlg, + ssl_options = SslOpts} = State) -> case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of @@ -311,7 +311,7 @@ cipher(Type, Event, State) -> connection(info, Event, State) -> handle_info(Event, connection, State); connection(internal, #hello_request{}, - #state{host = Host, port = Port, + #state{role = client, host = Host, port = Port, session = #session{own_certificate = Cert} = Session0, session_cache = Cache, session_cache_cb = CacheCb, ssl_options = SslOpts, @@ -326,14 +326,16 @@ connection(internal, #hello_request{}, = Hello#client_hello.session_id}}), next_event(hello, Record, State); connection(internal, #client_hello{} = Hello, - #state{role = server, allow_renegotiate = true} = State) -> + #state{role = server, allow_renegotiate = true} = State0) -> %% Mitigate Computational DoS attack %% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html %% http://www.thc.org/thc-ssl-dos/ Rather than disabling client %% initiated renegotiation we will disallow many client initiated %% renegotiations immediately after each other. erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate), - {next_state, hello, State#state{allow_renegotiate = false}, [{next_event, internal, Hello}]}; + {Record, State} = next_record(State0#state{allow_renegotiate = false, + renegotiation = {true, peer}}), + next_event(hello, Record, State, [{next_event, internal, Hello}]); connection(internal, #client_hello{}, #state{role = server, allow_renegotiate = false} = State0) -> Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION), @@ -398,39 +400,12 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, StateName, #state{protocol_buffers = #protocol_buffers{tls_handshake_buffer = Buf0} = Buffers, negotiated_version = Version} = State0) -> - - Handle = - fun({#hello_request{} = Packet, _}, {connection, HState}) -> - %% This message should not be included in handshake - %% message hashes. Starts new handshake (renegotiation) - Hs0 = ssl_handshake:init_handshake_history(), - {HState#state{tls_handshake_history = Hs0, - renegotiation = {true, peer}}, - {next_event, internal, Packet}}; - ({#hello_request{}, _}, {next_state, _SName, HState}) -> - %% This message should not be included in handshake - %% message hashes. Already in negotiation so it will be ignored! - {HState, []}; - ({#client_hello{} = Packet, Raw}, {connection, HState0}) -> - HState = handle_sni_extension(Packet, HState0), - Version = Packet#client_hello.client_version, - Hs0 = ssl_handshake:init_handshake_history(), - Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), - {HState#state{tls_handshake_history = Hs1, - renegotiation = {true, peer}}, - {next_event, internal, Packet}}; - - ({Packet, Raw}, {_SName, HState0 = #state{tls_handshake_history=Hs0}}) -> - HState = handle_sni_extension(Packet, HState0), - Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), - {HState#state{tls_handshake_history=Hs1}, {next_event, internal, Packet}} - end, - try + try {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0), - State1 = State0#state{protocol_buffers = - Buffers#protocol_buffers{tls_packets = Packets, - tls_handshake_buffer = Buf}}, - {State, Events} = tls_handshake_events(Handle, StateName, State1, []), + State = + State0#state{protocol_buffers = + Buffers#protocol_buffers{tls_handshake_buffer = Buf}}, + Events = tls_handshake_events(Packets), case StateName of connection -> ssl_connection:hibernate_after(StateName, State, Events); @@ -779,24 +754,12 @@ send_or_reply(_, Pid, _From, Data) -> send_user(Pid, Msg) -> Pid ! Msg. -tls_handshake_events(Handle, StateName, - #state{protocol_buffers = - #protocol_buffers{tls_packets = [Packet]} = Buffers} = State0, Acc) -> - {State, Event} = Handle(Packet, {StateName, - State0#state{protocol_buffers = - Buffers#protocol_buffers{tls_packets = []}}}), - {State, lists:reverse([Event |Acc])}; -tls_handshake_events(Handle, StateName, - #state{protocol_buffers = - #protocol_buffers{tls_packets = - [Packet | Packets]} = Buffers} = State0, Acc) -> - {State, Event} = Handle(Packet, {StateName, State0#state{protocol_buffers = - Buffers#protocol_buffers{tls_packets = - Packets}}}), - tls_handshake_events(Handle, StateName, State, [Event | Acc]); - -tls_handshake_events(_Handle, _, #state{}, _) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). +tls_handshake_events([]) -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake)); +tls_handshake_events(Packets) -> + lists:map(fun(Packet) -> + {next_event, internal, {handshake, Packet}} + end, Packets). write_application_data(Data0, From, #state{socket = Socket, @@ -1065,5 +1028,5 @@ handle_sni_extension(#client_hello{extensions = HelloExtensions}, State0) -> } end end; -handle_sni_extension(_, State0) -> - State0. +handle_sni_extension(_, State) -> + State. diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl index 3a1fd00c06..b8a03f578d 100644 --- a/lib/ssl/test/ssl_ECC_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -343,6 +343,12 @@ new_ca(FileName, CA, OwnCa) -> E1 = public_key:pem_decode(P1), {ok, P2} = file:read_file(OwnCa), E2 = public_key:pem_decode(P2), - Pem = public_key:pem_encode(E2 ++E1), - file:write_file(FileName, Pem), + case os:cmd("openssl version") of + "OpenSSL 1.0.1p-freebsd" ++ _ -> + Pem = public_key:pem_encode(E1 ++E2), + file:write_file(FileName, Pem); + _ -> + Pem = public_key:pem_encode(E2 ++E1), + file:write_file(FileName, Pem) + end, FileName. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 686cdc569d..99f7c9b780 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -2631,7 +2631,7 @@ client_no_wrap_sequence_number(Config) when is_list(Config) -> {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), ErlData = "From erlang to erlang", - N = 10, + N = 12, Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, @@ -2668,7 +2668,7 @@ server_no_wrap_sequence_number(Config) when is_list(Config) -> {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Data = "From erlang to erlang", - N = 10, + N = 12, Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, @@ -3939,6 +3939,7 @@ prf_verify_value(Socket, TlsVer, Expected, Algo) -> send_recv_result_timeout_client(Socket) -> {error, timeout} = ssl:recv(Socket, 11, 500), + {error, timeout} = ssl:recv(Socket, 11, 0), ssl:send(Socket, "Hello world"), receive Msg -> diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl index d90ec428ee..f0ce82f4fe 100644 --- a/lib/ssl/test/ssl_dist_SUITE.erl +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -21,6 +21,7 @@ -module(ssl_dist_SUITE). -include_lib("common_test/include/ct.hrl"). +-include_lib("public_key/include/public_key.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). @@ -41,7 +42,9 @@ %%-------------------------------------------------------------------- all() -> [basic, payload, plain_options, plain_verify_options, nodelay_option, - listen_port_options, listen_options, connect_options, use_interface]. + listen_port_options, listen_options, connect_options, use_interface, + verify_fun_fail, verify_fun_pass, crl_check_pass, crl_check_fail, + crl_check_best_effort, crl_cache_check_pass, crl_cache_check_fail]. groups() -> []. @@ -418,6 +421,255 @@ use_interface(Config) when is_list(Config) -> stop_ssl_node(NH1), success(Config). +%%-------------------------------------------------------------------- +verify_fun_fail() -> + [{doc,"Test specifying verify_fun with a function that always fails"}]. +verify_fun_fail(Config) when is_list(Config) -> + DistOpts = "-ssl_dist_opt " + "server_verify verify_peer server_verify_fun " + "\"{ssl_dist_SUITE,verify_fail_always,{}}\" " + "client_verify verify_peer client_verify_fun " + "\"{ssl_dist_SUITE,verify_fail_always,{}}\" ", + + NH1 = start_ssl_node([{additional_dist_opts, DistOpts} | Config]), + NH2 = start_ssl_node([{additional_dist_opts, DistOpts} | Config]), + Node2 = NH2#node_handle.nodename, + + pang = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + %% Check that the function ran on the client node. + [{verify_fail_always_ran, true}] = + apply_on_ssl_node(NH1, fun () -> ets:tab2list(verify_fun_ran) end), + %% On the server node, it wouldn't run, because the server didn't + %% request a certificate from the client. + undefined = + apply_on_ssl_node(NH2, fun () -> ets:info(verify_fun_ran) end), + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). + +verify_fail_always(_Certificate, _Event, _State) -> + %% Create an ETS table, to record the fact that the verify function ran. + %% Spawn a new process, to avoid the ETS table disappearing. + Parent = self(), + spawn( + fun() -> + ets:new(verify_fun_ran, [public, named_table]), + ets:insert(verify_fun_ran, {verify_fail_always_ran, true}), + Parent ! go_ahead, + timer:sleep(infinity) + end), + receive go_ahead -> ok end, + {fail, bad_certificate}. + +%%-------------------------------------------------------------------- +verify_fun_pass() -> + [{doc,"Test specifying verify_fun with a function that always succeeds"}]. +verify_fun_pass(Config) when is_list(Config) -> + DistOpts = "-ssl_dist_opt " + "server_verify verify_peer server_verify_fun " + "\"{ssl_dist_SUITE,verify_pass_always,{}}\" " + "server_fail_if_no_peer_cert true " + "client_verify verify_peer client_verify_fun " + "\"{ssl_dist_SUITE,verify_pass_always,{}}\" ", + + NH1 = start_ssl_node([{additional_dist_opts, DistOpts} | Config]), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node([{additional_dist_opts, DistOpts} | Config]), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + %% Check that the function ran on the client node. + [{verify_pass_always_ran, true}] = + apply_on_ssl_node(NH1, fun () -> ets:tab2list(verify_fun_ran) end), + %% Check that it ran on the server node as well. The server + %% requested and verified the client's certificate because we + %% passed fail_if_no_peer_cert. + [{verify_pass_always_ran, true}] = + apply_on_ssl_node(NH2, fun () -> ets:tab2list(verify_fun_ran) end), + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). + +verify_pass_always(_Certificate, _Event, State) -> + %% Create an ETS table, to record the fact that the verify function ran. + %% Spawn a new process, to avoid the ETS table disappearing. + Parent = self(), + spawn( + fun() -> + ets:new(verify_fun_ran, [public, named_table]), + ets:insert(verify_fun_ran, {verify_pass_always_ran, true}), + Parent ! go_ahead, + timer:sleep(infinity) + end), + receive go_ahead -> ok end, + {valid, State}. +%%-------------------------------------------------------------------- +crl_check_pass() -> + [{doc,"Test crl_check with non-revoked certificate"}]. +crl_check_pass(Config) when is_list(Config) -> + DistOpts = "-ssl_dist_opt client_crl_check true", + NewConfig = + [{many_verify_opts, true}, {additional_dist_opts, DistOpts}] ++ Config, + + NH1 = start_ssl_node(NewConfig), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node(NewConfig), + Node2 = NH2#node_handle.nodename, + + PrivDir = ?config(priv_dir, Config), + cache_crls_on_ssl_nodes(PrivDir, ["erlangCA", "otpCA"], [NH1, NH2]), + + %% The server's certificate is not revoked, so connection succeeds. + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). + +%%-------------------------------------------------------------------- +crl_check_fail() -> + [{doc,"Test crl_check with revoked certificate"}]. +crl_check_fail(Config) when is_list(Config) -> + DistOpts = "-ssl_dist_opt client_crl_check true", + NewConfig = + [{many_verify_opts, true}, + %% The server uses a revoked certificate. + {server_cert_dir, "revoked"}, + {additional_dist_opts, DistOpts}] ++ Config, + + NH1 = start_ssl_node(NewConfig), + %%Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node(NewConfig), + Node2 = NH2#node_handle.nodename, + + PrivDir = ?config(priv_dir, Config), + cache_crls_on_ssl_nodes(PrivDir, ["erlangCA", "otpCA"], [NH1, NH2]), + + %% The server's certificate is revoked, so connection fails. + pang = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). + +%%-------------------------------------------------------------------- +crl_check_best_effort() -> + [{doc,"Test specifying crl_check as best_effort"}]. +crl_check_best_effort(Config) when is_list(Config) -> + DistOpts = "-ssl_dist_opt " + "server_verify verify_peer server_crl_check best_effort", + NewConfig = + [{many_verify_opts, true}, {additional_dist_opts, DistOpts}] ++ Config, + + %% We don't have the correct CRL at hand, but since crl_check is + %% best_effort, we accept it anyway. + NH1 = start_ssl_node(NewConfig), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node(NewConfig), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). + +%%-------------------------------------------------------------------- +crl_cache_check_pass() -> + [{doc,"Test specifying crl_check with custom crl_cache module"}]. +crl_cache_check_pass(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + NodeDir = filename:join([PrivDir, "Certs"]), + DistOpts = "-ssl_dist_opt " + "client_crl_check true " + "client_crl_cache " + "\"{ssl_dist_SUITE,{\\\"" ++ NodeDir ++ "\\\",[]}}\"", + NewConfig = + [{many_verify_opts, true}, {additional_dist_opts, DistOpts}] ++ Config, + + NH1 = start_ssl_node(NewConfig), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node(NewConfig), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). + +%%-------------------------------------------------------------------- +crl_cache_check_fail() -> + [{doc,"Test custom crl_cache module with revoked certificate"}]. +crl_cache_check_fail(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + NodeDir = filename:join([PrivDir, "Certs"]), + DistOpts = "-ssl_dist_opt " + "client_crl_check true " + "client_crl_cache " + "\"{ssl_dist_SUITE,{\\\"" ++ NodeDir ++ "\\\",[]}}\"", + NewConfig = + [{many_verify_opts, true}, + %% The server uses a revoked certificate. + {server_cert_dir, "revoked"}, + {additional_dist_opts, DistOpts}] ++ Config, + + NH1 = start_ssl_node(NewConfig), + NH2 = start_ssl_node(NewConfig), + Node2 = NH2#node_handle.nodename, + + pang = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). + +%% ssl_crl_cache_api callbacks +lookup(_DistributionPoint, _DbHandle) -> + not_available. + +select({rdnSequence, NameParts}, {NodeDir, _}) -> + %% Extract the CN from the issuer name... + [CN] = [CN || + [#'AttributeTypeAndValue'{ + type = ?'id-at-commonName', + value = <<_, _, CN/binary>>}] <- NameParts], + %% ...and use that as the directory name to find the CRL. + error_logger:info_report([{found_cn, CN}]), + CRLFile = filename:join([NodeDir, CN, "crl.pem"]), + {ok, PemBin} = file:read_file(CRLFile), + PemEntries = public_key:pem_decode(PemBin), + CRLs = [ CRL || {'CertificateList', CRL, not_encrypted} + <- PemEntries], + CRLs. + +fresh_crl(_DistributionPoint, CRL) -> + CRL. %%-------------------------------------------------------------------- %%% Internal functions ----------------------------------------------- @@ -528,6 +780,19 @@ start_ssl_node_raw(Name, Args) -> exit({failed_to_start_node, Name, Error}) end. +cache_crls_on_ssl_nodes(PrivDir, CANames, NHs) -> + [begin + File = filename:join([PrivDir, "Certs", CAName, "crl.pem"]), + {ok, PemBin} = file:read_file(File), + PemEntries = public_key:pem_decode(PemBin), + CRLs = [ CRL || {'CertificateList', CRL, not_encrypted} + <- PemEntries], + ok = apply_on_ssl_node(NH, ssl_manager, insert_crls, + ["no_distribution_point", CRLs, dist]) + end + || NH <- NHs, CAName <- CANames], + ok. + %% %% command line creation %% @@ -563,11 +828,13 @@ mk_node_cmdline(ListenPort, Name, Args) -> ++ NameSw ++ " " ++ Name ++ " " ++ "-pa " ++ Pa ++ " " ++ "-run application start crypto -run application start public_key " + ++ "-eval 'net_kernel:verbose(1)' " ++ "-run " ++ atom_to_list(?MODULE) ++ " cnct2tstsrvr " ++ host_name() ++ " " ++ integer_to_list(ListenPort) ++ " " ++ Args ++ " " ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ Name ++ " " + ++ "-kernel error_logger \"{file,\\\"" ++ Pwd ++ "/error_log." ++ Name ++ "\\\"}\" " ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()). %% @@ -815,8 +1082,8 @@ setup_dist_opts(Config) -> DataDir = proplists:get_value(data_dir, Config), Dhfile = filename:join([DataDir, "dHParam.pem"]), NodeDir = filename:join([PrivDir, "Certs"]), - SDir = filename:join([NodeDir, "server"]), - CDir = filename:join([NodeDir, "client"]), + SDir = filename:join([NodeDir, proplists:get_value(server_cert_dir, Config, "server")]), + CDir = filename:join([NodeDir, proplists:get_value(client_cert_dir, Config, "client")]), SC = filename:join([SDir, "cert.pem"]), SK = filename:join([SDir, "key.pem"]), SKC = filename:join([SDir, "keycert.pem"]), diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 6a73acb704..042d57c0e2 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -167,7 +167,7 @@ end_per_group(_GroupName, Config) -> Config. init_per_testcase(_TestCase, Config) -> - ct:timetrap({seconds, 30}), + ct:timetrap({seconds, 90}), Config. diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index 5e6137d2a6..b352844ba0 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -118,7 +118,7 @@ init_customized_session_cache(Type, Config) -> Config)), ets:new(ssl_test, [named_table, public, set]), ets:insert(ssl_test, {type, Type}), - ct:timetrap({seconds, 5}), + ct:timetrap({seconds, 20}), Config. end_per_testcase(session_cache_process_list, Config) -> diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 32bcdc4f2a..09176d2ca0 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -106,7 +106,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.3","crypto-3.3", + {runtime_dependencies, ["sasl-3.0","kernel-5.0","erts-8.0","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 8c1c625676..40764a943d 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -215,7 +215,7 @@ memory_check_summary(_Config) -> receive {get_failed_memchecks, FailedMemchecks} -> ok end, io:format("Failed memchecks: ~p\n",[FailedMemchecks]), NoFailedMemchecks = length(FailedMemchecks), - if NoFailedMemchecks > 3 -> + if NoFailedMemchecks > 300 -> ct:fail("Too many failed (~p) memchecks", [NoFailedMemchecks]); true -> ok @@ -604,9 +604,9 @@ memory(Config) when is_list(Config) -> memory_do(Opts) -> L = [T1,T2,T3,T4] = fill_sets_int(1000,Opts), XR1 = case mem_mode(T1) of - {normal,_} -> {13836,13046,13046,13052}; %{13862,13072,13072,13078}; - {compressed,4} -> {11041,10251,10251,10252}; %{11067,10277,10277,10278}; - {compressed,8} -> {10050,9260,9260,9260} %{10076,9286,9286,9286} + {normal,_} -> {13836,13560,13560,13566}; %{13836,13046,13046,13052} + {compressed,4} -> {11041,10865,10865,10866}; %{11041,10251,10251,10252} + {compressed,8} -> {10050,9774,9774,9774} % {10050,9260,9260,9260} end, XRes1 = adjust_xmem(L, XR1), Res1 = {?S(T1),?S(T2),?S(T3),?S(T4)}, @@ -620,9 +620,9 @@ memory_do(Opts) -> end, L), XR2 = case mem_mode(T1) of - {normal,_} -> {13826,13037,13028,13034}; %{13852,13063,13054,13060}; - {compressed,4} -> {11031,10242,10233,10234}; %{11057,10268,10259,10260}; - {compressed,8} -> {10040,9251,9242,9242} %10066,9277,9268,9268} + {normal,_} -> {13826,13551,13542,13548}; %{13826,13037,13028,13034}; + {compressed,4} -> {11031,10856,10747,10748}; %{11031,10242,10233,10234}; + {compressed,8} -> {10040,9765,9756,9756} %{10040,9251,9242,9242} end, XRes2 = adjust_xmem(L, XR2), Res2 = {?S(T1),?S(T2),?S(T3),?S(T4)}, @@ -636,9 +636,9 @@ memory_do(Opts) -> end, L), XR3 = case mem_mode(T1) of - {normal,_} -> {13816,13028,13010,13016}; %{13842,13054,13036,13042}; - {compressed,4} -> {11021,10233,10215,10216}; %{11047,10259,10241,10242}; - {compressed,8} -> {10030,9242,9224,9224} %{10056,9268,9250,9250} + {normal,_} -> {13816,13542,13524,13530}; %{13816,13028,13010,13016} + {compressed,4} -> {11021,10747,10729,10730}; %{11021,10233,10215,10216} + {compressed,8} -> {10030,9756,9738,9738} %{10030,9242,9224,9224} end, XRes3 = adjust_xmem(L, XR3), Res3 = {?S(T1),?S(T2),?S(T3),?S(T4)}, @@ -5350,12 +5350,12 @@ verify_table_load(T) -> Stats = ets:info(T,stats), {Buckets,AvgLen,StdDev,ExpSD,_MinLen,_MaxLen,_} = Stats, ok = if - AvgLen > 7 -> + AvgLen > 2 -> io:format("Table overloaded: Stats=~p\n~p\n", [Stats, ets:info(T)]), false; - Buckets>256, AvgLen < 6 -> + Buckets>256, AvgLen < 0.5 -> io:format("Table underloaded: Stats=~p\n~p\n", [Stats, ets:info(T)]), false; diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 3242511f4a..338cd3dc0a 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -185,7 +185,7 @@ start(Config) when is_list(Config) -> gen_server:start({global, my_test_name}, gen_server_SUITE, [], []), ok = gen_server:call({global, my_test_name}, stop), - ct:sleep(1), + busy_wait_for_process(Pid4,600), {'EXIT', {noproc,_}} = (catch gen_server:call(Pid4, started_p, 10)), %% global register linked @@ -214,7 +214,7 @@ start(Config) when is_list(Config) -> gen_server:start({via, dummy_via, my_test_name}, gen_server_SUITE, [], []), ok = gen_server:call({via, dummy_via, my_test_name}, stop), - ct:sleep(1), + busy_wait_for_process(Pid6,600), {'EXIT', {noproc,_}} = (catch gen_server:call(Pid6, started_p, 10)), %% via register linked |