aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/emulator/beam/beam_load.c14
-rw-r--r--lib/common_test/src/ct_snmp.erl302
-rw-r--r--lib/common_test/test/ct_snmp_SUITE.erl14
-rw-r--r--lib/common_test/test/ct_snmp_SUITE_data/snmp.cfg62
-rw-r--r--lib/common_test/test/ct_snmp_SUITE_data/snmp1_SUITE.erl152
-rw-r--r--lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl395
-rw-r--r--lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/community.conf1
-rw-r--r--lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/context.conf1
-rw-r--r--lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/notify.conf1
-rw-r--r--lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/standard.conf7
-rw-r--r--lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_addr.conf2
-rw-r--r--lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_params.conf1
-rw-r--r--lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/usm.conf1
-rw-r--r--lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/vacm.conf6
-rw-r--r--lib/common_test/test/ct_testspec_1_SUITE.erl108
-rw-r--r--lib/dialyzer/src/dialyzer.erl4
-rw-r--r--lib/dialyzer/src/dialyzer_dataflow.erl2
-rw-r--r--lib/dialyzer/test/r9c_SUITE_data/results/asn14
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/fun_ref_match2
-rw-r--r--lib/inets/doc/src/httpc.xml35
-rw-r--r--lib/inets/src/http_client/httpc.erl12
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl995
-rw-r--r--lib/inets/src/http_client/httpc_internal.hrl2
-rw-r--r--lib/inets/src/http_client/httpc_manager.erl23
-rw-r--r--lib/inets/src/http_server/httpd_conf.erl4
-rw-r--r--lib/inets/src/inets_app/inets.erl9
-rw-r--r--lib/inets/test/Makefile4
-rw-r--r--lib/inets/test/erl_make_certs.erl429
-rw-r--r--lib/inets/test/httpc_SUITE.erl466
-rw-r--r--lib/inets/test/httpc_proxy_SUITE.erl575
-rw-r--r--lib/inets/test/httpc_proxy_SUITE_data/apache2/apache2.conf87
-rw-r--r--lib/inets/test/httpc_proxy_SUITE_data/apache2/htdocs/index.html4
-rwxr-xr-xlib/inets/test/httpc_proxy_SUITE_data/server_proxy.sh198
-rw-r--r--lib/mnesia/test/mnesia_recovery_test.erl92
-rw-r--r--lib/os_mon/test/Makefile1
-rw-r--r--lib/os_mon/test/os_mon.spec1
-rw-r--r--lib/os_mon/test/os_mon_mib_SUITE.cfg8
-rw-r--r--lib/os_mon/test/os_mon_mib_SUITE.erl147
-rw-r--r--lib/reltool/test/reltool_server_SUITE.erl41
-rw-r--r--lib/ssh/doc/src/ssh.xml2
-rw-r--r--lib/ssh/src/ssh_auth.hrl2
-rw-r--r--lib/ssh/src/ssh_connection.erl17
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl32
-rw-r--r--lib/ssl/doc/src/ssl.xml52
-rw-r--r--lib/ssl/src/ssl.erl107
-rw-r--r--lib/ssl/src/ssl_connection.erl115
-rw-r--r--lib/ssl/src/ssl_handshake.erl213
-rw-r--r--lib/ssl/src/ssl_handshake.hrl20
-rw-r--r--lib/ssl/src/ssl_internal.hrl4
-rw-r--r--lib/ssl/src/ssl_manager.erl2
-rw-r--r--lib/ssl/test/Makefile2
-rw-r--r--lib/ssl/test/make_certs.erl19
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl21
-rw-r--r--lib/ssl/test/ssl_npn_handshake_SUITE.erl310
-rw-r--r--lib/ssl/test/ssl_npn_hello_SUITE.erl117
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl300
-rw-r--r--lib/stdlib/doc/src/ets.xml8
-rw-r--r--lib/stdlib/doc/src/re.xml4
-rw-r--r--lib/stdlib/src/binary.erl2
-rw-r--r--lib/stdlib/src/erl_lint.erl61
-rw-r--r--lib/stdlib/src/ets.erl4
-rw-r--r--lib/stdlib/src/io_lib.erl7
-rw-r--r--lib/stdlib/src/re.erl6
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl31
-rw-r--r--lib/stdlib/test/re_SUITE.erl6
-rw-r--r--lib/test_server/src/test_server_ctrl.erl25
-rw-r--r--lib/test_server/src/test_server_sup.erl6
-rw-r--r--system/doc/embedded/part.xml1
68 files changed, 4076 insertions, 1632 deletions
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index d3f55a2ba4..25ae480dc7 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -5527,7 +5527,8 @@ stub_copy_info(LoaderState* stp,
int chunk, /* Chunk: ATTR_CHUNK or COMPILE_CHUNK */
byte* info, /* Where to store info. */
BeamInstr* ptr_word, /* Where to store pointer into info. */
- BeamInstr* size_word) /* Where to store size of info. */
+ BeamInstr* size_word, /* Where to store size into info. */
+ BeamInstr* size_on_heap_word) /* Where to store size on heap. */
{
Sint decoded_size;
Uint size = stp->chunks[chunk].size;
@@ -5538,7 +5539,8 @@ stub_copy_info(LoaderState* stp,
if (decoded_size < 0) {
return 0;
}
- *size_word = decoded_size;
+ *size_word = (BeamInstr) size;
+ *size_on_heap_word = decoded_size;
}
return info + size;
}
@@ -5960,12 +5962,16 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
info = (byte *) fp;
info = stub_copy_info(stp, ATTR_CHUNK, info,
- code+MI_ATTR_PTR, code+MI_ATTR_SIZE_ON_HEAP);
+ code+MI_ATTR_PTR,
+ code+MI_ATTR_SIZE,
+ code+MI_ATTR_SIZE_ON_HEAP);
if (info == NULL) {
goto error;
}
info = stub_copy_info(stp, COMPILE_CHUNK, info,
- code+MI_COMPILE_PTR, code+MI_COMPILE_SIZE_ON_HEAP);
+ code+MI_COMPILE_PTR,
+ code+MI_COMPILE_SIZE,
+ code+MI_COMPILE_SIZE_ON_HEAP);
if (info == NULL) {
goto error;
}
diff --git a/lib/common_test/src/ct_snmp.erl b/lib/common_test/src/ct_snmp.erl
index 02f849201d..71038bd4f4 100644
--- a/lib/common_test/src/ct_snmp.erl
+++ b/lib/common_test/src/ct_snmp.erl
@@ -39,7 +39,7 @@
%%% %%% Manager config
%%% [{start_manager, boolean()} % Optional - default is true
%%% {users, [{user_name(), [call_back_module(), user_data()]}]}, %% Optional
-%%% {usm_users, [{usm_user_name(), usm_config()}]},%% Optional - snmp v3 only
+%%% {usm_users, [{usm_user_name(), [usm_config()]}]},%% Optional - snmp v3 only
%%% % managed_agents is optional
%%% {managed_agents,[{agent_name(), [user_name(), agent_ip(), agent_port(), [agent_config()]]}]},
%%% {max_msg_size, integer()}, % Optional - default is 484
@@ -130,7 +130,7 @@
%%% @type agent_config() = {Item, Value}
%%% @type user_name() = atom()
%%% @type usm_user_name() = string()
-%%% @type usm_config() = string()
+%%% @type usm_config() = {Item, Value}
%%% @type call_back_module() = atom()
%%% @type user_data() = term()
%%% @type oids() = [oid()]
@@ -157,8 +157,9 @@
%%% API
-export([start/2, start/3, stop/1, get_values/3, get_next_values/3, set_values/4,
set_info/1, register_users/2, register_agents/2, register_usm_users/2,
- unregister_users/1, unregister_agents/1, update_usm_users/2,
- load_mibs/1]).
+ unregister_users/1, unregister_users/2, unregister_agents/1,
+ unregister_agents/2, unregister_usm_users/1, unregister_usm_users/2,
+ load_mibs/1, unload_mibs/1]).
%% Manager values
-define(CT_SNMP_LOG_FILE, "ct_snmp_set.log").
@@ -322,12 +323,23 @@ set_info(Config) ->
%%% Reason = term()
%%%
%%% @doc Register the manager entity (=user) responsible for specific agent(s).
-%%% Corresponds to making an entry in users.conf
+%%% Corresponds to making an entry in users.conf.
+%%%
+%%% This function will try to register the given users, without
+%%% checking if any of them already exist. In order to change an
+%%% already registered user, the user must first be unregistered.
register_users(MgrAgentConfName, Users) ->
- {snmp, SnmpVals} = ct:get_config(MgrAgentConfName),
- NewSnmpVals = lists:keyreplace(users, 1, SnmpVals, {users, Users}),
- ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}),
- setup_users(Users).
+ case setup_users(Users) of
+ ok ->
+ SnmpVals = ct:get_config(MgrAgentConfName),
+ OldUsers = ct:get_config({MgrAgentConfName,users},[]),
+ NewSnmpVals = lists:keystore(users, 1, SnmpVals,
+ {users, Users ++ OldUsers}),
+ ct_config:update_config(MgrAgentConfName, NewSnmpVals),
+ ok;
+ Error ->
+ Error
+ end.
%%% @spec register_agents(MgrAgentConfName, ManagedAgents) -> ok | {error, Reason}
%%%
@@ -337,12 +349,24 @@ register_users(MgrAgentConfName, Users) ->
%%%
%%% @doc Explicitly instruct the manager to handle this agent.
%%% Corresponds to making an entry in agents.conf
+%%%
+%%% This function will try to register the given managed agents,
+%%% without checking if any of them already exist. In order to change
+%%% an already registered managed agent, the agent must first be
+%%% unregistered.
register_agents(MgrAgentConfName, ManagedAgents) ->
- {snmp, SnmpVals} = ct:get_config(MgrAgentConfName),
- NewSnmpVals = lists:keyreplace(managed_agents, 1, SnmpVals,
- {managed_agents, ManagedAgents}),
- ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}),
- setup_managed_agents(MgrAgentConfName,ManagedAgents).
+ case setup_managed_agents(MgrAgentConfName,ManagedAgents) of
+ ok ->
+ SnmpVals = ct:get_config(MgrAgentConfName),
+ OldAgents = ct:get_config({MgrAgentConfName,managed_agents},[]),
+ NewSnmpVals = lists:keystore(managed_agents, 1, SnmpVals,
+ {managed_agents,
+ ManagedAgents ++ OldAgents}),
+ ct_config:update_config(MgrAgentConfName, NewSnmpVals),
+ ok;
+ Error ->
+ Error
+ end.
%%% @spec register_usm_users(MgrAgentConfName, UsmUsers) -> ok | {error, Reason}
%%%
@@ -352,60 +376,115 @@ register_agents(MgrAgentConfName, ManagedAgents) ->
%%%
%%% @doc Explicitly instruct the manager to handle this USM user.
%%% Corresponds to making an entry in usm.conf
+%%%
+%%% This function will try to register the given users, without
+%%% checking if any of them already exist. In order to change an
+%%% already registered user, the user must first be unregistered.
register_usm_users(MgrAgentConfName, UsmUsers) ->
- {snmp, SnmpVals} = ct:get_config(MgrAgentConfName),
- NewSnmpVals = lists:keyreplace(users, 1, SnmpVals, {usm_users, UsmUsers}),
- ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}),
EngineID = ct:get_config({MgrAgentConfName, engine_id}, ?ENGINE_ID),
- setup_usm_users(UsmUsers, EngineID).
+ case setup_usm_users(UsmUsers, EngineID) of
+ ok ->
+ SnmpVals = ct:get_config(MgrAgentConfName),
+ OldUsmUsers = ct:get_config({MgrAgentConfName,usm_users},[]),
+ NewSnmpVals = lists:keystore(usm_users, 1, SnmpVals,
+ {usm_users, UsmUsers ++ OldUsmUsers}),
+ ct_config:update_config(MgrAgentConfName, NewSnmpVals),
+ ok;
+ Error ->
+ Error
+ end.
-%%% @spec unregister_users(MgrAgentConfName) -> ok | {error, Reason}
+%%% @spec unregister_users(MgrAgentConfName) -> ok
%%%
%%% MgrAgentConfName = atom()
%%% Reason = term()
%%%
-%%% @doc Removes information added when calling register_users/2.
+%%% @doc Unregister all users.
unregister_users(MgrAgentConfName) ->
- Users = lists:map(fun({UserName, _}) -> UserName end,
- ct:get_config({MgrAgentConfName, users})),
- {snmp, SnmpVals} = ct:get_config(MgrAgentConfName),
- NewSnmpVals = lists:keyreplace(users, 1, SnmpVals, {users, []}),
- ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}),
- takedown_users(Users).
+ Users = [Id || {Id,_} <- ct:get_config({MgrAgentConfName, users},[])],
+ unregister_users(MgrAgentConfName,Users).
-%%% @spec unregister_agents(MgrAgentConfName) -> ok | {error, Reason}
+%%% @spec unregister_users(MgrAgentConfName,Users) -> ok
%%%
%%% MgrAgentConfName = atom()
+%%% Users = [user_name()]
%%% Reason = term()
%%%
-%%% @doc Removes information added when calling register_agents/2.
+%%% @doc Unregister the given users.
+unregister_users(MgrAgentConfName,Users) ->
+ takedown_users(Users),
+ SnmpVals = ct:get_config(MgrAgentConfName),
+ AllUsers = ct:get_config({MgrAgentConfName, users},[]),
+ RemainingUsers = lists:filter(fun({Id,_}) ->
+ not lists:member(Id,Users)
+ end,
+ AllUsers),
+ NewSnmpVals = lists:keyreplace(users, 1, SnmpVals, {users,RemainingUsers}),
+ ct_config:update_config(MgrAgentConfName, NewSnmpVals),
+ ok.
+
+%%% @spec unregister_agents(MgrAgentConfName) -> ok
+%%%
+%%% MgrAgentConfName = atom()
+%%% Reason = term()
+%%%
+%%% @doc Unregister all managed agents.
unregister_agents(MgrAgentConfName) ->
- ManagedAgents = lists:map(fun({_, [Uid, AgentIP, AgentPort, _]}) ->
- {Uid, AgentIP, AgentPort}
- end,
- ct:get_config({MgrAgentConfName, managed_agents})),
- {snmp, SnmpVals} = ct:get_config(MgrAgentConfName),
- NewSnmpVals = lists:keyreplace(managed_agents, 1, SnmpVals,
- {managed_agents, []}),
- ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}),
- takedown_managed_agents(ManagedAgents).
+ ManagedAgents = [AgentName ||
+ {AgentName, _} <-
+ ct:get_config({MgrAgentConfName,managed_agents},[])],
+ unregister_agents(MgrAgentConfName,ManagedAgents).
+%%% @spec unregister_agents(MgrAgentConfName,ManagedAgents) -> ok
+%%%
+%%% MgrAgentConfName = atom()
+%%% ManagedAgents = [agent_name()]
+%%% Reason = term()
+%%%
+%%% @doc Unregister the given managed agents.
+unregister_agents(MgrAgentConfName,ManagedAgents) ->
+ takedown_managed_agents(MgrAgentConfName, ManagedAgents),
+ SnmpVals = ct:get_config(MgrAgentConfName),
+ AllAgents = ct:get_config({MgrAgentConfName,managed_agents},[]),
+ RemainingAgents = lists:filter(fun({Name,_}) ->
+ not lists:member(Name,ManagedAgents)
+ end,
+ AllAgents),
+ NewSnmpVals = lists:keyreplace(managed_agents, 1, SnmpVals,
+ {managed_agents,RemainingAgents}),
+ ct_config:update_config(MgrAgentConfName, NewSnmpVals),
+ ok.
-%%% @spec update_usm_users(MgrAgentConfName, UsmUsers) -> ok | {error, Reason}
+%%% @spec unregister_usm_users(MgrAgentConfName) -> ok
%%%
%%% MgrAgentConfName = atom()
-%%% UsmUsers = usm_users()
%%% Reason = term()
%%%
-%%% @doc Alters information added when calling register_usm_users/2.
-update_usm_users(MgrAgentConfName, UsmUsers) ->
-
- {snmp, SnmpVals} = ct:get_config(MgrAgentConfName),
- NewSnmpVals = lists:keyreplace(usm_users, 1, SnmpVals,
- {usm_users, UsmUsers}),
- ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}),
+%%% @doc Unregister all usm users.
+unregister_usm_users(MgrAgentConfName) ->
+ UsmUsers = [Id || {Id,_} <- ct:get_config({MgrAgentConfName, usm_users},[])],
+ unregister_usm_users(MgrAgentConfName,UsmUsers).
+
+%%% @spec unregister_usm_users(MgrAgentConfName,UsmUsers) -> ok
+%%%
+%%% MgrAgentConfName = atom()
+%%% UsmUsers = [usm_user_name()]
+%%% Reason = term()
+%%%
+%%% @doc Unregister the given usm users.
+unregister_usm_users(MgrAgentConfName,UsmUsers) ->
EngineID = ct:get_config({MgrAgentConfName, engine_id}, ?ENGINE_ID),
- do_update_usm_users(UsmUsers, EngineID).
+ takedown_usm_users(UsmUsers,EngineID),
+ SnmpVals = ct:get_config(MgrAgentConfName),
+ AllUsmUsers = ct:get_config({MgrAgentConfName, usm_users},[]),
+ RemainingUsmUsers = lists:filter(fun({Id,_}) ->
+ not lists:member(Id,UsmUsers)
+ end,
+ AllUsmUsers),
+ NewSnmpVals = lists:keyreplace(usm_users, 1, SnmpVals,
+ {usm_users,RemainingUsmUsers}),
+ ct_config:update_config(MgrAgentConfName, NewSnmpVals),
+ ok.
%%% @spec load_mibs(Mibs) -> ok | {error, Reason}
%%%
@@ -417,6 +496,15 @@ update_usm_users(MgrAgentConfName, UsmUsers) ->
load_mibs(Mibs) ->
snmpa:load_mibs(snmp_master_agent, Mibs).
+%%% @spec unload_mibs(Mibs) -> ok | {error, Reason}
+%%%
+%%% Mibs = [MibName]
+%%% MibName = string()
+%%% Reason = term()
+%%%
+%%% @doc Unload the mibs from the agent 'snmp_master_agent'.
+unload_mibs(Mibs) ->
+ snmpa:unload_mibs(snmp_master_agent, Mibs).
%%%========================================================================
%%% Internal functions
@@ -533,69 +621,57 @@ manager_register(true, MgrAgentConfName) ->
%%%---------------------------------------------------------------------------
setup_users(Users) ->
- lists:foreach(fun({Id, [Module, Data]}) ->
- snmpm:register_user(Id, Module, Data)
- end, Users).
+ while_ok(fun({Id, [Module, Data]}) ->
+ snmpm:register_user(Id, Module, Data)
+ end, Users).
%%%---------------------------------------------------------------------------
-setup_managed_agents(_,[]) ->
- ok;
-
-setup_managed_agents(AgentConfName,
- [{AgentName, [Uid, AgentIp, AgentUdpPort, AgentConf0]} |
- Rest]) ->
- NewAgentIp = case AgentIp of
- IpTuple when is_tuple(IpTuple) ->
- IpTuple;
- HostName when is_list(HostName) ->
- {ok,Hostent} = inet:gethostbyname(HostName),
- [IpTuple|_] = Hostent#hostent.h_addr_list,
- IpTuple
- end,
- AgentConf =
- case lists:keymember(engine_id,1,AgentConf0) of
- true ->
- AgentConf0;
- false ->
- DefaultEngineID = ct:get_config({AgentConfName,agent_engine_id},
- ?AGENT_ENGINE_ID),
- [{engine_id,DefaultEngineID}|AgentConf0]
+setup_managed_agents(AgentConfName,Agents) ->
+ Fun =
+ fun({AgentName, [Uid, AgentIp, AgentUdpPort, AgentConf0]}) ->
+ NewAgentIp = case AgentIp of
+ IpTuple when is_tuple(IpTuple) ->
+ IpTuple;
+ HostName when is_list(HostName) ->
+ {ok,Hostent} = inet:gethostbyname(HostName),
+ [IpTuple|_] = Hostent#hostent.h_addr_list,
+ IpTuple
+ end,
+ AgentConf =
+ case lists:keymember(engine_id,1,AgentConf0) of
+ true ->
+ AgentConf0;
+ false ->
+ DefaultEngineID =
+ ct:get_config({AgentConfName,agent_engine_id},
+ ?AGENT_ENGINE_ID),
+ [{engine_id,DefaultEngineID}|AgentConf0]
+ end,
+ snmpm:register_agent(Uid, target_name(AgentName),
+ [{address,NewAgentIp},{port,AgentUdpPort} |
+ AgentConf])
end,
- ok = snmpm:register_agent(Uid, target_name(AgentName),
- [{address,NewAgentIp},{port,AgentUdpPort} |
- AgentConf]),
- setup_managed_agents(AgentConfName,Rest).
+ while_ok(Fun,Agents).
%%%---------------------------------------------------------------------------
setup_usm_users(UsmUsers, EngineID)->
- lists:foreach(fun({UsmUser, Conf}) ->
- snmpm:register_usm_user(EngineID, UsmUser, Conf)
- end, UsmUsers).
+ while_ok(fun({UsmUser, Conf}) ->
+ snmpm:register_usm_user(EngineID, UsmUser, Conf)
+ end, UsmUsers).
%%%---------------------------------------------------------------------------
takedown_users(Users) ->
- lists:foreach(fun({Id}) ->
+ lists:foreach(fun(Id) ->
snmpm:unregister_user(Id)
end, Users).
%%%---------------------------------------------------------------------------
-takedown_managed_agents([{Uid, AgentIp, AgentUdpPort} |
- Rest]) ->
- NewAgentIp = case AgentIp of
- IpTuple when is_tuple(IpTuple) ->
- IpTuple;
- HostName when is_list(HostName) ->
- {ok,Hostent} = inet:gethostbyname(HostName),
- [IpTuple|_] = Hostent#hostent.h_addr_list,
- IpTuple
- end,
- ok = snmpm:unregister_agent(Uid, NewAgentIp, AgentUdpPort),
- takedown_managed_agents(Rest);
-
-takedown_managed_agents([]) ->
- ok.
+takedown_managed_agents(MgrAgentConfName,ManagedAgents) ->
+ lists:foreach(fun(AgentName) ->
+ [Uid | _] = agent_conf(AgentName, MgrAgentConfName),
+ snmpm:unregister_agent(Uid, target_name(AgentName))
+ end, ManagedAgents).
%%%---------------------------------------------------------------------------
-do_update_usm_users(UsmUsers, EngineID) ->
- lists:foreach(fun({UsmUser, {Item, Val}}) ->
- snmpm:update_usm_user_info(EngineID, UsmUser,
- Item, Val)
- end, UsmUsers).
+takedown_usm_users(UsmUsers, EngineID) ->
+ lists:foreach(fun(Id) ->
+ snmpm:unregister_usm_user(EngineID, Id)
+ end, UsmUsers).
%%%---------------------------------------------------------------------------
log(PrivDir, Agent, {_, _, Varbinds}, NewVarsAndVals) ->
@@ -659,7 +735,7 @@ override_contexts(Config, {data_dir_file, File}) ->
override_contexts(Config, ContextInfo);
override_contexts(Config, Contexts) ->
- Dir = ?config(priv_dir, Config),
+ Dir = filename:join(?config(priv_dir, Config),"conf"),
File = filename:join(Dir,"context.conf"),
file:delete(File),
snmp_config:write_agent_context_config(Dir, "", Contexts).
@@ -675,7 +751,7 @@ override_sysinfo(Config, {data_dir_file, File}) ->
override_sysinfo(Config, SysInfo);
override_sysinfo(Config, SysInfo) ->
- Dir = ?config(priv_dir, Config),
+ Dir = filename:join(?config(priv_dir, Config),"conf"),
File = filename:join(Dir,"standard.conf"),
file:delete(File),
snmp_config:write_agent_standard_config(Dir, "", SysInfo).
@@ -690,7 +766,7 @@ override_target_address(Config, {data_dir_file, File}) ->
override_target_address(Config, TargetAddressConf);
override_target_address(Config, TargetAddressConf) ->
- Dir = ?config(priv_dir, Config),
+ Dir = filename:join(?config(priv_dir, Config),"conf"),
File = filename:join(Dir,"target_addr.conf"),
file:delete(File),
snmp_config:write_agent_target_addr_config(Dir, "", TargetAddressConf).
@@ -706,7 +782,7 @@ override_target_params(Config, {data_dir_file, File}) ->
override_target_params(Config, TargetParamsConf);
override_target_params(Config, TargetParamsConf) ->
- Dir = ?config(priv_dir, Config),
+ Dir = filename:join(?config(priv_dir, Config),"conf"),
File = filename:join(Dir,"target_params.conf"),
file:delete(File),
snmp_config:write_agent_target_params_config(Dir, "", TargetParamsConf).
@@ -721,7 +797,7 @@ override_notify(Config, {data_dir_file, File}) ->
override_notify(Config, NotifyConf);
override_notify(Config, NotifyConf) ->
- Dir = ?config(priv_dir, Config),
+ Dir = filename:join(?config(priv_dir, Config),"conf"),
File = filename:join(Dir,"notify.conf"),
file:delete(File),
snmp_config:write_agent_notify_config(Dir, "", NotifyConf).
@@ -736,7 +812,7 @@ override_usm(Config, {data_dir_file, File}) ->
override_usm(Config, UsmConf);
override_usm(Config, UsmConf) ->
- Dir = ?config(priv_dir, Config),
+ Dir = filename:join(?config(priv_dir, Config),"conf"),
File = filename:join(Dir,"usm.conf"),
file:delete(File),
snmp_config:write_agent_usm_config(Dir, "", UsmConf).
@@ -751,7 +827,7 @@ override_community(Config, {data_dir_file, File}) ->
override_community(Config, CommunityConf);
override_community(Config, CommunityConf) ->
- Dir = ?config(priv_dir, Config),
+ Dir = filename:join(?config(priv_dir, Config),"conf"),
File = filename:join(Dir,"community.conf"),
file:delete(File),
snmp_config:write_agent_community_config(Dir, "", CommunityConf).
@@ -767,8 +843,8 @@ override_vacm(Config, {data_dir_file, File}) ->
override_vacm(Config, VacmConf);
override_vacm(Config, VacmConf) ->
- Dir = ?config(priv_dir, Config),
- File = filename:join(Dir,"vacm.conf"),
+ Dir = filename:join(?config(priv_dir, Config),"conf"),
+ File = filename:join(Dir,"vacm.conf"),
file:delete(File),
snmp_config:write_agent_vacm_config(Dir, "", VacmConf).
@@ -776,3 +852,11 @@ override_vacm(Config, VacmConf) ->
target_name(Agent) ->
atom_to_list(Agent).
+
+while_ok(Fun,[H|T]) ->
+ case Fun(H) of
+ ok -> while_ok(Fun,T);
+ Error -> Error
+ end;
+while_ok(_Fun,[]) ->
+ ok.
diff --git a/lib/common_test/test/ct_snmp_SUITE.erl b/lib/common_test/test/ct_snmp_SUITE.erl
index 848752b816..f8b4543770 100644
--- a/lib/common_test/test/ct_snmp_SUITE.erl
+++ b/lib/common_test/test/ct_snmp_SUITE.erl
@@ -70,7 +70,7 @@ all() ->
%%%
default(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
- Suite = filename:join(DataDir, "snmp1_SUITE"),
+ Suite = filename:join(DataDir, "snmp_SUITE"),
CfgFile = filename:join(DataDir, "snmp.cfg"),
{Opts,ERPid} = setup([{suite,Suite},{config,CfgFile},
{label,default}], Config),
@@ -110,14 +110,14 @@ reformat(Events, EH) ->
%%%-----------------------------------------------------------------
events_to_check(_TestName,Config) ->
{module,_} = code:load_abs(filename:join(?config(data_dir,Config),
- snmp1_SUITE)),
+ snmp_SUITE)),
TCs = get_tcs(),
- code:purge(snmp1_SUITE),
- code:delete(snmp1_SUITE),
+ code:purge(snmp_SUITE),
+ code:delete(snmp_SUITE),
OneTest =
[{?eh,start_logging,{'DEF','RUNDIR'}}] ++
- [{?eh,tc_done,{snmp1_SUITE,TC,ok}} || TC <- TCs] ++
+ [{?eh,tc_done,{snmp_SUITE,TC,ok}} || TC <- TCs] ++
[{?eh,stop_logging,[]}],
%% 2 tests (ct:run_test + script_start) is default
@@ -125,9 +125,9 @@ events_to_check(_TestName,Config) ->
get_tcs() ->
- All = snmp1_SUITE:all(),
+ All = snmp_SUITE:all(),
Groups =
- try snmp1_SUITE:groups()
+ try snmp_SUITE:groups()
catch error:undef -> []
end,
flatten_tcs(All,Groups).
diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp.cfg b/lib/common_test/test/ct_snmp_SUITE_data/snmp.cfg
index b0ac0e6a96..895e097de6 100644
--- a/lib/common_test/test/ct_snmp_SUITE_data/snmp.cfg
+++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp.cfg
@@ -1,20 +1,44 @@
%% -*- erlang -*-
-{snmp, [{start_agent,true},
- {users,[{user_name,[snmp1_SUITE,[]]}]},
- {managed_agents,[{agent_name, [user_name, {127,0,0,1}, 4000,
- [{engine_id,"ct_snmp-test-engine"},
- {version,v2}]]}]},
- {engine_id,"ct_snmp-test-engine"},
- {agent_vsns,[v2]}
- ]}.
-{snmp_app,[{manager, [{config, [{verbosity, silence}]},
- {server,[{verbosity,silence}]},
- {net_if,[{verbosity,silence}]},
- {versions,[v2]}
- ]},
- {agent, [{config, [{verbosity, silence}]},
- {net_if,[{verbosity,silence}]},
- {mib_server,[{verbosity,silence}]},
- {local_db,[{verbosity,silence}]},
- {agent_verbosity,silence}
- ]}]}.
+{snmp1, [{start_agent,true},
+ {users,[{user_name,[snmpm_user_default,[]]}]},
+ {managed_agents,[{agent_name, [user_name, {127,0,0,1}, 4000,
+ [{engine_id,"ct_snmp-test-engine"},
+ {version,v2}]]}]},
+ {engine_id,"ct_snmp-test-engine"},
+ {agent_vsns,[v2]}
+ ]}.
+{snmp2, [{start_agent,true},
+ {engine_id,"ct_snmp-test-engine"}
+ ]}.
+{snmp3, [{start_agent,true},
+ {engine_id,"ct_snmp-test-engine"},
+ {agent_vsns,[v1,v2,v3]},
+ {agent_contexts,{data_dir_file,"context.conf"}},
+ {agent_usm,{data_dir_file,"usm.conf"}},
+ {agent_community,{data_dir_file,"community.conf"}},
+ {agent_notify_def,{data_dir_file,"notify.conf"}},
+ {agent_sysinfo,{data_dir_file,"standard.conf"}},
+ {agent_target_address_def,{data_dir_file,"target_addr.conf"}},
+ {agent_target_param_def,{data_dir_file,"target_params.conf"}},
+ {agent_vacm,{data_dir_file,"vacm.conf"}}]}.
+{snmp_app1,[{manager, [{config, [{verbosity, silence}]},
+ {server,[{verbosity,silence}]},
+ {net_if,[{verbosity,silence}]},
+ {versions,[v2]}
+ ]},
+ {agent, [{config, [{verbosity, silence}]},
+ {net_if,[{verbosity,silence}]},
+ {mib_server,[{verbosity,silence}]},
+ {local_db,[{verbosity,silence}]},
+ {agent_verbosity,silence}
+ ]}]}.
+{snmp_app2,[{manager, [{config, [{verbosity, silence}]},
+ {server,[{verbosity,silence}]},
+ {net_if,[{verbosity,silence}]}
+ ]},
+ {agent, [{config, [{verbosity, silence}]},
+ {net_if,[{verbosity,silence}]},
+ {mib_server,[{verbosity,silence}]},
+ {local_db,[{verbosity,silence}]},
+ {agent_verbosity,silence}
+ ]}]}.
diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp1_SUITE.erl b/lib/common_test/test/ct_snmp_SUITE_data/snmp1_SUITE.erl
deleted file mode 100644
index dcc5c5378b..0000000000
--- a/lib/common_test/test/ct_snmp_SUITE_data/snmp1_SUITE.erl
+++ /dev/null
@@ -1,152 +0,0 @@
-%%--------------------------------------------------------------------
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2012. All Rights Reserved.
-%%
-%% The contents of this file are subject to the Erlang Public License,
-%% Version 1.1, (the "License"); you may not use this file except in
-%% compliance with the License. You should have received a copy of the
-%% Erlang Public License along with this software. If not, it can be
-%% retrieved online at http://www.erlang.org/.
-%%
-%% Software distributed under the License is distributed on an "AS IS"
-%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-%% the License for the specific language governing rights and limitations
-%% under the License.
-%%
-%% %CopyrightEnd%
-%%
-%%----------------------------------------------------------------------
-%% File: ct_snmp_SUITE.erl
-%%
-%% Description:
-%% This file contains the test cases for the ct_snmp API.
-%%
-%% @author Support
-%% @doc Test of SNMP support in common_test
-%% @end
-%%----------------------------------------------------------------------
-%%----------------------------------------------------------------------
--module(snmp1_SUITE).
--include_lib("common_test/include/ct.hrl").
--include_lib("snmp/include/STANDARD-MIB.hrl").
--include_lib("snmp/include/snmp_types.hrl").
-
--compile(export_all).
-
-%% Default timetrap timeout (set in init_per_testcase).
--define(default_timeout, ?t:minutes(1)).
-
-%% SNMP user stuff
--behaviour(snmpm_user).
--export([handle_error/3,
- handle_agent/5,
- handle_pdu/4,
- handle_trap/3,
- handle_inform/3,
- handle_report/3]).
-
-
-suite() ->
- [{require, snmp_mgr_agent, snmp},
- {require, snmp_app_cfg, snmp_app}].
-
-all() ->
- [start_stop,
- {group,get_set}].
-
-
-groups() ->
- [{get_set,[get_values,get_next_values,set_values]}].
-
-init_per_group(get_set, Config) ->
- ok = ct_snmp:start(Config,snmp_mgr_agent,snmp_app_cfg),
- Config.
-
-end_per_group(get_set, Config) ->
- ok = ct_snmp:stop(Config),
- Config.
-
-init_per_testcase(_Case, Config) ->
- Dog = test_server:timetrap(?default_timeout),
- [{watchdog, Dog}|Config].
-
-end_per_testcase(_Case, Config) ->
- Dog=?config(watchdog, Config),
- test_server:timetrap_cancel(Dog),
- ok.
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(Config) ->
- Config.
-
-break(_Config) ->
- test_server:break(""),
- ok.
-
-start_stop(Config) ->
- ok = ct_snmp:start(Config,snmp_mgr_agent,snmp_app_cfg),
- timer:sleep(1000),
- {snmp,_,_} = lists:keyfind(snmp,1,application:which_applications()),
- [_|_] = filelib:wildcard("*/*.conf",?config(priv_dir,Config)),
-
- ok = ct_snmp:stop(Config),
- timer:sleep(1000),
- false = lists:keyfind(snmp,1,application:which_applications()),
- [] = filelib:wildcard("*/*.conf",?config(priv_dir,Config)),
- ok.
-
-get_values(_Config) ->
- Oids1 = [?sysDescr_instance, ?sysName_instance],
- {noError,_,V1} = ct_snmp:get_values(agent_name,Oids1,snmp_mgr_agent),
- [#varbind{oid=?sysDescr_instance,value="Erlang SNMP agent"},
- #varbind{oid=?sysName_instance,value="ct_test"}] = V1,
- ok.
-
-get_next_values(_Config) ->
- Oids2 = [?system],
- {noError,_,V2} = ct_snmp:get_next_values(agent_name,Oids2,snmp_mgr_agent),
- [#varbind{oid=?sysDescr_instance,value="Erlang SNMP agent"}] = V2,
- ok.
-
-set_values(Config) ->
- Oid3 = ?sysName_instance,
- NewName = "ct_test changed by " ++ atom_to_list(?MODULE),
- VarsAndVals = [{Oid3,s,NewName}],
- {noError,_,_} =
- ct_snmp:set_values(agent_name,VarsAndVals,snmp_mgr_agent,Config),
-
- Oids4 = [?sysName_instance],
- {noError,_,V4} = ct_snmp:get_values(agent_name,Oids4,snmp_mgr_agent),
- [#varbind{oid=?sysName_instance,value=NewName}] = V4,
-
- ok.
-
-
-%%%-----------------------------------------------------------------
-%%% SNMP Manager User callback
-handle_error(ReqId, Reason, UserData) ->
- erlang:display({handle_error,ReqId, Reason, UserData}),
- ignore.
-
-handle_agent(Addr, Port, Type, SnmpInfo, UserData) ->
- erlang:display({handle_agent,Addr, Port, Type, SnmpInfo, UserData}),
- ignore.
-
-handle_pdu(TargetName, ReqId, SnmpPduInfo, UserData) ->
- erlang:display({handle_pdu,TargetName, ReqId, SnmpPduInfo, UserData}),
- ignore.
-
-handle_trap(TargetName, SnmpTrapInfo, UserData) ->
- erlang:display({handle_trap,TargetName, SnmpTrapInfo, UserData}),
- ignore.
-
-handle_inform(TargetName, SnmpInformInfo, UserData) ->
- erlang:display({handle_inform,TargetName, SnmpInformInfo, UserData}),
- ignore.
-
-handle_report(TargetName, SnmpReportInfo, UserData) ->
- erlang:display({handle_report,TargetName, SnmpReportInfo, UserData}),
- ignore.
diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl
new file mode 100644
index 0000000000..16b2b5690c
--- /dev/null
+++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl
@@ -0,0 +1,395 @@
+%%--------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+%% File: ct_snmp_SUITE.erl
+%%
+%% Description:
+%% This file contains the test cases for the ct_snmp API.
+%%
+%% @author Support
+%% @doc Test of SNMP support in common_test
+%% @end
+%%----------------------------------------------------------------------
+%%----------------------------------------------------------------------
+-module(snmp_SUITE).
+-include_lib("common_test/include/ct.hrl").
+-include_lib("snmp/include/STANDARD-MIB.hrl").
+-include_lib("snmp/include/SNMP-USER-BASED-SM-MIB.hrl").
+-include_lib("snmp/include/snmp_types.hrl").
+
+-compile(export_all).
+
+%% Default timetrap timeout (set in init_per_testcase).
+-define(default_timeout, ?t:minutes(1)).
+
+-define(AGENT_UDP, 4000).
+
+suite() ->
+ [
+ {require, snmp1, snmp1},
+ {require, snmp_app1, snmp_app1},
+ {require, snmp2, snmp2},
+ {require, snmp_app2, snmp_app2},
+ {require, snmp3, snmp3}
+ ].
+
+all() ->
+ [start_stop,
+ {group,get_set},
+ {group,register},
+ {group,override},
+ set_info].
+
+
+groups() ->
+ [{get_set,[get_values,
+ get_next_values,
+ set_values,
+ load_mibs]},
+ {register,[register_users,
+ register_users_fail,
+ register_agents,
+ register_agents_fail,
+ register_usm_users,
+ register_usm_users_fail]},
+ {override,[override_usm,
+ override_standard,
+ override_context,
+ override_community,
+ override_notify,
+ override_target_addr,
+ override_target_params,
+ override_vacm]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ Config.
+
+init_per_group(get_set, Config) ->
+ ok = ct_snmp:start(Config,snmp1,snmp_app1),
+ Config;
+init_per_group(register, Config) ->
+ ok = ct_snmp:start(Config,snmp2,snmp_app2),
+ Config;
+init_per_group(_, Config) ->
+ ok = ct_snmp:start(Config,snmp3,snmp_app2),
+ Config.
+
+end_per_group(_Group, Config) ->
+ catch ct_snmp:stop(Config),
+ Config.
+
+init_per_testcase(_Case, Config) ->
+ Dog = test_server:timetrap(?default_timeout),
+ [{watchdog, Dog}|Config].
+
+end_per_testcase(Case, Config) ->
+ try apply(?MODULE,Case,[cleanup,Config])
+ catch error:undef -> ok
+ end,
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Test cases
+break(_Config) ->
+ test_server:break(""),
+ ok.
+
+start_stop(Config) ->
+ ok = ct_snmp:start(Config,snmp1,snmp_app1),
+ timer:sleep(1000),
+ {snmp,_,_} = lists:keyfind(snmp,1,application:which_applications()),
+ [_|_] = filelib:wildcard("*/*.conf",?config(priv_dir,Config)),
+
+ ok = ct_snmp:stop(Config),
+ timer:sleep(1000),
+ false = lists:keyfind(snmp,1,application:which_applications()),
+ [] = filelib:wildcard("*/*.conf",?config(priv_dir,Config)),
+ ok.
+
+get_values(_Config) ->
+ Oids1 = [?sysDescr_instance, ?sysName_instance],
+ {noError,_,V1} = ct_snmp:get_values(agent_name,Oids1,snmp1),
+ [#varbind{oid=?sysDescr_instance,value="Erlang SNMP agent"},
+ #varbind{oid=?sysName_instance,value="ct_test"}] = V1,
+ ok.
+
+get_next_values(_Config) ->
+ Oids2 = [?system],
+ {noError,_,V2} = ct_snmp:get_next_values(agent_name,Oids2,snmp1),
+ [#varbind{oid=?sysDescr_instance,value="Erlang SNMP agent"}] = V2,
+ ok.
+
+set_values(Config) ->
+ Oid3 = ?sysName_instance,
+ NewName = "ct_test changed by " ++ atom_to_list(?MODULE),
+ VarsAndVals = [{Oid3,s,NewName}],
+ {noError,_,_} =
+ ct_snmp:set_values(agent_name,VarsAndVals,snmp1,Config),
+
+ Oids4 = [?sysName_instance],
+ {noError,_,V4} = ct_snmp:get_values(agent_name,Oids4,snmp1),
+ [#varbind{oid=?sysName_instance,value=NewName}] = V4,
+
+ ok.
+
+load_mibs(_Config) ->
+ [{'SNMPv2-MIB',_}=SnmpV2Mib] = snmpa:which_mibs(),
+ Mib = filename:join([code:priv_dir(snmp),"mibs","SNMP-USER-BASED-SM-MIB"]),
+ ok = ct_snmp:load_mibs([Mib]),
+ TwoMibs = [_,_] = snmpa:which_mibs(),
+ [{'SNMP-USER-BASED-SM-MIB',_}] = lists:delete(SnmpV2Mib,TwoMibs),
+ ok = ct_snmp:unload_mibs([Mib]),
+ [{'SNMPv2-MIB',_}] = snmpa:which_mibs(),
+ ok.
+
+
+register_users(_Config) ->
+ [] = snmpm:which_users(),
+ ok = ct_snmp:register_users(snmp2,[{reg_user1,[snmpm_user_default,[]]}]),
+ [_] = snmpm:which_users(),
+ [_] = ct:get_config({snmp2,users}),
+ ok = ct_snmp:register_users(snmp2,[{reg_user2,[snmpm_user_default,[]]}]),
+ [_,_] = snmpm:which_users(),
+ [_,_] = ct:get_config({snmp2,users}),
+ ok = ct_snmp:register_users(snmp2,[{reg_user3,[snmpm_user_default,[]]}]),
+ [_,_,_] = snmpm:which_users(),
+ [_,_,_] = ct:get_config({snmp2,users}),
+ ok = ct_snmp:unregister_users(snmp2,[reg_user3]),
+ [_,_] = snmpm:which_users(),
+ [_,_] = ct:get_config({snmp2,users}),
+ ok = ct_snmp:unregister_users(snmp2),
+ [] = snmpm:which_users(),
+ [] = ct:get_config({snmp2,users}),
+ ok.
+register_users(cleanup,_Config) ->
+ ct_snmp:unregister_users(snmp2).
+
+register_users_fail(_Config) ->
+ [] = snmpm:which_users(),
+ {error,_} = ct_snmp:register_users(snmp2,[{reg_user3,[unknown_module,[]]}]),
+ [] = snmpm:which_users(),
+ ok.
+register_users_fail(cleanup,_Config) ->
+ ct_snmp:unregister_users(snmp2).
+
+register_agents(_Config) ->
+ {ok, HostName} = inet:gethostname(),
+ {ok, Addr} = inet:getaddr(HostName, inet),
+
+ [] = snmpm:which_agents(),
+ ok = ct_snmp:register_users(snmp2,[{reg_user1,[snmpm_user_default,[]]}]),
+ ok = ct_snmp:register_agents(snmp2,[{reg_agent1,
+ [reg_user1,Addr,?AGENT_UDP,[]]}]),
+ [_] = snmpm:which_agents(),
+ [_] = ct:get_config({snmp2,managed_agents}),
+ ok = ct_snmp:register_agents(snmp2,[{reg_agent2,
+ [reg_user1,Addr,?AGENT_UDP,[]]}]),
+ [_,_] = snmpm:which_agents(),
+ [_,_] = ct:get_config({snmp2,managed_agents}),
+
+ ok = ct_snmp:register_agents(snmp2,[{reg_agent3,
+ [reg_user1,Addr,?AGENT_UDP,[]]}]),
+ [_,_,_] = snmpm:which_agents(),
+ [_,_,_] = ct:get_config({snmp2,managed_agents}),
+
+ ok = ct_snmp:unregister_agents(snmp2,[reg_agent3]),
+ [_,_] = snmpm:which_agents(),
+ [_,_] = ct:get_config({snmp2,managed_agents}),
+
+ ok = ct_snmp:unregister_agents(snmp2),
+ ok = ct_snmp:unregister_users(snmp2),
+ [] = snmpm:which_agents(),
+ [] = ct:get_config({snmp2,managed_agents}),
+ ok.
+register_agents(cleanup,_Config) ->
+ ct_snmp:unregister_agents(snmp2),
+ ct_snmp:unregister_users(snmp2).
+
+register_agents_fail(_Config) ->
+ {ok, HostName} = inet:gethostname(),
+ {ok, Addr} = inet:getaddr(HostName, inet),
+
+ [] = snmpm:which_agents(),
+ {error,_}
+ = ct_snmp:register_agents(snmp2,[{reg_agent3,
+ [unknown_user,Addr,?AGENT_UDP,[]]}]),
+ [] = snmpm:which_agents(),
+ ok.
+register_agents_fail(cleanup,_Config) ->
+ ct_snmp:unregister_agents(snmp2).
+
+register_usm_users(_Config) ->
+ [] = snmpm:which_usm_users(),
+ ok = ct_snmp:register_usm_users(snmp2,[{"reg_usm_user1",[]}]),
+ [_] = snmpm:which_usm_users(),
+ [_] = ct:get_config({snmp2,usm_users}),
+ ok = ct_snmp:register_usm_users(snmp2,[{"reg_usm_user2",[]}]),
+ [_,_] = snmpm:which_usm_users(),
+ [_,_] = ct:get_config({snmp2,usm_users}),
+ ok = ct_snmp:register_usm_users(snmp2,[{"reg_usm_user3",[]}]),
+ [_,_,_] = snmpm:which_usm_users(),
+ [_,_,_] = ct:get_config({snmp2,usm_users}),
+ ok = ct_snmp:unregister_usm_users(snmp2,["reg_usm_user3"]),
+ [_,_] = snmpm:which_usm_users(),
+ [_,_] = ct:get_config({snmp2,usm_users}),
+ ok = ct_snmp:unregister_usm_users(snmp2),
+ [] = snmpm:which_usm_users(),
+ [] = ct:get_config({snmp2,usm_users}),
+ ok.
+register_usm_users(cleanup,_Config) ->
+ ct_snmp:unregister_usm_users(snmp2).
+
+register_usm_users_fail(_Config) ->
+ [] = snmpm:which_usm_users(),
+ {error,_}
+ = ct_snmp:register_usm_users(snmp2,[{"reg_usm_user3",
+ [{sec_name,invalid_data_type}]}]),
+ [] = snmpm:which_usm_users(),
+ ok.
+register_usm_users_fail(cleanup,_Config) ->
+ ct_snmp:unregister_usm_users(snmp2).
+
+%% Test that functionality for overriding default configuration file
+%% works - i.e. that the files are written and that the configuration
+%% is actually used.
+%%
+%% Note that the config files used in this test case do not
+%% necessarily make up a reasonable configuration for the snmp
+%% application...
+override_usm(Config) ->
+ DataDir = ?config(data_dir,Config),
+ PrivDir = ?config(priv_dir,Config),
+ ConfDir = filename:join(PrivDir,"conf"),
+
+ Mib = filename:join([code:priv_dir(snmp),"mibs","SNMP-USER-BASED-SM-MIB"]),
+ ok = ct_snmp:load_mibs([Mib]),
+
+ %% Check that usm.conf is overwritten
+ {ok,MyUsm} = snmpa_conf:read_usm_config(DataDir),
+ {ok,UsedUsm} = snmpa_conf:read_usm_config(ConfDir),
+ true = (MyUsm == UsedUsm),
+
+ %% Check that the usm user is actually configured...
+ [{Index,"secname"}] =
+ snmp_user_based_sm_mib:usmUserTable(get_next,?usmUserEntry,[3]),
+ true = lists:suffix("usm_user_name",Index),
+ ok.
+
+override_standard(Config) ->
+ DataDir = ?config(data_dir,Config),
+ PrivDir = ?config(priv_dir,Config),
+ ConfDir = filename:join(PrivDir,"conf"),
+
+ %% Check that standard.conf is overwritten
+ {ok,MyStandard} = snmpa_conf:read_standard_config(DataDir),
+ {ok,UsedStandard} = snmpa_conf:read_standard_config(ConfDir),
+ true = (MyStandard == UsedStandard),
+
+ %% Check that the values from standard.conf is actually configured...
+ {value,"name for override test"} = snmp_standard_mib:sysName(get),
+ {value,"agent for ct_snmp override test"} = snmp_standard_mib:sysDescr(get),
+ ok.
+
+override_context(Config) ->
+ DataDir = ?config(data_dir,Config),
+ PrivDir = ?config(priv_dir,Config),
+ ConfDir = filename:join(PrivDir,"conf"),
+
+ %% Check that context.conf is overwritten
+ {ok,MyContext} = snmpa_conf:read_context_config(DataDir),
+ {ok,UsedContext} = snmpa_conf:read_context_config(ConfDir),
+ true = (MyContext == UsedContext),
+ ok.
+
+override_community(Config) ->
+ DataDir = ?config(data_dir,Config),
+ PrivDir = ?config(priv_dir,Config),
+ ConfDir = filename:join(PrivDir,"conf"),
+
+ %% Check that community.conf is overwritten
+ {ok,MyCommunity} = snmpa_conf:read_community_config(DataDir),
+ {ok,UsedCommunity} = snmpa_conf:read_community_config(ConfDir),
+ true = (MyCommunity == UsedCommunity),
+ ok.
+
+override_notify(Config) ->
+ DataDir = ?config(data_dir,Config),
+ PrivDir = ?config(priv_dir,Config),
+ ConfDir = filename:join(PrivDir,"conf"),
+
+ %% Check that notify.conf is overwritten
+ {ok,MyNotify} = snmpa_conf:read_notify_config(DataDir),
+ {ok,UsedNotify} = snmpa_conf:read_notify_config(ConfDir),
+ true = (MyNotify == UsedNotify),
+ ok.
+
+override_target_addr(Config) ->
+ DataDir = ?config(data_dir,Config),
+ PrivDir = ?config(priv_dir,Config),
+ ConfDir = filename:join(PrivDir,"conf"),
+
+ %% Check that target_addr.conf is overwritten
+ {ok,MyTargetAddr} = snmpa_conf:read_target_addr_config(DataDir),
+ {ok,UsedTargetAddr} = snmpa_conf:read_target_addr_config(ConfDir),
+ true = (MyTargetAddr == UsedTargetAddr),
+ ok.
+
+override_target_params(Config) ->
+ DataDir = ?config(data_dir,Config),
+ PrivDir = ?config(priv_dir,Config),
+ ConfDir = filename:join(PrivDir,"conf"),
+
+ %% Check that target_params.conf is overwritten
+ {ok,MyTargetParams} = snmpa_conf:read_target_params_config(DataDir),
+ {ok,UsedTargetParams} = snmpa_conf:read_target_params_config(ConfDir),
+ true = (MyTargetParams == UsedTargetParams),
+ ok.
+
+override_vacm(Config) ->
+ DataDir = ?config(data_dir,Config),
+ PrivDir = ?config(priv_dir,Config),
+ ConfDir = filename:join(PrivDir,"conf"),
+
+ %% Check that vacm.conf is overwritten
+ {ok,MyVacm} = snmpa_conf:read_vacm_config(DataDir),
+ {ok,UsedVacm} = snmpa_conf:read_vacm_config(ConfDir),
+ true = (MyVacm == UsedVacm),
+ ok.
+
+
+
+
+%% NOTE!! This test must always be executed last in the suite, and
+%% should match all set requests performed in the suite. I.e. if you
+%% add a set request, you must add an entry in the return value of
+%% ct_snmp:set_info/1 below.
+set_info(Config) ->
+ %% From test case set_values/1:
+ Oid1 = ?sysName_instance,
+ NewValue1 = "ct_test changed by " ++ atom_to_list(?MODULE),
+
+ %% The test...
+ [{_AgentName,_,[{Oid1,_,NewValue1}]}]
+ = ct_snmp:set_info(Config),
+ ok.
diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/community.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/community.conf
new file mode 100644
index 0000000000..5a64df6605
--- /dev/null
+++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/community.conf
@@ -0,0 +1 @@
+{"public", "public", "initial", "", ""}.
diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/context.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/context.conf
new file mode 100644
index 0000000000..feed5e1d11
--- /dev/null
+++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/context.conf
@@ -0,0 +1 @@
+"testcontext".
diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/notify.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/notify.conf
new file mode 100644
index 0000000000..367ba3aa4b
--- /dev/null
+++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/notify.conf
@@ -0,0 +1 @@
+{"standard inform", "std_inform", inform}.
diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/standard.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/standard.conf
new file mode 100644
index 0000000000..79908fb355
--- /dev/null
+++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/standard.conf
@@ -0,0 +1,7 @@
+{sysDescr, "agent for ct_snmp override test"}.
+{sysObjectID, [1,2,3]}.
+{sysContact, "[email protected]"}.
+{sysLocation, "erlang"}.
+{sysServices, 72}.
+{snmpEnableAuthenTraps, enabled}.
+{sysName, "name for override test"}.
diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_addr.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_addr.conf
new file mode 100644
index 0000000000..d02672a074
--- /dev/null
+++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_addr.conf
@@ -0,0 +1,2 @@
+{"target1", snmpUDPDomain, [147,214,122,73], 5000, 1500, 3, "std_trap", "target_v3", "", [], 2048}.
+{"target2", snmpUDPDomain, [147,214,122,73], 5000, 1500, 3, "std_inform", "target_v3", "", [], 2048}.
diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_params.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_params.conf
new file mode 100644
index 0000000000..5a9a619422
--- /dev/null
+++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_params.conf
@@ -0,0 +1 @@
+{"target_v3", v3, usm, "initial", noAuthNoPriv}.
diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/usm.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/usm.conf
new file mode 100644
index 0000000000..d6e245914e
--- /dev/null
+++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/usm.conf
@@ -0,0 +1 @@
+{"ct_snmp-test-engine","usm_user_name","secname",zeroDotZero,usmNoAuthProtocol,"","",usmNoPrivProtocol,"","","","",""}.
diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/vacm.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/vacm.conf
new file mode 100644
index 0000000000..158fe02e3b
--- /dev/null
+++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/vacm.conf
@@ -0,0 +1,6 @@
+{vacmSecurityToGroup, usm, "initial", "initial"}.
+{vacmAccess, "initial", "", any, noAuthNoPriv, exact, "restricted", "", "restricted"}.
+{vacmAccess, "initial", "", usm, authNoPriv, exact, "internet", "internet", "internet"}.
+{vacmAccess, "initial", "", usm, authPriv, exact, "internet", "internet", "internet"}.
+{vacmViewTreeFamily, "restricted", [1,3,6,1], included, null}.
+{vacmViewTreeFamily, "internet", [1,3,6,1], included, null}.
diff --git a/lib/common_test/test/ct_testspec_1_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE.erl
index b7e19f25dd..6a4a4acd80 100644
--- a/lib/common_test/test/ct_testspec_1_SUITE.erl
+++ b/lib/common_test/test/ct_testspec_1_SUITE.erl
@@ -58,7 +58,7 @@ end_per_testcase(TestCase, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
-all() ->
+all() ->
[all_suites, skip_all_suites, suite, skip_suite,
all_testcases, skip_all_testcases, testcase,
skip_testcase, all_groups, skip_all_groups, group,
@@ -67,23 +67,23 @@ all() ->
skip_group_testcase, topgroup, subgroup, skip_subgroup,
subgroup_all_testcases, skip_subgroup_all_testcases,
subgroup_testcase, skip_subgroup_testcase,
- sub_skipped_by_top, testcase_in_multiple_groups,
- order_of_tests_in_multiple_dirs_no_merge_tests,
- order_of_tests_in_multiple_suites_no_merge_tests,
- order_of_suites_in_multiple_dirs_no_merge_tests,
- order_of_groups_in_multiple_dirs_no_merge_tests,
- order_of_groups_in_multiple_suites_no_merge_tests,
- order_of_tests_in_multiple_dirs,
- order_of_tests_in_multiple_suites,
- order_of_suites_in_multiple_dirs,
- order_of_groups_in_multiple_dirs,
- order_of_groups_in_multiple_suites,
- order_of_tests_in_multiple_suites_with_skip_no_merge_tests,
- order_of_tests_in_multiple_suites_with_skip,
+ sub_skipped_by_top, testcase_many_groups,
+ order_of_tests_many_dirs_no_merge_tests,
+ order_of_tests_many_suites_no_merge_tests,
+ order_of_suites_many_dirs_no_merge_tests,
+ order_of_groups_many_dirs_no_merge_tests,
+ order_of_groups_many_suites_no_merge_tests,
+ order_of_tests_many_dirs,
+ order_of_tests_many_suites,
+ order_of_suites_many_dirs,
+ order_of_groups_many_dirs,
+ order_of_groups_many_suites,
+ order_of_tests_many_suites_with_skip_no_merge_tests,
+ order_of_tests_many_suites_with_skip,
all_plus_one_tc_no_merge_tests,
all_plus_one_tc].
-groups() ->
+groups() ->
[].
init_per_group(_GroupName, Config) ->
@@ -373,19 +373,19 @@ sub_skipped_by_top(Config) when is_list(Config) ->
%%%-----------------------------------------------------------------
%%%
-testcase_in_multiple_groups(Config) when is_list(Config) ->
+testcase_many_groups(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
TestDir = filename:join(DataDir, "groups_1"),
TestSpec = [{cases,TestDir,groups_12_SUITE,[testcase_1a,testcase_1b]},
{skip_cases,TestDir,groups_12_SUITE,[testcase_1b],"SKIPPED!"}],
- setup_and_execute(testcase_in_multiple_groups, TestSpec, Config).
+ setup_and_execute(testcase_many_groups, TestSpec, Config).
%%%-----------------------------------------------------------------
%%%
-order_of_tests_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) ->
+order_of_tests_many_dirs_no_merge_tests(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
TestDir1 = filename:join(DataDir, "groups_1"),
@@ -395,13 +395,13 @@ order_of_tests_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) ->
{cases,TestDir2,groups_22_SUITE,[testcase_1]},
{cases,TestDir1,groups_12_SUITE,[testcase_1b]}],
- setup_and_execute(order_of_tests_in_multiple_dirs_no_merge_tests,
+ setup_and_execute(order_of_tests_many_dirs_no_merge_tests,
TestSpec, Config).
%%%-----------------------------------------------------------------
%%%
-order_of_tests_in_multiple_suites_no_merge_tests(Config) when is_list(Config) ->
+order_of_tests_many_suites_no_merge_tests(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
TestDir1 = filename:join(DataDir, "groups_1"),
@@ -410,13 +410,13 @@ order_of_tests_in_multiple_suites_no_merge_tests(Config) when is_list(Config) ->
{cases,TestDir1,groups_11_SUITE,[testcase_1]},
{cases,TestDir1,groups_12_SUITE,[testcase_1b]}],
- setup_and_execute(order_of_tests_in_multiple_suites_no_merge_tests,
+ setup_and_execute(order_of_tests_many_suites_no_merge_tests,
TestSpec, Config).
%%%-----------------------------------------------------------------
%%%
-order_of_suites_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) ->
+order_of_suites_many_dirs_no_merge_tests(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
TestDir1 = filename:join(DataDir, "groups_1"),
@@ -426,13 +426,13 @@ order_of_suites_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) ->
{suites,TestDir2,groups_22_SUITE},
{suites,TestDir1,groups_11_SUITE}],
- setup_and_execute(order_of_suites_in_multiple_dirs_no_merge_tests,
+ setup_and_execute(order_of_suites_many_dirs_no_merge_tests,
TestSpec, Config).
%%%-----------------------------------------------------------------
%%%
-order_of_groups_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) ->
+order_of_groups_many_dirs_no_merge_tests(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
TestDir1 = filename:join(DataDir, "groups_1"),
@@ -442,13 +442,13 @@ order_of_groups_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) ->
{groups,TestDir2,groups_22_SUITE,test_group_1a},
{groups,TestDir1,groups_12_SUITE,test_group_1b}],
- setup_and_execute(order_of_groups_in_multiple_dirs_no_merge_tests,
+ setup_and_execute(order_of_groups_many_dirs_no_merge_tests,
TestSpec, Config).
%%%-----------------------------------------------------------------
%%%
-order_of_groups_in_multiple_suites_no_merge_tests(Config)
+order_of_groups_many_suites_no_merge_tests(Config)
when is_list(Config) ->
DataDir = ?config(data_dir, Config),
@@ -458,13 +458,13 @@ order_of_groups_in_multiple_suites_no_merge_tests(Config)
{groups,TestDir1,groups_11_SUITE,test_group_1a},
{groups,TestDir1,groups_12_SUITE,test_group_1b}],
- setup_and_execute(order_of_groups_in_multiple_suites_no_merge_tests,
+ setup_and_execute(order_of_groups_many_suites_no_merge_tests,
TestSpec, Config).
%%%-----------------------------------------------------------------
%%%
-order_of_tests_in_multiple_suites_with_skip_no_merge_tests(Config)
+order_of_tests_many_suites_with_skip_no_merge_tests(Config)
when is_list(Config) ->
DataDir = ?config(data_dir, Config),
@@ -477,14 +477,14 @@ order_of_tests_in_multiple_suites_with_skip_no_merge_tests(Config)
{skip_cases,TestDir1,groups_12_SUITE,[testcase_1b],"Skip it"}],
setup_and_execute(
- order_of_tests_in_multiple_suites_with_skip_no_merge_tests,
+ order_of_tests_many_suites_with_skip_no_merge_tests,
TestSpec, Config).
%%%-----------------------------------------------------------------
%%%
-order_of_tests_in_multiple_dirs(Config) when is_list(Config) ->
+order_of_tests_many_dirs(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
TestDir1 = filename:join(DataDir, "groups_1"),
@@ -493,13 +493,13 @@ order_of_tests_in_multiple_dirs(Config) when is_list(Config) ->
{cases,TestDir2,groups_22_SUITE,[testcase_1]},
{cases,TestDir1,groups_12_SUITE,[testcase_1b]}],
- setup_and_execute(order_of_tests_in_multiple_dirs,
+ setup_and_execute(order_of_tests_many_dirs,
TestSpec, Config).
%%%-----------------------------------------------------------------
%%%
-order_of_tests_in_multiple_suites(Config) when is_list(Config) ->
+order_of_tests_many_suites(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
TestDir1 = filename:join(DataDir, "groups_1"),
@@ -507,13 +507,13 @@ order_of_tests_in_multiple_suites(Config) when is_list(Config) ->
{cases,TestDir1,groups_11_SUITE,[testcase_1]},
{cases,TestDir1,groups_12_SUITE,[testcase_1b]}],
- setup_and_execute(order_of_tests_in_multiple_suites,
+ setup_and_execute(order_of_tests_many_suites,
TestSpec, Config).
%%%-----------------------------------------------------------------
%%%
-order_of_suites_in_multiple_dirs(Config) when is_list(Config) ->
+order_of_suites_many_dirs(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
TestDir1 = filename:join(DataDir, "groups_1"),
@@ -522,13 +522,13 @@ order_of_suites_in_multiple_dirs(Config) when is_list(Config) ->
{suites,TestDir2,groups_22_SUITE},
{suites,TestDir1,groups_11_SUITE}],
- setup_and_execute(order_of_suites_in_multiple_dirs,
+ setup_and_execute(order_of_suites_many_dirs,
TestSpec, Config).
%%%-----------------------------------------------------------------
%%%
-order_of_groups_in_multiple_dirs(Config) when is_list(Config) ->
+order_of_groups_many_dirs(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
TestDir1 = filename:join(DataDir, "groups_1"),
@@ -537,13 +537,13 @@ order_of_groups_in_multiple_dirs(Config) when is_list(Config) ->
{groups,TestDir2,groups_22_SUITE,test_group_1a},
{groups,TestDir1,groups_12_SUITE,test_group_1b}],
- setup_and_execute(order_of_groups_in_multiple_dirs,
+ setup_and_execute(order_of_groups_many_dirs,
TestSpec, Config).
%%%-----------------------------------------------------------------
%%%
-order_of_groups_in_multiple_suites(Config) when is_list(Config) ->
+order_of_groups_many_suites(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
TestDir1 = filename:join(DataDir, "groups_1"),
@@ -551,13 +551,13 @@ order_of_groups_in_multiple_suites(Config) when is_list(Config) ->
{groups,TestDir1,groups_11_SUITE,test_group_1a},
{groups,TestDir1,groups_12_SUITE,test_group_1b}],
- setup_and_execute(order_of_groups_in_multiple_suites,
+ setup_and_execute(order_of_groups_many_suites,
TestSpec, Config).
%%%-----------------------------------------------------------------
%%%
-order_of_tests_in_multiple_suites_with_skip(Config) when is_list(Config) ->
+order_of_tests_many_suites_with_skip(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
TestDir1 = filename:join(DataDir, "groups_1"),
@@ -567,7 +567,7 @@ order_of_tests_in_multiple_suites_with_skip(Config) when is_list(Config) ->
{cases,TestDir1,groups_11_SUITE,[testcase_2]},
{skip_cases,TestDir1,groups_12_SUITE,[testcase_1b],"Skip it!"}],
- setup_and_execute(order_of_tests_in_multiple_suites_with_skip,
+ setup_and_execute(order_of_tests_many_suites_with_skip,
TestSpec, Config).
%%%-----------------------------------------------------------------
@@ -1204,10 +1204,10 @@ test_events(sub_skipped_by_top) ->
{negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}}
];
-test_events(testcase_in_multiple_groups) ->
+test_events(testcase_many_groups) ->
[];
-test_events(order_of_tests_in_multiple_dirs_no_merge_tests) ->
+test_events(order_of_tests_many_dirs_no_merge_tests) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_start,{groups_12_SUITE,testcase_1a}},
{?eh,tc_done, {groups_12_SUITE,testcase_1a,
@@ -1219,7 +1219,7 @@ test_events(order_of_tests_in_multiple_dirs_no_merge_tests) ->
{failed,{error,{test_case_failed,no_group_data}}}}},
{?eh,stop_logging,[]}
];
-test_events(order_of_tests_in_multiple_suites_no_merge_tests) ->
+test_events(order_of_tests_many_suites_no_merge_tests) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_start,{groups_12_SUITE,testcase_1a}},
{?eh,tc_done,{groups_12_SUITE,testcase_1a,'_'}},
@@ -1229,7 +1229,7 @@ test_events(order_of_tests_in_multiple_suites_no_merge_tests) ->
{?eh,tc_done,{groups_12_SUITE,testcase_1b,'_'}},
{?eh,stop_logging,[]}
];
-test_events(order_of_suites_in_multiple_dirs_no_merge_tests) ->
+test_events(order_of_suites_many_dirs_no_merge_tests) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_start,{groups_12_SUITE,init_per_suite}},
{?eh,tc_done,{groups_12_SUITE,init_per_suite,'_'}},
@@ -1244,7 +1244,7 @@ test_events(order_of_suites_in_multiple_dirs_no_merge_tests) ->
{?eh,tc_start,{groups_11_SUITE,end_per_suite}},
{?eh,tc_done,{groups_11_SUITE,end_per_suite,'_'}},
{?eh,stop_logging,[]}];
-test_events(order_of_groups_in_multiple_dirs_no_merge_tests) ->
+test_events(order_of_groups_many_dirs_no_merge_tests) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1a,'_'}}},
@@ -1257,7 +1257,7 @@ test_events(order_of_groups_in_multiple_dirs_no_merge_tests) ->
{?eh,tc_done, {groups_12_SUITE,{end_per_group,test_group_1b,'_'},'_'}},
{?eh,stop_logging,[]}];
-test_events(order_of_groups_in_multiple_suites_no_merge_tests) ->
+test_events(order_of_groups_many_suites_no_merge_tests) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1a,'_'}}},
@@ -1270,7 +1270,7 @@ test_events(order_of_groups_in_multiple_suites_no_merge_tests) ->
{?eh,tc_done, {groups_12_SUITE,{end_per_group,test_group_1b,'_'},'_'}},
{?eh,stop_logging,[]}];
-test_events(order_of_tests_in_multiple_suites_with_skip_no_merge_tests) ->
+test_events(order_of_tests_many_suites_with_skip_no_merge_tests) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_start,{groups_12_SUITE,testcase_1a}},
{?eh,tc_done,{groups_12_SUITE,testcase_1a,'_'}},
@@ -1282,7 +1282,7 @@ test_events(order_of_tests_in_multiple_suites_with_skip_no_merge_tests) ->
{?eh,stop_logging,[]}
];
-test_events(order_of_tests_in_multiple_dirs) ->
+test_events(order_of_tests_many_dirs) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_start,{groups_12_SUITE,testcase_1a}},
{?eh,tc_done,
@@ -1296,7 +1296,7 @@ test_events(order_of_tests_in_multiple_dirs) ->
{?eh,tc_done,{groups_22_SUITE,testcase_1,ok}},
{?eh,stop_logging,[]}
];
-test_events(order_of_tests_in_multiple_suites) ->
+test_events(order_of_tests_many_suites) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_start,{groups_12_SUITE,testcase_1a}},
{?eh,tc_done,{groups_12_SUITE,testcase_1a,'_'}},
@@ -1308,7 +1308,7 @@ test_events(order_of_tests_in_multiple_suites) ->
{?eh,tc_done,{groups_11_SUITE,testcase_1,ok}},
{?eh,stop_logging,[]}
];
-test_events(order_of_suites_in_multiple_dirs) ->
+test_events(order_of_suites_many_dirs) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_start,{groups_12_SUITE,init_per_suite}},
{?eh,tc_done,{groups_12_SUITE,init_per_suite,'_'}},
@@ -1325,7 +1325,7 @@ test_events(order_of_suites_in_multiple_dirs) ->
{?eh,tc_start,{groups_22_SUITE,end_per_suite}},
{?eh,tc_done,{groups_22_SUITE,end_per_suite,'_'}},
{?eh,stop_logging,[]}];
-test_events(order_of_groups_in_multiple_dirs) ->
+test_events(order_of_groups_many_dirs) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1a,'_'}}},
@@ -1338,7 +1338,7 @@ test_events(order_of_groups_in_multiple_dirs) ->
{?eh,tc_done, {groups_22_SUITE,{end_per_group,test_group_1a,'_'},'_'}},
{?eh,stop_logging,[]}];
-test_events(order_of_groups_in_multiple_suites) ->
+test_events(order_of_groups_many_suites) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1a,'_'}}},
@@ -1352,7 +1352,7 @@ test_events(order_of_groups_in_multiple_suites) ->
{?eh,stop_logging,[]}];
-test_events(order_of_tests_in_multiple_suites_with_skip) ->
+test_events(order_of_tests_many_suites_with_skip) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_start,{groups_12_SUITE,testcase_1a}},
{?eh,tc_done,{groups_12_SUITE,testcase_1a,'_'}},
diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl
index 3e3c12405f..d875c45c4a 100644
--- a/lib/dialyzer/src/dialyzer.erl
+++ b/lib/dialyzer/src/dialyzer.erl
@@ -2,7 +2,7 @@
%%-----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -380,8 +380,6 @@ message_to_string({pattern_match_cov, [Pat, Type]}) ->
message_to_string({unmatched_return, [Type]}) ->
io_lib:format("Expression produces a value of type ~s,"
" but this value is unmatched\n", [Type]);
-message_to_string({unused_fun, []}) ->
- io_lib:format("Function will never be called\n", []);
message_to_string({unused_fun, [F, A]}) ->
io_lib:format("Function ~w/~w will never be called\n", [F, A]);
%%----- Warnings for specs and contracts -------------------
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl
index 7131633da1..f40bb2d395 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -2806,7 +2806,7 @@ state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab,
true ->
{Warn, Msg} =
case dialyzer_callgraph:lookup_name(FunLbl, Callgraph) of
- error -> {true, {unused_fun, []}};
+ error -> {false, {}};
{ok, {_M, F, A} = MFA} ->
{not sets:is_element(MFA, NoWarnUnused),
{unused_fun, [F, A]}}
diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/asn1 b/lib/dialyzer/test/r9c_SUITE_data/results/asn1
index 292275dd6e..c11105b76d 100644
--- a/lib/dialyzer/test/r9c_SUITE_data/results/asn1
+++ b/lib/dialyzer/test/r9c_SUITE_data/results/asn1
@@ -68,7 +68,6 @@ asn1rt_check.erl:100: The variable _ can never match since previous clauses comp
asn1rt_check.erl:85: The variable _ can never match since previous clauses completely covered the type [any()]
asn1rt_driver_handler.erl:32: The pattern 'already_done' can never match the type {'error',_}
asn1rt_per.erl:1065: The pattern {'BMPString', {'octets', Ol}} can never match the type {_,[{'bits',1 | 2 | 4 | 8 | 16 | 32,_}]}
-asn1rt_per.erl:1066: Function will never be called
asn1rt_per.erl:1231: The call erlang:'not'('implemented') will never return since it differs in the 1st argument from the success typing arguments: (boolean())
asn1rt_per.erl:1233: The call erlang:'not'('implemented') will never return since it differs in the 1st argument from the success typing arguments: (boolean())
asn1rt_per.erl:1235: The call erlang:'not'('implemented') will never return since it differs in the 1st argument from the success typing arguments: (boolean())
@@ -76,7 +75,6 @@ asn1rt_per.erl:1237: The call erlang:'not'('implemented') will never return sinc
asn1rt_per.erl:989: The pattern <_C, 'true', _Val> can never match the type <_,'false',_>
asn1rt_per_bin.erl:1361: The pattern <_, 'true', _> can never match the type <_,'false',_>
asn1rt_per_bin.erl:1436: The pattern {'BMPString', {'octets', Ol}} can never match the type {'BMPString' | 'IA5String' | 'NumericString' | 'PrintableString' | 'UniversalString' | 'VisibleString',[{'bits',1 | 2 | 4 | 8 | 16 | 32,_}]}
-asn1rt_per_bin.erl:1437: Function will never be called
asn1rt_per_bin.erl:161: The call asn1rt_per_bin:getbit({0,maybe_improper_list()}) will never return since it differs in the 1st argument from the success typing arguments: (<<_:8,_:_*8>> | {non_neg_integer(),<<_:1,_:_*1>>})
asn1rt_per_bin.erl:1812: The pattern {Name, Val} can never match since previous clauses completely covered the type any()
asn1rt_per_bin.erl:2106: Cons will produce an improper list since its 2nd argument is binary()
@@ -94,7 +92,6 @@ asn1rt_per_bin.erl:487: The variable _ can never match since previous clauses co
asn1rt_per_bin.erl:498: The variable _ can never match since previous clauses completely covered the type integer()
asn1rt_per_bin_rt2ct.erl:152: The call asn1rt_per_bin_rt2ct:getbit({0,maybe_improper_list()}) will never return since it differs in the 1st argument from the success typing arguments: (<<_:8,_:_*8>> | {non_neg_integer(),<<_:1,_:_*1>>})
asn1rt_per_bin_rt2ct.erl:1533: The pattern {'BMPString', {'octets', Ol}} can never match the type {_,[[any(),...]]}
-asn1rt_per_bin_rt2ct.erl:1534: Function will never be called
asn1rt_per_bin_rt2ct.erl:1875: The pattern {Name, Val} can never match since previous clauses completely covered the type any()
asn1rt_per_bin_rt2ct.erl:443: The variable _ can never match since previous clauses completely covered the type integer()
asn1rt_per_bin_rt2ct.erl:464: The variable _ can never match since previous clauses completely covered the type integer()
@@ -103,4 +100,3 @@ asn1rt_per_bin_rt2ct.erl:484: The variable _ can never match since previous clau
asn1rt_per_bin_rt2ct.erl:495: The variable _ can never match since previous clauses completely covered the type integer()
asn1rt_per_v1.erl:1209: The pattern <_, 'true', _> can never match the type <_,'false',_>
asn1rt_per_v1.erl:1290: The pattern {'BMPString', {'octets', Ol}} can never match the type {'BMPString' | 'IA5String' | 'NumericString' | 'PrintableString' | 'UniversalString' | 'VisibleString',[{'bits',1 | 2 | 4 | 8 | 16 | 32,_}]}
-asn1rt_per_v1.erl:1291: Function will never be called
diff --git a/lib/dialyzer/test/small_SUITE_data/results/fun_ref_match b/lib/dialyzer/test/small_SUITE_data/results/fun_ref_match
index 60b34530b4..e69de29bb2 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/fun_ref_match
+++ b/lib/dialyzer/test/small_SUITE_data/results/fun_ref_match
@@ -1,2 +0,0 @@
-
-fun_ref_match.erl:14: Function will never be called
diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml
index 14ce3cbe7f..741f2abaef 100644
--- a/lib/inets/doc/src/httpc.xml
+++ b/lib/inets/doc/src/httpc.xml
@@ -43,8 +43,12 @@
cookies and other options that can be applied to more than one
request. </p>
- <p>If the scheme
- https is used the ssl application needs to be started.</p>
+ <p>If the scheme https is used the ssl application needs to be
+ started. When https links needs to go through a proxy the
+ CONNECT method extension to HTTP-1.1 is used to establish a
+ tunnel and then the connection is upgraded to TLS,
+ however "TLS upgrade" according to RFC 2817 is not
+ supported.</p>
<p>Also note that pipelining will only be used if the pipeline
timeout is set, otherwise persistent connections without
@@ -449,7 +453,8 @@ apply(Module, Function, [ReplyInfo | Args])
<type>
<v>Options = [Option]</v>
<v>Option = {proxy, {Proxy, NoProxy}} |
- {max_sessions, MaxSessions} |
+ {https_proxy, {Proxy, NoProxy}} |
+ {max_sessions, MaxSessions} |
{max_keep_alive_length, MaxKeepAlive} |
{keep_alive_timeout, KeepAliveTimeout} |
{max_pipeline_length, MaxPipeline} |
@@ -460,25 +465,23 @@ apply(Module, Function, [ReplyInfo | Args])
{port, Port} |
{socket_opts, socket_opts()} |
{verbose, VerboseMode} </v>
+
<v>Proxy = {Hostname, Port}</v>
<v>Hostname = string() </v>
<d>ex: "localhost" or "foo.bar.se"</d>
<v>Port = integer()</v>
<d>ex: 8080 </d>
- <v>socket_opts() = [socket_opt()]</v>
- <d>The options are appended to the socket options used by the
- client. </d>
- <d>These are the default values when a new request handler
- is started (for the initial connect). They are passed directly
- to the underlying transport (gen_tcp or ssl) <em>without</em>
- verification! </d>
<v>NoProxy = [NoProxyDesc]</v>
<v>NoProxyDesc = DomainDesc | HostName | IPDesc</v>
<v>DomainDesc = "*.Domain"</v>
<d>ex: "*.ericsson.se"</d>
<v>IpDesc = string()</v>
<d>ex: "134.138" or "[FEDC:BA98" (all IP-addresses starting with 134.138 or FEDC:BA98), "66.35.250.150" or "[2010:836B:4179::836B:4179]" (a complete IP-address).</d>
- <v>MaxSessions = integer() </v>
+
+ <d>proxy defaults to {undefined, []} e.i. no proxy is configured and https_proxy defaults to
+ the value of proxy.</d>
+
+ <v>MaxSessions = integer() </v>
<d>Default is <c>2</c>.
Maximum number of persistent connections to a host.</d>
<v>MaxKeepAlive = integer() </v>
@@ -520,6 +523,13 @@ apply(Module, Function, [ReplyInfo | Args])
<v>Port = integer() </v>
<d>Specify which local port number to use.
See <seealso marker="kernel:gen_tcp#connect">gen_tcp:connect/3,4</seealso> for more info. </d>
+ <v>socket_opts() = [socket_opt()]</v>
+ <d>The options are appended to the socket options used by the
+ client. </d>
+ <d>These are the default values when a new request handler
+ is started (for the initial connect). They are passed directly
+ to the underlying transport (gen_tcp or ssl) <em>without</em>
+ verification! </d>
<v>VerboseMode = false | verbose | debug | trace </v>
<d>Default is <c>false</c>.
This option is used to switch on (or off)
@@ -554,7 +564,8 @@ apply(Module, Function, [ReplyInfo | Args])
<fsummary>Gets the currently used options.</fsummary>
<type>
<v>OptionItems = all | [option_item()]</v>
- <v>option_item() = proxy |
+ <v>option_item() = proxy |
+ https_proxy
max_sessions |
keep_alive_timeout |
max_keep_alive_length |
diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl
index b6e7708353..ede649a5a9 100644
--- a/lib/inets/src/http_client/httpc.erl
+++ b/lib/inets/src/http_client/httpc.erl
@@ -917,6 +917,10 @@ validate_options([{proxy, Proxy} = Opt| Tail], Acc) ->
validate_proxy(Proxy),
validate_options(Tail, [Opt | Acc]);
+validate_options([{https_proxy, Proxy} = Opt| Tail], Acc) ->
+ validate_https_proxy(Proxy),
+ validate_options(Tail, [Opt | Acc]);
+
validate_options([{max_sessions, Value} = Opt| Tail], Acc) ->
validate_max_sessions(Value),
validate_options(Tail, [Opt | Acc]);
@@ -979,6 +983,14 @@ validate_proxy({{ProxyHost, ProxyPort}, NoProxy} = Proxy)
validate_proxy(BadProxy) ->
bad_option(proxy, BadProxy).
+validate_https_proxy({{ProxyHost, ProxyPort}, NoProxy} = Proxy)
+ when is_list(ProxyHost) andalso
+ is_integer(ProxyPort) andalso
+ is_list(NoProxy) ->
+ Proxy;
+validate_https_proxy(BadProxy) ->
+ bad_option(https_proxy, BadProxy).
+
validate_max_sessions(Value) when is_integer(Value) andalso (Value >= 0) ->
Value;
validate_max_sessions(BadValue) ->
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index 923213d34d..784a9c0019 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -29,44 +29,44 @@
%%--------------------------------------------------------------------
%% Internal Application API
-export([
- start_link/4,
- %% connect_and_send/2,
- send/2,
- cancel/3,
- stream/3,
- stream_next/1,
- info/1
- ]).
+ start_link/4,
+ %% connect_and_send/2,
+ send/2,
+ cancel/3,
+ stream/3,
+ stream_next/1,
+ info/1
+ ]).
%% gen_server callbacks
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
- terminate/2, code_change/3]).
+ terminate/2, code_change/3]).
-record(timers,
- {
- request_timers = [], % [ref()]
- queue_timer % ref()
- }).
+ {
+ request_timers = [], % [ref()]
+ queue_timer % ref()
+ }).
-record(state,
- {
- request, % #request{}
- session, % #session{}
- status_line, % {Version, StatusCode, ReasonPharse}
- headers, % #http_response_h{}
- body, % binary()
- mfa, % {Module, Function, Args}
- pipeline = queue:new(), % queue()
- keep_alive = queue:new(), % queue()
- status, % undefined | new | pipeline | keep_alive | close | ssl_tunnel
- canceled = [], % [RequestId]
- max_header_size = nolimit, % nolimit | integer()
- max_body_size = nolimit, % nolimit | integer()
- options, % #options{}
- timers = #timers{}, % #timers{}
- profile_name, % atom() - id of httpc_manager process.
- once % send | undefined
- }).
+ {
+ request, % #request{}
+ session, % #session{}
+ status_line, % {Version, StatusCode, ReasonPharse}
+ headers, % #http_response_h{}
+ body, % binary()
+ mfa, % {Module, Function, Args}
+ pipeline = queue:new(), % queue()
+ keep_alive = queue:new(), % queue()
+ status, % undefined | new | pipeline | keep_alive | close | {ssl_tunnel, Request}
+ canceled = [], % [RequestId]
+ max_header_size = nolimit, % nolimit | integer()
+ max_body_size = nolimit, % nolimit | integer()
+ options, % #options{}
+ timers = #timers{}, % #timers{}
+ profile_name, % atom() - id of httpc_manager process.
+ once % send | undefined
+ }).
%%====================================================================
@@ -75,8 +75,8 @@
%%--------------------------------------------------------------------
%% Function: start_link(Request, Options, ProfileName) -> {ok, Pid}
%%
-%% Request = #request{}
-%% Options = #options{}
+%% Request = #request{}
+%% Options = #options{}
%% ProfileName = atom() - id of httpc manager process
%%
%% Description: Starts a http-request handler process. Intended to be
@@ -96,11 +96,11 @@
start_link(Parent, Request, Options, ProfileName) ->
{ok, proc_lib:start_link(?MODULE, init, [[Parent, Request, Options,
- ProfileName]])}.
+ ProfileName]])}.
%%--------------------------------------------------------------------
%% Function: send(Request, Pid) -> ok
-%% Request = #request{}
+%% Request = #request{}
%% Pid = pid() - the pid of the http-request handler process.
%%
%% Description: Uses this handlers session to send a request. Intended
@@ -112,7 +112,7 @@ send(Request, Pid) ->
%%--------------------------------------------------------------------
%% Function: cancel(RequestId, Pid) -> ok
-%% RequestId = ref()
+%% RequestId = ref()
%% Pid = pid() - the pid of the http-request handler process.
%%
%% Description: Cancels a request. Intended to be called by the httpc
@@ -142,12 +142,16 @@ stream_next(Pid) ->
%% Used for debugging and testing
%%--------------------------------------------------------------------
info(Pid) ->
- call(info, Pid).
-
+ try
+ call(info, Pid)
+ catch
+ _:_ ->
+ []
+ end.
%%--------------------------------------------------------------------
%% Function: stream(BodyPart, Request, Code) -> _
-%% BodyPart = binary()
+%% BodyPart = binary()
%% Request = #request{}
%% Code = integer()
%%
@@ -167,7 +171,7 @@ stream(BodyPart, #request{stream = Self} = Request, Code)
((Self =:= self) orelse (Self =:= {self, once})) ->
?hcrt("stream - self", [{stream, Self}, {code, Code}]),
httpc_response:send(Request#request.from,
- {Request#request.id, stream, BodyPart}),
+ {Request#request.id, stream, BodyPart}),
{<<>>, Request};
%% Stream to file
@@ -177,11 +181,11 @@ stream(BodyPart, #request{stream = Filename} = Request, Code)
when ((Code =:= 200) orelse (Code =:= 206)) andalso is_list(Filename) ->
?hcrt("stream - filename", [{stream, Filename}, {code, Code}]),
case file:open(Filename, [write, raw, append, delayed_write]) of
- {ok, Fd} ->
- ?hcrt("stream - file open ok", [{fd, Fd}]),
- stream(BodyPart, Request#request{stream = Fd}, 200);
- {error, Reason} ->
- exit({stream_to_file_failed, Reason})
+ {ok, Fd} ->
+ ?hcrt("stream - file open ok", [{fd, Fd}]),
+ stream(BodyPart, Request#request{stream = Fd}, 200);
+ {error, Reason} ->
+ exit({stream_to_file_failed, Reason})
end;
%% Stream to file
@@ -189,10 +193,10 @@ stream(BodyPart, #request{stream = Fd} = Request, Code)
when ((Code =:= 200) orelse (Code =:= 206)) ->
?hcrt("stream to file", [{stream, Fd}, {code, Code}]),
case file:write(Fd, BodyPart) of
- ok ->
- {<<>>, Request};
- {error, Reason} ->
- exit({stream_to_file_failed, Reason})
+ ok ->
+ {<<>>, Request};
+ {error, Reason} ->
+ exit({stream_to_file_failed, Reason})
end;
stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed
@@ -208,7 +212,7 @@ stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed
%% Function: init([Options, ProfileName]) -> {ok, State} |
%% {ok, State, Timeout} | ignore | {stop, Reason}
%%
-%% Options = #options{}
+%% Options = #options{}
%% ProfileName = atom() - id of httpc manager process
%%
%% Description: Initiates the httpc_handler process
@@ -224,20 +228,19 @@ init([Parent, Request, Options, ProfileName]) ->
%% Do not let initial tcp-connection block the manager-process
proc_lib:init_ack(Parent, self()),
handle_verbose(Options#options.verbose),
- Address = handle_proxy(Request#request.address, Options#options.proxy),
+ ProxyOptions = handle_proxy_options(Request#request.scheme, Options),
+ Address = handle_proxy(Request#request.address, ProxyOptions),
{ok, State} =
- case {Address /= Request#request.address, Request#request.scheme} of
- {true, https} ->
- Error = https_through_proxy_is_not_currently_supported,
- self() ! {init_error,
- Error, httpc_response:error(Request, Error)},
- {ok, #state{request = Request, options = Options,
- status = ssl_tunnel}};
- {_, _} ->
- connect_and_send_first_request(Address, Request,
- #state{options = Options,
- profile_name = ProfileName})
- end,
+ case {Address /= Request#request.address, Request#request.scheme} of
+ {true, https} ->
+ connect_and_send_upgrade_request(Address, Request,
+ #state{options = Options,
+ profile_name = ProfileName});
+ {_, _} ->
+ connect_and_send_first_request(Address, Request,
+ #state{options = Options,
+ profile_name = ProfileName})
+ end,
gen_server:enter_loop(?MODULE, [], State).
%%--------------------------------------------------------------------
@@ -250,139 +253,139 @@ init([Parent, Request, Options, ProfileName]) ->
%% Description: Handling call messages
%%--------------------------------------------------------------------
handle_call(#request{address = Addr} = Request, _,
- #state{status = Status,
- session = #session{type = pipeline} = Session,
- timers = Timers,
- options = #options{proxy = Proxy} = _Options,
- profile_name = ProfileName} = State)
+ #state{status = Status,
+ session = #session{type = pipeline} = Session,
+ timers = Timers,
+ options = #options{proxy = Proxy} = _Options,
+ profile_name = ProfileName} = State)
when Status =/= undefined ->
?hcrv("new request on a pipeline session",
- [{request, Request},
- {profile, ProfileName},
- {status, Status},
- {timers, Timers}]),
+ [{request, Request},
+ {profile, ProfileName},
+ {status, Status},
+ {timers, Timers}]),
Address = handle_proxy(Addr, Proxy),
case httpc_request:send(Address, Session, Request) of
ok ->
- ?hcrd("request sent", []),
+ ?hcrd("request sent", []),
- %% Activate the request time out for the new request
- NewState =
- activate_request_timeout(State#state{request = Request}),
+ %% Activate the request time out for the new request
+ NewState =
+ activate_request_timeout(State#state{request = Request}),
- ClientClose =
- httpc_request:is_client_closing(Request#request.headers),
+ ClientClose =
+ httpc_request:is_client_closing(Request#request.headers),
case State#state.request of
#request{} -> %% Old request not yet finished
- ?hcrd("old request still not finished", []),
- %% Make sure to use the new value of timers in state
- NewTimers = NewState#state.timers,
+ ?hcrd("old request still not finished", []),
+ %% Make sure to use the new value of timers in state
+ NewTimers = NewState#state.timers,
NewPipeline = queue:in(Request, State#state.pipeline),
- NewSession =
- Session#session{queue_length =
- %% Queue + current
- queue:len(NewPipeline) + 1,
- client_close = ClientClose},
- insert_session(NewSession, ProfileName),
- ?hcrd("session updated", []),
+ NewSession =
+ Session#session{queue_length =
+ %% Queue + current
+ queue:len(NewPipeline) + 1,
+ client_close = ClientClose},
+ insert_session(NewSession, ProfileName),
+ ?hcrd("session updated", []),
{reply, ok, State#state{pipeline = NewPipeline,
- session = NewSession,
- timers = NewTimers}};
- undefined ->
- %% Note: tcp-message receiving has already been
- %% activated by handle_pipeline/2.
- ?hcrd("no current request", []),
- cancel_timer(Timers#timers.queue_timer,
- timeout_queue),
- NewSession =
- Session#session{queue_length = 1,
- client_close = ClientClose},
- httpc_manager:insert_session(NewSession, ProfileName),
- Relaxed =
- (Request#request.settings)#http_options.relaxed,
- MFA = {httpc_response, parse,
- [State#state.max_header_size, Relaxed]},
- NewTimers = Timers#timers{queue_timer = undefined},
- ?hcrd("session created", []),
- {reply, ok, NewState#state{request = Request,
- session = NewSession,
- mfa = MFA,
- timers = NewTimers}}
- end;
- {error, Reason} ->
- ?hcri("failed sending request", [{reason, Reason}]),
- {reply, {pipeline_failed, Reason}, State}
+ session = NewSession,
+ timers = NewTimers}};
+ undefined ->
+ %% Note: tcp-message receiving has already been
+ %% activated by handle_pipeline/2.
+ ?hcrd("no current request", []),
+ cancel_timer(Timers#timers.queue_timer,
+ timeout_queue),
+ NewSession =
+ Session#session{queue_length = 1,
+ client_close = ClientClose},
+ httpc_manager:insert_session(NewSession, ProfileName),
+ Relaxed =
+ (Request#request.settings)#http_options.relaxed,
+ MFA = {httpc_response, parse,
+ [State#state.max_header_size, Relaxed]},
+ NewTimers = Timers#timers{queue_timer = undefined},
+ ?hcrd("session created", []),
+ {reply, ok, NewState#state{request = Request,
+ session = NewSession,
+ mfa = MFA,
+ timers = NewTimers}}
+ end;
+ {error, Reason} ->
+ ?hcri("failed sending request", [{reason, Reason}]),
+ {reply, {pipeline_failed, Reason}, State}
end;
handle_call(#request{address = Addr} = Request, _,
- #state{status = Status,
- session = #session{type = keep_alive} = Session,
- timers = Timers,
- options = #options{proxy = Proxy} = _Options,
- profile_name = ProfileName} = State)
+ #state{status = Status,
+ session = #session{type = keep_alive} = Session,
+ timers = Timers,
+ options = #options{proxy = Proxy} = _Options,
+ profile_name = ProfileName} = State)
when Status =/= undefined ->
?hcrv("new request on a keep-alive session",
- [{request, Request},
- {profile, ProfileName},
- {status, Status}]),
+ [{request, Request},
+ {profile, ProfileName},
+ {status, Status}]),
Address = handle_proxy(Addr, Proxy),
case httpc_request:send(Address, Session, Request) of
- ok ->
+ ok ->
- ?hcrd("request sent", []),
+ ?hcrd("request sent", []),
- %% Activate the request time out for the new request
- NewState =
- activate_request_timeout(State#state{request = Request}),
+ %% Activate the request time out for the new request
+ NewState =
+ activate_request_timeout(State#state{request = Request}),
- ClientClose =
- httpc_request:is_client_closing(Request#request.headers),
+ ClientClose =
+ httpc_request:is_client_closing(Request#request.headers),
- case State#state.request of
- #request{} -> %% Old request not yet finished
- %% Make sure to use the new value of timers in state
- ?hcrd("old request still not finished", []),
- NewTimers = NewState#state.timers,
+ case State#state.request of
+ #request{} -> %% Old request not yet finished
+ %% Make sure to use the new value of timers in state
+ ?hcrd("old request still not finished", []),
+ NewTimers = NewState#state.timers,
NewKeepAlive = queue:in(Request, State#state.keep_alive),
- NewSession =
- Session#session{queue_length =
- %% Queue + current
- queue:len(NewKeepAlive) + 1,
- client_close = ClientClose},
- insert_session(NewSession, ProfileName),
- ?hcrd("session updated", []),
+ NewSession =
+ Session#session{queue_length =
+ %% Queue + current
+ queue:len(NewKeepAlive) + 1,
+ client_close = ClientClose},
+ insert_session(NewSession, ProfileName),
+ ?hcrd("session updated", []),
{reply, ok, State#state{keep_alive = NewKeepAlive,
- session = NewSession,
- timers = NewTimers}};
- undefined ->
- %% Note: tcp-message reciving has already been
- %% activated by handle_pipeline/2.
- ?hcrd("no current request", []),
- cancel_timer(Timers#timers.queue_timer,
- timeout_queue),
- NewSession =
- Session#session{queue_length = 1,
- client_close = ClientClose},
- insert_session(NewSession, ProfileName),
- Relaxed =
- (Request#request.settings)#http_options.relaxed,
- MFA = {httpc_response, parse,
- [State#state.max_header_size, Relaxed]},
- {reply, ok, NewState#state{request = Request,
- session = NewSession,
- mfa = MFA}}
- end;
+ session = NewSession,
+ timers = NewTimers}};
+ undefined ->
+ %% Note: tcp-message reciving has already been
+ %% activated by handle_pipeline/2.
+ ?hcrd("no current request", []),
+ cancel_timer(Timers#timers.queue_timer,
+ timeout_queue),
+ NewSession =
+ Session#session{queue_length = 1,
+ client_close = ClientClose},
+ insert_session(NewSession, ProfileName),
+ Relaxed =
+ (Request#request.settings)#http_options.relaxed,
+ MFA = {httpc_response, parse,
+ [State#state.max_header_size, Relaxed]},
+ {reply, ok, NewState#state{request = Request,
+ session = NewSession,
+ mfa = MFA}}
+ end;
- {error, Reason} ->
- ?hcri("failed sending request", [{reason, Reason}]),
- {reply, {request_failed, Reason}, State}
+ {error, Reason} ->
+ ?hcri("failed sending request", [{reason, Reason}]),
+ {reply, {request_failed, Reason}, State}
end;
@@ -411,25 +414,25 @@ handle_call(info, _, State) ->
%% request as if it was never issued as in this case the request will
%% not have been sent.
handle_cast({cancel, RequestId, From},
- #state{request = #request{id = RequestId} = Request,
- profile_name = ProfileName,
- canceled = Canceled} = State) ->
+ #state{request = #request{id = RequestId} = Request,
+ profile_name = ProfileName,
+ canceled = Canceled} = State) ->
?hcrv("cancel current request", [{request_id, RequestId},
- {profile, ProfileName},
- {canceled, Canceled}]),
+ {profile, ProfileName},
+ {canceled, Canceled}]),
httpc_manager:request_canceled(RequestId, ProfileName, From),
?hcrv("canceled", []),
{stop, normal,
State#state{canceled = [RequestId | Canceled],
- request = Request#request{from = answer_sent}}};
+ request = Request#request{from = answer_sent}}};
handle_cast({cancel, RequestId, From},
- #state{profile_name = ProfileName,
- request = #request{id = CurrId},
- canceled = Canceled} = State) ->
+ #state{profile_name = ProfileName,
+ request = #request{id = CurrId},
+ canceled = Canceled} = State) ->
?hcrv("cancel", [{request_id, RequestId},
- {curr_req_id, CurrId},
- {profile, ProfileName},
- {canceled, Canceled}]),
+ {curr_req_id, CurrId},
+ {profile, ProfileName},
+ {canceled, Canceled}]),
httpc_manager:request_canceled(RequestId, ProfileName, From),
?hcrv("canceled", []),
{noreply, State#state{canceled = [RequestId | Canceled]}};
@@ -446,94 +449,94 @@ handle_cast(stream_next, #state{session = Session} = State) ->
%% Description: Handling all non call/cast messages
%%--------------------------------------------------------------------
handle_info({Proto, _Socket, Data},
- #state{mfa = {Module, Function, Args},
- request = #request{method = Method,
- stream = Stream} = Request,
- session = Session,
- status_line = StatusLine} = State)
+ #state{mfa = {Module, Function, Args},
+ request = #request{method = Method,
+ stream = Stream} = Request,
+ session = Session,
+ status_line = StatusLine} = State)
when (Proto =:= tcp) orelse
(Proto =:= ssl) orelse
(Proto =:= httpc_handler) ->
?hcri("received data", [{proto, Proto},
- {module, Module},
- {function, Function},
- {method, Method},
- {stream, Stream},
- {session, Session},
- {status_line, StatusLine}]),
+ {module, Module},
+ {function, Function},
+ {method, Method},
+ {stream, Stream},
+ {session, Session},
+ {status_line, StatusLine}]),
FinalResult =
- try Module:Function([Data | Args]) of
- {ok, Result} ->
- ?hcrd("data processed - ok", []),
- handle_http_msg(Result, State);
- {_, whole_body, _} when Method =:= head ->
- ?hcrd("data processed - whole body", []),
- handle_response(State#state{body = <<>>});
- {Module, whole_body, [Body, Length]} ->
- ?hcrd("data processed - whole body", [{length, Length}]),
- {_, Code, _} = StatusLine,
- {NewBody, NewRequest} = stream(Body, Request, Code),
- %% When we stream we will not keep the already
- %% streamed data, that would be a waste of memory.
- NewLength =
- case Stream of
- none ->
- Length;
- _ ->
- Length - size(Body)
- end,
-
- NewState = next_body_chunk(State),
- NewMFA = {Module, whole_body, [NewBody, NewLength]},
- {noreply, NewState#state{mfa = NewMFA,
- request = NewRequest}};
- NewMFA ->
- ?hcrd("data processed - new mfa", []),
- activate_once(Session),
- {noreply, State#state{mfa = NewMFA}}
- catch
- exit:_Exit ->
- ?hcrd("data processing exit", [{exit, _Exit}]),
- ClientReason = {could_not_parse_as_http, Data},
- ClientErrMsg = httpc_response:error(Request, ClientReason),
- NewState = answer_request(Request, ClientErrMsg, State),
- {stop, normal, NewState};
- error:_Error ->
- ?hcrd("data processing error", [{error, _Error}]),
- ClientReason = {could_not_parse_as_http, Data},
- ClientErrMsg = httpc_response:error(Request, ClientReason),
- NewState = answer_request(Request, ClientErrMsg, State),
- {stop, normal, NewState}
-
- end,
+ try Module:Function([Data | Args]) of
+ {ok, Result} ->
+ ?hcrd("data processed - ok", []),
+ handle_http_msg(Result, State);
+ {_, whole_body, _} when Method =:= head ->
+ ?hcrd("data processed - whole body", []),
+ handle_response(State#state{body = <<>>});
+ {Module, whole_body, [Body, Length]} ->
+ ?hcrd("data processed - whole body", [{length, Length}]),
+ {_, Code, _} = StatusLine,
+ {NewBody, NewRequest} = stream(Body, Request, Code),
+ %% When we stream we will not keep the already
+ %% streamed data, that would be a waste of memory.
+ NewLength =
+ case Stream of
+ none ->
+ Length;
+ _ ->
+ Length - size(Body)
+ end,
+
+ NewState = next_body_chunk(State),
+ NewMFA = {Module, whole_body, [NewBody, NewLength]},
+ {noreply, NewState#state{mfa = NewMFA,
+ request = NewRequest}};
+ NewMFA ->
+ ?hcrd("data processed - new mfa", []),
+ activate_once(Session),
+ {noreply, State#state{mfa = NewMFA}}
+ catch
+ exit:_Exit ->
+ ?hcrd("data processing exit", [{exit, _Exit}]),
+ ClientReason = {could_not_parse_as_http, Data},
+ ClientErrMsg = httpc_response:error(Request, ClientReason),
+ NewState = answer_request(Request, ClientErrMsg, State),
+ {stop, normal, NewState};
+ error:_Error ->
+ ?hcrd("data processing error", [{error, _Error}]),
+ ClientReason = {could_not_parse_as_http, Data},
+ ClientErrMsg = httpc_response:error(Request, ClientReason),
+ NewState = answer_request(Request, ClientErrMsg, State),
+ {stop, normal, NewState}
+
+ end,
?hcri("data processed", [{final_result, FinalResult}]),
FinalResult;
handle_info({Proto, Socket, Data},
- #state{mfa = MFA,
- request = Request,
- session = Session,
- status = Status,
- status_line = StatusLine,
- profile_name = Profile} = State)
+ #state{mfa = MFA,
+ request = Request,
+ session = Session,
+ status = Status,
+ status_line = StatusLine,
+ profile_name = Profile} = State)
when (Proto =:= tcp) orelse
(Proto =:= ssl) orelse
(Proto =:= httpc_handler) ->
error_logger:warning_msg("Received unexpected ~p data on ~p"
- "~n Data: ~p"
- "~n MFA: ~p"
- "~n Request: ~p"
- "~n Session: ~p"
- "~n Status: ~p"
- "~n StatusLine: ~p"
- "~n Profile: ~p"
- "~n",
- [Proto, Socket, Data, MFA,
- Request, Session, Status, StatusLine, Profile]),
+ "~n Data: ~p"
+ "~n MFA: ~p"
+ "~n Request: ~p"
+ "~n Session: ~p"
+ "~n Status: ~p"
+ "~n StatusLine: ~p"
+ "~n Profile: ~p"
+ "~n",
+ [Proto, Socket, Data, MFA,
+ Request, Session, Status, StatusLine, Profile]),
{noreply, State};
@@ -572,45 +575,45 @@ handle_info({ssl_error, _, _} = Reason, State) ->
%% Internally, to a request handling process, a request timeout is
%% seen as a canceled request.
handle_info({timeout, RequestId},
- #state{request = #request{id = RequestId} = Request,
- canceled = Canceled,
- profile_name = ProfileName} = State) ->
+ #state{request = #request{id = RequestId} = Request,
+ canceled = Canceled,
+ profile_name = ProfileName} = State) ->
?hcri("timeout of current request", [{id, RequestId}]),
httpc_response:send(Request#request.from,
- httpc_response:error(Request, timeout)),
+ httpc_response:error(Request, timeout)),
httpc_manager:request_done(RequestId, ProfileName),
?hcrv("response (timeout) sent - now terminate", []),
{stop, normal,
State#state{request = Request#request{from = answer_sent},
- canceled = [RequestId | Canceled]}};
+ canceled = [RequestId | Canceled]}};
handle_info({timeout, RequestId},
- #state{canceled = Canceled,
- profile_name = ProfileName} = State) ->
+ #state{canceled = Canceled,
+ profile_name = ProfileName} = State) ->
?hcri("timeout", [{id, RequestId}]),
Filter =
- fun(#request{id = Id, from = From} = Request) when Id =:= RequestId ->
- ?hcrv("found request", [{id, Id}, {from, From}]),
- %% Notify the owner
- httpc_response:send(From,
- httpc_response:error(Request, timeout)),
- httpc_manager:request_done(RequestId, ProfileName),
- ?hcrv("response (timeout) sent", []),
- [Request#request{from = answer_sent}];
- (_) ->
- true
- end,
+ fun(#request{id = Id, from = From} = Request) when Id =:= RequestId ->
+ ?hcrv("found request", [{id, Id}, {from, From}]),
+ %% Notify the owner
+ httpc_response:send(From,
+ httpc_response:error(Request, timeout)),
+ httpc_manager:request_done(RequestId, ProfileName),
+ ?hcrv("response (timeout) sent", []),
+ [Request#request{from = answer_sent}];
+ (_) ->
+ true
+ end,
case State#state.status of
- pipeline ->
- ?hcrd("pipeline", []),
- Pipeline = queue:filter(Filter, State#state.pipeline),
- {noreply, State#state{canceled = [RequestId | Canceled],
- pipeline = Pipeline}};
- keep_alive ->
- ?hcrd("keep_alive", []),
- KeepAlive = queue:filter(Filter, State#state.keep_alive),
- {noreply, State#state{canceled = [RequestId | Canceled],
- keep_alive = KeepAlive}}
+ pipeline ->
+ ?hcrd("pipeline", []),
+ Pipeline = queue:filter(Filter, State#state.pipeline),
+ {noreply, State#state{canceled = [RequestId | Canceled],
+ pipeline = Pipeline}};
+ keep_alive ->
+ ?hcrd("keep_alive", []),
+ KeepAlive = queue:filter(Filter, State#state.keep_alive),
+ {noreply, State#state{canceled = [RequestId | Canceled],
+ keep_alive = KeepAlive}}
end;
handle_info(timeout_queue, State = #state{request = undefined}) ->
@@ -619,11 +622,11 @@ handle_info(timeout_queue, State = #state{request = undefined}) ->
%% Timing was such as the pipeline_timout was not canceled!
handle_info(timeout_queue, #state{timers = Timers} = State) ->
{noreply, State#state{timers =
- Timers#timers{queue_timer = undefined}}};
+ Timers#timers{queue_timer = undefined}}};
%% Setting up the connection to the server somehow failed.
handle_info({init_error, Tag, ClientErrMsg},
- State = #state{request = Request}) ->
+ State = #state{request = Request}) ->
?hcrv("init error", [{tag, Tag}, {client_error, ClientErrMsg}]),
NewState = answer_request(Request, ClientErrMsg, State),
{stop, normal, NewState};
@@ -647,21 +650,21 @@ handle_info({'EXIT', _, _}, State) ->
%% Init error there is no socket to be closed.
terminate(normal,
- #state{request = Request,
- session = {send_failed, AReason} = Reason} = State) ->
+ #state{request = Request,
+ session = {send_failed, AReason} = Reason} = State) ->
?hcrd("terminate", [{send_reason, AReason}, {request, Request}]),
maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
+ httpc_response:error(Request, Reason),
+ State),
ok;
terminate(normal,
- #state{request = Request,
- session = {connect_failed, AReason} = Reason} = State) ->
+ #state{request = Request,
+ session = {connect_failed, AReason} = Reason} = State) ->
?hcrd("terminate", [{connect_reason, AReason}, {request, Request}]),
maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
+ httpc_response:error(Request, Reason),
+ State),
ok;
terminate(normal, #state{session = undefined}) ->
@@ -670,21 +673,21 @@ terminate(normal, #state{session = undefined}) ->
%% Init error sending, no session information has been setup but
%% there is a socket that needs closing.
terminate(normal,
- #state{session = #session{id = undefined} = Session}) ->
+ #state{session = #session{id = undefined} = Session}) ->
close_socket(Session);
%% Socket closed remotely
terminate(normal,
- #state{session = #session{socket = {remote_close, Socket},
- socket_type = SocketType,
- id = Id},
- profile_name = ProfileName,
- request = Request,
- timers = Timers,
- pipeline = Pipeline,
- keep_alive = KeepAlive} = State) ->
+ #state{session = #session{socket = {remote_close, Socket},
+ socket_type = SocketType,
+ id = Id},
+ profile_name = ProfileName,
+ request = Request,
+ timers = Timers,
+ pipeline = Pipeline,
+ keep_alive = KeepAlive} = State) ->
?hcrt("terminate(normal) - remote close",
- [{id, Id}, {profile, ProfileName}]),
+ [{id, Id}, {profile, ProfileName}]),
%% Clobber session
(catch httpc_manager:delete_session(Id, ProfileName)),
@@ -702,15 +705,15 @@ terminate(normal,
http_transport:close(SocketType, Socket);
terminate(Reason, #state{session = #session{id = Id,
- socket = Socket,
- socket_type = SocketType},
- request = undefined,
- profile_name = ProfileName,
- timers = Timers,
- pipeline = Pipeline,
- keep_alive = KeepAlive} = State) ->
+ socket = Socket,
+ socket_type = SocketType},
+ request = undefined,
+ profile_name = ProfileName,
+ timers = Timers,
+ pipeline = Pipeline,
+ keep_alive = KeepAlive} = State) ->
?hcrt("terminate",
- [{id, Id}, {profile, ProfileName}, {reason, Reason}]),
+ [{id, Id}, {profile, ProfileName}, {reason, Reason}]),
%% Clobber session
(catch httpc_manager:delete_session(Id, ProfileName)),
@@ -728,16 +731,16 @@ terminate(Reason, #state{request = undefined}) ->
terminate(Reason, #state{request = Request} = State) ->
?hcrd("terminate", [{reason, Reason}, {request, Request}]),
NewState = maybe_send_answer(Request,
- httpc_response:error(Request, Reason),
- State),
+ httpc_response:error(Request, Reason),
+ State),
terminate(Reason, NewState#state{request = undefined}).
maybe_retry_queue(Q, State) ->
case queue:is_empty(Q) of
- false ->
- retry_pipeline(queue:to_list(Q), State);
- true ->
- ok
+ false ->
+ retry_pipeline(queue:to_list(Q), State);
+ true ->
+ ok
end.
maybe_send_answer(#request{from = answer_sent}, _Reason, State) ->
@@ -761,44 +764,44 @@ deliver_answer(Request) ->
%%--------------------------------------------------------------------
code_change(_,
- #state{session = OldSession,
- profile_name = ProfileName} = State,
- upgrade_from_pre_5_8_1) ->
+ #state{session = OldSession,
+ profile_name = ProfileName} = State,
+ upgrade_from_pre_5_8_1) ->
case OldSession of
- {session,
- Id, ClientClose, Scheme, Socket, SocketType, QueueLen, Type} ->
- NewSession = #session{id = Id,
- client_close = ClientClose,
- scheme = Scheme,
- socket = Socket,
- socket_type = SocketType,
- queue_length = QueueLen,
- type = Type},
- insert_session(NewSession, ProfileName),
- {ok, State#state{session = NewSession}};
- _ ->
- {ok, State}
+ {session,
+ Id, ClientClose, Scheme, Socket, SocketType, QueueLen, Type} ->
+ NewSession = #session{id = Id,
+ client_close = ClientClose,
+ scheme = Scheme,
+ socket = Socket,
+ socket_type = SocketType,
+ queue_length = QueueLen,
+ type = Type},
+ insert_session(NewSession, ProfileName),
+ {ok, State#state{session = NewSession}};
+ _ ->
+ {ok, State}
end;
code_change(_,
- #state{session = OldSession,
- profile_name = ProfileName} = State,
- downgrade_to_pre_5_8_1) ->
+ #state{session = OldSession,
+ profile_name = ProfileName} = State,
+ downgrade_to_pre_5_8_1) ->
case OldSession of
- #session{id = Id,
- client_close = ClientClose,
- scheme = Scheme,
- socket = Socket,
- socket_type = SocketType,
- queue_length = QueueLen,
- type = Type} ->
- NewSession = {session,
- Id, ClientClose, Scheme, Socket, SocketType,
- QueueLen, Type},
- insert_session(NewSession, ProfileName),
- {ok, State#state{session = NewSession}};
- _ ->
- {ok, State}
+ #session{id = Id,
+ client_close = ClientClose,
+ scheme = Scheme,
+ socket = Socket,
+ socket_type = SocketType,
+ queue_length = QueueLen,
+ type = Type} ->
+ NewSession = {session,
+ Id, ClientClose, Scheme, Socket, SocketType,
+ QueueLen, Type},
+ insert_session(NewSession, ProfileName),
+ {ok, State#state{session = NewSession}};
+ _ ->
+ {ok, State}
end;
code_change(_, State, _) ->
@@ -806,22 +809,22 @@ code_change(_, State, _) ->
%% new_http_options({http_options, TimeOut, AutoRedirect, SslOpts,
-%% Auth, Relaxed}) ->
+%% Auth, Relaxed}) ->
%% {http_options, "HTTP/1.1", TimeOut, AutoRedirect, SslOpts,
%% Auth, Relaxed}.
%% old_http_options({http_options, _, TimeOut, AutoRedirect,
-%% SslOpts, Auth, Relaxed}) ->
+%% SslOpts, Auth, Relaxed}) ->
%% {http_options, TimeOut, AutoRedirect, SslOpts, Auth, Relaxed}.
%% new_queue(Queue, Fun) ->
%% List = queue:to_list(Queue),
%% NewList =
-%% lists:map(fun(Request) ->
-%% Settings =
-%% Fun(Request#request.settings),
-%% Request#request{settings = Settings}
-%% end, List),
+%% lists:map(fun(Request) ->
+%% Settings =
+%% Fun(Request#request.settings),
+%% Request#request{settings = Settings}
+%% end, List),
%% queue:from_list(NewList).
@@ -830,97 +833,121 @@ code_change(_, State, _) ->
%%%--------------------------------------------------------------------
connect(SocketType, ToAddress,
- #options{ipfamily = IpFamily,
- ip = FromAddress,
- port = FromPort,
- socket_opts = Opts0}, Timeout) ->
+ #options{ipfamily = IpFamily,
+ ip = FromAddress,
+ port = FromPort,
+ socket_opts = Opts0}, Timeout) ->
Opts1 =
- case FromPort of
- default ->
- Opts0;
- _ ->
- [{port, FromPort} | Opts0]
- end,
+ case FromPort of
+ default ->
+ Opts0;
+ _ ->
+ [{port, FromPort} | Opts0]
+ end,
Opts2 =
- case FromAddress of
- default ->
- Opts1;
- _ ->
- [{ip, FromAddress} | Opts1]
- end,
+ case FromAddress of
+ default ->
+ Opts1;
+ _ ->
+ [{ip, FromAddress} | Opts1]
+ end,
case IpFamily of
- inet6fb4 ->
- Opts3 = [inet6 | Opts2],
- case http_transport:connect(SocketType,
- ToAddress, Opts3, Timeout) of
- {error, Reason6} ->
- Opts4 = [inet | Opts2],
- case http_transport:connect(SocketType,
- ToAddress, Opts4, Timeout) of
- {error, Reason4} ->
- {error, {failed_connect,
- [{to_address, ToAddress},
- {inet6, Opts3, Reason6},
- {inet, Opts4, Reason4}]}};
- OK ->
- OK
- end;
- OK ->
- OK
- end;
- _ ->
- Opts3 = [IpFamily | Opts2],
- case http_transport:connect(SocketType, ToAddress, Opts3, Timeout) of
- {error, Reason} ->
- {error, {failed_connect, [{to_address, ToAddress},
- {IpFamily, Opts3, Reason}]}};
- Else ->
- Else
- end
+ inet6fb4 ->
+ Opts3 = [inet6 | Opts2],
+ case http_transport:connect(SocketType,
+ ToAddress, Opts3, Timeout) of
+ {error, Reason6} ->
+ Opts4 = [inet | Opts2],
+ case http_transport:connect(SocketType,
+ ToAddress, Opts4, Timeout) of
+ {error, Reason4} ->
+ {error, {failed_connect,
+ [{to_address, ToAddress},
+ {inet6, Opts3, Reason6},
+ {inet, Opts4, Reason4}]}};
+ OK ->
+ OK
+ end;
+ OK ->
+ OK
+ end;
+ _ ->
+ Opts3 = [IpFamily | Opts2],
+ case http_transport:connect(SocketType, ToAddress, Opts3, Timeout) of
+ {error, Reason} ->
+ {error, {failed_connect, [{to_address, ToAddress},
+ {IpFamily, Opts3, Reason}]}};
+ Else ->
+ Else
+ end
end.
connect_and_send_first_request(Address, Request, #state{options = Options} = State) ->
SocketType = socket_type(Request),
ConnTimeout = (Request#request.settings)#http_options.connect_timeout,
?hcri("connect",
- [{address, Address}, {request, Request}, {options, Options}]),
+ [{address, Address}, {request, Request}, {options, Options}]),
case connect(SocketType, Address, Options, ConnTimeout) of
- {ok, Socket} ->
- ClientClose =
- httpc_request:is_client_closing(
- Request#request.headers),
+ {ok, Socket} ->
+ ClientClose =
+ httpc_request:is_client_closing(
+ Request#request.headers),
+ SessionType = httpc_manager:session_type(Options),
+ SocketType = socket_type(Request),
+ Session = #session{id = {Request#request.address, self()},
+ scheme = Request#request.scheme,
+ socket = Socket,
+ socket_type = SocketType,
+ client_close = ClientClose,
+ type = SessionType},
+ ?hcri("connected - now send first request", [{socket, Socket}]),
+
+ case httpc_request:send(Address, Session, Request) of
+ ok ->
+ ?hcri("first request sent", []),
+ TmpState = State#state{request = Request,
+ session = Session,
+ mfa = init_mfa(Request, State),
+ status_line =
+ init_status_line(Request),
+ headers = undefined,
+ body = undefined,
+ status = new},
+ http_transport:setopts(SocketType,
+ Socket, [{active, once}]),
+ NewState = activate_request_timeout(TmpState),
+ {ok, NewState};
+ {error, Reason} ->
+ self() ! {init_error, error_sending,
+ httpc_response:error(Request, Reason)},
+ {ok, State#state{request = Request,
+ session =
+ #session{socket = Socket}}}
+ end;
+ {error, Reason} ->
+ self() ! {init_error, error_connecting,
+ httpc_response:error(Request, Reason)},
+ {ok, State#state{request = Request}}
+ end.
+
+connect_and_send_upgrade_request(Address, Request, #state{options = Options} = State) ->
+ ConnTimeout = (Request#request.settings)#http_options.connect_timeout,
+ SocketType = ip_comm,
+ case connect(SocketType, Address, Options, ConnTimeout) of
+ {ok, Socket} ->
SessionType = httpc_manager:session_type(Options),
- SocketType = socket_type(Request),
- Session = #session{id = {Request#request.address, self()},
- scheme = Request#request.scheme,
- socket = Socket,
+ Session = #session{socket = Socket,
socket_type = SocketType,
- client_close = ClientClose,
+ id = {Request#request.address, self()},
+ scheme = http,
+ client_close = false,
type = SessionType},
- ?hcri("connected - now send first request", [{socket, Socket}]),
-
- case httpc_request:send(Address, Session, Request) of
- ok ->
- ?hcri("first request sent", []),
- TmpState = State#state{request = Request,
- session = Session,
- mfa = init_mfa(Request, State),
- status_line =
- init_status_line(Request),
- headers = undefined,
- body = undefined,
- status = new},
- http_transport:setopts(SocketType,
- Socket, [{active, once}]),
- NewState = activate_request_timeout(TmpState),
- {ok, NewState};
- {error, Reason} ->
- self() ! {init_error, error_sending,
- httpc_response:error(Request, Reason)},
- {ok, State#state{request = Request,
- session =
- #session{socket = Socket}}}
- end;
+ ErrorHandler =
+ fun(ERequest, EState, EReason) ->
+ self() ! {init_error, error_sending,
+ httpc_response:error(ERequest, EReason)},
+ {ok, EState#state{request = ERequest}} end,
+ tls_tunnel(Address, Request, State#state{session = Session}, ErrorHandler);
{error, Reason} ->
self() ! {init_error, error_connecting,
httpc_response:error(Request, Reason)},
@@ -1024,15 +1051,25 @@ handle_http_msg(Body, #state{status_line = {_,Code, _}} = State) ->
{NewBody, NewRequest} = stream(Body, State#state.request, Code),
handle_response(State#state{body = NewBody, request = NewRequest}).
-handle_http_body(<<>>, State = #state{status_line = {_,304, _}}) ->
+handle_http_body(_, #state{status = {ssl_tunnel, _},
+ status_line = {_,200, _}} = State) ->
+ tls_upgrade(State);
+
+handle_http_body(_, #state{status = {ssl_tunnel, Request},
+ status_line = StatusLine} = State) ->
+ ClientErrMsg = httpc_response:error(Request,{could_no_establish_ssh_tunnel, StatusLine}),
+ NewState = answer_request(Request, ClientErrMsg, State),
+ {stop, normal, NewState};
+
+handle_http_body(<<>>, #state{status_line = {_,304, _}} = State) ->
?hcrt("handle_http_body - 304", []),
handle_response(State#state{body = <<>>});
-handle_http_body(<<>>, State = #state{status_line = {_,204, _}}) ->
+handle_http_body(<<>>, #state{status_line = {_,204, _}} = State) ->
?hcrt("handle_http_body - 204", []),
handle_response(State#state{body = <<>>});
-handle_http_body(<<>>, State = #state{request = #request{method = head}}) ->
+handle_http_body(<<>>, #state{request = #request{method = head}} = State) ->
?hcrt("handle_http_body - head", []),
handle_response(State#state{body = <<>>});
@@ -1119,7 +1156,7 @@ handle_response(#state{request = Request,
{session, Session},
{status_line, StatusLine}]),
- handle_cookies(Headers, Request, Options, ProfileName),
+ handle_cookies(Headers, Request, Options, httpc_manager), %% FOO profile_name
case httpc_response:result({StatusLine, Headers, Body}, Request) of
%% 100-continue
continue ->
@@ -1503,6 +1540,12 @@ retry_pipeline([Request | PipeLine],
end,
retry_pipeline(PipeLine, NewState).
+handle_proxy_options(https, #options{https_proxy = {HttpsProxy, _} = HttpsProxyOpt}) when
+ HttpsProxy =/= undefined ->
+ HttpsProxyOpt;
+handle_proxy_options(_, #options{proxy = Proxy}) ->
+ Proxy.
+
%%% Check to see if the given {Host,Port} tuple is in the NoProxyList
%%% Returns an eventually updated {Host,Port} tuple, with the proxy address
handle_proxy(HostPort = {Host, _Port}, {Proxy, NoProxy}) ->
@@ -1696,6 +1739,96 @@ send_raw(SocketType, Socket, ProcessBody, Acc) ->
end
end.
+tls_tunnel(Address, Request, #state{session = #session{socket = Socket,
+ socket_type = SocketType} = Session} = State,
+ ErrorHandler) ->
+ UpgradeRequest = tls_tunnel_request(Request),
+ case httpc_request:send(Address, Session, UpgradeRequest) of
+ ok ->
+ TmpState = State#state{request = UpgradeRequest,
+ %% session = Session,
+ mfa = init_mfa(UpgradeRequest, State),
+ status_line =
+ init_status_line(UpgradeRequest),
+ headers = undefined,
+ body = undefined},
+ http_transport:setopts(SocketType,
+ Socket, [{active, once}]),
+ NewState = activate_request_timeout(TmpState),
+ {ok, NewState#state{status = {ssl_tunnel, Request}}};
+ {error, Reason} ->
+ ErrorHandler(Request, State, Reason)
+ end.
+
+tls_tunnel_request(#request{headers = Headers,
+ settings = Options,
+ address = {Host, Port}= Adress,
+ ipv6_host_with_brackets = IPV6}) ->
+
+ URI = Host ++":" ++ integer_to_list(Port),
+
+ #request{
+ id = make_ref(),
+ from = self(),
+ scheme = http, %% Use tcp-first and then upgrade!
+ address = Adress,
+ path = URI,
+ pquery = "",
+ method = connect,
+ headers = #http_request_h{host = host_header(Headers, URI),
+ te = "",
+ pragma = "no-cache",
+ other = [{"Proxy-Connection", " Keep-Alive"}]},
+ settings = Options,
+ abs_uri = URI,
+ stream = false,
+ userinfo = "",
+ headers_as_is = [],
+ started = http_util:timestamp(),
+ ipv6_host_with_brackets = IPV6
+ }.
+
+host_header(#http_request_h{host = Host}, _) ->
+ Host;
+
+%% Handles header_as_is
+host_header(_, URI) ->
+ {ok, {_, _, Host, _, _, _}} = http_uri:parse(URI),
+ Host.
+
+tls_upgrade(#state{status =
+ {ssl_tunnel,
+ #request{settings =
+ #http_options{ssl = {_, TLSOptions} = SocketType}} = Request},
+ session = #session{socket = TCPSocket} = Session0,
+ options = Options} = State) ->
+
+ case ssl:connect(TCPSocket, TLSOptions) of
+ {ok, TLSSocket} ->
+ Address = Request#request.address,
+ ClientClose = httpc_request:is_client_closing(Request#request.headers),
+ SessionType = httpc_manager:session_type(Options),
+ Session = Session0#session{
+ scheme = https,
+ socket = TLSSocket,
+ socket_type = SocketType,
+ type = SessionType,
+ client_close = ClientClose},
+ httpc_request:send(Address, Session, Request),
+ http_transport:setopts(SocketType, TLSSocket, [{active, once}]),
+ NewState = State#state{session = Session,
+ request = Request,
+ mfa = init_mfa(Request, State),
+ status_line =
+ init_status_line(Request),
+ headers = undefined,
+ body = undefined,
+ status = new
+ },
+ {noreply, activate_request_timeout(NewState)};
+ {error, _Reason} ->
+ {stop, normal, State#state{request = Request}}
+ end.
%% ---------------------------------------------------------------------
%% Session wrappers
diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl
index 8af752546c..30e2742e9d 100644
--- a/lib/inets/src/http_client/httpc_internal.hrl
+++ b/lib/inets/src/http_client/httpc_internal.hrl
@@ -37,6 +37,7 @@
-define(HTTP_MAX_REDIRECTS, 4).
-define(HTTP_KEEP_ALIVE_TIMEOUT, 120000).
-define(HTTP_KEEP_ALIVE_LENGTH, 5).
+-define(TLS_UPGRADE_TOKEN, "TLS/1.0").
%%% HTTP Client per request settings
-record(http_options,
@@ -72,6 +73,7 @@
-record(options,
{
proxy = {undefined, []}, % {{ProxyHost, ProxyPort}, [NoProxy]},
+ https_proxy = {undefined, []}, % {{ProxyHost, ProxyPort}, [NoProxy]}
%% 0 means persistent connections are used without pipelining
pipeline_timeout = ?HTTP_PIPELINE_TIMEOUT,
max_pipeline_length = ?HTTP_PIPELINE_LENGTH,
diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl
index 3612b331e7..c45dcab802 100644
--- a/lib/inets/src/http_client/httpc_manager.erl
+++ b/lib/inets/src/http_client/httpc_manager.erl
@@ -577,6 +577,7 @@ handle_cast({set_options, Options}, State = #state{options = OldOptions}) ->
?hcrv("set options", [{options, Options}, {old_options, OldOptions}]),
NewOptions =
#options{proxy = get_proxy(Options, OldOptions),
+ https_proxy = get_https_proxy(Options, OldOptions),
pipeline_timeout = get_pipeline_timeout(Options, OldOptions),
max_pipeline_length = get_max_pipeline_length(Options, OldOptions),
max_keep_alive_length = get_max_keep_alive_length(Options, OldOptions),
@@ -741,7 +742,7 @@ get_manager_info(#state{handler_db = HDB,
SessionInfo = which_sessions2(SDB),
OptionsInfo =
[{Item, get_option(Item, Options)} ||
- Item <- record_info(fields, options)],
+ Item <- record_info(fields, options)],
CookieInfo = httpc_cookie:which_cookies(CDB),
[{handlers, HandlerInfo},
{sessions, SessionInfo},
@@ -769,20 +770,7 @@ get_handler_info(Tab) ->
Pattern = {'$2', '$1', '_'},
Handlers1 = [{Pid, Id} || [Pid, Id] <- ets:match(Tab, Pattern)],
Handlers2 = sort_handlers(Handlers1),
- Handlers3 = [{Pid, Reqs,
- try
- begin
- httpc_handler:info(Pid)
- end
- catch
- _:_ ->
- %% Why would this crash?
- %% Only if the process has died, but we don't
- %% know about it?
- []
- end} || {Pid, Reqs} <- Handlers2],
- Handlers3.
-
+ [{Pid, Reqs, httpc_handler:info(Pid)} || {Pid, Reqs} <- Handlers2].
handle_request(#request{settings =
#http_options{version = "HTTP/0.9"}} = Request,
@@ -1001,6 +989,8 @@ cast(ProfileName, Msg) ->
get_option(proxy, #options{proxy = Proxy}) ->
Proxy;
+get_option(https_proxy, #options{https_proxy = Proxy}) ->
+ Proxy;
get_option(pipeline_timeout, #options{pipeline_timeout = Timeout}) ->
Timeout;
get_option(max_pipeline_length, #options{max_pipeline_length = Length}) ->
@@ -1027,6 +1017,9 @@ get_option(socket_opts, #options{socket_opts = SocketOpts}) ->
get_proxy(Opts, #options{proxy = Default}) ->
proplists:get_value(proxy, Opts, Default).
+get_https_proxy(Opts, #options{https_proxy = Default}) ->
+ proplists:get_value(https_proxy, Opts, Default).
+
get_pipeline_timeout(Opts, #options{pipeline_timeout = Default}) ->
proplists:get_value(pipeline_timeout, Opts, Default).
diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl
index b575d7331b..747118431e 100644
--- a/lib/inets/src/http_server/httpd_conf.erl
+++ b/lib/inets/src/http_server/httpd_conf.erl
@@ -829,9 +829,7 @@ os_info(Info) ->
{OsFamily, _OsName} when Info =:= partial ->
lists:flatten(io_lib:format("(~w)", [OsFamily]));
{OsFamily, OsName} ->
- lists:flatten(io_lib:format("(~w/~w)", [OsFamily, OsName]));
- OsFamily ->
- lists:flatten(io_lib:format("(~w)", [OsFamily]))
+ lists:flatten(io_lib:format("(~w/~w)", [OsFamily, OsName]))
end.
otp_release() ->
diff --git a/lib/inets/src/inets_app/inets.erl b/lib/inets/src/inets_app/inets.erl
index f33e0abe27..ed8082534f 100644
--- a/lib/inets/src/inets_app/inets.erl
+++ b/lib/inets/src/inets_app/inets.erl
@@ -274,13 +274,8 @@ sys_info() ->
os_info() ->
V = os:version(),
- case os:type() of
- {OsFam, OsName} ->
- [{fam, OsFam}, {name, OsName}, {ver, V}];
- OsFam ->
- [{fam, OsFam}, {ver, V}]
- end.
-
+ {OsFam, OsName} = os:type(),
+ [{fam, OsFam}, {name, OsName}, {ver, V}].
print_mods_info(Versions) ->
case key1search(mod_info, Versions) of
diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile
index 0fc98eff6f..0ca99e8692 100644
--- a/lib/inets/test/Makefile
+++ b/lib/inets/test/Makefile
@@ -149,6 +149,7 @@ INETS_ROOT = ../../inets
MODULES = \
inets_test_lib \
+ erl_make_certs \
ftp_SUITE \
ftp_format_SUITE \
ftp_solaris8_sparc_test \
@@ -169,6 +170,7 @@ MODULES = \
http_format_SUITE \
httpc_SUITE \
httpc_cookie_SUITE \
+ httpc_proxy_SUITE \
httpd_SUITE \
httpd_basic_SUITE \
httpd_mod \
@@ -213,7 +215,7 @@ INETS_FILES = inets.config $(INETS_SPECS)
INETS_DATADIRS = inets_SUITE_data inets_sup_SUITE_data
HTTPD_DATADIRS = httpd_test_data httpd_SUITE_data
-HTTPC_DATADIRS = httpc_SUITE_data
+HTTPC_DATADIRS = httpc_SUITE_data httpc_proxy_SUITE_data
FTP_DATADIRS = ftp_SUITE_data
DATADIRS = $(INETS_DATADIRS) $(HTTPD_DATADIRS) $(HTTPC_DATADIRS) $(FTP_DATADIRS)
diff --git a/lib/inets/test/erl_make_certs.erl b/lib/inets/test/erl_make_certs.erl
new file mode 100644
index 0000000000..254aa6d2f9
--- /dev/null
+++ b/lib/inets/test/erl_make_certs.erl
@@ -0,0 +1,429 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% Create test certificates
+
+-module(erl_make_certs).
+-include_lib("public_key/include/public_key.hrl").
+
+-export([make_cert/1, gen_rsa/1, verify_signature/3, write_pem/3]).
+-compile(export_all).
+
+%%--------------------------------------------------------------------
+%% @doc Create and return a der encoded certificate
+%% Option Default
+%% -------------------------------------------------------
+%% digest sha1
+%% validity {date(), date() + week()}
+%% version 3
+%% subject [] list of the following content
+%% {name, Name}
+%% {email, Email}
+%% {city, City}
+%% {state, State}
+%% {org, Org}
+%% {org_unit, OrgUnit}
+%% {country, Country}
+%% {serial, Serial}
+%% {title, Title}
+%% {dnQualifer, DnQ}
+%% issuer = {Issuer, IssuerKey} true (i.e. a ca cert is created)
+%% (obs IssuerKey migth be {Key, Password}
+%% key = KeyFile|KeyBin|rsa|dsa Subject PublicKey rsa or dsa generates key
+%%
+%%
+%% (OBS: The generated keys are for testing only)
+%% @spec ([{::atom(), ::term()}]) -> {Cert::binary(), Key::binary()}
+%% @end
+%%--------------------------------------------------------------------
+
+make_cert(Opts) ->
+ SubjectPrivateKey = get_key(Opts),
+ {TBSCert, IssuerKey} = make_tbs(SubjectPrivateKey, Opts),
+ Cert = public_key:pkix_sign(TBSCert, IssuerKey),
+ true = verify_signature(Cert, IssuerKey, undef), %% verify that the keys where ok
+ {Cert, encode_key(SubjectPrivateKey)}.
+
+%%--------------------------------------------------------------------
+%% @doc Writes pem files in Dir with FileName ++ ".pem" and FileName ++ "_key.pem"
+%% @spec (::string(), ::string(), {Cert,Key}) -> ok
+%% @end
+%%--------------------------------------------------------------------
+write_pem(Dir, FileName, {Cert, Key = {_,_,not_encrypted}}) when is_binary(Cert) ->
+ ok = der_to_pem(filename:join(Dir, FileName ++ ".pem"),
+ [{'Certificate', Cert, not_encrypted}]),
+ ok = der_to_pem(filename:join(Dir, FileName ++ "_key.pem"), [Key]).
+
+%%--------------------------------------------------------------------
+%% @doc Creates a rsa key (OBS: for testing only)
+%% the size are in bytes
+%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()}
+%% @end
+%%--------------------------------------------------------------------
+gen_rsa(Size) when is_integer(Size) ->
+ Key = gen_rsa2(Size),
+ {Key, encode_key(Key)}.
+
+%%--------------------------------------------------------------------
+%% @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)}.
+
+%%--------------------------------------------------------------------
+%% @doc Verifies cert signatures
+%% @spec (::binary(), ::tuple()) -> ::boolean()
+%% @end
+%%--------------------------------------------------------------------
+verify_signature(DerEncodedCert, DerKey, _KeyParams) ->
+ Key = decode_key(DerKey),
+ case Key of
+ #'RSAPrivateKey'{modulus=Mod, publicExponent=Exp} ->
+ public_key:pkix_verify(DerEncodedCert,
+ #'RSAPublicKey'{modulus=Mod, publicExponent=Exp});
+ #'DSAPrivateKey'{p=P, q=Q, g=G, y=Y} ->
+ public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}})
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%% Implementation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+get_key(Opts) ->
+ case proplists:get_value(key, Opts) of
+ undefined -> make_key(rsa, Opts);
+ rsa -> make_key(rsa, Opts);
+ dsa -> make_key(dsa, Opts);
+ Key ->
+ Password = proplists:get_value(password, Opts, no_passwd),
+ decode_key(Key, Password)
+ end.
+
+decode_key({Key, Pw}) ->
+ decode_key(Key, Pw);
+decode_key(Key) ->
+ decode_key(Key, no_passwd).
+
+
+decode_key(#'RSAPublicKey'{} = Key,_) ->
+ Key;
+decode_key(#'RSAPrivateKey'{} = Key,_) ->
+ Key;
+decode_key(#'DSAPrivateKey'{} = Key,_) ->
+ Key;
+decode_key(PemEntry = {_,_,_}, Pw) ->
+ public_key:pem_entry_decode(PemEntry, Pw);
+decode_key(PemBin, Pw) ->
+ [KeyInfo] = public_key:pem_decode(PemBin),
+ decode_key(KeyInfo, Pw).
+
+encode_key(Key = #'RSAPrivateKey'{}) ->
+ {ok, Der} = 'OTP-PUB-KEY':encode('RSAPrivateKey', Key),
+ {'RSAPrivateKey', list_to_binary(Der), not_encrypted};
+encode_key(Key = #'DSAPrivateKey'{}) ->
+ {ok, Der} = 'OTP-PUB-KEY':encode('DSAPrivateKey', Key),
+ {'DSAPrivateKey', list_to_binary(Der), not_encrypted}.
+
+make_tbs(SubjectKey, Opts) ->
+ Version = list_to_atom("v"++integer_to_list(proplists:get_value(version, Opts, 3))),
+
+ IssuerProp = proplists:get_value(issuer, Opts, true),
+ {Issuer, IssuerKey} = issuer(IssuerProp, Opts, SubjectKey),
+
+ {Algo, Parameters} = sign_algorithm(IssuerKey, Opts),
+
+ SignAlgo = #'SignatureAlgorithm'{algorithm = Algo,
+ parameters = Parameters},
+ Subject = case IssuerProp of
+ true -> %% Is a Root Ca
+ Issuer;
+ _ ->
+ subject(proplists:get_value(subject, Opts),false)
+ end,
+
+ {#'OTPTBSCertificate'{serialNumber = trunc(random:uniform()*100000000)*10000 + 1,
+ signature = SignAlgo,
+ issuer = Issuer,
+ validity = validity(Opts),
+ subject = Subject,
+ subjectPublicKeyInfo = publickey(SubjectKey),
+ version = Version,
+ extensions = extensions(Opts)
+ }, IssuerKey}.
+
+issuer(true, Opts, SubjectKey) ->
+ %% Self signed
+ {subject(proplists:get_value(subject, Opts), true), SubjectKey};
+issuer({Issuer, IssuerKey}, _Opts, _SubjectKey) when is_binary(Issuer) ->
+ {issuer_der(Issuer), decode_key(IssuerKey)};
+issuer({File, IssuerKey}, _Opts, _SubjectKey) when is_list(File) ->
+ {ok, [{cert, Cert, _}|_]} = pem_to_der(File),
+ {issuer_der(Cert), decode_key(IssuerKey)}.
+
+issuer_der(Issuer) ->
+ Decoded = public_key:pkix_decode_cert(Issuer, otp),
+ #'OTPCertificate'{tbsCertificate=Tbs} = Decoded,
+ #'OTPTBSCertificate'{subject=Subject} = Tbs,
+ Subject.
+
+subject(undefined, IsRootCA) ->
+ User = if IsRootCA -> "RootCA"; true -> user() end,
+ Opts = [{email, User ++ "@erlang.org"},
+ {name, User},
+ {city, "Stockholm"},
+ {country, "SE"},
+ {org, "erlang"},
+ {org_unit, "testing dep"}],
+ subject(Opts);
+subject(Opts, _) ->
+ subject(Opts).
+
+user() ->
+ case os:getenv("USER") of
+ false ->
+ "test_user";
+ User ->
+ User
+ end.
+
+subject(SubjectOpts) when is_list(SubjectOpts) ->
+ Encode = fun(Opt) ->
+ {Type,Value} = subject_enc(Opt),
+ [#'AttributeTypeAndValue'{type=Type, value=Value}]
+ end,
+ {rdnSequence, [Encode(Opt) || Opt <- SubjectOpts]}.
+
+%% Fill in the blanks
+subject_enc({name, Name}) -> {?'id-at-commonName', {printableString, Name}};
+subject_enc({email, Email}) -> {?'id-emailAddress', Email};
+subject_enc({city, City}) -> {?'id-at-localityName', {printableString, City}};
+subject_enc({state, State}) -> {?'id-at-stateOrProvinceName', {printableString, State}};
+subject_enc({org, Org}) -> {?'id-at-organizationName', {printableString, Org}};
+subject_enc({org_unit, OrgUnit}) -> {?'id-at-organizationalUnitName', {printableString, OrgUnit}};
+subject_enc({country, Country}) -> {?'id-at-countryName', Country};
+subject_enc({serial, Serial}) -> {?'id-at-serialNumber', Serial};
+subject_enc({title, Title}) -> {?'id-at-title', {printableString, Title}};
+subject_enc({dnQualifer, DnQ}) -> {?'id-at-dnQualifier', DnQ};
+subject_enc(Other) -> Other.
+
+
+extensions(Opts) ->
+ case proplists:get_value(extensions, Opts, []) of
+ false ->
+ asn1_NOVALUE;
+ Exts ->
+ lists:flatten([extension(Ext) || Ext <- default_extensions(Exts)])
+ end.
+
+default_extensions(Exts) ->
+ Def = [{key_usage,undefined},
+ {subject_altname, undefined},
+ {issuer_altname, undefined},
+ {basic_constraints, default},
+ {name_constraints, undefined},
+ {policy_constraints, undefined},
+ {ext_key_usage, undefined},
+ {inhibit_any, undefined},
+ {auth_key_id, undefined},
+ {subject_key_id, undefined},
+ {policy_mapping, undefined}],
+ Filter = fun({Key, _}, D) -> lists:keydelete(Key, 1, D) end,
+ Exts ++ lists:foldl(Filter, Def, Exts).
+
+extension({_, undefined}) -> [];
+extension({basic_constraints, Data}) ->
+ case Data of
+ default ->
+ #'Extension'{extnID = ?'id-ce-basicConstraints',
+ extnValue = #'BasicConstraints'{cA=true},
+ critical=true};
+ false ->
+ [];
+ Len when is_integer(Len) ->
+ #'Extension'{extnID = ?'id-ce-basicConstraints',
+ extnValue = #'BasicConstraints'{cA=true, pathLenConstraint=Len},
+ critical=true};
+ _ ->
+ #'Extension'{extnID = ?'id-ce-basicConstraints',
+ extnValue = Data}
+ end;
+extension({Id, Data, Critical}) ->
+ #'Extension'{extnID = Id, extnValue = Data, critical = Critical}.
+
+
+publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) ->
+ Public = #'RSAPublicKey'{modulus=N, publicExponent=E},
+ Algo = #'PublicKeyAlgorithm'{algorithm= ?rsaEncryption, parameters='NULL'},
+ #'OTPSubjectPublicKeyInfo'{algorithm = Algo,
+ subjectPublicKey = Public};
+publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) ->
+ Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa',
+ parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}},
+ #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}.
+
+validity(Opts) ->
+ DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1),
+ DefTo0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())+7),
+ {DefFrom, DefTo} = proplists:get_value(validity, Opts, {DefFrom0, DefTo0}),
+ Format = fun({Y,M,D}) -> lists:flatten(io_lib:format("~w~2..0w~2..0w000000Z",[Y,M,D])) end,
+ #'Validity'{notBefore={generalTime, Format(DefFrom)},
+ notAfter ={generalTime, Format(DefTo)}}.
+
+sign_algorithm(#'RSAPrivateKey'{}, Opts) ->
+ Type = case proplists:get_value(digest, Opts, sha1) of
+ sha1 -> ?'sha1WithRSAEncryption';
+ sha512 -> ?'sha512WithRSAEncryption';
+ sha384 -> ?'sha384WithRSAEncryption';
+ sha256 -> ?'sha256WithRSAEncryption';
+ md5 -> ?'md5WithRSAEncryption';
+ md2 -> ?'md2WithRSAEncryption'
+ end,
+ {Type, 'NULL'};
+sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) ->
+ {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}.
+
+make_key(rsa, _Opts) ->
+ %% (OBS: for testing only)
+ gen_rsa2(64);
+make_key(dsa, _Opts) ->
+ gen_dsa2(128, 20). %% Bytes i.e. {1024, 160}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% RSA key generation (OBS: for testing only)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-define(SMALL_PRIMES, [65537,97,89,83,79,73,71,67,61,59,53,
+ 47,43,41,37,31,29,23,19,17,13,11,7,5,3]).
+
+gen_rsa2(Size) ->
+ P = prime(Size),
+ Q = prime(Size),
+ N = P*Q,
+ Tot = (P - 1) * (Q - 1),
+ [E|_] = lists:dropwhile(fun(Candidate) -> (Tot rem Candidate) == 0 end, ?SMALL_PRIMES),
+ {D1,D2} = extended_gcd(E, Tot),
+ D = erlang:max(D1,D2),
+ case D < E of
+ true ->
+ gen_rsa2(Size);
+ false ->
+ {Co1,Co2} = extended_gcd(Q, P),
+ Co = erlang:max(Co1,Co2),
+ #'RSAPrivateKey'{version = 'two-prime',
+ modulus = N,
+ publicExponent = E,
+ privateExponent = D,
+ prime1 = P,
+ prime2 = Q,
+ exponent1 = D rem (P-1),
+ exponent2 = D rem (Q-1),
+ coefficient = Co
+ }
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% 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_exp(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_exp(G, X, P), %% Calculate y = g^x mod p.
+
+ #'DSAPrivateKey'{version=0, p=P, q=Q, g=G, y=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(crypto:mpint(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),
+ crypto:erlint(prime_odd(Rand, 0)).
+
+prime_odd(Rand, N) ->
+ case is_prime(Rand, 50) of
+ true ->
+ Rand;
+ false ->
+ NotPrime = crypto:erlint(Rand),
+ prime_odd(crypto:mpint(NotPrime+2), N+1)
+ end.
+
+%% see http://en.wikipedia.org/wiki/Fermat_primality_test
+is_prime(_, 0) -> true;
+is_prime(Candidate, Test) ->
+ CoPrime = odd_rand(<<0,0,0,4, 10000:32>>, Candidate),
+ case crypto:mod_exp(CoPrime, Candidate, Candidate) of
+ CoPrime -> is_prime(Candidate, Test-1);
+ _ -> false
+ end.
+
+odd_rand(Size) ->
+ Min = 1 bsl (Size*8-1),
+ Max = (1 bsl (Size*8))-1,
+ odd_rand(crypto:mpint(Min), crypto:mpint(Max)).
+
+odd_rand(Min,Max) ->
+ Rand = <<Sz:32, _/binary>> = crypto:rand_uniform(Min,Max),
+ BitSkip = (Sz+4)*8-1,
+ case Rand of
+ Odd = <<_:BitSkip, 1:1>> -> Odd;
+ Even = <<_:BitSkip, 0:1>> ->
+ crypto:mpint(crypto:erlint(Even)+1)
+ end.
+
+extended_gcd(A, B) ->
+ case A rem B of
+ 0 ->
+ {0, 1};
+ N ->
+ {X, Y} = extended_gcd(B, N),
+ {Y, X-Y*(A div B)}
+ end.
+
+pem_to_der(File) ->
+ {ok, PemBin} = file:read_file(File),
+ public_key:pem_decode(PemBin).
+
+der_to_pem(File, Entries) ->
+ PemBin = public_key:pem_encode(Entries),
+ file:write_file(File, PemBin).
diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index 1cdd96f0b0..cb81d2cc5e 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -34,9 +34,6 @@
-compile(export_all).
%% Test server specific exports
--define(PROXY_URL, "http://www.erlang.org").
--define(PROXY, "www-proxy.ericsson.se").
--define(PROXY_PORT, 8080).
-define(IP_PORT, 8998).
-define(SSL_PORT, 8999).
-define(NOT_IN_USE_PORT, 8997).
@@ -91,7 +88,6 @@ all() ->
options,
headers_as_is,
selecting_session,
- {group, proxy},
{group, ssl},
{group, stream},
{group, ipv6},
@@ -101,18 +97,6 @@ all() ->
groups() ->
[
- {proxy, [], [proxy_options,
- proxy_head,
- proxy_get,
- proxy_trace,
- proxy_post,
- proxy_put,
- proxy_delete,
- proxy_auth,
- proxy_headers,
- proxy_emulate_lower_versions,
- proxy_page_does_not_exist,
- proxy_https_not_supported]},
{ssl, [], [ssl_head,
essl_head,
ssl_get,
@@ -120,13 +104,11 @@ groups() ->
ssl_trace,
essl_trace]},
{stream, [], [http_stream,
- http_stream_once,
- proxy_stream]},
+ http_stream_once]},
{tickets, [], [hexed_query_otp_6191,
empty_body_otp_6243,
empty_response_header_otp_6830,
transfer_encoding_otp_6807,
- proxy_not_modified_otp_6821,
no_content_204_otp_6982,
missing_CR_otp_7304,
{group, otp_7883},
@@ -287,66 +269,6 @@ init_per_testcase(Case, Timeout, Config) ->
init_per_testcase_ssl(essl, PrivDir, SslConfFile,
[{watchdog, Dog} | TmpConfig]);
- "proxy_" ++ Rest ->
- io:format("init_per_testcase -> Rest: ~p~n", [Rest]),
- case Rest of
- "https_not_supported" ->
- tsp("init_per_testcase -> [proxy case] start inets"),
- inets:start(),
- tsp("init_per_testcase -> "
- "[proxy case] start crypto, public_key and ssl"),
- try ?ENSURE_STARTED([crypto, public_key, ssl]) of
- ok ->
- [{watchdog, Dog} | TmpConfig]
- catch
- throw:{error, {failed_starting, App, _}} ->
- SkipString =
- "Could not start " ++ atom_to_list(App),
- skip(SkipString);
- _:X ->
- SkipString =
- lists:flatten(
- io_lib:format("Failed starting apps: ~p", [X])),
- skip(SkipString)
- end;
-
- _ ->
- %% We use erlang.org for the proxy tests
- %% and after the switch to erlang-web, many
- %% of the test cases no longer work (erlang.org
- %% previously run on Apache).
- %% Until we have had time to update inets
- %% (and updated erlang.org to use that inets)
- %% and the test cases, we simply skip the
- %% problematic test cases.
- %% This is not ideal, but I am busy....
- case is_proxy_available(?PROXY, ?PROXY_PORT) of
- true ->
- BadCases =
- [
- "delete",
- "get",
- "head",
- "not_modified_otp_6821",
- "options",
- "page_does_not_exist",
- "post",
- "put",
- "stream"
- ],
- case lists:member(Rest, BadCases) of
- true ->
- [skip("TC and server not compatible") |
- TmpConfig];
- false ->
- inets:start(),
- [{watchdog, Dog} | TmpConfig]
- end;
- false ->
- [skip("proxy not responding") | TmpConfig]
- end
- end;
-
"ipv6_" ++ _Rest ->
%% Ensure needed apps (crypto, public_key and ssl) are started
try ?ENSURE_STARTED([crypto, public_key, ssl]) of
@@ -415,13 +337,6 @@ init_per_testcase(Case, Timeout, Config) ->
%% so this value will be overwritten (see "ipv6_" below).
%% </IPv6>
- %% This will fail for the ipv6_ - cases (but that is ok)
- ProxyExceptions = ["localhost", ?IPV6_LOCAL_HOST],
- tsp("init_per_testcase -> Options before proxy set: ~n~p",
- [httpc:get_options(all)]),
- ok = httpc:set_options([{proxy, {{?PROXY, ?PROXY_PORT}, ProxyExceptions}}]),
- tsp("init_per_testcase -> Options after proxy set: ~n~p",
- [httpc:get_options(all)]),
inets:enable_trace(max, io, httpc),
%% inets:enable_trace(max, io, all),
%% snmp:set_trace([gen_tcp]),
@@ -915,7 +830,7 @@ pipeline_await_async_reply(ReqIds, _, Acc) ->
%%-------------------------------------------------------------------------
http_trace(doc) ->
- ["Perform a TRACE request that goes through a proxy."];
+ ["Perform a TRACE request."];
http_trace(suite) ->
[];
http_trace(Config) when is_list(Config) ->
@@ -1554,260 +1469,6 @@ http_cookie(Config) when is_list(Config) ->
ok.
%%-------------------------------------------------------------------------
-proxy_options(doc) ->
- ["Perform a OPTIONS request that goes through a proxy."];
-proxy_options(suite) ->
- [];
-proxy_options(Config) when is_list(Config) ->
- %% As of 2011-03-24, erlang.org (which is used as server)
- %% does no longer run Apache, but instead runs inets, which
- %% do not implement "options".
- case ?config(skip, Config) of
- undefined ->
- case httpc:request(options, {?PROXY_URL, []}, [], []) of
- {ok, {{_,200,_}, Headers, _}} ->
- case lists:keysearch("allow", 1, Headers) of
- {value, {"allow", _}} ->
- ok;
- _ ->
- tsf(http_options_request_failed)
- end;
- Unexpected ->
- tsf({unexpected_result, Unexpected})
- end;
- Reason ->
- skip(Reason)
- end.
-
-
-%%-------------------------------------------------------------------------
-proxy_head(doc) ->
- ["Perform a HEAD request that goes through a proxy."];
-proxy_head(suite) ->
- [];
-proxy_head(Config) when is_list(Config) ->
- %% As of 2011-03-24, erlang.org (which is used as server)
- %% does no longer run Apache, but instead runs inets.
- case ?config(skip, Config) of
- undefined ->
- case httpc:request(head, {?PROXY_URL, []}, [], []) of
- {ok, {{_,200, _}, [_ | _], []}} ->
- ok;
- Unexpected ->
- tsf({unexpected_result, Unexpected})
- end;
- Reason ->
- skip(Reason)
- end.
-
-
-%%-------------------------------------------------------------------------
-proxy_get(doc) ->
- ["Perform a GET request that goes through a proxy."];
-proxy_get(suite) ->
- [];
-proxy_get(Config) when is_list(Config) ->
- case ?config(skip, Config) of
- undefined ->
- case httpc:request(get, {?PROXY_URL, []}, [], []) of
- {ok, {{_,200,_}, [_ | _], Body = [_ | _]}} ->
- inets_test_lib:check_body(Body);
- Unexpected ->
- tsf({unexpected_result, Unexpected})
- end;
- Reason ->
- skip(Reason)
- end.
-
-%%-------------------------------------------------------------------------
-proxy_emulate_lower_versions(doc) ->
- ["Perform requests as 0.9 and 1.0 clients."];
-proxy_emulate_lower_versions(suite) ->
- [];
-proxy_emulate_lower_versions(Config) when is_list(Config) ->
- case ?config(skip, Config) of
- undefined ->
- Result09 = pelv_get("HTTP/0.9"),
- case Result09 of
- {ok, [_| _] = Body0} ->
- inets_test_lib:check_body(Body0),
- ok;
- _ ->
- tsf({unexpected_result, "HTTP/0.9", Result09})
- end,
-
- %% We do not check the version here as many servers
- %% do not behave according to the rfc and send
- %% 1.1 in its response.
- Result10 = pelv_get("HTTP/1.0"),
- case Result10 of
- {ok,{{_, 200, _}, [_ | _], Body1 = [_ | _]}} ->
- inets_test_lib:check_body(Body1),
- ok;
- _ ->
- tsf({unexpected_result, "HTTP/1.0", Result10})
- end,
-
- Result11 = pelv_get("HTTP/1.1"),
- case Result11 of
- {ok, {{"HTTP/1.1", 200, _}, [_ | _], Body2 = [_ | _]}} ->
- inets_test_lib:check_body(Body2);
- _ ->
- tsf({unexpected_result, "HTTP/1.1", Result11})
- end;
-
- Reason ->
- skip(Reason)
- end.
-
-pelv_get(Version) ->
- httpc:request(get, {?PROXY_URL, []}, [{version, Version}], []).
-
-
-%%-------------------------------------------------------------------------
-proxy_trace(doc) ->
- ["Perform a TRACE request that goes through a proxy."];
-proxy_trace(suite) ->
- [];
-proxy_trace(Config) when is_list(Config) ->
- %%{ok, {{_,200,_}, [_ | _], "TRACE " ++ _}} =
- %% httpc:request(trace, {?PROXY_URL, []}, [], []),
- skip("HTTP TRACE is no longer allowed on the ?PROXY_URL server due "
- "to security reasons").
-
-
-%%-------------------------------------------------------------------------
-proxy_post(doc) ->
- ["Perform a POST request that goes through a proxy. Note the server"
- " will reject the request this is a test of the sending of the"
- " request."];
-proxy_post(suite) ->
- [];
-proxy_post(Config) when is_list(Config) ->
- %% As of 2011-03-24, erlang.org (which is used as server)
- %% does no longer run Apache, but instead runs inets.
- case ?config(skip, Config) of
- undefined ->
- case httpc:request(post, {?PROXY_URL, [],
- "text/plain", "foobar"}, [],[]) of
- {ok, {{_,405,_}, [_ | _], [_ | _]}} ->
- ok;
- Unexpected ->
- tsf({unexpected_result, Unexpected})
- end;
- Reason ->
- skip(Reason)
- end.
-
-
-%%-------------------------------------------------------------------------
-proxy_put(doc) ->
- ["Perform a PUT request that goes through a proxy. Note the server"
- " will reject the request this is a test of the sending of the"
- " request."];
-proxy_put(suite) ->
- [];
-proxy_put(Config) when is_list(Config) ->
- %% As of 2011-03-24, erlang.org (which is used as server)
- %% does no longer run Apache, but instead runs inets.
- case ?config(skip, Config) of
- undefined ->
- case httpc:request(put, {"http://www.erlang.org/foobar.html", [],
- "html", "<html> <body><h1> foo </h1>"
- "<p>bar</p> </body></html>"}, [], []) of
- {ok, {{_,405,_}, [_ | _], [_ | _]}} ->
- ok;
- Unexpected ->
- tsf({unexpected_result, Unexpected})
- end;
- Reason ->
- skip(Reason)
- end.
-
-
-%%-------------------------------------------------------------------------
-proxy_delete(doc) ->
- ["Perform a DELETE request that goes through a proxy. Note the server"
- " will reject the request this is a test of the sending of the"
- " request. But as the file does not exist the return code will"
- " be 404 not found."];
-proxy_delete(suite) ->
- [];
-proxy_delete(Config) when is_list(Config) ->
- %% As of 2011-03-24, erlang.org (which is used as server)
- %% does no longer run Apache, but instead runs inets.
- case ?config(skip, Config) of
- undefined ->
- URL = ?PROXY_URL ++ "/foobar.html",
- case httpc:request(delete, {URL, []}, [], []) of
- {ok, {{_,404,_}, [_ | _], [_ | _]}} ->
- ok;
- Unexpected ->
- tsf({unexpected_result, Unexpected})
- end;
- Reason ->
- skip(Reason)
- end.
-
-
-%%-------------------------------------------------------------------------
-proxy_headers(doc) ->
- ["Use as many request headers as possible"];
-proxy_headers(suite) ->
- [];
-proxy_headers(Config) when is_list(Config) ->
- case ?config(skip, Config) of
- undefined ->
- {ok, {{_,200,_}, [_ | _], [_ | _]}}
- = httpc:request(get, {?PROXY_URL,
- [
- {"Accept",
- "text/*, text/html,"
- " text/html;level=1,"
- " */*"},
- {"Accept-Charset",
- "iso-8859-5, unicode-1-1;"
- "q=0.8"},
- {"Accept-Encoding", "*"},
- {"Accept-Language",
- "sv, en-gb;q=0.8,"
- " en;q=0.7"},
- {"User-Agent", "inets"},
- {"Max-Forwards","5"},
- {"Referer",
- "http://otp.ericsson.se:8000"
- "/product/internal"}
- ]}, [], []),
- ok;
- Reason ->
- skip(Reason)
- end.
-
-
-%%-------------------------------------------------------------------------
-proxy_auth(doc) ->
- ["Test the code for sending of proxy authorization."];
-proxy_auth(suite) ->
- [];
-proxy_auth(Config) when is_list(Config) ->
- %% Our proxy seems to ignore the header, however our proxy
- %% does not requirer an auth header, but we want to know
- %% atleast the code for sending the header does not crash!
- case ?config(skip, Config) of
- undefined ->
- case httpc:request(get, {?PROXY_URL, []},
- [{proxy_auth, {"foo", "bar"}}], []) of
- {ok, {{_,200, _}, [_ | _], [_|_]}} ->
- ok;
- Unexpected ->
- tsf({unexpected_result, Unexpected})
- end;
- Reason ->
- skip(Reason)
- end.
-
-
-%%-------------------------------------------------------------------------
http_server_does_not_exist(doc) ->
["Test that we get an error message back when the server "
"does note exist."];
@@ -1835,39 +1496,6 @@ page_does_not_exist(Config) when is_list(Config) ->
%%-------------------------------------------------------------------------
-proxy_page_does_not_exist(doc) ->
- ["Test that we get a 404 when the page is not found."];
-proxy_page_does_not_exist(suite) ->
- [];
-proxy_page_does_not_exist(Config) when is_list(Config) ->
- case ?config(skip, Config) of
- undefined ->
- URL = ?PROXY_URL ++ "/doesnotexist.html",
- {ok, {{_,404,_}, [_ | _], [_ | _]}} =
- httpc:request(get, {URL, []}, [], []),
- ok;
- Reason ->
- skip(Reason)
- end.
-
-
-%%-------------------------------------------------------------------------
-
-proxy_https_not_supported(doc) ->
- [];
-proxy_https_not_supported(suite) ->
- [];
-proxy_https_not_supported(Config) when is_list(Config) ->
- Result = httpc:request(get, {"https://login.yahoo.com", []}, [], []),
- case Result of
- {error, https_through_proxy_is_not_currently_supported} ->
- ok;
- _ ->
- tsf({unexpected_reason, Result})
- end.
-
-
-%%-------------------------------------------------------------------------
http_stream(doc) ->
["Test the option stream for asynchrony requests"];
@@ -1968,36 +1596,6 @@ once(URL) ->
%%-------------------------------------------------------------------------
-proxy_stream(doc) ->
- ["Test the option stream for asynchrony requests"];
-proxy_stream(suite) ->
- [];
-proxy_stream(Config) when is_list(Config) ->
- case ?config(skip, Config) of
- undefined ->
- {ok, {{_,200,_}, [_ | _], Body}} =
- httpc:request(get, {?PROXY_URL, []}, [], []),
-
- {ok, RequestId} =
- httpc:request(get, {?PROXY_URL, []}, [],
- [{sync, false}, {stream, self}]),
-
- receive
- {http, {RequestId, stream_start, _Headers}} ->
- ok;
- {http, Msg} ->
- tsf(Msg)
- end,
-
- StreamedBody = receive_streamed_body(RequestId, <<>>),
-
- Body == binary_to_list(StreamedBody);
- Reason ->
- skip(Reason)
- end.
-
-
-%%-------------------------------------------------------------------------
parse_url(doc) ->
["Test that an url is parsed correctly"];
parse_url(suite) ->
@@ -2589,21 +2187,6 @@ transfer_encoding_otp_6807(Config) when is_list(Config) ->
%%-------------------------------------------------------------------------
-proxy_not_modified_otp_6821(doc) ->
- ["If unmodified no body should be returned"];
-proxy_not_modified_otp_6821(suite) ->
- [];
-proxy_not_modified_otp_6821(Config) when is_list(Config) ->
- case ?config(skip, Config) of
- undefined ->
- provocate_not_modified_bug(?PROXY_URL);
- Reason ->
- skip(Reason)
- end.
-
-
-%%-------------------------------------------------------------------------
-
empty_response_header_otp_6830(doc) ->
["Test the case that the HTTP server does not send any headers"];
empty_response_header_otp_6830(suite) ->
@@ -3410,15 +2993,6 @@ create_config(FileName, ComType, Port, PrivDir, ServerRoot, DocRoot,
cline(List) ->
lists:flatten([List, "\r\n"]).
-is_proxy_available(Proxy, Port) ->
- case gen_tcp:connect(Proxy, Port, []) of
- {ok, Socket} ->
- gen_tcp:close(Socket),
- true;
- _ ->
- false
- end.
-
receive_streamed_body(RequestId, Body) ->
receive
{http, {RequestId, stream, BinBodyPart}} ->
@@ -3912,42 +3486,6 @@ content_length(["content-length:" ++ Value | _]) ->
content_length([_Head | Tail]) ->
content_length(Tail).
-provocate_not_modified_bug(Url) ->
- Timeout = 15000, %% 15s should be plenty
-
- {ok, {{_, 200, _}, ReplyHeaders, _Body}} =
- httpc:request(get, {Url, []}, [{timeout, Timeout}], []),
- Etag = pick_header(ReplyHeaders, "ETag"),
- Last = pick_header(ReplyHeaders, "last-modified"),
-
- case httpc:request(get, {Url, [{"If-None-Match", Etag},
- {"If-Modified-Since", Last}]},
- [{timeout, 15000}],
- []) of
- {ok, {{_, 304, _}, _, _}} -> %% The expected reply
- page_unchanged;
- {ok, {{_, 200, _}, _, _}} ->
- %% If the page has changed since the
- %% last request we retry to
- %% trigger the bug
- provocate_not_modified_bug(Url);
- {error, timeout} ->
- %% Not what we expected. Tcpdump can be used to
- %% verify that we receive the complete http-reply
- %% but still time out.
- incorrect_result
- end.
-
-pick_header(Headers, Name) ->
- case lists:keysearch(string:to_lower(Name), 1,
- [{string:to_lower(X), Y} || {X, Y} <- Headers]) of
- false ->
- [];
- {value, {_Key, Val}} ->
- Val
- end.
-
-
%% -------------------------------------------------------------------------
simple_request_and_verify(Config,
diff --git a/lib/inets/test/httpc_proxy_SUITE.erl b/lib/inets/test/httpc_proxy_SUITE.erl
new file mode 100644
index 0000000000..84db39e76b
--- /dev/null
+++ b/lib/inets/test/httpc_proxy_SUITE.erl
@@ -0,0 +1,575 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+
+%%
+%% ts:run(inets, httpc_proxy_SUITE, [batch]).
+%% ct:run("../inets_test", httpc_proxy_SUITE).
+%%
+
+-module(httpc_proxy_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+
+-include_lib("kernel/include/file.hrl").
+-include("inets_test_lib.hrl").
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-define(LOCAL_PROXY_SCRIPT, "server_proxy.sh").
+-define(p(F, A), % Debug printout
+ begin
+ io:format(
+ "~w ~w: " ++ begin F end,
+ [self(),?MODULE] ++ begin A end)
+ end).
+
+%%--------------------------------------------------------------------
+%% Common Test interface functions -----------------------------------
+%%--------------------------------------------------------------------
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [{group,local_proxy},
+ {group,local_proxy_https}].
+
+groups() ->
+ [{local_proxy,[],
+ [http_emulate_lower_versions
+ |local_proxy_cases()]},
+ {local_proxy_https,[],
+ local_proxy_cases()}].
+
+%% internal functions
+
+local_proxy_cases() ->
+ [http_head,
+ http_get,
+ http_options,
+ http_trace,
+ http_post,
+ http_put,
+ http_delete,
+ http_headers,
+ http_proxy_auth,
+ http_doesnotexist,
+ http_stream,
+ http_not_modified_otp_6821].
+
+%%--------------------------------------------------------------------
+
+init_per_suite(Config0) ->
+ case init_apps([crypto,public_key], Config0) of
+ Config when is_list(Config) ->
+ make_cert_files(dsa, "server-", Config),
+ Config;
+ Other ->
+ Other
+ end.
+
+end_per_suite(_Config) ->
+ [app_stop(App) || App <- r(suite_apps())],
+ ok.
+
+%% internal functions
+
+suite_apps() ->
+ [crypto,public_key].
+
+%%--------------------------------------------------------------------
+
+init_per_group(local_proxy, Config) ->
+ init_local_proxy([{protocol,http}|Config]);
+init_per_group(local_proxy_https, Config) ->
+ init_local_proxy([{protocol,https}|Config]).
+
+end_per_group(Group, Config)
+ when
+ Group =:= local_proxy;
+ Group =:= local_proxy_https ->
+ rcmd_local_proxy(["stop"], Config),
+ Config;
+end_per_group(_, Config) ->
+ Config.
+
+%%--------------------------------------------------------------------
+
+init_per_testcase(Case, Config0) ->
+ ct:timetrap({seconds,30}),
+ Apps = apps(Case, Config0),
+ case init_apps(Apps, Config0) of
+ Config when is_list(Config) ->
+ case app_start(inets, Config) of
+ ok ->
+ Config;
+ Error ->
+ [app_stop(N) || N <- [inets|r(Apps)]],
+ ct:fail({could_not_init_inets,Error})
+ end;
+ E3 ->
+ E3
+ end.
+
+end_per_testcase(_Case, Config) ->
+ app_stop(inets),
+ Config.
+
+%% internal functions
+
+apps(_Case, Config) ->
+ case ?config(protocol, Config) of
+ https ->
+ [ssl];
+ _ ->
+ []
+ end.
+
+%%--------------------------------------------------------------------
+%% Test Cases --------------------------------------------------------
+%%--------------------------------------------------------------------
+
+http_head(doc) ->
+ ["Test http/https HEAD request."];
+http_head(Config) when is_list(Config) ->
+ Method = head,
+ URL = url("/index.html", Config),
+ Request = {URL,[]},
+ HttpOpts = [],
+ Opts = [],
+ {ok,{{_,200,_},[_|_],[]}} =
+ httpc:request(Method, Request, HttpOpts, Opts),
+ ok.
+
+%%--------------------------------------------------------------------
+
+http_get(doc) ->
+ ["Test http/https GET request."];
+http_get(Config) when is_list(Config) ->
+ Method = get,
+ URL = url("/index.html", Config),
+ Request = {URL,[]},
+ Timeout = timer:seconds(1),
+ ConnTimeout = Timeout + timer:seconds(1),
+
+ HttpOpts1 = [{timeout,Timeout},{connect_timeout,ConnTimeout}],
+ Opts1 = [],
+ {ok,{{_,200,_},[_|_],[_|_]=B1}} =
+ httpc:request(Method, Request, HttpOpts1, Opts1),
+ inets_test_lib:check_body(B1),
+
+ HttpOpts2 = [],
+ Opts2 = [{body_format,binary}],
+ {ok,{{_,200,_},[_|_],B2}} =
+ httpc:request(Method, Request, HttpOpts2, Opts2),
+ inets_test_lib:check_body(binary_to_list(B2)).
+
+%%--------------------------------------------------------------------
+
+http_options(doc) ->
+ ["Perform an OPTIONS request."];
+http_options(Config) when is_list(Config) ->
+ Method = options,
+ URL = url("/index.html", Config),
+ Request = {URL,[]},
+ HttpOpts = [],
+ Opts = [],
+ {ok,{{_,200,_},Headers,_}} =
+ httpc:request(Method, Request, HttpOpts, Opts),
+ {value,_} = lists:keysearch("allow", 1, Headers),
+ ok.
+
+%%--------------------------------------------------------------------
+
+http_trace(doc) ->
+ ["Perform a TRACE request."];
+http_trace(Config) when is_list(Config) ->
+ Method = trace,
+ URL = url("/index.html", Config),
+ Request = {URL,[]},
+ HttpOpts = [],
+ Opts = [],
+ {ok,{{_,200,_},[_|_],"TRACE "++_}} =
+ httpc:request(Method, Request, HttpOpts, Opts),
+ ok.
+
+%%--------------------------------------------------------------------
+
+http_post(doc) ->
+ ["Perform a POST request that goes through a proxy. When the "
+ "request goes to an ordinary file it seems the POST data "
+ "is ignored."];
+http_post(Config) when is_list(Config) ->
+ Method = post,
+ URL = url("/index.html", Config),
+ Request = {URL,[],"text/plain","foobar"},
+ HttpOpts = [],
+ Opts = [],
+ {ok,{{_,200,_},[_|_],[_|_]}} =
+ httpc:request(Method, Request, HttpOpts, Opts),
+ ok.
+
+%%--------------------------------------------------------------------
+
+http_put(doc) ->
+ ["Perform a PUT request. The server will not allow it "
+ "but we only test sending the request."];
+http_put(Config) when is_list(Config) ->
+ Method = put,
+ URL = url("/put.html", Config),
+ Content =
+ "<html><body> <h1>foo</h1> <p>bar</p> </body></html>",
+ Request = {URL,[],"html",Content},
+ HttpOpts = [],
+ Opts = [],
+ {ok,{{_,405,_},[_|_],[_|_]}} =
+ httpc:request(Method, Request, HttpOpts, Opts),
+ ok.
+
+%%--------------------------------------------------------------------
+
+http_delete(doc) ->
+ ["Perform a DELETE request that goes through a proxy. Note the server "
+ "will reject the request with a 405 Method Not Allowed,"
+ "but this is just a test of sending the request."];
+http_delete(Config) when is_list(Config) ->
+ Method = delete,
+ URL = url("/delete.html", Config),
+ Request = {URL,[]},
+ HttpOpts = [],
+ Opts = [],
+ {ok,{{_,405,_},[_|_],[_|_]}} =
+ httpc:request(Method, Request, HttpOpts, Opts),
+ ok.
+
+%%--------------------------------------------------------------------
+
+http_headers(doc) ->
+ ["Use as many request headers as possible"];
+http_headers(Config) when is_list(Config) ->
+ Method = get,
+ URL = url("/index.html", Config),
+ Headers =
+ [{"Accept",
+ "text/*, text/html, text/html;level=1, */*"},
+ {"Accept-Charset",
+ "iso-8859-5, unicode-1-1;q=0.8"},
+ {"Accept-Encoding", "*"},
+ {"Accept-Language",
+ "sv, en-gb;q=0.8, en;q=0.7"},
+ {"User-Agent", "inets"},
+ {"Max-Forwards","5"},
+ {"Referer",
+ "http://otp.ericsson.se:8000/product/internal"}],
+ Request = {URL,Headers},
+ HttpOpts = [],
+ Opts = [],
+ {ok,{{_,200,_},[_|_],[_|_]}} =
+ httpc:request(Method, Request, HttpOpts, Opts),
+ ok.
+
+%%--------------------------------------------------------------------
+
+http_proxy_auth(doc) ->
+ ["Test the code for sending of proxy authorization."];
+http_proxy_auth(Config) when is_list(Config) ->
+ %% Our proxy seems to ignore the header, however our proxy
+ %% does not requirer an auth header, but we want to know
+ %% atleast the code for sending the header does not crash!
+ Method = get,
+ URL = url("/index.html", Config),
+ Request = {URL,[]},
+ HttpOpts = [{proxy_auth,{"foo","bar"}}],
+ Opts = [],
+ {ok,{{_,200,_},[_|_],[_|_]}} =
+ httpc:request(Method, Request, HttpOpts, Opts),
+ ok.
+
+%%--------------------------------------------------------------------
+
+http_doesnotexist(doc) ->
+ ["Test that we get a 404 when the page is not found."];
+http_doesnotexist(Config) when is_list(Config) ->
+ Method = get,
+ URL = url("/doesnotexist.html", Config),
+ Request = {URL,[]},
+ HttpOpts = [{proxy_auth,{"foo","bar"}}],
+ Opts = [],
+ {ok,{{_,404,_},[_|_],[_|_]}} =
+ httpc:request(Method, Request, HttpOpts, Opts),
+ ok.
+
+%%--------------------------------------------------------------------
+
+http_stream(doc) ->
+ ["Test the option stream for asynchronous requests"];
+http_stream(Config) when is_list(Config) ->
+ Method = get,
+ URL = url("/index.html", Config),
+ Request = {URL,[]},
+ HttpOpts = [],
+
+ Opts1 = [{body_format,binary}],
+ {ok,{{_,200,_},[_|_],Body}} =
+ httpc:request(Method, Request, HttpOpts, Opts1),
+
+ Opts2 = [{sync,false},{stream,self}],
+ {ok,RequestId} =
+ httpc:request(Method, Request, HttpOpts, Opts2),
+ receive
+ {http,{RequestId,stream_start,[_|_]}} ->
+ ok
+ end,
+ case http_stream(RequestId, <<>>) of
+ Body -> ok
+ end.
+ %% StreamedBody = http_stream(RequestId, <<>>),
+ %% Body =:= StreamedBody,
+ %% ok.
+
+http_stream(RequestId, Body) ->
+ receive
+ {http,{RequestId,stream,Bin}} ->
+ http_stream(RequestId, <<Body/binary,Bin/binary>>);
+ {http,{RequestId,stream_end,_Headers}} ->
+ Body
+ end.
+
+%%--------------------------------------------------------------------
+
+http_emulate_lower_versions(doc) ->
+ ["Perform requests as 0.9 and 1.0 clients."];
+http_emulate_lower_versions(Config) when is_list(Config) ->
+ Method = get,
+ URL = url("/index.html", Config),
+ Request = {URL,[]},
+ Opts = [],
+
+ HttpOpts1 = [{version,"HTTP/0.9"}],
+ {ok,[_|_]=B1} =
+ httpc:request(Method, Request, HttpOpts1, Opts),
+ inets_test_lib:check_body(B1),
+
+ HttpOpts2 = [{version,"HTTP/1.0"}],
+ {ok,{{_,200,_},[_|_],[_|_]=B2}} =
+ httpc:request(Method, Request, HttpOpts2, Opts),
+ inets_test_lib:check_body(B2),
+
+ HttpOpts3 = [{version,"HTTP/1.1"}],
+ {ok,{{_,200,_},[_|_],[_|_]=B3}} =
+ httpc:request(Method, Request, HttpOpts3, Opts),
+ inets_test_lib:check_body(B3),
+
+ ok.
+
+%%--------------------------------------------------------------------
+http_not_modified_otp_6821(doc) ->
+ ["If unmodified no body should be returned"];
+http_not_modified_otp_6821(Config) when is_list(Config) ->
+ Method = get,
+ URL = url("/index.html", Config),
+ Opts = [],
+
+ Request1 = {URL,[]},
+ HttpOpts1 = [],
+ {ok,{{_,200,_},ReplyHeaders,[_|_]}} =
+ httpc:request(Method, Request1, HttpOpts1, Opts),
+ ETag = header_value("etag", ReplyHeaders),
+ LastModified = header_value("last-modified", ReplyHeaders),
+
+ Request2 =
+ {URL,
+ [{"If-None-Match",ETag},
+ {"If-Modified-Since",LastModified}]},
+ HttpOpts2 = [{timeout,15000}], % Limit wait for bug result
+ {ok,{{_,304,_},_,[]}} = % Page Unchanged
+ httpc:request(Method, Request2, HttpOpts2, Opts),
+
+ ok.
+
+header_value(Name, [{HeaderName,HeaderValue}|Headers]) ->
+ case string:to_lower(HeaderName) of
+ Name ->
+ HeaderValue;
+ _ ->
+ header_value(Name, Headers)
+ end.
+
+%%--------------------------------------------------------------------
+%% Internal Functions ------------------------------------------------
+%%--------------------------------------------------------------------
+
+init_apps([], Config) ->
+ Config;
+init_apps([App|Apps], Config) ->
+ case app_start(App, Config) of
+ ok ->
+ init_apps(Apps, Config);
+ Error ->
+ Msg =
+ lists:flatten(
+ io_lib:format(
+ "Could not start ~p due to ~p.~n",
+ [App, Error])),
+ {skip,Msg}
+ end.
+
+app_start(App, Config) ->
+ try
+ case App of
+ crypto ->
+ crypto:stop(),
+ ok = crypto:start();
+ inets ->
+ application:stop(App),
+ ok = application:start(App),
+ case ?config(proxy, Config) of
+ undefined -> ok;
+ {_,ProxySpec} ->
+ ok = httpc:set_options([{proxy,ProxySpec}])
+ end;
+ _ ->
+ application:stop(App),
+ ok = application:start(App)
+ end
+ catch
+ Class:Reason ->
+ {exception,Class,Reason}
+ end.
+
+app_stop(App) ->
+ application:stop(App).
+
+make_cert_files(Alg, Prefix, Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ CaInfo = {CaCert,_} = erl_make_certs:make_cert([{key,Alg}]),
+ {Cert,CertKey} = erl_make_certs:make_cert([{key,Alg},{issuer,CaInfo}]),
+ CaCertFile = filename:join(PrivDir, Prefix++"cacerts.pem"),
+ CertFile = filename:join(PrivDir, Prefix++"cert.pem"),
+ KeyFile = filename:join(PrivDir, Prefix++"key.pem"),
+ der_to_pem(CaCertFile, [{'Certificate', CaCert, not_encrypted}]),
+ der_to_pem(CertFile, [{'Certificate', Cert, not_encrypted}]),
+ der_to_pem(KeyFile, [CertKey]),
+ ok.
+
+der_to_pem(File, Entries) ->
+ PemBin = public_key:pem_encode(Entries),
+ file:write_file(File, PemBin).
+
+
+
+url(AbsPath, Config) ->
+ Protocol = ?config(protocol, Config),
+ {ServerName,ServerPort} = ?config(Protocol, Config),
+ atom_to_list(Protocol) ++ "://" ++
+ ServerName ++ ":" ++ integer_to_list(ServerPort) ++
+ AbsPath.
+
+%%--------------------------------------------------------------------
+
+init_local_proxy(Config) ->
+ case os:type() of
+ {unix,_} ->
+ case rcmd_local_proxy(["start"], Config) of
+ {0,[":STARTED:"++String]} ->
+ init_local_proxy_string(String, Config);
+ {_,[":SKIP:"++_|_]}=Reason ->
+ {skip,Reason};
+ Error ->
+ rcmd_local_proxy(["stop"], Config),
+ ct:fail({local_proxy_start_failed,Error})
+ end;
+ _ ->
+ {skip,"Platform can not run local proxy start script"}
+ end.
+
+init_local_proxy_string(String, Config) ->
+ {Proxy,Server} = split($|, String),
+ {ProxyName,ProxyPort} = split($:, Proxy),
+ {ServerName,ServerPorts} = split($:, Server),
+ {ServerHttpPort,ServerHttpsPort} = split($:, ServerPorts),
+ [{proxy,{local,{{ProxyName,list_to_integer(ProxyPort)},[]}}},
+ {http,{ServerName,list_to_integer(ServerHttpPort)}},
+ {https,{ServerName,list_to_integer(ServerHttpsPort)}}
+ |Config].
+
+rcmd_local_proxy(Args, Config) ->
+ DataDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
+ Script = filename:join(DataDir, ?LOCAL_PROXY_SCRIPT),
+ rcmd(Script, Args, [{cd,PrivDir}]).
+
+rcmd(Cmd, Args, Opts) ->
+ Port =
+ erlang:open_port(
+ {spawn_executable,Cmd},
+ [{args,Args},{line,80},exit_status,eof,hide|Opts]),
+ rcmd_loop(Port, [], [], undefined, false).
+
+rcmd_loop(Port, Lines, Buf, Exit, EOF) ->
+ receive
+ {Port,{data,{Flag,Line}}} ->
+ case Flag of
+ noeol ->
+ rcmd_loop(Port, Lines, r(Line, Buf), Exit, EOF);
+ eol ->
+ rcmd_loop(Port, [r(Buf, Line)|Lines], [], Exit, EOF)
+ end;
+ {Port,{exit_status,Status}} when Exit =:= undefined ->
+ case EOF of
+ true ->
+ rcmd_close(Port, Lines, Buf, Status);
+ false ->
+ rcmd_loop(Port, Lines, Buf, Status, EOF)
+ end;
+ {Port,eof} when EOF =:= false ->
+ case Exit of
+ undefined ->
+ rcmd_loop(Port, Lines, Buf, Exit, true);
+ Status ->
+ rcmd_close(Port, Lines, Buf, Status)
+ end;
+ {Port,_}=Unexpected ->
+ ct:fail({unexpected_from_port,Unexpected})
+ end.
+
+rcmd_close(Port, Lines, Buf, Status) ->
+ catch port_close(Port),
+ case Buf of
+ [] ->
+ {Status,Lines};
+ _ ->
+ {Status,[r(Buf)|Lines]}
+ end.
+
+%%--------------------------------------------------------------------
+
+%% Split on first match of X in Ys, do not include X in neither part
+split(X, Ys) ->
+ split(X, Ys, []).
+%%
+split(X, [X|Ys], Rs) ->
+ {r(Rs),Ys};
+split(X, [Y|Ys], Rs) ->
+ split(X, Ys, [Y|Rs]).
+
+r(L) -> lists:reverse(L).
+r(L, R) -> lists:reverse(L, R).
diff --git a/lib/inets/test/httpc_proxy_SUITE_data/apache2/apache2.conf b/lib/inets/test/httpc_proxy_SUITE_data/apache2/apache2.conf
new file mode 100644
index 0000000000..37af88c510
--- /dev/null
+++ b/lib/inets/test/httpc_proxy_SUITE_data/apache2/apache2.conf
@@ -0,0 +1,87 @@
+## Simple Apache 2 configuration file for daily test very local http server
+##
+## %CopyrightBegin%
+##
+## Copyright Ericsson AB 2012. All Rights Reserved.
+##
+## The contents of this file are subject to the Erlang Public License,
+## Version 1.1, (the "License"); you may not use this file except in
+## compliance with the License. You should have received a copy of the
+## Erlang Public License along with this software. If not, it can be
+## retrieved online at http://www.erlang.org/.
+##
+## Software distributed under the License is distributed on an "AS IS"
+## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+## the License for the specific language governing rights and limitations
+## under the License.
+##
+## %CopyrightEnd%
+##
+## Author: Raimo Niskanen, Erlang/OTP
+#
+LockFile ${APACHE_LOCK_DIR}/accept.lock
+PidFile ${APACHE_PID_FILE}
+
+Timeout 300
+
+User ${APACHE_RUN_USER}
+Group ${APACHE_RUN_GROUP}
+
+DefaultType text/plain
+HostnameLookups Off
+ErrorLog ${APACHE_LOG_DIR}/error.log
+LogLevel warn
+
+Include ${APACHE_MODS_DIR}/*.load
+Include ${APACHE_MODS_DIR}/*.conf
+
+Listen ${APACHE_HTTP_PORT} http
+
+<IfModule mod_ssl.c>
+ Listen ${APACHE_HTTPS_PORT} https
+ SSLMutex file:${APACHE_LOCK_DIR}/ssl_mutex
+</IfModule>
+
+#<IfModule mod_gnutls.c>
+# Listen 8443
+#</IfModule>
+
+#LogFormat "%v:%p %h %l %u %t \"%r\" %>s %O \"%{Referer}i\" \"%{User-Agent}i\"" vhost_combined
+LogFormat "%h %l %u %t \"%r\" %>s %O \"%{Referer}i\" \"%{User-Agent}i\"" combined
+#LogFormat "%h %l %u %t \"%r\" %>s %O" common
+#LogFormat "%{Referer}i -> %U" referer
+#LogFormat "%{User-agent}i" agent
+
+CustomLog ${APACHE_LOG_DIR}/access.log combined
+
+<Directory />
+ AllowOverride None
+ Order Deny,Allow
+ Deny from all
+</Directory>
+
+ServerTokens Minimal
+ServerSignature Off
+KeepAlive On
+KeepAliveTimeout 5
+
+ServerName ${APACHE_SERVER_NAME}
+ServerAdmin webmaster@${APACHE_SERVER_NAME}
+DocumentRoot ${APACHE_DOCROOT}
+<Directory ${APACHE_DOCROOT}>
+ Options Indexes FollowSymLinks MultiViews
+ AllowOverride None
+ Order allow,deny
+ Allow from all
+</Directory>
+
+<VirtualHost *:${APACHE_HTTP_PORT}>
+</VirtualHost>
+
+<IfModule mod_ssl.c>
+ <VirtualHost *:${APACHE_HTTPS_PORT}>
+ SSLCertificateFile ${APACHE_CERTS_DIR}/server-cert.pem
+ SSLCertificateKeyFile ${APACHE_CERTS_DIR}/server-key.pem
+ SSLEngine on
+ </VirtualHost>
+</IfModule>
diff --git a/lib/inets/test/httpc_proxy_SUITE_data/apache2/htdocs/index.html b/lib/inets/test/httpc_proxy_SUITE_data/apache2/htdocs/index.html
new file mode 100644
index 0000000000..1c70d95348
--- /dev/null
+++ b/lib/inets/test/httpc_proxy_SUITE_data/apache2/htdocs/index.html
@@ -0,0 +1,4 @@
+<html><body><h1>It works!</h1>
+<p>This is the default web page for this server.</p>
+<p>The web server software is running but no content has been added, yet.</p>
+</body></html>
diff --git a/lib/inets/test/httpc_proxy_SUITE_data/server_proxy.sh b/lib/inets/test/httpc_proxy_SUITE_data/server_proxy.sh
new file mode 100755
index 0000000000..4b05ea63ef
--- /dev/null
+++ b/lib/inets/test/httpc_proxy_SUITE_data/server_proxy.sh
@@ -0,0 +1,198 @@
+#! /bin/sh
+##
+## Command file to handle external webserver and proxy
+## apache2 and tinyproxy.
+##
+## %CopyrightBegin%
+##
+## Copyright Ericsson AB 2012. All Rights Reserved.
+##
+## The contents of this file are subject to the Erlang Public License,
+## Version 1.1, (the "License"); you may not use this file except in
+## compliance with the License. You should have received a copy of the
+## Erlang Public License along with this software. If not, it can be
+## retrieved online at http://www.erlang.org/.
+##
+## Software distributed under the License is distributed on an "AS IS"
+## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+## the License for the specific language governing rights and limitations
+## under the License.
+##
+## %CopyrightEnd%
+##
+## Author: Raimo Niskanen, Erlang/OTP
+#
+
+PATH=/usr/local/bin:/usr/local/sbin:/bin:/usr/bin:/sbin:/usr/sbin
+SHELL=/bin/sh
+unset CDPATH ENV BASH_ENV
+IFS='
+ '
+
+APACHE_MODS_AVAILABLE_DIR="/etc/apache2/mods-available"
+MODS="authz_host.load mime.conf mime.load ssl.conf ssl.load"
+
+APACHE_HTTP_PORT=8080
+APACHE_HTTPS_PORT=8443
+APACHE_SERVER_NAME=localhost
+export APACHE_HTTP_PORT APACHE_HTTPS_PORT APACHE_SERVER_NAME
+
+PROXY_SERVER_NAME=localhost
+PROXY_PORT=8000
+export PROXY_SERVER_NAME PROXY_PORT
+
+# All stdout goes to the calling erlang port, therefore
+# these helpers push all side info to stderr.
+status () { echo "$@"; }
+info () { echo "$@" 1>&2; }
+die () { REASON="$?"; status "$@"; exit "$REASON"; }
+cmd () { "$@" 1>&2; }
+silent () { "$@" 1>/dev/null 2>&1; }
+
+wait_for_pidfile () {
+ PIDFILE="${1:?Missing argument: PidFile}"
+ for t in 1 1 1 2 2 3 3 3 4; do
+ PID="`head -1 "$1" 2>/dev/null`" && [ :"$PID" != : ] && break
+ sleep $t
+ done
+ [ :"$PID" = : ] && die ":ERROR:No or empty PidFile: $1"
+ info "Started $PIDFILE[$PID]."
+}
+
+kill_and_wait () {
+ PID_FILE="${1:?Missing argument: PidFile}"
+ if [ -f "$PID_FILE" ]; then
+ PID="`head -1 "$PID_FILE" 2>/dev/null`"
+ [ :"$PID" = : ] && \
+ info "Empty Pid file: $1"
+ info "Stopping $1 [$PID]..."
+ shift
+ case :"${1:?Missing argument: kill command}" in
+ :kill)
+ [ :"$PID" = : ] || cmd kill "$PID";;
+ :*)
+ cmd "$@";;
+ esac
+ wait "$PID"
+ for t in 1 1 1 2; do
+ sleep $t
+ [ -e "$PID_FILE" ] || break
+ done
+ silent rm "$PID_FILE"
+ else
+ info "No pid file: $1"
+ fi
+}
+
+
+PRIV_DIR="`pwd`"
+DATA_DIR="`dirname "$0"`"
+DATA_DIR="`cd "$DATA_DIR" && pwd`"
+
+silent type apache2ctl || \
+ die ":SKIP: Can not find apache2ctl."
+silent type tinyproxy || \
+ die ":SKIP: Can not find tinyproxy."
+
+[ -d "$APACHE_MODS_AVAILABLE_DIR" ] || \
+ die ":SKIP:Can not locate modules dir $APACHE_MODS_AVAILABLE_DIR."
+
+silent mkdir apache2 tinyproxy
+cd apache2 || \
+ die ":ERROR:Can not cd to apache2"
+CWD="`pwd`"
+(cd ../tinyproxy) || \
+ die ":ERROR:Can not cd to ../tinyproxy"
+
+unset APACHE_HTTPD APACHE_LYNX APACHE_STATUSURL
+
+## apache2ctl envvars variables
+APACHE_CONFDIR="$DATA_DIR/apache2"
+[ -f "$APACHE_CONFDIR"/apache2.conf ] || \
+ die ":SKIP:No config file: $APACHE_CONFDIR/apache2.conf."
+APACHE_RUN_USER=`id | sed 's/^uid=[0-9]\{1,\}(\([^)]*\)).*/\1/'`
+APACHE_RUN_GROUP=`id | sed 's/.*[ ]gid=[0-9]\{1,\}(\([^)]*\)).*/\1/'`
+APACHE_RUN_DIR="$CWD/run"
+APACHE_PID_FILE="$APACHE_RUN_DIR/pid"
+APACHE_LOCK_DIR="$CWD/lock"
+APACHE_LOG_DIR="$CWD/log"
+export APACHE_CONFDIR APACHE_RUN_USER APACHE_RUN_GROUP
+export APACHE_RUN_DIR APACHE_PID_FILE
+export APACHE_LOCK_DIR APACHE_LOG_DIR
+silent cmd mkdir "$APACHE_CONFDIR"
+silent cmd mkdir "$APACHE_RUN_DIR" "$APACHE_LOCK_DIR" "$APACHE_LOG_DIR"
+
+## Our apache2.conf additional variables
+APACHE_MODS_DIR="$CWD/mods"
+APACHE_DOCROOT="$APACHE_CONFDIR/htdocs"
+APACHE_CERTS_DIR="$PRIV_DIR"
+export APACHE_MODS_DIR APACHE_DOCROOT APACHE_CERTS_DIR
+[ -d "$APACHE_MODS_DIR" ] || {
+ cmd mkdir "$APACHE_MODS_DIR"
+ for MOD in $MODS; do
+ cmd ln -s "$APACHE_MODS_AVAILABLE_DIR/$MOD" "$APACHE_MODS_DIR" || {
+ die ":ERROR:ln of apache 2 module $MOD failed"
+ }
+ done
+}
+
+case :"${1:?}" in
+
+ :start)
+ info "Starting apache2..."
+ cmd apache2ctl start
+ [ $? = 0 ] || \
+ die ":ERROR: apache2 did not start."
+ wait_for_pidfile "$APACHE_PID_FILE"
+
+ info "Starting tinyproxy..."
+ cmd cd ../tinyproxy || \
+ die ":ERROR:Can not cd to `pwd`/../tinyproxy"
+ cat >tinyproxy.conf <<EOF
+Port $PROXY_PORT
+
+Listen 127.0.0.1
+BindSame yes
+Timeout 600
+
+DefaultErrorFile "default.html"
+Logfile "tinyproxy.log"
+PidFile "tinyproxy.pid"
+
+MaxClients 100
+MinSpareServers 2
+MaxSpareServers 8
+StartServers 2
+MaxRequestsPerChild 0
+
+ViaProxyName "tinyproxy"
+
+ConnectPort $APACHE_HTTPS_PORT
+EOF
+ (tinyproxy -d -c tinyproxy.conf 1>/dev/null 2>&1 </dev/null &)&
+ wait_for_pidfile tinyproxy.pid
+
+ status ":STARTED:$PROXY_SERVER_NAME:$PROXY_PORT|\
+$APACHE_SERVER_NAME:$APACHE_HTTP_PORT:$APACHE_HTTPS_PORT"
+ exit 0
+ ;;
+
+ :stop)
+ kill_and_wait ../tinyproxy/tinyproxy.pid kill
+ kill_and_wait "$APACHE_PID_FILE" apache2ctl stop
+
+ status ":STOPPED:"
+ exit 0
+ ;;
+
+ :apache2ctl)
+ shift
+ cmd apache2ctl ${1+"$@"}
+ exit
+ ;;
+
+ :*)
+ (exit 1); die ":ERROR: I do not know of command '$1'."
+ ;;
+
+esac
diff --git a/lib/mnesia/test/mnesia_recovery_test.erl b/lib/mnesia/test/mnesia_recovery_test.erl
index 625e6e824c..c4910a4b11 100644
--- a/lib/mnesia/test/mnesia_recovery_test.erl
+++ b/lib/mnesia/test/mnesia_recovery_test.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -99,21 +99,21 @@ groups() ->
async_dirty_post_kill_coord_node,
async_dirty_post_kill_coord_pid]},
{asym_trans, [],
- [asym_trans_kill_part_ask,
- asym_trans_kill_part_commit_vote,
- asym_trans_kill_part_pre_commit,
- asym_trans_kill_part_log_commit,
- asym_trans_kill_part_do_commit,
- asym_trans_kill_coord_got_votes,
- asym_trans_kill_coord_pid_got_votes,
- asym_trans_kill_coord_log_commit_rec,
- asym_trans_kill_coord_pid_log_commit_rec,
- asym_trans_kill_coord_log_commit_dec,
- asym_trans_kill_coord_pid_log_commit_dec,
- asym_trans_kill_coord_rec_acc_pre_commit_log_commit,
- asym_trans_kill_coord_pid_rec_acc_pre_commit_log_commit,
- asym_trans_kill_coord_rec_acc_pre_commit_done_commit,
- asym_trans_kill_coord_pid_rec_acc_pre_commit_done_commit]},
+ [asymtrans_part_ask,
+ asymtrans_part_commit_vote,
+ asymtrans_part_pre_commit,
+ asymtrans_part_log_commit,
+ asymtrans_part_do_commit,
+ asymtrans_coord_got_votes,
+ asymtrans_coord_pid_got_votes,
+ asymtrans_coord_log_commit_rec,
+ asymtrans_coord_pid_log_commit_rec,
+ asymtrans_coord_log_commit_dec,
+ asymtrans_coord_pid_log_commit_dec,
+ asymtrans_coord_rec_acc_pre_commit_log_commit,
+ asymtrans_coord_pid_rec_acc_pre_commit_log_commit,
+ asymtrans_coord_rec_acc_pre_commit_done_commit,
+ asymtrans_coord_pid_rec_acc_pre_commit_done_commit]},
{after_corrupt_files, [],
[after_corrupt_files_decision_log_head,
after_corrupt_files_decision_log_tail,
@@ -978,8 +978,8 @@ do_async_dirty([Tab], _Fahter) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-asym_trans_kill_part_ask(suite) -> [];
-asym_trans_kill_part_ask(Config) when is_list(Config) ->
+asymtrans_part_ask(suite) -> [];
+asymtrans_part_ask(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -989,8 +989,8 @@ asym_trans_kill_part_ask(Config) when is_list(Config) ->
kill_after_debug_point(Part1, {Part1, {mnesia_tm, doit_ask_commit}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_part_commit_vote(suite) -> [];
-asym_trans_kill_part_commit_vote(Config) when is_list(Config) ->
+asymtrans_part_commit_vote(suite) -> [];
+asymtrans_part_commit_vote(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1000,8 +1000,8 @@ asym_trans_kill_part_commit_vote(Config) when is_list(Config) ->
kill_after_debug_point(Part1, {Part1, {mnesia_tm, commit_participant, vote_yes}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_part_pre_commit(suite) -> [];
-asym_trans_kill_part_pre_commit(Config) when is_list(Config) ->
+asymtrans_part_pre_commit(suite) -> [];
+asymtrans_part_pre_commit(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1011,8 +1011,8 @@ asym_trans_kill_part_pre_commit(Config) when is_list(Config) ->
kill_after_debug_point(Part1, {Part1, {mnesia_tm, commit_participant, pre_commit}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_part_log_commit(suite) -> [];
-asym_trans_kill_part_log_commit(Config) when is_list(Config) ->
+asymtrans_part_log_commit(suite) -> [];
+asymtrans_part_log_commit(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1022,8 +1022,8 @@ asym_trans_kill_part_log_commit(Config) when is_list(Config) ->
kill_after_debug_point(Part1, {Part1, {mnesia_tm, commit_participant, log_commit}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_part_do_commit(suite) -> [];
-asym_trans_kill_part_do_commit(Config) when is_list(Config) ->
+asymtrans_part_do_commit(suite) -> [];
+asymtrans_part_do_commit(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1033,8 +1033,8 @@ asym_trans_kill_part_do_commit(Config) when is_list(Config) ->
kill_after_debug_point(Part1, {Part1, {mnesia_tm, commit_participant, do_commit}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_coord_got_votes(suite) -> [];
-asym_trans_kill_coord_got_votes(Config) when is_list(Config) ->
+asymtrans_coord_got_votes(suite) -> [];
+asymtrans_coord_got_votes(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1044,8 +1044,8 @@ asym_trans_kill_coord_got_votes(Config) when is_list(Config) ->
kill_after_debug_point(Coord, {Coord, {mnesia_tm, multi_commit_asym_got_votes}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_coord_pid_got_votes(suite) -> [];
-asym_trans_kill_coord_pid_got_votes(Config) when is_list(Config) ->
+asymtrans_coord_pid_got_votes(suite) -> [];
+asymtrans_coord_pid_got_votes(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1055,8 +1055,8 @@ asym_trans_kill_coord_pid_got_votes(Config) when is_list(Config) ->
kill_after_debug_point(coord_pid, {Coord, {mnesia_tm, multi_commit_asym_got_votes}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_coord_log_commit_rec(suite) -> [];
-asym_trans_kill_coord_log_commit_rec(Config) when is_list(Config) ->
+asymtrans_coord_log_commit_rec(suite) -> [];
+asymtrans_coord_log_commit_rec(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1066,8 +1066,8 @@ asym_trans_kill_coord_log_commit_rec(Config) when is_list(Config) ->
kill_after_debug_point(Coord, {Coord, {mnesia_tm, multi_commit_asym_log_commit_rec}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_coord_pid_log_commit_rec(suite) -> [];
-asym_trans_kill_coord_pid_log_commit_rec(Config) when is_list(Config) ->
+asymtrans_coord_pid_log_commit_rec(suite) -> [];
+asymtrans_coord_pid_log_commit_rec(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1077,8 +1077,8 @@ asym_trans_kill_coord_pid_log_commit_rec(Config) when is_list(Config) ->
kill_after_debug_point(coord_pid, {Coord, {mnesia_tm, multi_commit_asym_log_commit_rec}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_coord_log_commit_dec(suite) -> [];
-asym_trans_kill_coord_log_commit_dec(Config) when is_list(Config) ->
+asymtrans_coord_log_commit_dec(suite) -> [];
+asymtrans_coord_log_commit_dec(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1088,8 +1088,8 @@ asym_trans_kill_coord_log_commit_dec(Config) when is_list(Config) ->
kill_after_debug_point(Coord, {Coord, {mnesia_tm, multi_commit_asym_log_commit_dec}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_coord_pid_log_commit_dec(suite) -> [];
-asym_trans_kill_coord_pid_log_commit_dec(Config) when is_list(Config) ->
+asymtrans_coord_pid_log_commit_dec(suite) -> [];
+asymtrans_coord_pid_log_commit_dec(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1099,8 +1099,8 @@ asym_trans_kill_coord_pid_log_commit_dec(Config) when is_list(Config) ->
kill_after_debug_point(coord_pid, {Coord, {mnesia_tm, multi_commit_asym_log_commit_dec}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_coord_rec_acc_pre_commit_log_commit(suite) -> [];
-asym_trans_kill_coord_rec_acc_pre_commit_log_commit(Config) when is_list(Config) ->
+asymtrans_coord_rec_acc_pre_commit_log_commit(suite) -> [];
+asymtrans_coord_rec_acc_pre_commit_log_commit(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1110,8 +1110,8 @@ asym_trans_kill_coord_rec_acc_pre_commit_log_commit(Config) when is_list(Config)
kill_after_debug_point(Coord, {Coord, {mnesia_tm, rec_acc_pre_commit_log_commit}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_coord_pid_rec_acc_pre_commit_log_commit(suite) -> [];
-asym_trans_kill_coord_pid_rec_acc_pre_commit_log_commit(Config) when is_list(Config) ->
+asymtrans_coord_pid_rec_acc_pre_commit_log_commit(suite) -> [];
+asymtrans_coord_pid_rec_acc_pre_commit_log_commit(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1121,8 +1121,8 @@ asym_trans_kill_coord_pid_rec_acc_pre_commit_log_commit(Config) when is_list(Con
kill_after_debug_point(coord_pid, {Coord, {mnesia_tm, rec_acc_pre_commit_log_commit}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_coord_rec_acc_pre_commit_done_commit(suite) -> [];
-asym_trans_kill_coord_rec_acc_pre_commit_done_commit(Config) when is_list(Config) ->
+asymtrans_coord_rec_acc_pre_commit_done_commit(suite) -> [];
+asymtrans_coord_rec_acc_pre_commit_done_commit(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
@@ -1132,8 +1132,8 @@ asym_trans_kill_coord_rec_acc_pre_commit_done_commit(Config) when is_list(Config
kill_after_debug_point(Coord, {Coord, {mnesia_tm, rec_acc_pre_commit_done_commit}},
TransFun, [Tab1, Tab2], Nodes).
-asym_trans_kill_coord_pid_rec_acc_pre_commit_done_commit(suite) -> [];
-asym_trans_kill_coord_pid_rec_acc_pre_commit_done_commit(Config) when is_list(Config) ->
+asymtrans_coord_pid_rec_acc_pre_commit_done_commit(suite) -> [];
+asymtrans_coord_pid_rec_acc_pre_commit_done_commit(Config) when is_list(Config) ->
?is_debug_compiled,
Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]),
[Coord, Part1, Part2] = Nodes,
diff --git a/lib/os_mon/test/Makefile b/lib/os_mon/test/Makefile
index 9c5f2c1820..461bebc102 100644
--- a/lib/os_mon/test/Makefile
+++ b/lib/os_mon/test/Makefile
@@ -86,6 +86,7 @@ release_spec:
release_tests_spec: make_emakefile
$(INSTALL_DIR) "$(RELSYSDIR)"
$(INSTALL_DATA) os_mon.spec os_mon.cover $(EMAKEFILE) $(SOURCE) "$(RELSYSDIR)"
+ $(INSTALL_DATA) os_mon_mib_SUITE.cfg "$(RELSYSDIR)"
## tar chf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
diff --git a/lib/os_mon/test/os_mon.spec b/lib/os_mon/test/os_mon.spec
index d292b258f3..4b4286b313 100644
--- a/lib/os_mon/test/os_mon.spec
+++ b/lib/os_mon/test/os_mon.spec
@@ -1 +1,2 @@
{suites,"../os_mon_test",all}.
+{config,"os_mon_mib_SUITE.cfg"}. \ No newline at end of file
diff --git a/lib/os_mon/test/os_mon_mib_SUITE.cfg b/lib/os_mon/test/os_mon_mib_SUITE.cfg
new file mode 100644
index 0000000000..a33c23530b
--- /dev/null
+++ b/lib/os_mon/test/os_mon_mib_SUITE.cfg
@@ -0,0 +1,8 @@
+%% -*- erlang -*-
+{snmp, [{start_agent,true},
+ {users,[{os_mon_mib_test,[snmpm_user_default,[]]}]},
+ {managed_agents,[{os_mon_mib_test,
+ [os_mon_mib_test, {127,0,0,1}, 4000, []]}]},
+ {agent_sysname,"Test os_mon_mibs"},
+ {mgr_port,5001}
+ ]}.
diff --git a/lib/os_mon/test/os_mon_mib_SUITE.erl b/lib/os_mon/test/os_mon_mib_SUITE.erl
index a137efc441..08f5532d50 100644
--- a/lib/os_mon/test/os_mon_mib_SUITE.erl
+++ b/lib/os_mon/test/os_mon_mib_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,16 +18,20 @@
%%
-module(os_mon_mib_SUITE).
-%-define(STANDALONE,1).
+%%-----------------------------------------------------------------
+%% This suite can no longer be executed standalone, i.e. it must be
+%% executed with common test. The reason is that ct_snmp is used
+%% instead of the snmp application directly. The suite requires a
+%% config file, os_mon_mib_SUITE.cfg, found in the same directory as
+%% the suite.
+%%
+%% Execute with:
+%% > ct_run -suite os_mon_mib_SUITE -config os_mon_mib_SUITE.cfg
+%%-----------------------------------------------------------------
--ifdef(STANDALONE).
--define(line,erlang:display({line,?LINE}),).
--define(config(A,B), config(A,B)).
--else.
-include_lib("test_server/include/test_server.hrl").
-include_lib("os_mon/include/OTP-OS-MON-MIB.hrl").
-include_lib("snmp/include/snmp_types.hrl").
--endif.
% Test server specific exports
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
@@ -60,15 +64,6 @@
-define(MGR_PORT, 5001).
%%---------------------------------------------------------------------
--ifdef(STANDALONE).
--export([run/0]).
-run() ->
- catch init_per_suite([]),
- Ret = (catch update_load_table([])),
- catch end_per_suite([]),
- Ret.
--else.
-
init_per_testcase(_Case, Config) when is_list(Config) ->
Dog = test_server:timetrap(test_server:minutes(6)),
[{watchdog, Dog}|Config].
@@ -78,7 +73,8 @@ end_per_testcase(_Case, Config) when is_list(Config) ->
test_server:timetrap_cancel(Dog),
Config.
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() -> [{ct_hooks,[ts_install_cth]},
+ {require, snmp_mgr_agent, snmp}].
all() ->
[load_unload, get_mem_sys_mark, get_mem_proc_mark,
@@ -104,8 +100,6 @@ end_per_group(_GroupName, Config) ->
Config.
-
--endif.
%%---------------------------------------------------------------------
%%--------------------------------------------------------------------
%% Function: init_per_suite(Config) -> Config
@@ -121,50 +115,13 @@ init_per_suite(Config) ->
?line application:start(mnesia),
?line application:start(os_mon),
- %% Create initial configuration data for the snmp application
- ?line PrivDir = ?config(priv_dir, Config),
- ?line ConfDir = filename:join(PrivDir, "conf"),
- ?line DbDir = filename:join(PrivDir,"db"),
- ?line MgrDir = filename:join(PrivDir,"mgr"),
-
- ?line file:make_dir(ConfDir),
- ?line file:make_dir(DbDir),
- ?line file:make_dir(MgrDir),
-
- {ok, HostName} = inet:gethostname(),
- {ok, Addr} = inet:getaddr(HostName, inet),
-
- ?line snmp_config:write_agent_snmp_files(ConfDir, ?CONF_FILE_VER,
- tuple_to_list(Addr), ?TRAP_UDP,
- tuple_to_list(Addr),
- ?AGENT_UDP, ?SYS_NAME),
-
- ?line snmp_config:write_manager_snmp_files(MgrDir, tuple_to_list(Addr),
- ?MGR_PORT, ?MAX_MSG_SIZE,
- ?ENGINE_ID, [], [], []),
-
- %% To make sure application:set_env is not overwritten by any
- %% app-file settings.
- ?line ok = application:load(snmp),
-
- ?line application:set_env(snmp, agent, [{db_dir, DbDir},
- {config, [{dir, ConfDir}]},
- {agent_type, master},
- {agent_verbosity, trace},
- {net_if, [{verbosity, trace}]}]),
- ?line application:set_env(snmp, manager, [{config, [{dir, MgrDir},
- {db_dir, MgrDir},
- {verbosity, trace}]},
- {server, [{verbosity, trace}]},
- {net_if, [{verbosity, trace}]},
- {versions, [v1, v2, v3]}]),
- application:start(snmp),
+ ok = ct_snmp:start(Config,snmp_mgr_agent),
%% Load the mibs that should be tested
otp_mib:load(snmp_master_agent),
os_mon_mib:load(snmp_master_agent),
- [{agent_ip, Addr}| Config].
+ Config.
%%--------------------------------------------------------------------
%% Function: end_per_suite(Config) -> _
%% Config - [tuple()]
@@ -197,7 +154,7 @@ end_per_suite(Config) ->
load_unload(doc) ->
["Test to unload and the reload the OTP.mib "];
load_unload(suite) -> [];
-load_unload(Config) when list(Config) ->
+load_unload(Config) when is_list(Config) ->
?line os_mon_mib:unload(snmp_master_agent),
?line os_mon_mib:load(snmp_master_agent),
ok.
@@ -424,7 +381,7 @@ cpu_load(doc) ->
[];
cpu_load(suite) ->
[];
-cpu_load(Config) when list(Config) ->
+cpu_load(Config) when is_list(Config) ->
?line [{[?loadCpuLoad, Len | NodeStr], Load}] =
os_mon_mib:load_table(get_next,[], [?loadCpuLoad]),
?line Len = length(NodeStr),
@@ -640,32 +597,24 @@ disk_capacity(Config) when is_list(Config) ->
%%---------------------------------------------------------------------
real_snmp_request(doc) ->
- ["Starts an snmp manager and sends a real snmp-reques. i.e. "
+ ["Starts an snmp manager and sends a real snmp-request. i.e. "
"sends a udp message on the correct format."];
real_snmp_request(suite) -> [];
-real_snmp_request(Config) when list(Config) ->
- Agent_ip = ?config(agent_ip, Config),
-
- ?line ok = snmpm:register_user(os_mon_mib_test, snmpm_user_default, []),
- ?line ok = snmpm:register_agent(os_mon_mib_test, Agent_ip, ?AGENT_UDP),
-
+real_snmp_request(Config) when is_list(Config) ->
NodStr = atom_to_list(node()),
Len = length(NodStr),
{_, _, {Pid, _}} = memsup:get_memory_data(),
PidStr = lists:flatten(io_lib:format("~w", [Pid])),
io:format("FOO: ~p~n", [PidStr]),
- ?line ok = snmp_get(Agent_ip,
- [?loadEntry ++
+ ?line ok = snmp_get([?loadEntry ++
[?loadLargestErlProcess, Len | NodStr]],
PidStr),
- ?line ok = snmp_get_next(Agent_ip,
- [?loadEntry ++
+ ?line ok = snmp_get_next([?loadEntry ++
[?loadSystemUsedMemory, Len | NodStr]],
?loadEntry ++ [?loadSystemUsedMemory + 1, Len
| NodStr], PidStr),
- ?line ok = snmp_set(Agent_ip, [?loadEntry ++
- [?loadLargestErlProcess, Len | NodStr]],
- s, "<0.101.0>"),
+ ?line ok = snmp_set([?loadEntry ++ [?loadLargestErlProcess, Len | NodStr]],
+ s, "<0.101.0>", Config),
ok.
otp_7441(doc) ->
@@ -674,34 +623,17 @@ otp_7441(doc) ->
otp_7441(suite) ->
[];
otp_7441(Config) when is_list(Config) ->
- Agent_ip = ?config(agent_ip, Config),
-
-
NodStr = atom_to_list(node()),
Len = length(NodStr),
Oids = [Oid|_] = [?loadEntry ++ [?loadSystemTotalMemory, Len | NodStr]],
- ?line { ok, {noError,0,[#varbind{oid = Oid, variabletype = 'Unsigned32'}]}, _} =
- snmpm:g(os_mon_mib_test, Agent_ip, ?AGENT_UDP, Oids),
+ {noError,0,[#varbind{oid = Oid, variabletype = 'Unsigned32'}]} =
+ ct_snmp:get_values(os_mon_mib_test, Oids, snmp_mgr_agent),
ok.
%%---------------------------------------------------------------------
%% Internal functions
%%---------------------------------------------------------------------
--ifdef(STANDALONE).
-config(priv_dir,_) ->
- "/tmp".
-
-start_node() ->
- Host = hd(tl(string:tokens(atom_to_list(node()),"@"))),
- {ok,Node} = slave:start(Host,testnisse),
- net_adm:ping(testnisse),
- Node.
-
-
-stop_node(Node) ->
- rpc:call(Node,erlang,halt,[]).
--else.
start_node() ->
?line Pa = filename:dirname(code:which(?MODULE)),
?line {ok,Node} = test_server:start_node(testnisse, slave,
@@ -711,8 +643,6 @@ start_node() ->
stop_node(Node) ->
test_server:stop_node(Node).
--endif.
-
del_dir(Dir) ->
io:format("Deleting: ~s~n",[Dir]),
{ok, Files} = file:list_dir(Dir),
@@ -722,21 +652,22 @@ del_dir(Dir) ->
file:del_dir(Dir).
%%---------------------------------------------------------------------
-snmp_get(Agent_ip, Oids = [Oid |_], Result) ->
- ?line {ok,{noError,0,[#varbind{oid = Oid,
- variabletype = 'OCTET STRING',
- value = Result}]}, _} =
- snmpm:g(os_mon_mib_test, Agent_ip, ?AGENT_UDP, Oids),
+snmp_get(Oids = [Oid |_], Result) ->
+ {noError,0,[#varbind{oid = Oid,
+ variabletype = 'OCTET STRING',
+ value = Result}]} =
+ ct_snmp:get_values(os_mon_mib_test, Oids, snmp_mgr_agent),
ok.
-snmp_get_next(Agent_ip, Oids, NextOid, Result) ->
- ?line {ok,{noError,0,[#varbind{oid = NextOid,
- variabletype = 'OCTET STRING',
- value = Result}]},_} =
- snmpm:gn(os_mon_mib_test, Agent_ip, ?AGENT_UDP, Oids),
+snmp_get_next(Oids, NextOid, Result) ->
+ {noError,0,[#varbind{oid = NextOid,
+ variabletype = 'OCTET STRING',
+ value = Result}]} =
+ ct_snmp:get_next_values(os_mon_mib_test, Oids, snmp_mgr_agent),
ok.
-snmp_set(Agent_ip, Oid, ValuType, Value) ->
- ?line {ok, {notWritable, _, _}, _} =
- snmpm:s(os_mon_mib_test,Agent_ip,?AGENT_UDP,[{Oid, ValuType, Value}]),
+snmp_set(Oid, ValuType, Value, Config) ->
+ {notWritable, _, _} =
+ ct_snmp:set_values(os_mon_mib_test, [{Oid, ValuType, Value}],
+ snmp_mgr_agent, Config),
ok.
diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl
index 773b11583e..8d71865508 100644
--- a/lib/reltool/test/reltool_server_SUITE.erl
+++ b/lib/reltool/test/reltool_server_SUITE.erl
@@ -1084,9 +1084,14 @@ create_slim(Config) ->
RootDir = code:root_dir(),
Erl = filename:join([RootDir, "bin", "erl"]),
- Args = "-boot_var RELTOOL_EXT_LIB " ++ TargetLibDir ++
- " -boot " ++ filename:join(TargetRelVsnDir,RelName) ++
- " -sasl releases_dir \\\"" ++ TargetRelDir ++ "\\\"",
+ EscapedQuote =
+ case os:type() of
+ {win32,_} -> "\\\"";
+ _ -> "\""
+ end,
+ Args = ["-boot_var", "RELTOOL_EXT_LIB", TargetLibDir,
+ "-boot", filename:join(TargetRelVsnDir,RelName),
+ "-sasl", "releases_dir", EscapedQuote++TargetRelDir++EscapedQuote],
{ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl, Args)),
?msym(RootDir, rpc:call(Node, code, root_dir, [])),
?msym([{RelName,RelVsn,_,permanent}],
@@ -2412,11 +2417,13 @@ mod_path(Node,Mod) ->
start_node(Name, ErlPath) ->
start_node(Name, ErlPath, []).
-start_node(Name, ErlPath, Args) ->
+start_node(Name, ErlPath, Args0) ->
FullName = full_node_name(Name),
- CmdLine = mk_node_cmdline(Name, ErlPath, Args),
- io:format("Starting node ~p: ~s~n", [FullName, CmdLine]),
- case open_port({spawn, CmdLine}, []) of
+ Args = mk_node_args(Name, Args0),
+ io:format("Starting node ~p: ~s~n",
+ [FullName, lists:flatten([[X," "] || X <- [ErlPath|Args]])]),
+ %io:format("open_port({spawn_executable, ~p}, [{args,~p}])~n",[ErlPath,Args]),
+ case open_port({spawn_executable, ErlPath}, [{args,Args}]) of
Port when is_port(Port) ->
unlink(Port),
erlang:port_close(Port),
@@ -2433,23 +2440,21 @@ stop_node(Node) ->
spawn(Node, fun () -> halt() end),
receive {nodedown, Node} -> ok end.
-mk_node_cmdline(Name, Prog, Args) ->
- Static = "-detached -noinput",
+mk_node_args(Name, Args) ->
Pa = filename:dirname(code:which(?MODULE)),
NameSw = case net_kernel:longnames() of
- false -> "-sname ";
- true -> "-name ";
+ false -> "-sname";
+ true -> "-name";
_ -> exit(not_distributed_node)
end,
{ok, Pwd} = file:get_cwd(),
NameStr = atom_to_list(Name),
- Prog ++ " "
- ++ Static ++ " "
- ++ NameSw ++ " " ++ NameStr ++ " "
- ++ "-pa " ++ Pa ++ " "
- ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ NameStr ++ " "
- ++ "-setcookie " ++ atom_to_list(erlang:get_cookie())
- ++ " " ++ Args.
+ ["-detached", "-noinput",
+ NameSw, NameStr,
+ "-pa", Pa,
+ "-env", "ERL_CRASH_DUMP", Pwd ++ "/erl_crash_dump." ++ NameStr,
+ "-setcookie", atom_to_list(erlang:get_cookie())
+ | Args].
full_node_name(PreName) ->
HostSuffix = lists:dropwhile(fun ($@) -> false; (_) -> true end,
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index b84b3a3dcb..0133250979 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -265,7 +265,7 @@
<item>
<p>Comma separated string that determines which authentication methodes that the server
should support and in what order they will be tried. Defaults to
- <c><![CDATA["publickey,keyboard_interactive,password"]]></c></p>
+ <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p>
</item>
<tag><c><![CDATA[{user_passwords, [{string() = User, string() = Password}]}]]></c></tag>
<item>
diff --git a/lib/ssh/src/ssh_auth.hrl b/lib/ssh/src/ssh_auth.hrl
index 7d7bad4436..e74ee10041 100644
--- a/lib/ssh/src/ssh_auth.hrl
+++ b/lib/ssh/src/ssh_auth.hrl
@@ -21,7 +21,7 @@
%%% Description: Ssh User Authentication Protocol
--define(SUPPORTED_AUTH_METHODS, "publickey,keyboard_interactive,password").
+-define(SUPPORTED_AUTH_METHODS, "publickey,keyboard-interactive,password").
-define(PREFERRED_PK_ALG, ssh_rsa).
diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl
index c2a7c63cbe..e3b8ebfb79 100644
--- a/lib/ssh/src/ssh_connection.erl
+++ b/lib/ssh/src/ssh_connection.erl
@@ -441,7 +441,7 @@ handle_msg(#ssh_msg_channel_window_adjust{recipient_channel = ChannelId,
{SendList, Channel} = %% TODO: Datatype 0 ?
update_send_window(Channel0#channel{send_window_size = Size + Add},
- 0, <<>>, Connection),
+ 0, undefined, Connection),
Replies = lists:map(fun({Type, Data}) ->
{connection_reply, ConnectionPid,
@@ -1073,14 +1073,15 @@ request_reply_or_data(#channel{local_id = ChannelId, user = ChannelPid},
false ->
{{channel_data, ChannelPid, Reply}, Connection}
end.
+update_send_window(Channel, _, undefined,
+ #connection{channel_cache = Cache}) ->
+ do_update_send_window(Channel, Channel#channel.send_buf, Cache);
-update_send_window(Channel0, DataType, Data,
- #connection{channel_cache = Cache}) ->
- Buf0 = if Data == <<>> ->
- Channel0#channel.send_buf;
- true ->
- Channel0#channel.send_buf ++ [{DataType, Data}]
- end,
+update_send_window(Channel, DataType, Data,
+ #connection{channel_cache = Cache}) ->
+ do_update_send_window(Channel, Channel#channel.send_buf ++ [{DataType, Data}], Cache).
+
+do_update_send_window(Channel0, Buf0, Cache) ->
{Buf1, NewSz, Buf2} = get_window(Buf0,
Channel0#channel.send_packet_size,
Channel0#channel.send_window_size),
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index 2ceaa9daa5..c224e5b800 100644
--- a/lib/ssh/test/ssh_basic_SUITE.erl
+++ b/lib/ssh/test/ssh_basic_SUITE.erl
@@ -110,12 +110,13 @@ all() ->
{group, rsa_pass_key},
{group, internal_error},
daemon_already_started,
- server_password_option, server_userpassword_option,
+ server_password_option,
+ server_userpassword_option,
close].
groups() ->
- [{dsa_key, [], [exec, exec_compressed, shell, known_hosts]},
- {rsa_key, [], [exec, exec_compressed, shell, known_hosts]},
+ [{dsa_key, [], [send, exec, exec_compressed, shell, known_hosts]},
+ {rsa_key, [], [send, exec, exec_compressed, shell, known_hosts]},
{dsa_pass_key, [], [pass_phrase]},
{rsa_pass_key, [], [pass_phrase]},
{internal_error, [], [internal_error]}
@@ -532,6 +533,31 @@ internal_error(Config) when is_list(Config) ->
ssh:stop_daemon(Pid).
%%--------------------------------------------------------------------
+send(doc) ->
+ ["Test ssh_connection:send/3"];
+
+send(suite) ->
+ [];
+
+send(Config) when is_list(Config) ->
+ process_flag(trap_exit, true),
+ SystemDir = filename:join(?config(priv_dir, Config), system),
+ UserDir = ?config(priv_dir, Config),
+
+ {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {failfun, fun ssh_test_lib:failfun/2}]),
+ ConnectionRef =
+ ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user_interaction, false}]),
+ {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity),
+ ok = ssh_connection:send(ConnectionRef, ChannelId, <<"Data">>),
+ ok = ssh_connection:send(ConnectionRef, ChannelId, << >>),
+ ssh:stop_daemon(Pid).
+
+
+%%--------------------------------------------------------------------
close(doc) ->
["Simulate that we try to close an already closed connection"];
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index 5098d26a3a..f0eac76264 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -79,7 +79,9 @@
{keyfile, path()} | {password, string()} |
{cacerts, [der_encoded()]} | {cacertfile, path()} |
|{dh, der_encoded()} | {dhfile, path()} | {ciphers, ciphers()} |
- {ssl_imp, ssl_imp()}| {reuse_sessions, boolean()} | {reuse_session, fun()}
+ {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | {reuse_session, fun()}
+ {next_protocols_advertised, list(binary()} |
+ {client_preferred_next_protocols, binary(), client | server, list(binary())}
</c></p>
<p><c>transportoption() = {CallbackModule, DataTag, ClosedTag}
@@ -301,8 +303,29 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} |
when possible.
</item>
+ <tag>{client_preferred_next_protocols, Precedence:: server | client, ClientPrefs::[binary()]}
+ {client_preferred_next_protocols, Precedence:: server | client, ClientPrefs::[binary()] , Default :: binary()}}</tag>
+
+ <item> <p>Indicates the client will try to perform Next Protocol
+ Negotiation.</p>
+
+ <p>If precedence is server the negaotiated protocol will be the
+ first protocol that appears on the server advertised list that is
+ also on the clients preference list.</p>
+
+ <p>If the precedence is client the negaotiated protocol will be the
+ first protocol that appears on the clients preference list that is
+ also on the server advertised list.</p>
+
+ <p> If the client does not support any of the servers advertised
+ protocols or the server does not advertise any protocols the
+ client will fallback to the first protocol in its list or if a
+ default is supplied it will fallback to that instead. If the
+ server does not support next protocol renegotiation the
+ connection will be aborted if no default protocol is supplied.</p>
+ </item>
</taglist>
- </section>
+ </section>
<section>
<title>SSL OPTION DESCRIPTIONS - SERVER SIDE</title>
@@ -353,6 +376,14 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} |
SuggestedSessionId is a binary(), PeerCert is a DER encoded
certificate, Compression is an enumeration integer
and CipherSuite is of type ciphersuite().
+ </item>
+
+ <tag>{next_protocols_advertised, Protocols :: list(binary())}</tag>
+ <item>The list of protocols to send to the client if the client indicates
+ it supports the Next Protocol extension. The client may select a protocol
+ that is not on this list. The list of protocols must not contain an empty
+ binary. If the server negotiates a Next Protocol it can be accessed
+ using <c>negotiated_next_protocol/1</c> method.
</item>
</taglist>
@@ -766,8 +797,23 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} |
ssl application.</p>
</desc>
</func>
+ <func>
+ <name>negotiated_next_protocol(Socket) -> {ok, Protocol} | {error, next_protocol_not_negotiated}</name>
+ <fsummary>Returns the Next Protocol negotiated.</fsummary>
+ <type>
+ <v>Socket = sslsocket()</v>
+ <v>Protocol = binary()</v>
+ </type>
+ <desc>
+ <p>
+ Returns the Next Protocol negotiated.
+ </p>
+ </desc>
+ </func>
+
+
</funcs>
-
+
<section>
<title>SEE ALSO</title>
<p><seealso marker="kernel:inet">inet(3) </seealso> and
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 40d933a256..9a562aa5a8 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -31,13 +31,15 @@
controlling_process/2, listen/2, pid/1, peername/1, peercert/1,
recv/2, recv/3, send/2, getopts/2, setopts/2, sockname/1,
versions/0, session_info/1, format_error/1,
- renegotiate/1, prf/5, clear_pem_cache/0, random_bytes/1]).
+ renegotiate/1, prf/5, clear_pem_cache/0, random_bytes/1, negotiated_next_protocol/1]).
+
-deprecated({pid, 1, next_major_release}).
-include("ssl_internal.hrl").
-include("ssl_record.hrl").
-include("ssl_cipher.hrl").
+-include("ssl_handshake.hrl").
-include_lib("public_key/include/public_key.hrl").
@@ -65,7 +67,9 @@
{keyfile, path()} | {password, string()} | {cacerts, [Der::binary()]} |
{cacertfile, path()} | {dh, Der::binary()} | {dhfile, path()} |
{ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} |
- {reuse_session, fun()} | {hibernate_after, integer()|undefined}.
+ {reuse_session, fun()} | {hibernate_after, integer()|undefined} |
+ {next_protocols_advertised, list(binary())} |
+ {client_preferred_next_protocols, binary(), client | server, list(binary())}.
-type verify_type() :: verify_none | verify_peer.
-type path() :: string().
@@ -314,6 +318,14 @@ suite_definition(S) ->
{KeyExchange, Cipher, Hash}.
%%--------------------------------------------------------------------
+-spec negotiated_next_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}.
+%%
+%% Description: Returns the next protocol that has been negotiated. If no
+%% protocol has been negotiated will return {error, next_protocol_not_negotiated}
+%%--------------------------------------------------------------------
+negotiated_next_protocol(#sslsocket{fd = new_ssl, pid = Pid}) ->
+ ssl_connection:negotiated_next_protocol(Pid).
+
-spec cipher_suites() -> [erl_cipher_suite()].
-spec cipher_suites(erlang | openssl) -> [erl_cipher_suite()] | [string()].
@@ -594,7 +606,9 @@ handle_options(Opts0, _Role) ->
renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT),
debug = handle_option(debug, Opts, []),
hibernate_after = handle_option(hibernate_after, Opts, undefined),
- erl_dist = handle_option(erl_dist, Opts, false)
+ erl_dist = handle_option(erl_dist, Opts, false),
+ next_protocols_advertised = handle_option(next_protocols_advertised, Opts, undefined),
+ next_protocol_selector = make_next_protocol_selector(handle_option(client_preferred_next_protocols, Opts, undefined))
},
CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}),
@@ -603,7 +617,8 @@ handle_options(Opts0, _Role) ->
depth, cert, certfile, key, keyfile,
password, cacerts, cacertfile, dh, dhfile, ciphers,
debug, reuse_session, reuse_sessions, ssl_imp,
- cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist],
+ cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist, next_protocols_advertised,
+ client_preferred_next_protocols],
SockOpts = lists:foldl(fun(Key, PropList) ->
proplists:delete(Key, PropList)
@@ -728,12 +743,64 @@ validate_option(hibernate_after, undefined) ->
undefined;
validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 ->
Value;
-validate_option(erl_dist,Value) when Value == true;
+validate_option(erl_dist,Value) when Value == true;
Value == false ->
Value;
+validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols} = Value)
+ when is_list(PreferredProtocols) ->
+ case ssl_record:highest_protocol_version([]) of
+ {3,0} ->
+ throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}});
+ _ ->
+ validate_binary_list(client_preferred_next_protocols, PreferredProtocols),
+ validate_npn_ordering(Precedence),
+ {Precedence, PreferredProtocols, ?NO_PROTOCOL}
+ end;
+validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols, Default} = Value)
+ when is_list(PreferredProtocols), is_binary(Default),
+ byte_size(Default) > 0, byte_size(Default) < 256 ->
+ case ssl_record:highest_protocol_version([]) of
+ {3,0} ->
+ throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}});
+ _ ->
+ validate_binary_list(client_preferred_next_protocols, PreferredProtocols),
+ validate_npn_ordering(Precedence),
+ Value
+ end;
+
+validate_option(client_preferred_next_protocols, undefined) ->
+ undefined;
+validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) ->
+ case ssl_record:highest_protocol_version([]) of
+ {3,0} ->
+ throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}});
+ _ ->
+ validate_binary_list(next_protocols_advertised, Value),
+ Value
+ end;
+
+validate_option(next_protocols_advertised, undefined) ->
+ undefined;
validate_option(Opt, Value) ->
throw({error, {eoptions, {Opt, Value}}}).
-
+
+validate_npn_ordering(client) ->
+ ok;
+validate_npn_ordering(server) ->
+ ok;
+validate_npn_ordering(Value) ->
+ throw({error, {eoptions, {client_preferred_next_protocols, {invalid_precedence, Value}}}}).
+
+validate_binary_list(Opt, List) ->
+ lists:foreach(
+ fun(Bin) when is_binary(Bin),
+ byte_size(Bin) > 0,
+ byte_size(Bin) < 256 ->
+ ok;
+ (Bin) ->
+ throw({error, {eoptions, {Opt, {invalid_protocol, Bin}}}})
+ end, List).
+
validate_versions([], Versions) ->
Versions;
validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2';
@@ -839,6 +906,34 @@ cipher_suites(Version, Ciphers0) ->
no_format(Error) ->
lists:flatten(io_lib:format("No format string for error: \"~p\" available.", [Error])).
+
+detect(_Pred, []) ->
+ undefined;
+detect(Pred, [H|T]) ->
+ case Pred(H) of
+ true ->
+ H;
+ _ ->
+ detect(Pred, T)
+ end.
+
+make_next_protocol_selector(undefined) ->
+ undefined;
+make_next_protocol_selector({client, AllProtocols, DefaultProtocol}) ->
+ fun(AdvertisedProtocols) ->
+ case detect(fun(PreferredProtocol) -> lists:member(PreferredProtocol, AdvertisedProtocols) end, AllProtocols) of
+ undefined -> DefaultProtocol;
+ PreferredProtocol -> PreferredProtocol
+ end
+ end;
+
+make_next_protocol_selector({server, AllProtocols, DefaultProtocol}) ->
+ fun(AdvertisedProtocols) ->
+ case detect(fun(PreferredProtocol) -> lists:member(PreferredProtocol, AllProtocols) end, AdvertisedProtocols) of
+ undefined -> DefaultProtocol;
+ PreferredProtocol -> PreferredProtocol
+ end
+ end.
%% Only used to remove exit messages from old ssl
%% First is a nonsense clause to provide some
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index ff2556c488..23f22987df 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -41,7 +41,7 @@
socket_control/3, close/1, shutdown/2,
new_user/2, get_opts/2, set_opts/2, info/1, session_info/1,
peer_certificate/1, sockname/1, peername/1, renegotiation/1,
- prf/5]).
+ negotiated_next_protocol/1, prf/5]).
%% Called by ssl_connection_sup
-export([start_link/7]).
@@ -92,7 +92,9 @@
start_or_recv_from, % "gen_fsm From"
send_queue, % queue()
terminated = false, %
- allow_renegotiate = true
+ allow_renegotiate = true,
+ expecting_next_protocol_negotiation = false :: boolean(),
+ next_protocol = undefined :: undefined | binary()
}).
-define(DEFAULT_DIFFIE_HELLMAN_PARAMS,
@@ -221,6 +223,13 @@ new_user(ConnectionPid, User) ->
sockname(ConnectionPid) ->
sync_send_all_state_event(ConnectionPid, sockname).
%%--------------------------------------------------------------------
+-spec negotiated_next_protocol(pid()) -> {ok, binary()} | {error, reason()}.
+%%
+%% Description: Returns the negotiated protocol
+%%--------------------------------------------------------------------
+negotiated_next_protocol(ConnectionPid) ->
+ sync_send_all_state_event(ConnectionPid, negotiated_next_protocol).
+%%--------------------------------------------------------------------
-spec peername(pid()) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}.
%%
%% Description: Same as inet:peername/1
@@ -374,31 +383,41 @@ hello(#server_hello{cipher_suite = CipherSuite,
renegotiation = {Renegotiation, _},
ssl_options = SslOptions} = State0) ->
case ssl_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of
- {Version, NewId, ConnectionStates} ->
+ #alert{} = Alert ->
+ handle_own_alert(Alert, ReqVersion, hello, State0),
+ {stop, normal, State0};
+
+ {Version, NewId, ConnectionStates, NextProtocol} ->
{KeyAlgorithm, _, _, _} =
ssl_cipher:suite_definition(CipherSuite),
-
+
PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm),
-
+
+ NewNextProtocol = case NextProtocol of
+ undefined ->
+ State0#state.next_protocol;
+ _ ->
+ NextProtocol
+ end,
+
State = State0#state{key_algorithm = KeyAlgorithm,
hashsign_algorithm = default_hashsign(Version, KeyAlgorithm),
negotiated_version = Version,
connection_states = ConnectionStates,
- premaster_secret = PremasterSecret},
-
+ premaster_secret = PremasterSecret,
+ expecting_next_protocol_negotiation = NextProtocol =/= undefined,
+ next_protocol = NewNextProtocol},
+
case ssl_session:is_new(OldId, NewId) of
true ->
handle_new_session(NewId, CipherSuite, Compression,
State#state{connection_states = ConnectionStates});
false ->
- handle_resumed_session(NewId, State#state{connection_states = ConnectionStates})
- end;
- #alert{} = Alert ->
- handle_own_alert(Alert, ReqVersion, hello, State0),
- {stop, normal, State0}
+ handle_resumed_session(NewId, State#state{connection_states = ConnectionStates})
+ end
end;
-hello(Hello = #client_hello{client_version = ClientVersion},
+hello(Hello = #client_hello{client_version = ClientVersion},
State = #state{connection_states = ConnectionStates0,
port = Port, session = #session{own_certificate = Cert} = Session0,
renegotiation = {Renegotiation, _},
@@ -407,8 +426,8 @@ hello(Hello = #client_hello{client_version = ClientVersion},
ssl_options = SslOpts}) ->
case ssl_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
ConnectionStates0, Cert}, Renegotiation) of
- {Version, {Type, Session}, ConnectionStates} ->
- do_server_hello(Type, State#state{connection_states =
+ {Version, {Type, Session}, ConnectionStates, ProtocolsToAdvertise} ->
+ do_server_hello(Type, ProtocolsToAdvertise, State#state{connection_states =
ConnectionStates,
negotiated_version = Version,
session = Session});
@@ -593,6 +612,7 @@ certify(#client_key_exchange{exchange_keys = Keys},
{stop, normal, State}
end;
+
certify(timeout, State) ->
{ next_state, certify, State, hibernate };
@@ -662,6 +682,12 @@ cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashS
{stop, normal, State0}
end;
+% client must send a next protocol message if we are expecting it
+cipher(#finished{}, #state{role = server, expecting_next_protocol_negotiation = true,
+ next_protocol = undefined, negotiated_version = Version} = State0) ->
+ handle_own_alert(?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), Version, cipher, State0),
+ {stop, normal, State0};
+
cipher(#finished{verify_data = Data} = Finished,
#state{negotiated_version = Version,
host = Host,
@@ -683,6 +709,13 @@ cipher(#finished{verify_data = Data} = Finished,
{stop, normal, State}
end;
+% only allowed to send next_protocol message after change cipher spec
+% & before finished message and it is not allowed during renegotiation
+cipher(#next_protocol{selected_protocol = SelectedProtocol},
+ #state{role = server, expecting_next_protocol_negotiation = true} = State0) ->
+ {Record, State} = next_record(State0#state{next_protocol = SelectedProtocol}),
+ next_state(cipher, cipher, Record, State);
+
cipher(timeout, State) ->
{ next_state, cipher, State, hibernate };
@@ -842,6 +875,10 @@ handle_sync_event(sockname, _From, StateName,
SockNameReply = inet:sockname(Socket),
{reply, SockNameReply, StateName, State, get_timeout(State)};
+handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = undefined} = State) ->
+ {reply, {error, next_protocol_not_negotiated}, StateName, State, get_timeout(State)};
+handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = NextProtocol} = State) ->
+ {reply, {ok, NextProtocol}, StateName, State, get_timeout(State)};
handle_sync_event(peername, _From, StateName,
#state{socket = Socket} = State) ->
PeerNameReply = inet:peername(Socket),
@@ -1274,17 +1311,18 @@ verify_client_cert(#state{client_certificate_requested = true, role = client,
verify_client_cert(#state{client_certificate_requested = false} = State) ->
State.
-do_server_hello(Type, #state{negotiated_version = Version,
- session = #session{session_id = SessId},
- connection_states = ConnectionStates0,
- renegotiation = {Renegotiation, _}}
- = State0) when is_atom(Type) ->
+do_server_hello(Type, NextProtocolsToSend, #state{negotiated_version = Version,
+ session = #session{session_id = SessId},
+ connection_states = ConnectionStates0,
+ renegotiation = {Renegotiation, _}}
+ = State0) when is_atom(Type) ->
ServerHello =
ssl_handshake:server_hello(SessId, Version,
- ConnectionStates0, Renegotiation),
- State = server_hello(ServerHello, State0),
-
+ ConnectionStates0, Renegotiation, NextProtocolsToSend),
+ State = server_hello(ServerHello,
+ State0#state{expecting_next_protocol_negotiation =
+ NextProtocolsToSend =/= undefined}),
case Type of
new ->
new_server_hello(ServerHello, State);
@@ -1538,12 +1576,33 @@ request_client_cert(#state{ssl_options = #ssl_options{verify = verify_none}} =
State.
finalize_handshake(State, StateName) ->
- ConnectionStates0 = cipher_protocol(State),
+ ConnectionStates0 = cipher_protocol(State),
+
ConnectionStates =
ssl_record:activate_pending_connection_state(ConnectionStates0,
write),
- finished(State#state{connection_states = ConnectionStates}, StateName).
-
+
+ State1 = State#state{connection_states = ConnectionStates},
+ State2 = next_protocol(State1),
+ finished(State2, StateName).
+
+next_protocol(#state{role = server} = State) ->
+ State;
+next_protocol(#state{next_protocol = undefined} = State) ->
+ State;
+next_protocol(#state{expecting_next_protocol_negotiation = false} = State) ->
+ State;
+next_protocol(#state{transport_cb = Transport, socket = Socket,
+ negotiated_version = Version,
+ next_protocol = NextProtocol,
+ connection_states = ConnectionStates0,
+ tls_handshake_history = Handshake0} = State) ->
+ NextProtocolMessage = ssl_handshake:next_protocol(NextProtocol),
+ {BinMsg, ConnectionStates, Handshake} = encode_handshake(NextProtocolMessage, Version, ConnectionStates0, Handshake0),
+ Transport:send(Socket, BinMsg),
+ State#state{connection_states = ConnectionStates,
+ tls_handshake_history = Handshake}.
+
cipher_protocol(#state{connection_states = ConnectionStates0,
socket = Socket,
negotiated_version = Version,
@@ -2053,8 +2112,8 @@ next_state_is_connection(_, State =
next_state_is_connection(StateName, State0) ->
{Record, State} = next_record_if_active(State0),
next_state(StateName, connection, Record, State#state{premaster_secret = undefined,
- public_key_info = undefined,
- tls_handshake_history = ssl_handshake:init_handshake_history()}).
+ public_key_info = undefined,
+ tls_handshake_history = ssl_handshake:init_handshake_history()}).
register_session(client, Host, Port, #session{is_resumable = new} = Session0) ->
Session = Session0#session{is_resumable = true},
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index bb26302fff..fa1784714f 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -30,21 +30,21 @@
-include("ssl_internal.hrl").
-include_lib("public_key/include/public_key.hrl").
--export([master_secret/4, client_hello/8, server_hello/4, hello/4,
+-export([master_secret/4, client_hello/8, server_hello/5, hello/4,
hello_request/0, certify/7, certificate/4,
client_certificate_verify/6, certificate_verify/6,
certificate_request/3, key_exchange/3, server_key_exchange_hash/2,
finished/5, verify_connection/6, get_tls_handshake/3,
decode_client_key/3, server_hello_done/0,
encode_handshake/2, init_handshake_history/0, update_handshake_history/2,
- decrypt_premaster_secret/2, prf/5]).
+ decrypt_premaster_secret/2, prf/5, next_protocol/1]).
-export([dec_hello_extensions/2]).
-type tls_handshake() :: #client_hello{} | #server_hello{} |
#server_hello_done{} | #certificate{} | #certificate_request{} |
#client_key_exchange{} | #finished{} | #certificate_verify{} |
- #hello_request{}.
+ #hello_request{} | #next_protocol{}.
%%====================================================================
%% Internal application API
@@ -77,18 +77,31 @@ client_hello(Host, Port, ConnectionStates,
cipher_suites = cipher_suites(Ciphers, Renegotiation),
compression_methods = ssl_record:compressions(),
random = SecParams#security_parameters.client_random,
+
renegotiation_info =
renegotiation_info(client, ConnectionStates, Renegotiation),
- hash_signs = default_hash_signs()
+ hash_signs = default_hash_signs(),
+ next_protocol_negotiation =
+ encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, Renegotiation)
}.
+encode_protocol(Protocol, Acc) ->
+ Len = byte_size(Protocol),
+ <<Acc/binary, ?BYTE(Len), Protocol/binary>>.
+
+encode_protocols_advertised_on_server(undefined) ->
+ undefined;
+
+encode_protocols_advertised_on_server(Protocols) ->
+ #next_protocol_negotiation{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}.
+
%%--------------------------------------------------------------------
-spec server_hello(session_id(), tls_version(), #connection_states{},
- boolean()) -> #server_hello{}.
+ boolean(), [binary()] | undefined) -> #server_hello{}.
%%
%% Description: Creates a server hello message.
%%--------------------------------------------------------------------
-server_hello(SessionId, Version, ConnectionStates, Renegotiation) ->
+server_hello(SessionId, Version, ConnectionStates, Renegotiation, ProtocolsAdvertisedOnServer) ->
Pending = ssl_record:pending_connection_state(ConnectionStates, read),
SecParams = Pending#connection_state.security_parameters,
#server_hello{server_version = Version,
@@ -98,7 +111,8 @@ server_hello(SessionId, Version, ConnectionStates, Renegotiation) ->
random = SecParams#security_parameters.server_random,
session_id = SessionId,
renegotiation_info =
- renegotiation_info(server, ConnectionStates, Renegotiation)
+ renegotiation_info(server, ConnectionStates, Renegotiation),
+ next_protocol_negotiation = encode_protocols_advertised_on_server(ProtocolsAdvertisedOnServer)
}.
%%--------------------------------------------------------------------
@@ -113,20 +127,21 @@ hello_request() ->
%%--------------------------------------------------------------------
-spec hello(#server_hello{} | #client_hello{}, #ssl_options{},
#connection_states{} | {inet:port_number(), #session{}, db_handle(),
- atom(), #connection_states{}, binary()},
- boolean()) -> {tls_version(), session_id(), #connection_states{}}|
- {tls_version(), {resumed | new, #session{}},
- #connection_states{}} | #alert{}.
+ atom(), #connection_states{}, binary()},
+ boolean()) ->
+ {tls_version(), session_id(), #connection_states{}, binary() | undefined}|
+ {tls_version(), {resumed | new, #session{}}, #connection_states{}, list(binary()) | undefined} |
+ #alert{}.
%%
%% Description: Handles a recieved hello message
%%--------------------------------------------------------------------
hello(#server_hello{cipher_suite = CipherSuite, server_version = Version,
compression_method = Compression, random = Random,
session_id = SessionId, renegotiation_info = Info,
- hash_signs = _HashSigns},
- #ssl_options{secure_renegotiate = SecureRenegotation},
+ hash_signs = _HashSigns} = Hello,
+ #ssl_options{secure_renegotiate = SecureRenegotation, next_protocol_selector = NextProtocolSelector},
ConnectionStates0, Renegotiation) ->
-%%TODO: select hash and signature algorigthm
+ %%TODO: select hash and signature algorigthm
case ssl_record:is_acceptable_version(Version) of
true ->
case handle_renegotiation_info(client, Info, ConnectionStates0,
@@ -135,7 +150,12 @@ hello(#server_hello{cipher_suite = CipherSuite, server_version = Version,
ConnectionStates =
hello_pending_connection_states(client, Version, CipherSuite, Random,
Compression, ConnectionStates1),
- {Version, SessionId, ConnectionStates};
+ case handle_next_protocol(Hello, NextProtocolSelector, Renegotiation) of
+ #alert{} = Alert ->
+ Alert;
+ Protocol ->
+ {Version, SessionId, ConnectionStates, Protocol}
+ end;
#alert{} = Alert ->
Alert
end;
@@ -145,9 +165,8 @@ hello(#server_hello{cipher_suite = CipherSuite, server_version = Version,
hello(#client_hello{client_version = ClientVersion, random = Random,
cipher_suites = CipherSuites,
- renegotiation_info = Info,
- hash_signs = _HashSigns} = Hello,
- #ssl_options{versions = Versions,
+ renegotiation_info = Info} = Hello,
+ #ssl_options{versions = Versions,
secure_renegotiate = SecureRenegotation} = SslOpts,
{Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) ->
%% TODO: select hash and signature algorithm
@@ -173,7 +192,12 @@ hello(#client_hello{client_version = ClientVersion, random = Random,
Random,
Compression,
ConnectionStates1),
- {Version, {Type, Session}, ConnectionStates};
+ case handle_next_protocol_on_server(Hello, Renegotiation, SslOpts) of
+ #alert{} = Alert ->
+ Alert;
+ ProtocolsToAdvertise ->
+ {Version, {Type, Session}, ConnectionStates, ProtocolsToAdvertise}
+ end;
#alert{} = Alert ->
Alert
end
@@ -427,6 +451,11 @@ master_secret(Version, PremasterSecret, ConnectionStates, Role) ->
?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)
end.
+-spec next_protocol(binary()) -> #next_protocol{}.
+
+next_protocol(SelectedProtocol) ->
+ #next_protocol{selected_protocol = SelectedProtocol}.
+
%%--------------------------------------------------------------------
-spec finished(tls_version(), client | server, integer(), binary(), tls_handshake_history()) ->
#finished{}.
@@ -660,6 +689,57 @@ renegotiation_info(server, ConnectionStates, true) ->
#renegotiation_info{renegotiated_connection = undefined}
end.
+decode_next_protocols({next_protocol_negotiation, Protocols}) ->
+ decode_next_protocols(Protocols, []).
+decode_next_protocols(<<>>, Acc) ->
+ lists:reverse(Acc);
+decode_next_protocols(<<?BYTE(Len), Protocol:Len/binary, Rest/binary>>, Acc) ->
+ case Len of
+ 0 ->
+ {error, invalid_next_protocols};
+ _ ->
+ decode_next_protocols(Rest, [Protocol|Acc])
+ end;
+decode_next_protocols(_Bytes, _Acc) ->
+ {error, invalid_next_protocols}.
+
+next_protocol_extension_allowed(NextProtocolSelector, Renegotiating) ->
+ NextProtocolSelector =/= undefined andalso not Renegotiating.
+
+handle_next_protocol_on_server(#client_hello{next_protocol_negotiation = undefined}, _Renegotiation, _SslOpts) ->
+ undefined;
+
+handle_next_protocol_on_server(#client_hello{next_protocol_negotiation = {next_protocol_negotiation, <<>>}},
+ false, #ssl_options{next_protocols_advertised = Protocols}) ->
+ Protocols;
+
+handle_next_protocol_on_server(_Hello, _Renegotiation, _SSLOpts) ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE). % unexpected next protocol extension
+
+handle_next_protocol(#server_hello{next_protocol_negotiation = undefined},
+ _NextProtocolSelector, _Renegotiating) ->
+ undefined;
+
+handle_next_protocol(#server_hello{next_protocol_negotiation = Protocols},
+ NextProtocolSelector, Renegotiating) ->
+
+ case next_protocol_extension_allowed(NextProtocolSelector, Renegotiating) of
+ true ->
+ select_next_protocol(decode_next_protocols(Protocols), NextProtocolSelector);
+ false ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) % unexpected next protocol extension
+ end.
+
+select_next_protocol({error, _Reason}, _NextProtocolSelector) ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE);
+select_next_protocol(Protocols, NextProtocolSelector) ->
+ case NextProtocolSelector(Protocols) of
+ ?NO_PROTOCOL ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE);
+ Protocol when is_binary(Protocol) ->
+ Protocol
+ end.
+
handle_renegotiation_info(_, #renegotiation_info{renegotiated_connection = ?byte(0)},
ConnectionStates, false, _, _) ->
{ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)};
@@ -816,17 +896,21 @@ master_secret(Version, MasterSecret, #security_parameters{
ServerCipherState, Role)}.
-dec_hs(_Version, ?HELLO_REQUEST, <<>>) ->
+dec_hs(_, ?NEXT_PROTOCOL, <<?BYTE(SelectedProtocolLength), SelectedProtocol:SelectedProtocolLength/binary,
+ ?BYTE(PaddingLength), _Padding:PaddingLength/binary>>) ->
+ #next_protocol{selected_protocol = SelectedProtocol};
+
+dec_hs(_, ?HELLO_REQUEST, <<>>) ->
#hello_request{};
%% Client hello v2.
%% The server must be able to receive such messages, from clients that
%% are willing to use ssl v3 or higher, but have ssl v2 compatibility.
dec_hs(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor),
- ?UINT16(CSLength), ?UINT16(0),
- ?UINT16(CDLength),
- CipherSuites:CSLength/binary,
- ChallengeData:CDLength/binary>>) ->
+ ?UINT16(CSLength), ?UINT16(0),
+ ?UINT16(CDLength),
+ CipherSuites:CSLength/binary,
+ ChallengeData:CDLength/binary>>) ->
#client_hello{client_version = {Major, Minor},
random = ssl_ssl2:client_random(ChallengeData, CDLength),
session_id = 0,
@@ -839,20 +923,22 @@ dec_hs(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
?UINT16(Cs_length), CipherSuites:Cs_length/binary,
?BYTE(Cm_length), Comp_methods:Cm_length/binary,
Extensions/binary>>) ->
- HelloExtensions = dec_hello_extensions(Extensions),
- RenegotiationInfo = proplists:get_value(renegotiation_info, HelloExtensions,
- undefined),
- HashSigns = proplists:get_value(hash_signs, HelloExtensions,
- undefined),
+
+ DecodedExtensions = dec_hello_extensions(Extensions),
+ RenegotiationInfo = proplists:get_value(renegotiation_info, DecodedExtensions, undefined),
+ HashSigns = proplists:get_value(hash_signs, DecodedExtensions, undefined),
+ NextProtocolNegotiation = proplists:get_value(next_protocol_negotiation, DecodedExtensions, undefined),
+
#client_hello{
- client_version = {Major,Minor},
- random = Random,
- session_id = Session_ID,
- cipher_suites = from_2bytes(CipherSuites),
- compression_methods = Comp_methods,
- renegotiation_info = RenegotiationInfo,
- hash_signs = HashSigns
- };
+ client_version = {Major,Minor},
+ random = Random,
+ session_id = Session_ID,
+ cipher_suites = from_2bytes(CipherSuites),
+ compression_methods = Comp_methods,
+ renegotiation_info = RenegotiationInfo,
+ hash_signs = HashSigns,
+ next_protocol_negotiation = NextProtocolNegotiation
+ };
dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
?BYTE(SID_length), Session_ID:SID_length/binary,
@@ -868,7 +954,7 @@ dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
?BYTE(SID_length), Session_ID:SID_length/binary,
- Cipher_suite:2/binary, ?BYTE(Comp_method),
+ Cipher_suite:2/binary, ?BYTE(Comp_method),
?UINT16(ExtLen), Extensions:ExtLen/binary>>) ->
HelloExtensions = dec_hello_extensions(Extensions, []),
@@ -876,6 +962,8 @@ dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
undefined),
HashSigns = proplists:get_value(hash_signs, HelloExtensions,
undefined),
+ NextProtocolNegotiation = proplists:get_value(next_protocol_negotiation, HelloExtensions, undefined),
+
#server_hello{
server_version = {Major,Minor},
random = Random,
@@ -883,7 +971,8 @@ dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
cipher_suite = Cipher_suite,
compression_method = Comp_method,
renegotiation_info = RenegotiationInfo,
- hash_signs = HashSigns};
+ hash_signs = HashSigns,
+ next_protocol_negotiation = NextProtocolNegotiation};
dec_hs(_Version, ?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>) ->
#certificate{asn1_certificates = certs_to_list(ASN1Certs)};
@@ -959,6 +1048,9 @@ dec_hello_extensions(_) ->
dec_hello_extensions(<<>>, Acc) ->
Acc;
+dec_hello_extensions(<<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), ExtensionData:Len/binary, Rest/binary>>, Acc) ->
+ Prop = {next_protocol_negotiation, #next_protocol_negotiation{extension_data = ExtensionData}},
+ dec_hello_extensions(Rest, [Prop | Acc]);
dec_hello_extensions(<<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info:Len/binary, Rest/binary>>, Acc) ->
RenegotiateInfo = case Len of
1 -> % Initial handshake
@@ -982,6 +1074,7 @@ dec_hello_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len),
%% Ignore data following the ClientHello (i.e.,
%% extensions) if not understood.
+
dec_hello_extensions(<<?UINT16(_), ?UINT16(Len), _Unknown:Len/binary, Rest/binary>>, Acc) ->
dec_hello_extensions(Rest, Acc);
%% This theoretically should not happen if the protocol is followed, but if it does it is ignored.
@@ -1014,6 +1107,11 @@ certs_from_list(ACList) ->
<<?UINT24(CertLen), Cert/binary>>
end || Cert <- ACList]).
+enc_hs(#next_protocol{selected_protocol = SelectedProtocol}, _Version) ->
+ PaddingLength = 32 - ((byte_size(SelectedProtocol) + 2) rem 32),
+
+ {?NEXT_PROTOCOL, <<?BYTE((byte_size(SelectedProtocol))), SelectedProtocol/binary,
+ ?BYTE(PaddingLength), 0:(PaddingLength * 8)>>};
enc_hs(#hello_request{}, _Version) ->
{?HELLO_REQUEST, <<>>};
enc_hs(#client_hello{client_version = {Major, Minor},
@@ -1022,19 +1120,21 @@ enc_hs(#client_hello{client_version = {Major, Minor},
cipher_suites = CipherSuites,
compression_methods = CompMethods,
renegotiation_info = RenegotiationInfo,
- hash_signs = HashSigns}, _Version) ->
+ hash_signs = HashSigns,
+ next_protocol_negotiation = NextProtocolNegotiation}, _Version) ->
SIDLength = byte_size(SessionID),
BinCompMethods = list_to_binary(CompMethods),
CmLength = byte_size(BinCompMethods),
BinCipherSuites = list_to_binary(CipherSuites),
CsLength = byte_size(BinCipherSuites),
- Extensions0 = hello_extensions(RenegotiationInfo),
+ Extensions0 = hello_extensions(RenegotiationInfo, NextProtocolNegotiation),
Extensions1 = if
Major == 3, Minor >=3 -> Extensions0 ++ hello_extensions(HashSigns);
true -> Extensions0
end,
ExtensionsBin = enc_hello_extensions(Extensions1),
- {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
+
+ {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
?BYTE(SIDLength), SessionID/binary,
?UINT16(CsLength), BinCipherSuites/binary,
?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>};
@@ -1044,9 +1144,10 @@ enc_hs(#server_hello{server_version = {Major, Minor},
session_id = Session_ID,
cipher_suite = Cipher_suite,
compression_method = Comp_method,
- renegotiation_info = RenegotiationInfo}, _Version) ->
+ renegotiation_info = RenegotiationInfo,
+ next_protocol_negotiation = NextProtocolNegotiation}, _Version) ->
SID_length = byte_size(Session_ID),
- Extensions = hello_extensions(RenegotiationInfo),
+ Extensions = hello_extensions(RenegotiationInfo, NextProtocolNegotiation),
ExtensionsBin = enc_hello_extensions(Extensions),
{?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
?BYTE(SID_length), Session_ID/binary,
@@ -1119,8 +1220,9 @@ enc_sign(_HashSign, Sign, _Version) ->
SignLen = byte_size(Sign),
<<?UINT16(SignLen), Sign/binary>>.
-hello_extensions(undefined) ->
- [];
+hello_extensions(RenegotiationInfo, NextProtocolNegotiation) ->
+ hello_extensions(RenegotiationInfo) ++ next_protocol_extension(NextProtocolNegotiation).
+
%% Renegotiation info
hello_extensions(#renegotiation_info{renegotiated_connection = undefined}) ->
[];
@@ -1129,6 +1231,11 @@ hello_extensions(#renegotiation_info{} = Info) ->
hello_extensions(#hash_sign_algos{} = Info) ->
[Info].
+next_protocol_extension(undefined) ->
+ [];
+next_protocol_extension(#next_protocol_negotiation{} = Info) ->
+ [Info].
+
enc_hello_extensions(Extensions) ->
enc_hello_extensions(Extensions, <<>>).
enc_hello_extensions([], <<>>) ->
@@ -1137,6 +1244,9 @@ enc_hello_extensions([], Acc) ->
Size = byte_size(Acc),
<<?UINT16(Size), Acc/binary>>;
+enc_hello_extensions([#next_protocol_negotiation{extension_data = ExtensionData} | Rest], Acc) ->
+ Len = byte_size(ExtensionData),
+ enc_hello_extensions(Rest, <<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), ExtensionData/binary, Acc/binary>>);
enc_hello_extensions([#renegotiation_info{renegotiated_connection = ?byte(0) = Info} | Rest], Acc) ->
Len = byte_size(Info),
enc_hello_extensions(Rest, <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info/binary, Acc/binary>>);
@@ -1151,8 +1261,15 @@ enc_hello_extensions([#hash_sign_algos{hash_sign_algos = HashSignAlgos} | Rest],
{Hash, Sign} <- HashSignAlgos >>,
ListLen = byte_size(SignAlgoList),
Len = ListLen + 2,
- enc_hello_extensions(Rest, <<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), ?UINT16(ListLen), SignAlgoList/binary, Acc/binary>>).
-
+ enc_hello_extensions(Rest, <<?UINT16(?SIGNATURE_ALGORITHMS_EXT),
+ ?UINT16(Len), ?UINT16(ListLen), SignAlgoList/binary, Acc/binary>>).
+
+encode_client_protocol_negotiation(undefined, _) ->
+ undefined;
+encode_client_protocol_negotiation(_, false) ->
+ #next_protocol_negotiation{extension_data = <<>>};
+encode_client_protocol_negotiation(_, _) ->
+ undefined.
from_3bytes(Bin3) ->
from_3bytes(Bin3, []).
diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl
index cc17dc2975..9af6511d68 100644
--- a/lib/ssl/src/ssl_handshake.hrl
+++ b/lib/ssl/src/ssl_handshake.hrl
@@ -33,6 +33,8 @@
-type public_key_info() :: {algo_oid(), #'RSAPublicKey'{} | integer() , public_key_params()}.
-type tls_handshake_history() :: {[binary()], [binary()]}.
+-define(NO_PROTOCOL, <<>>).
+
%% Signature algorithms
-define(ANON, 0).
-define(RSA, 1).
@@ -97,7 +99,8 @@
cipher_suites, % cipher_suites<2..2^16-1>
compression_methods, % compression_methods<1..2^8-1>,
renegotiation_info,
- hash_signs % supported combinations of hashes/signature algos
+ hash_signs, % supported combinations of hashes/signature algos
+ next_protocol_negotiation = undefined % [binary()]
}).
-record(server_hello, {
@@ -107,7 +110,8 @@
cipher_suite, % cipher_suites
compression_method, % compression_method
renegotiation_info,
- hash_signs % supported combinations of hashes/signature algos
+ hash_signs, % supported combinations of hashes/signature algos
+ next_protocol_negotiation = undefined % [binary()]
}).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -234,6 +238,18 @@
hash_sign_algos
}).
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Next Protocol Negotiation
+%% (http://tools.ietf.org/html/draft-agl-tls-nextprotoneg-02)
+%% (http://technotes.googlecode.com/git/nextprotoneg.html)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-define(NEXTPROTONEG_EXT, 13172).
+-define(NEXT_PROTOCOL, 67).
+-record(next_protocol_negotiation, {extension_data}).
+
+-record(next_protocol, {selected_protocol}).
+
-endif. % -ifdef(ssl_handshake).
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index b8f2ae3b51..a5db2dcee7 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -106,7 +106,9 @@
% after which ssl_connection will
% go into hibernation
%% This option should only be set to true by inet_tls_dist
- erl_dist = false
+ erl_dist = false,
+ next_protocols_advertised = undefined, %% [binary()],
+ next_protocol_selector = undefined %% fun([binary()]) -> binary())
}).
-record(socket_options,
diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl
index af2bfa394d..0cf4f2ce33 100644
--- a/lib/ssl/src/ssl_manager.erl
+++ b/lib/ssl/src/ssl_manager.erl
@@ -191,7 +191,7 @@ init([Name, Opts]) ->
proplists:get_value(session_lifetime, Opts, ?'24H_in_sec'),
CertDb = ssl_certificate_db:create(),
SessionCache = CacheCb:init(proplists:get_value(session_cb_init_args, Opts, [])),
- Timer = erlang:send_after(SessionLifeTime * 1000,
+ Timer = erlang:send_after(SessionLifeTime * 1000 + 5000,
self(), validate_sessions),
erlang:send_after(?CLEAR_PEM_CACHE, self(), clear_pem_cache),
{ok, #state{certificate_db = CertDb,
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index 343157b22e..d36dcb588b 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -44,6 +44,8 @@ MODULES = \
ssl_to_openssl_SUITE \
ssl_session_cache_SUITE \
ssl_dist_SUITE \
+ ssl_npn_hello_SUITE \
+ ssl_npn_handshake_SUITE \
make_certs\
erl_make_certs
diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl
index 693289990c..4603a9f846 100644
--- a/lib/ssl/test/make_certs.erl
+++ b/lib/ssl/test/make_certs.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -121,7 +121,19 @@ create_self_signed_cert(Root, OpenSSLCmd, CAName, Cnf) ->
" -keyout ", KeyFile,
" -out ", CertFile],
Env = [{"ROOTDIR", Root}],
- cmd(Cmd, Env).
+ cmd(Cmd, Env),
+ fix_key_file(OpenSSLCmd, KeyFile).
+
+% openssl 1.0 generates key files in pkcs8 format by default and we don't handle this format
+fix_key_file(OpenSSLCmd, KeyFile) ->
+ KeyFileTmp = KeyFile ++ ".tmp",
+ Cmd = [OpenSSLCmd, " rsa",
+ " -in ",
+ KeyFile,
+ " -out ",
+ KeyFileTmp],
+ cmd(Cmd, []),
+ ok = file:rename(KeyFileTmp, KeyFile).
create_ca_dir(Root, CAName, Cnf) ->
CARoot = filename:join([Root, CAName]),
@@ -139,7 +151,8 @@ create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile) ->
" -keyout ", KeyFile,
" -out ", ReqFile],
Env = [{"ROOTDIR", Root}],
- cmd(Cmd, Env).
+ cmd(Cmd, Env),
+ fix_key_file(OpenSSLCmd, KeyFile).
sign_req(Root, OpenSSLCmd, CA, CertType, ReqFile, CertFile) ->
CACnfFile = filename:join([Root, CA, "ca.cnf"]),
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 93f7209aea..6cf712fa6f 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -39,6 +39,7 @@
-define(EXPIRE, 10).
-define(SLEEP, 500).
-define(RENEGOTIATION_DISABLE_TIME, 12000).
+-define(CLEAN_SESSION_DB, 60000).
%% Test server callback functions
%%--------------------------------------------------------------------
@@ -108,12 +109,12 @@ init_per_testcase(protocol_versions, Config) ->
init_per_testcase(reuse_session_expired, Config0) ->
Config = lists:keydelete(watchdog, 1, Config0),
- Dog = ssl_test_lib:timetrap(?EXPIRE * 1000 * 5),
ssl:stop(),
application:load(ssl),
application:set_env(ssl, session_lifetime, ?EXPIRE),
+ application:set_env(ssl, session_delay_cleanup_time, 500),
ssl:start(),
- [{watchdog, Dog} | Config];
+ Config;
init_per_testcase(empty_protocol_versions, Config) ->
ssl:stop(),
@@ -141,6 +142,7 @@ init_per_testcase(_TestCase, Config0) ->
%%--------------------------------------------------------------------
end_per_testcase(reuse_session_expired, Config) ->
application:unset_env(ssl, session_lifetime),
+ application:unset_env(ssl, session_delay_cleanup_time),
end_per_testcase(default_action, Config);
end_per_testcase(_TestCase, Config) ->
@@ -2089,13 +2091,14 @@ reuse_session_expired(Config) when is_list(Config) ->
%% Make sure session is unregistered due to expiration
test_server:sleep((?EXPIRE+1)),
[{session_id, Id} |_] = SessionInfo,
+
make_sure_expired(Hostname, Port, Id),
Client2 =
ssl_test_lib:start_client([{node, ClientNode},
- {port, Port}, {host, Hostname},
+ {port, Port}, {host, Hostname},
{mfa, {ssl_test_lib, session_info_result, []}},
- {from, self()}, {options, ClientOpts}]),
+ {from, self()}, {options, ClientOpts}]),
receive
{Client2, SessionInfo} ->
test_server:fail(session_reused_when_session_expired);
@@ -2113,16 +2116,16 @@ make_sure_expired(Host, Port, Id) ->
[_, _,_, _, Prop] = StatusInfo,
State = ssl_test_lib:state(Prop),
Cache = element(2, State),
- case ssl_session_cache:lookup(Cache, {{Host, Port}, Id}) of
+
+ case ssl_session_cache:lookup(Cache, {{Host, Port}, Id}) of
undefined ->
- ok;
+ ok;
#session{is_resumable = false} ->
- ok;
+ ok;
_ ->
test_server:sleep(?SLEEP),
make_sure_expired(Host, Port, Id)
- end.
-
+ end.
%%--------------------------------------------------------------------
server_does_not_want_to_reuse_session(doc) ->
diff --git a/lib/ssl/test/ssl_npn_handshake_SUITE.erl b/lib/ssl/test/ssl_npn_handshake_SUITE.erl
new file mode 100644
index 0000000000..8597aa6740
--- /dev/null
+++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl
@@ -0,0 +1,310 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2012. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+-module(ssl_npn_handshake_SUITE).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+-include_lib("common_test/include/ct.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [{group, 'tlsv1.2'},
+ {group, 'tlsv1.1'},
+ {group, 'tlsv1'},
+ {group, 'sslv3'}].
+
+groups() ->
+ [
+ {'tlsv1.2', [], next_protocol_tests()},
+ {'tlsv1.1', [], next_protocol_tests()},
+ {'tlsv1', [], next_protocol_tests()},
+ {'sslv3', [], next_protocol_not_supported()}
+ ].
+
+next_protocol_tests() ->
+ [validate_empty_protocols_are_not_allowed,
+ validate_empty_advertisement_list_is_allowed,
+ validate_advertisement_must_be_a_binary_list,
+ validate_client_protocols_must_be_a_tuple,
+ normal_npn_handshake_server_preference,
+ normal_npn_handshake_client_preference,
+ fallback_npn_handshake,
+ fallback_npn_handshake_server_preference,
+ client_negotiate_server_does_not_support,
+ no_client_negotiate_but_server_supports_npn,
+ renegotiate_from_client_after_npn_handshake
+ ].
+
+next_protocol_not_supported() ->
+ [npn_not_supported_client,
+ npn_not_supported_server
+ ].
+
+init_per_suite(Config) ->
+ catch crypto:stop(),
+ try crypto:start() of
+ ok ->
+ application:start(public_key),
+ ssl:start(),
+ Result =
+ (catch make_certs:all(?config(data_dir, Config),
+ ?config(priv_dir, Config))),
+ test_server:format("Make certs ~p~n", [Result]),
+ ssl_test_lib:cert_options(Config)
+ catch _:_ ->
+ {skip, "Crypto did not start"}
+ end.
+
+end_per_suite(_Config) ->
+ ssl:stop(),
+ application:stop(crypto).
+
+
+init_per_group(GroupName, Config) ->
+ case ssl_test_lib:is_tls_version(GroupName) of
+ true ->
+ case ssl_test_lib:sufficient_crypto_support(GroupName) of
+ true ->
+ ssl_test_lib:init_tls_version(GroupName),
+ Config;
+ false ->
+ {skip, "Missing crypto support"}
+ end;
+ _ ->
+ ssl:start(),
+ Config
+ end.
+
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+%% Test cases starts here.
+%%--------------------------------------------------------------------
+
+validate_empty_protocols_are_not_allowed(Config) when is_list(Config) ->
+ {error, {eoptions, {next_protocols_advertised, {invalid_protocol, <<>>}}}}
+ = (catch ssl:listen(9443,
+ [{next_protocols_advertised, [<<"foo/1">>, <<"">>]}])),
+ {error, {eoptions, {client_preferred_next_protocols, {invalid_protocol, <<>>}}}}
+ = (catch ssl:connect({127,0,0,1}, 9443,
+ [{client_preferred_next_protocols,
+ {client, [<<"foo/1">>, <<"">>], <<"foox/1">>}}], infinity)),
+ Option = {client_preferred_next_protocols, {invalid_protocol, <<"">>}},
+ {error, {eoptions, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option], infinity)).
+
+%--------------------------------------------------------------------------------
+
+validate_empty_advertisement_list_is_allowed(Config) when is_list(Config) ->
+ Option = {next_protocols_advertised, []},
+ {ok, Socket} = ssl:listen(0, [Option]),
+ ssl:close(Socket).
+%--------------------------------------------------------------------------------
+
+validate_advertisement_must_be_a_binary_list(Config) when is_list(Config) ->
+ Option = {next_protocols_advertised, blah},
+ {error, {eoptions, Option}} = (catch ssl:listen(9443, [Option])).
+%--------------------------------------------------------------------------------
+
+validate_client_protocols_must_be_a_tuple(Config) when is_list(Config) ->
+ Option = {client_preferred_next_protocols, [<<"foo/1">>]},
+ {error, {eoptions, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option])).
+
+%--------------------------------------------------------------------------------
+
+normal_npn_handshake_server_preference(Config) when is_list(Config) ->
+ run_npn_handshake(Config,
+ [{client_preferred_next_protocols,
+ {server, [<<"http/1.0">>, <<"http/1.1">>], <<"http/1.1">>}}],
+ [{next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}],
+ {ok, <<"http/1.1">>}).
+%--------------------------------------------------------------------------------
+
+normal_npn_handshake_client_preference(Config) when is_list(Config) ->
+ run_npn_handshake(Config,
+ [{client_preferred_next_protocols,
+ {client, [<<"http/1.0">>, <<"http/1.1">>], <<"http/1.1">>}}],
+ [{next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}],
+ {ok, <<"http/1.0">>}).
+
+%--------------------------------------------------------------------------------
+
+fallback_npn_handshake(Config) when is_list(Config) ->
+ run_npn_handshake(Config,
+ [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}}],
+ [{next_protocols_advertised, [<<"spdy/1">>, <<"http/1.1">>, <<"http/1.0">>]}],
+ {ok, <<"http/1.1">>}).
+%--------------------------------------------------------------------------------
+
+fallback_npn_handshake_server_preference(Config) when is_list(Config) ->
+ run_npn_handshake(Config,
+ [{client_preferred_next_protocols, {server, [<<"spdy/2">>], <<"http/1.1">>}}],
+ [{next_protocols_advertised, [<<"spdy/1">>, <<"http/1.1">>, <<"http/1.0">>]}],
+ {ok, <<"http/1.1">>}).
+
+%--------------------------------------------------------------------------------
+
+no_client_negotiate_but_server_supports_npn(Config) when is_list(Config) ->
+ run_npn_handshake(Config,
+ [],
+ [{next_protocols_advertised, [<<"spdy/1">>, <<"http/1.1">>, <<"http/1.0">>]}],
+ {error, next_protocol_not_negotiated}).
+%--------------------------------------------------------------------------------
+
+
+client_negotiate_server_does_not_support(Config) when is_list(Config) ->
+ run_npn_handshake(Config,
+ [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}}],
+ [],
+ {error, next_protocol_not_negotiated}).
+
+%--------------------------------------------------------------------------------
+renegotiate_from_client_after_npn_handshake(Config) when is_list(Config) ->
+ Data = "hello world",
+
+ ClientOpts0 = ?config(client_opts, Config),
+ ClientOpts = [{client_preferred_next_protocols,
+ {client, [<<"http/1.0">>], <<"http/1.1">>}}] ++ ClientOpts0,
+ ServerOpts0 = ?config(server_opts, Config),
+ ServerOpts = [{next_protocols_advertised,
+ [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0,
+ ExpectedProtocol = {ok, <<"http/1.0">>},
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, ssl_receive_and_assert_npn, [ExpectedProtocol, Data]}},
+ {options, ServerOpts}]),
+
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, assert_npn_and_renegotiate_and_send_data, [ExpectedProtocol, Data]}},
+ {options, ClientOpts}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok).
+
+%--------------------------------------------------------------------------------
+npn_not_supported_client(Config) when is_list(Config) ->
+ ClientOpts0 = ?config(client_opts, Config),
+ PrefProtocols = {client_preferred_next_protocols,
+ {client, [<<"http/1.0">>], <<"http/1.1">>}},
+ ClientOpts = [PrefProtocols] ++ ClientOpts0,
+ {ClientNode, _ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Client = ssl_test_lib:start_client_error([{node, ClientNode},
+ {port, 8888}, {host, Hostname},
+ {from, self()}, {options, ClientOpts}]),
+
+ ssl_test_lib:check_result(Client, {error,
+ {eoptions,
+ {not_supported_in_sslv3, PrefProtocols}}}).
+
+%--------------------------------------------------------------------------------
+npn_not_supported_server(Config) when is_list(Config)->
+ ServerOpts0 = ?config(server_opts, Config),
+ AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]},
+ ServerOpts = [AdvProtocols] ++ ServerOpts0,
+
+ {error, {eoptions, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts).
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+run_npn_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) ->
+ Data = "hello world",
+
+ ClientOpts0 = ?config(client_opts, Config),
+ ClientOpts = ClientExtraOpts ++ ClientOpts0,
+ ServerOpts0 = ?config(server_opts, Config),
+ ServerOpts = ServerExtraOpts ++ ServerOpts0,
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, ssl_receive_and_assert_npn, [ExpectedProtocol, Data]}},
+ {options, ServerOpts}]),
+
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, ssl_send_and_assert_npn, [ExpectedProtocol, Data]}},
+ {options, ClientOpts}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok).
+
+
+assert_npn(Socket, Protocol) ->
+ test_server:format("Negotiated Protocol ~p, Expecting: ~p ~n",
+ [ssl:negotiated_next_protocol(Socket), Protocol]),
+ Protocol = ssl:negotiated_next_protocol(Socket).
+
+assert_npn_and_renegotiate_and_send_data(Socket, Protocol, Data) ->
+ assert_npn(Socket, Protocol),
+ test_server:format("Renegotiating ~n", []),
+ ok = ssl:renegotiate(Socket),
+ ssl:send(Socket, Data),
+ assert_npn(Socket, Protocol),
+ ok.
+
+ssl_send_and_assert_npn(Socket, Protocol, Data) ->
+ assert_npn(Socket, Protocol),
+ ssl_send(Socket, Data).
+
+ssl_receive_and_assert_npn(Socket, Protocol, Data) ->
+ assert_npn(Socket, Protocol),
+ ssl_receive(Socket, Data).
+
+ssl_send(Socket, Data) ->
+ test_server:format("Connection info: ~p~n",
+ [ssl:connection_info(Socket)]),
+ ssl:send(Socket, Data).
+
+ssl_receive(Socket, Data) ->
+ ssl_receive(Socket, Data, []).
+
+ssl_receive(Socket, Data, Buffer) ->
+ test_server:format("Connection info: ~p~n",
+ [ssl:connection_info(Socket)]),
+ receive
+ {ssl, Socket, MoreData} ->
+ test_server:format("Received ~p~n",[MoreData]),
+ NewBuffer = Buffer ++ MoreData,
+ case NewBuffer of
+ Data ->
+ ssl:send(Socket, "Got it"),
+ ok;
+ _ ->
+ ssl_receive(Socket, Data, NewBuffer)
+ end;
+ Other ->
+ test_server:fail({unexpected_message, Other})
+ after 4000 ->
+ test_server:fail({did_not_get, Data})
+ end.
+
+
+connection_info_result(Socket) ->
+ ssl:connection_info(Socket).
diff --git a/lib/ssl/test/ssl_npn_hello_SUITE.erl b/lib/ssl/test/ssl_npn_hello_SUITE.erl
new file mode 100644
index 0000000000..5102c74e87
--- /dev/null
+++ b/lib/ssl/test/ssl_npn_hello_SUITE.erl
@@ -0,0 +1,117 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2012. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+
+-module(ssl_npn_hello_SUITE).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+-include("ssl_handshake.hrl").
+-include("ssl_record.hrl").
+-include_lib("common_test/include/ct.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [encode_and_decode_npn_client_hello_test,
+ encode_and_decode_npn_server_hello_test,
+ encode_and_decode_client_hello_test,
+ encode_and_decode_server_hello_test,
+ create_server_hello_with_advertised_protocols_test,
+ create_server_hello_with_no_advertised_protocols_test].
+
+
+create_client_handshake(Npn) ->
+ ssl_handshake:encode_handshake(#client_hello{
+ client_version = {1, 2},
+ random = <<1:256>>,
+ session_id = <<>>,
+ cipher_suites = "",
+ compression_methods = "",
+ next_protocol_negotiation = Npn,
+ renegotiation_info = #renegotiation_info{}
+ }, vsn).
+
+
+encode_and_decode_client_hello_test(_Config) ->
+ HandShakeData = create_client_handshake(undefined),
+ Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ {[{DecodedHandshakeMessage, _Raw}], _} = ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>),
+ NextProtocolNegotiation = DecodedHandshakeMessage#client_hello.next_protocol_negotiation,
+ NextProtocolNegotiation = undefined.
+
+encode_and_decode_npn_client_hello_test(_Config) ->
+ HandShakeData = create_client_handshake(#next_protocol_negotiation{extension_data = <<>>}),
+ Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ {[{DecodedHandshakeMessage, _Raw}], _} = ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>),
+ NextProtocolNegotiation = DecodedHandshakeMessage#client_hello.next_protocol_negotiation,
+ NextProtocolNegotiation = #next_protocol_negotiation{extension_data = <<>>}.
+
+create_server_handshake(Npn) ->
+ ssl_handshake:encode_handshake(#server_hello{
+ server_version = {1, 2},
+ random = <<1:256>>,
+ session_id = <<>>,
+ cipher_suite = <<1,2>>,
+ compression_method = 1,
+ next_protocol_negotiation = Npn,
+ renegotiation_info = #renegotiation_info{}
+ }, vsn).
+
+encode_and_decode_server_hello_test(_Config) ->
+ HandShakeData = create_server_handshake(undefined),
+ Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ {[{DecodedHandshakeMessage, _Raw}], _} =
+ ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>),
+ NextProtocolNegotiation = DecodedHandshakeMessage#server_hello.next_protocol_negotiation,
+ NextProtocolNegotiation = undefined.
+
+encode_and_decode_npn_server_hello_test(_Config) ->
+ HandShakeData = create_server_handshake(#next_protocol_negotiation{extension_data = <<6, "spdy/2">>}),
+ Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ {[{DecodedHandshakeMessage, _Raw}], _} = ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>),
+ NextProtocolNegotiation = DecodedHandshakeMessage#server_hello.next_protocol_negotiation,
+ ct:print("~p ~n", [NextProtocolNegotiation]),
+ NextProtocolNegotiation = #next_protocol_negotiation{extension_data = <<6, "spdy/2">>}.
+
+create_connection_states() ->
+ #connection_states{
+ pending_read = #connection_state{
+ security_parameters = #security_parameters{
+ server_random = <<1:256>>,
+ compression_algorithm = 1,
+ cipher_suite = <<1, 2>>
+ }
+ },
+
+ current_read = #connection_state {
+ secure_renegotiation = false
+ }
+ }.
+
+create_server_hello_with_no_advertised_protocols_test(_Config) ->
+ Hello = ssl_handshake:server_hello(<<>>, {3, 0}, create_connection_states(), false, undefined),
+ undefined = Hello#server_hello.next_protocol_negotiation.
+
+create_server_hello_with_advertised_protocols_test(_Config) ->
+ Hello = ssl_handshake:server_hello(<<>>, {3, 0}, create_connection_states(),
+ false, [<<"spdy/1">>, <<"http/1.0">>, <<"http/1.1">>]),
+ #next_protocol_negotiation{extension_data = <<6, "spdy/1", 8, "http/1.0", 8, "http/1.1">>} =
+ Hello#server_hello.next_protocol_negotiation.
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index d446014f7b..21797bee08 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -29,7 +29,7 @@
-define(TIMEOUT, 120000).
-define(LONG_TIMEOUT, 600000).
-define(SLEEP, 1000).
--define(OPENSSL_RENEGOTIATE, "r\n").
+-define(OPENSSL_RENEGOTIATE, "R\n").
-define(OPENSSL_QUIT, "Q\n").
-define(OPENSSL_GARBAGE, "P\n").
-define(EXPIRE, 10).
@@ -114,6 +114,17 @@ special_init(TestCase, Config)
special_init(ssl2_erlang_server_openssl_client, Config) ->
check_sane_openssl_sslv2(Config);
+special_init(TestCase, Config)
+ when TestCase == erlang_client_openssl_server_npn;
+ TestCase == erlang_server_openssl_client_npn;
+ TestCase == erlang_server_openssl_client_npn_renegotiate;
+ TestCase == erlang_client_openssl_server_npn_renegotiate;
+ TestCase == erlang_server_openssl_client_npn_only_server;
+ TestCase == erlang_server_openssl_client_npn_only_client;
+ TestCase == erlang_client_openssl_server_npn_only_client;
+ TestCase == erlang_client_openssl_server_npn_only_server ->
+ check_openssl_npn_support(Config);
+
special_init(_, Config) ->
Config.
@@ -161,9 +172,9 @@ all() ->
groups() ->
[{basic, [], basic_tests()},
- {'tlsv1.2', [], all_versions_tests()},
- {'tlsv1.1', [], all_versions_tests()},
- {'tlsv1', [], all_versions_tests()},
+ {'tlsv1.2', [], all_versions_tests() ++ npn_tests()},
+ {'tlsv1.1', [], all_versions_tests() ++ npn_tests()},
+ {'tlsv1', [], all_versions_tests()++ npn_tests()},
{'sslv3', [], all_versions_tests()}].
basic_tests() ->
@@ -179,16 +190,26 @@ all_versions_tests() ->
erlang_server_openssl_client_dsa_cert,
erlang_server_openssl_client_reuse_session,
erlang_client_openssl_server_renegotiate,
- erlang_client_openssl_server_no_wrap_sequence_number,
- erlang_server_openssl_client_no_wrap_sequence_number,
+ erlang_client_openssl_server_nowrap_seqnum,
+ erlang_server_openssl_client_nowrap_seqnum,
erlang_client_openssl_server_no_server_ca_cert,
erlang_client_openssl_server_client_cert,
erlang_server_openssl_client_client_cert,
ciphers_rsa_signed_certs,
ciphers_dsa_signed_certs,
erlang_client_bad_openssl_server,
- ssl2_erlang_server_openssl_client
- ].
+ expired_session,
+ ssl2_erlang_server_openssl_client].
+
+npn_tests() ->
+ [erlang_client_openssl_server_npn,
+ erlang_server_openssl_client_npn,
+ erlang_server_openssl_client_npn_renegotiate,
+ erlang_client_openssl_server_npn_renegotiate,
+ erlang_server_openssl_client_npn_only_client,
+ erlang_server_openssl_client_npn_only_server,
+ erlang_client_openssl_server_npn_only_client,
+ erlang_client_openssl_server_npn_only_server].
init_per_group(GroupName, Config) ->
case ssl_test_lib:is_tls_version(GroupName) of
@@ -544,14 +565,14 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) ->
%%--------------------------------------------------------------------
-erlang_client_openssl_server_no_wrap_sequence_number(doc) ->
+erlang_client_openssl_server_nowrap_seqnum(doc) ->
["Test that erlang client will renegotiate session when",
"max sequence number celing is about to be reached. Although"
"in the testcase we use the test option renegotiate_at"
" to lower treashold substantially."];
-erlang_client_openssl_server_no_wrap_sequence_number(suite) ->
+erlang_client_openssl_server_nowrap_seqnum(suite) ->
[];
-erlang_client_openssl_server_no_wrap_sequence_number(Config) when is_list(Config) ->
+erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) ->
process_flag(trap_exit, true),
ServerOpts = ?config(server_opts, Config),
ClientOpts = ?config(client_opts, Config),
@@ -590,15 +611,15 @@ erlang_client_openssl_server_no_wrap_sequence_number(Config) when is_list(Config
process_flag(trap_exit, false),
ok.
%%--------------------------------------------------------------------
-erlang_server_openssl_client_no_wrap_sequence_number(doc) ->
+erlang_server_openssl_client_nowrap_seqnum(doc) ->
["Test that erlang client will renegotiate session when",
"max sequence number celing is about to be reached. Although"
"in the testcase we use the test option renegotiate_at"
" to lower treashold substantially."];
-erlang_server_openssl_client_no_wrap_sequence_number(suite) ->
+erlang_server_openssl_client_nowrap_seqnum(suite) ->
[];
-erlang_server_openssl_client_no_wrap_sequence_number(Config) when is_list(Config) ->
+erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) ->
process_flag(trap_exit, true),
ServerOpts = ?config(server_opts, Config),
@@ -1069,6 +1090,248 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) ->
ok.
%%--------------------------------------------------------------------
+erlang_client_openssl_server_npn(doc) ->
+ ["Test erlang client with openssl server doing npn negotiation"];
+erlang_client_openssl_server_npn(suite) ->
+ [];
+erlang_client_openssl_server_npn(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, fun(Client, OpensslPort) ->
+ port_command(OpensslPort, Data),
+
+ ssl_test_lib:check_result(Client, ok)
+ end),
+
+ ok.
+
+
+%%--------------------------------------------------------------------
+erlang_client_openssl_server_npn_renegotiate(doc) ->
+ ["Test erlang client with openssl server doing npn negotiation and renegotiate"];
+erlang_client_openssl_server_npn_renegotiate(suite) ->
+ [];
+erlang_client_openssl_server_npn_renegotiate(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, fun(Client, OpensslPort) ->
+ port_command(OpensslPort, ?OPENSSL_RENEGOTIATE),
+ test_server:sleep(?SLEEP),
+ port_command(OpensslPort, Data),
+ ssl_test_lib:check_result(Client, ok)
+ end),
+ ok.
+
+
+%%--------------------------------------------------------------------------
+
+
+erlang_server_openssl_client_npn(doc) ->
+ ["Test erlang server with openssl client and npn negotiation"];
+erlang_server_openssl_client_npn(suite) ->
+ [];
+erlang_server_openssl_client_npn(Config) when is_list(Config) ->
+
+ Data = "From openssl to erlang",
+ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, fun(Server, OpensslPort) ->
+ port_command(OpensslPort, Data),
+ ssl_test_lib:check_result(Server, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------------
+
+erlang_server_openssl_client_npn_renegotiate(doc) ->
+ ["Test erlang server with openssl client and npn negotiation with renegotiation"];
+erlang_server_openssl_client_npn_renegotiate(suite) ->
+ [];
+erlang_server_openssl_client_npn_renegotiate(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, fun(Server, OpensslPort) ->
+ port_command(OpensslPort, ?OPENSSL_RENEGOTIATE),
+ test_server:sleep(?SLEEP),
+ port_command(OpensslPort, Data),
+ ssl_test_lib:check_result(Server, ok)
+ end),
+ ok.
+%%--------------------------------------------------------------------------
+
+erlang_client_openssl_server_npn_only_server(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_client_and_openssl_server_with_opts(Config, [], "-nextprotoneg spdy/2", Data, fun(Server, OpensslPort) ->
+ port_command(OpensslPort, Data),
+ ssl_test_lib:check_result(Server, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------------
+
+erlang_client_openssl_server_npn_only_client(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_client_and_openssl_server_with_opts(Config, [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}}], "", Data, fun(Server, OpensslPort) ->
+ port_command(OpensslPort, Data),
+ ssl_test_lib:check_result(Server, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------------
+erlang_server_openssl_client_npn_only_server(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_server_and_openssl_client_with_opts(Config, [{next_protocols_advertised, [<<"spdy/2">>]}], "", Data, fun(Server, OpensslPort) ->
+ port_command(OpensslPort, Data),
+ ssl_test_lib:check_result(Server, ok)
+ end),
+ ok.
+
+erlang_server_openssl_client_npn_only_client(Config) when is_list(Config) ->
+ Data = "From openssl to erlang",
+ start_erlang_server_and_openssl_client_with_opts(Config, [], "-nextprotoneg spdy/2", Data, fun(Server, OpensslPort) ->
+ port_command(OpensslPort, Data),
+ ssl_test_lib:check_result(Server, ok)
+ end),
+ ok.
+
+%%--------------------------------------------------------------------------
+
+start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, OpensslServerOpts, Data, Callback) ->
+ process_flag(trap_exit, true),
+ ServerOpts = ?config(server_opts, Config),
+ ClientOpts0 = ?config(client_opts, Config),
+ ClientOpts = ErlangClientOpts ++ ClientOpts0,
+
+ {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
+
+ Data = "From openssl to erlang",
+
+ Port = ssl_test_lib:inet_port(node()),
+ CertFile = proplists:get_value(certfile, ServerOpts),
+ KeyFile = proplists:get_value(keyfile, ServerOpts),
+ Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+
+ Cmd = "openssl s_server " ++ OpensslServerOpts ++ " -accept " ++
+ integer_to_list(Port) ++ version_flag(Version) ++
+ " -cert " ++ CertFile ++ " -key " ++ KeyFile,
+
+ test_server:format("openssl cmd: ~p~n", [Cmd]),
+
+ OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]),
+
+ wait_for_openssl_server(),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ erlang_ssl_receive, [Data]}},
+ {options, ClientOpts}]),
+
+ Callback(Client, OpensslPort),
+
+ %% Clean close down! Server needs to be closed first !!
+ close_port(OpensslPort),
+
+ ssl_test_lib:close(Client),
+ process_flag(trap_exit, false).
+
+start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callback) ->
+ process_flag(trap_exit, true),
+ ServerOpts = ?config(server_opts, Config),
+ ClientOpts0 = ?config(client_opts, Config),
+ ClientOpts = [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}} | ClientOpts0],
+
+ {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
+
+ Data = "From openssl to erlang",
+
+ Port = ssl_test_lib:inet_port(node()),
+ CertFile = proplists:get_value(certfile, ServerOpts),
+ KeyFile = proplists:get_value(keyfile, ServerOpts),
+ Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+
+ Cmd = "openssl s_server -msg -nextprotoneg http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++
+ " -cert " ++ CertFile ++ " -key " ++ KeyFile,
+
+ test_server:format("openssl cmd: ~p~n", [Cmd]),
+
+ OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]),
+
+ wait_for_openssl_server(),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ erlang_ssl_receive_and_assert_npn, [<<"spdy/2">>, Data]}},
+ {options, ClientOpts}]),
+
+ Callback(Client, OpensslPort),
+
+ %% Clean close down! Server needs to be closed first !!
+ close_port(OpensslPort),
+
+ ssl_test_lib:close(Client),
+ process_flag(trap_exit, false).
+
+start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callback) ->
+ process_flag(trap_exit, true),
+ ServerOpts0 = ?config(server_opts, Config),
+ ServerOpts = [{next_protocols_advertised, [<<"spdy/2">>]}, ServerOpts0],
+
+ {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, erlang_ssl_receive_and_assert_npn, [<<"spdy/2">>, Data]}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Cmd = "openssl s_client -nextprotoneg http/1.0,spdy/2 -msg -port " ++ integer_to_list(Port) ++ version_flag(Version) ++
+ " -host localhost",
+
+ test_server:format("openssl cmd: ~p~n", [Cmd]),
+
+ OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]),
+
+ Callback(Server, OpenSslPort),
+
+ ssl_test_lib:close(Server),
+
+ close_port(OpenSslPort),
+ process_flag(trap_exit, false).
+
+start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenSSLClientOpts, Data, Callback) ->
+ process_flag(trap_exit, true),
+ ServerOpts0 = ?config(server_opts, Config),
+ ServerOpts = ErlangServerOpts ++ ServerOpts0,
+
+ {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, erlang_ssl_receive, [Data]}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Cmd = "openssl s_client " ++ OpenSSLClientOpts ++ " -msg -port " ++ integer_to_list(Port) ++
+ " -host localhost",
+
+ test_server:format("openssl cmd: ~p~n", [Cmd]),
+
+ OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]),
+
+ Callback(Server, OpenSslPort),
+
+ ssl_test_lib:close(Server),
+
+ close_port(OpenSslPort),
+ process_flag(trap_exit, false).
+
+
+erlang_ssl_receive_and_assert_npn(Socket, Protocol, Data) ->
+ {ok, Protocol} = ssl:negotiated_next_protocol(Socket),
+ erlang_ssl_receive(Socket, Data),
+ {ok, Protocol} = ssl:negotiated_next_protocol(Socket),
+ ok.
erlang_ssl_receive(Socket, Data) ->
test_server:format("Connection info: ~p~n",
@@ -1168,6 +1431,15 @@ version_flag('tlsv1.2') ->
version_flag(sslv3) ->
" -ssl3 ".
+check_openssl_npn_support(Config) ->
+ HelpText = os:cmd("openssl s_client --help"),
+ case string:str(HelpText, "nextprotoneg") of
+ 0 ->
+ {skip, "Openssl not compiled with nextprotoneg support"};
+ _ ->
+ Config
+ end.
+
check_sane_openssl_renegotaite(Config) ->
case os:cmd("openssl version") of
"OpenSSL 0.9.8" ++ _ ->
diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml
index 7880bf8fbb..abaf64fb91 100644
--- a/lib/stdlib/doc/src/ets.xml
+++ b/lib/stdlib/doc/src/ets.xml
@@ -146,6 +146,10 @@
<desc><p>A match specification, see above.</p></desc>
</datatype>
<datatype>
+ <name name="comp_match_spec"/>
+ <desc><p>A compiled match specification.</p></desc>
+ </datatype>
+ <datatype>
<name name="match_pattern"/>
</datatype>
<datatype>
@@ -766,8 +770,6 @@ ets:is_compiled_ms(Broken).</code>
</func>
<func>
<name name="match_spec_compile" arity="1"/>
- <type name="comp_match_spec"/>
- <type_desc name="comp_match_spec">A compiled match specification.</type_desc>
<fsummary>Compiles a match specification into its internal representation</fsummary>
<desc>
<p>This function transforms a
@@ -791,8 +793,6 @@ ets:is_compiled_ms(Broken).</code>
</func>
<func>
<name name="match_spec_run" arity="2"/>
- <type name="comp_match_spec"/>
- <type_desc name="comp_match_spec">A compiled match specification.</type_desc>
<fsummary>Performs matching, using a compiled match_spec, on a list of tuples</fsummary>
<desc>
<p>This function executes the matching specified in a
diff --git a/lib/stdlib/doc/src/re.xml b/lib/stdlib/doc/src/re.xml
index c6f45fb1e1..2211bfb925 100644
--- a/lib/stdlib/doc/src/re.xml
+++ b/lib/stdlib/doc/src/re.xml
@@ -490,8 +490,8 @@ This option makes it possible to include comments inside complicated patterns. N
<p>The replacement string can contain the special character
<c>&amp;</c>, which inserts the whole matching expression in the
- result, and the special sequence <c>\</c>N (where N is an
- integer &gt; 0), resulting in the subexpression number N will be
+ result, and the special sequence <c>\</c>N (where N is an integer &gt; 0),
+ <c>\g</c>N or <c>\g{</c>N<c>}</c> resulting in the subexpression number N will be
inserted in the result. If no subexpression with that number is
generated by the regular expression, nothing is inserted.</p>
<p>To insert an <c>&amp;</c> or <c>\</c> in the result, precede it
diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl
index 0e95372a76..1ed3422bc5 100644
--- a/lib/stdlib/src/binary.erl
+++ b/lib/stdlib/src/binary.erl
@@ -21,7 +21,7 @@
%% Implemented in this module:
-export([split/2,split/3,replace/3,replace/4]).
--opaque cp() :: tuple().
+-opaque cp() :: {'am' | 'bm', binary()}.
-type part() :: {Start :: non_neg_integer(), Length :: integer()}.
%%% BIFs.
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index 97dacac0a4..1e5f962375 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -365,6 +365,12 @@ format_error(callback_wrong_arity) ->
format_error({imported_predefined_type, Name}) ->
io_lib:format("referring to built-in type ~w as a remote type; "
"please take out the module name", [Name]);
+format_error({not_exported_opaque, {TypeName, Arity}}) ->
+ io_lib:format("opaque type ~w~s is not exported",
+ [TypeName, gen_type_paren(Arity)]);
+format_error({underspecified_opaque, {TypeName, Arity}}) ->
+ io_lib:format("opaque type ~w~s is underspecified and therefore meaningless",
+ [TypeName, gen_type_paren(Arity)]);
%% --- obsolete? unused? ---
format_error({format_error, {Fmt, Args}}) ->
io_lib:format(Fmt, Args);
@@ -851,7 +857,8 @@ post_traversal_check(Forms, St0) ->
StC = check_untyped_records(Forms, StB),
StD = check_on_load(StC),
StE = check_unused_records(Forms, StD),
- check_callback_information(StE).
+ StF = check_local_opaque_types(StE),
+ check_callback_information(StF).
%% check_behaviour(State0) -> State
%% Check that the behaviour attribute is valid.
@@ -2554,15 +2561,24 @@ find_field(_F, []) -> error.
%% Attr :: 'type' | 'opaque'
%% Checks that a type definition is valid.
+-record(typeinfo, {attr, line}).
+
type_def(_Attr, _Line, {record, _RecName}, Fields, [], St0) ->
%% The record field names and such are checked in the record format.
%% We only need to check the types.
Types = [T || {typed_record_field, _, T} <- Fields],
check_type({type, -1, product, Types}, St0);
-type_def(_Attr, Line, TypeName, ProtoType, Args, St0) ->
+type_def(Attr, Line, TypeName, ProtoType, Args, St0) ->
TypeDefs = St0#lint.types,
Arity = length(Args),
TypePair = {TypeName, Arity},
+ Info = #typeinfo{attr = Attr, line = Line},
+ StoreType =
+ fun(St) ->
+ NewDefs = dict:store(TypePair, Info, TypeDefs),
+ CheckType = {type, -1, product, [ProtoType|Args]},
+ check_type(CheckType, St#lint{types=NewDefs})
+ end,
case (dict:is_key(TypePair, TypeDefs) orelse is_var_arity_type(TypeName)) of
true ->
case dict:is_key(TypePair, default_types()) of
@@ -2572,20 +2588,29 @@ type_def(_Attr, Line, TypeName, ProtoType, Args, St0) ->
true ->
Warn = {new_builtin_type, TypePair},
St1 = add_warning(Line, Warn, St0),
- NewDefs = dict:store(TypePair, Line, TypeDefs),
- CheckType = {type, -1, product, [ProtoType|Args]},
- check_type(CheckType, St1#lint{types=NewDefs});
+ StoreType(St1);
false ->
add_error(Line, {builtin_type, TypePair}, St0)
end;
false -> add_error(Line, {redefine_type, TypePair}, St0)
end;
false ->
- NewDefs = dict:store(TypePair, Line, TypeDefs),
- CheckType = {type, -1, product, [ProtoType|Args]},
- check_type(CheckType, St0#lint{types=NewDefs})
+ St1 = case
+ Attr =:= opaque andalso
+ is_underspecified(ProtoType, Arity)
+ of
+ true ->
+ Warn = {underspecified_opaque, TypePair},
+ add_warning(Line, Warn, St0);
+ false -> St0
+ end,
+ StoreType(St1)
end.
+is_underspecified({type,_,term,[]}, 0) -> true;
+is_underspecified({type,_,any,[]}, 0) -> true;
+is_underspecified(_ProtType, _Arity) -> false.
+
check_type(Types, St) ->
{SeenVars, St1} = check_type(Types, dict:new(), St),
dict:fold(fun(Var, {seen_once, Line}, AccSt) ->
@@ -2895,7 +2920,7 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) ->
fun(_Type, -1, AccSt) ->
%% Default type
AccSt;
- (Type, FileLine, AccSt) ->
+ (Type, #typeinfo{line = FileLine}, AccSt) ->
case loc(FileLine) of
{FirstFile, _} ->
case gb_sets:is_member(Type, UsedTypes) of
@@ -2914,6 +2939,24 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) ->
St
end.
+check_local_opaque_types(St) ->
+ #lint{types=Ts, exp_types=ExpTs} = St,
+ FoldFun =
+ fun(_Type, -1, AccSt) ->
+ %% Default type
+ AccSt;
+ (_Type, #typeinfo{attr = type}, AccSt) ->
+ AccSt;
+ (Type, #typeinfo{attr = opaque, line = FileLine}, AccSt) ->
+ case gb_sets:is_element(Type, ExpTs) of
+ true -> AccSt;
+ false ->
+ Warn = {not_exported_opaque,Type},
+ add_warning(FileLine, Warn, AccSt)
+ end
+ end,
+ dict:fold(FoldFun, St, Ts).
+
%% icrt_clauses(Clauses, In, ImportVarTable, State) ->
%% {NewVts,State}.
diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl
index 817b397cc4..ee6cff1b75 100644
--- a/lib/stdlib/src/ets.erl
+++ b/lib/stdlib/src/ets.erl
@@ -42,7 +42,7 @@
-export([i/0, i/1, i/2, i/3]).
--export_type([tab/0, tid/0, match_spec/0]).
+-export_type([tab/0, tid/0, match_spec/0, comp_match_spec/0]).
%%-----------------------------------------------------------------------------
@@ -445,7 +445,7 @@ update_element(_, _, _) ->
%%% End of BIFs
--opaque comp_match_spec() :: any(). %% this one is REALLY opaque
+-opaque comp_match_spec() :: binary(). %% this one is REALLY opaque
-spec match_spec_run(List, CompiledMatchSpec) -> list() when
List :: [tuple()],
diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl
index 0252cdf742..ab62b72519 100644
--- a/lib/stdlib/src/io_lib.erl
+++ b/lib/stdlib/src/io_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -82,7 +82,10 @@
-type chars() :: [char() | chars()].
-type depth() :: -1 | non_neg_integer().
--opaque continuation() :: {_, _, _, _}. % XXX: refine
+-opaque continuation() :: {Format :: string(),
+ Stack :: chars(),
+ Nchars :: non_neg_integer(),
+ Results :: [term()]}.
%%----------------------------------------------------------------------
diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl
index 359afc8c14..c5109ec455 100644
--- a/lib/stdlib/src/re.erl
+++ b/lib/stdlib/src/re.erl
@@ -409,6 +409,12 @@ apply_mlist(Subject,Replacement,Mlist) ->
precomp_repl(<<>>) ->
[];
+precomp_repl(<<$\\,$g,${,Rest/binary>>) when byte_size(Rest) > 0 ->
+ {NS, <<$},NRest/binary>>} = pick_int(Rest),
+ [list_to_integer(NS) | precomp_repl(NRest)];
+precomp_repl(<<$\\,$g,Rest/binary>>) when byte_size(Rest) > 0 ->
+ {NS,NRest} = pick_int(Rest),
+ [list_to_integer(NS) | precomp_repl(NRest)];
precomp_repl(<<$\\,X,Rest/binary>>) when X < $1 ; X > $9 ->
%% Escaped character
case precomp_repl(Rest) of
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index 944d8ebd6a..90a37f6441 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -50,7 +50,8 @@
unsafe_vars_try/1,
guard/1, otp_4886/1, otp_4988/1, otp_5091/1, otp_5276/1, otp_5338/1,
otp_5362/1, otp_5371/1, otp_7227/1, otp_5494/1, otp_5644/1, otp_5878/1,
- otp_5917/1, otp_6585/1, otp_6885/1, export_all/1,
+ otp_5917/1, otp_6585/1, otp_6885/1, otp_10436/1,
+ export_all/1,
bif_clash/1,
behaviour_basic/1, behaviour_multiple/1,
otp_7550/1,
@@ -80,7 +81,7 @@ all() ->
unsafe_vars, unsafe_vars2, unsafe_vars_try, guard,
otp_4886, otp_4988, otp_5091, otp_5276, otp_5338,
otp_5362, otp_5371, otp_7227, otp_5494, otp_5644,
- otp_5878, otp_5917, otp_6585, otp_6885, export_all,
+ otp_5878, otp_5917, otp_6585, otp_6885, otp_10436, export_all,
bif_clash, behaviour_basic, behaviour_multiple,
otp_7550, otp_8051, format_warn, {group, on_load},
too_many_arguments].
@@ -2386,6 +2387,28 @@ otp_6885(Config) when is_list(Config) ->
[]} = run_test2(Config, Ts, []),
ok.
+otp_10436(doc) ->
+ "OTP-6885. Warnings for opaque types.";
+otp_10436(suite) -> [];
+otp_10436(Config) when is_list(Config) ->
+ Ts = <<"-module(otp_10436).
+ -export_type([t1/0]).
+ -opaque t1() :: {i, integer()}.
+ -opaque t2() :: {a, atom()}.
+ ">>,
+ {warnings,[{4,erl_lint,{not_exported_opaque,{t2,0}}},
+ {4,erl_lint,{unused_type,{t2,0}}}]} =
+ run_test2(Config, Ts, []),
+ Ts2 = <<"-module(otp_10436_2).
+ -export_type([t1/0, t2/0]).
+ -opaque t1() :: term().
+ -opaque t2() :: any().
+ ">>,
+ {warnings,[{3,erl_lint,{underspecified_opaque,{t1,0}}},
+ {4,erl_lint,{underspecified_opaque,{t2,0}}}]} =
+ run_test2(Config, Ts2, []),
+ ok.
+
export_all(doc) ->
"OTP-7392. Warning for export_all.";
export_all(Config) when is_list(Config) ->
@@ -2834,10 +2857,10 @@ otp_8051(doc) ->
otp_8051(Config) when is_list(Config) ->
Ts = [{otp_8051,
<<"-opaque foo() :: bar().
+ -export_type([foo/0]).
">>,
[],
- {error,[{1,erl_lint,{undefined_type,{bar,0}}}],
- [{1,erl_lint,{unused_type,{foo,0}}}]}}],
+ {errors,[{1,erl_lint,{undefined_type,{bar,0}}}],[]}}],
?line [] = run(Config, Ts),
ok.
diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl
index a542745e67..8ee0a13f4c 100644
--- a/lib/stdlib/test/re_SUITE.erl
+++ b/lib/stdlib/test/re_SUITE.erl
@@ -328,6 +328,12 @@ replace_return(Config) when is_list(Config) ->
?line <<"iXk">> = re:replace("abcdefghijk","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\9X",[{return,binary}]),
?line <<"jXk">> = re:replace("abcdefghijk","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\10X",[{return,binary}]),
?line <<"Xk">> = re:replace("abcdefghijk","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\11X",[{return,binary}]),
+ ?line <<"9X1">> = re:replace("12345678901","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\g9X",[{return,binary}]),
+ ?line <<"0X1">> = re:replace("12345678901","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\g10X",[{return,binary}]),
+ ?line <<"X1">> = re:replace("12345678901","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\g11X",[{return,binary}]),
+ ?line <<"971">> = re:replace("12345678901","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\g{9}7",[{return,binary}]),
+ ?line <<"071">> = re:replace("12345678901","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\g{10}7",[{return,binary}]),
+ ?line <<"71">> = re:replace("12345678901","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\g{11}7",[{return,binary}]),
?line "a\x{400}bcX" = re:replace("a\x{400}bcd","d","X",[global,{return,list},unicode]),
?line <<"a",208,128,"bcX">> = re:replace("a\x{400}bcd","d","X",[global,{return,binary},unicode]),
?line "a\x{400}bcd" = re:replace("a\x{400}bcd","Z","X",[global,{return,list},unicode]),
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
index f7266e5632..88d86285d5 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/test_server/src/test_server_ctrl.erl
@@ -4686,21 +4686,16 @@ output_to_fd(stdout, Msg, Sender) ->
io:format("Testing ~s: ~s\n", [Name, lists:flatten(Msg)]);
output_to_fd(undefined, _Msg, _Sender) ->
ok;
-output_to_fd(Fd, [$=|Msg], internal) ->
- io:put_chars(Fd, [$=]),
- io:put_chars(Fd, Msg),
- io:put_chars(Fd, "\n");
+output_to_fd(Fd, Msg=[$=|_], internal) ->
+ io:put_chars(Fd, [Msg,"\n"]);
output_to_fd(Fd, Msg, internal) ->
- io:put_chars(Fd, [$=,$=,$=,$ ]),
- io:put_chars(Fd, Msg),
- io:put_chars(Fd, "\n");
+ io:put_chars(Fd, [$=,$=,$=,$ , Msg, "\n"]);
output_to_fd(Fd, Msg, _Sender) ->
- io:put_chars(Fd, Msg),
case get(test_server_log_nl) of
- false -> ok;
- _ -> io:put_chars(Fd, "\n")
+ false -> io:put_chars(Fd, Msg);
+ _ -> io:put_chars(Fd, [Msg,"\n"])
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -5834,11 +5829,11 @@ write_default_cross_coverlog(TestDir) ->
{ok,CrossCoverLog} =
file:open(filename:join(TestDir,?cross_coverlog_name), [write]),
write_coverlog_header(CrossCoverLog),
- io:fwrite(CrossCoverLog,
- ["No cross cover modules exist for this application,",
- xhtml("<br>","<br />"),
- "or cross cover analysis is not completed.\n"
- "</body></html>\n"], []),
+ io:put_chars(CrossCoverLog,
+ ["No cross cover modules exist for this application,",
+ xhtml("<br>","<br />"),
+ "or cross cover analysis is not completed.\n"
+ "</body></html>\n"]),
file:close(CrossCoverLog).
write_cover_result_table(CoverLog,Coverage) ->
diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl
index 9d111ff769..4a27c1ebae 100644
--- a/lib/test_server/src/test_server_sup.erl
+++ b/lib/test_server/src/test_server_sup.erl
@@ -473,10 +473,8 @@ getenv_any([]) -> "".
%%
%% Returns the OS family
get_os_family() ->
- case os:type() of
- {OsFamily,_OsName} -> OsFamily;
- OsFamily -> OsFamily
- end.
+ {OsFamily,_OsName} = os:type(),
+ OsFamily.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/system/doc/embedded/part.xml b/system/doc/embedded/part.xml
index abedce46d6..d96a94a1a0 100644
--- a/system/doc/embedded/part.xml
+++ b/system/doc/embedded/part.xml
@@ -45,6 +45,5 @@
</description>
<xi:include href="embedded_solaris.xml"/>
<xi:include href="embedded_nt.xml"/>
- <xi:include href="vxworks.xml"/>
</part>