aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/dialyzer/src/dialyzer_analysis_callgraph.erl7
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl104
-rw-r--r--lib/dialyzer/src/dialyzer_utils.erl35
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/big_external_type.erl526
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/big_local_type.erl523
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/para/myqueue.erl17
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/para/myqueue_params.erl15
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/keydel.erl29
-rw-r--r--lib/diameter/doc/src/diameter.xml12
-rw-r--r--lib/diameter/doc/src/notes.xml63
-rw-r--r--lib/diameter/include/diameter_gen.hrl56
-rw-r--r--lib/diameter/src/base/diameter_codec.erl21
-rw-r--r--lib/diameter/src/base/diameter_config.erl5
-rw-r--r--lib/diameter/src/base/diameter_lib.erl62
-rw-r--r--lib/diameter/src/base/diameter_peer.erl5
-rw-r--r--lib/diameter/src/base/diameter_peer_fsm.erl7
-rw-r--r--lib/diameter/src/base/diameter_reg.erl5
-rw-r--r--lib/diameter/src/base/diameter_service.erl9
-rw-r--r--lib/diameter/src/base/diameter_stats.erl18
-rw-r--r--lib/diameter/src/base/diameter_sync.erl5
-rw-r--r--lib/diameter/src/base/diameter_watchdog.erl51
-rw-r--r--lib/diameter/src/diameter.appup.src36
-rw-r--r--lib/diameter/src/info/diameter_info.erl7
-rw-r--r--lib/diameter/src/transport/diameter_sctp.erl3
-rw-r--r--lib/diameter/test/diameter_examples_SUITE.erl2
-rw-r--r--lib/diameter/test/diameter_gen_sctp_SUITE.erl8
-rw-r--r--lib/diameter/test/diameter_relay_SUITE.erl44
-rw-r--r--lib/diameter/test/diameter_stats_SUITE.erl6
-rw-r--r--lib/diameter/test/diameter_transport_SUITE.erl5
-rw-r--r--lib/diameter/test/diameter_util.erl16
-rw-r--r--lib/diameter/test/diameter_watchdog_SUITE.erl7
-rw-r--r--lib/diameter/vsn.mk2
-rw-r--r--lib/eunit/src/eunit_tty.erl2
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl8
-rw-r--r--lib/hipe/cerl/erl_types.erl500
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl10
-rw-r--r--lib/kernel/test/standard_error_SUITE.erl31
-rw-r--r--lib/mnesia/examples/bench/bench_generate.erl40
-rw-r--r--lib/mnesia/examples/mnesia_tpcb.erl39
-rw-r--r--lib/mnesia/test/mnesia_atomicity_test.erl4
-rw-r--r--lib/mnesia/test/mnesia_config_test.erl4
-rw-r--r--lib/mnesia/test/mnesia_cost.erl10
-rw-r--r--lib/mnesia/test/mnesia_dbn_meters.erl55
-rw-r--r--lib/mnesia/test/mnesia_evil_backup.erl2
-rw-r--r--lib/mnesia/test/mnesia_isolation_test.erl4
-rw-r--r--lib/mnesia/test/mnesia_test_lib.erl4
-rw-r--r--lib/mnesia/test/mnesia_tpcb.erl71
-rw-r--r--lib/odbc/doc/src/odbc.xml12
-rw-r--r--lib/odbc/src/odbc.erl9
-rw-r--r--lib/odbc/test/odbc_connect_SUITE.erl30
-rw-r--r--lib/public_key/doc/src/public_key.xml11
-rw-r--r--lib/runtime_tools/doc/src/notes.xml17
-rw-r--r--lib/runtime_tools/vsn.mk2
-rw-r--r--lib/ssh/doc/src/ssh.xml18
-rw-r--r--lib/ssh/src/Makefile76
-rw-r--r--lib/ssh/src/ssh.app.src1
-rw-r--r--lib/ssh/src/ssh.erl31
-rw-r--r--lib/ssh/src/ssh.hrl1
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl52
-rw-r--r--lib/ssh/src/ssh_math.erl42
-rw-r--r--lib/ssh/src/ssh_message.erl17
-rw-r--r--lib/ssh/src/ssh_transport.erl391
-rw-r--r--lib/ssh/src/ssh_transport.hrl61
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl134
-rw-r--r--lib/ssh/test/ssh_connection_SUITE.erl14
-rw-r--r--lib/ssh/test/ssh_protocol_SUITE.erl102
-rw-r--r--lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test3
-rw-r--r--lib/ssh/test/ssh_sftp_SUITE.erl191
-rw-r--r--lib/ssh/test/ssh_sftp_SUITE_data/sftp_tar_test_data_高兴/f3.txt1
-rw-r--r--lib/ssh/test/ssh_sftp_SUITE_data/sftp_tar_test_data_高兴/g四.txt1
-rw-r--r--lib/ssh/test/ssh_sftpd_SUITE.erl14
-rw-r--r--lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl6
-rw-r--r--lib/ssh/test/ssh_test_lib.erl22
-rw-r--r--lib/ssh/test/ssh_to_openssh_SUITE.erl152
-rw-r--r--lib/ssh/test/ssh_trpt_test_lib.erl129
-rw-r--r--lib/ssh/test/ssh_upgrade_SUITE.erl10
-rw-r--r--lib/ssl/doc/src/ssl.xml8
-rw-r--r--lib/stdlib/doc/src/ets.xml2
-rw-r--r--lib/stdlib/src/qlc_pt.erl8
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl15
-rw-r--r--lib/tools/doc/src/make.xml2
81 files changed, 3076 insertions, 1004 deletions
diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
index 76b43b6ff0..c57a22129c 100644
--- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
@@ -167,9 +167,12 @@ analysis_start(Parent, Analysis, LegalWarnings) ->
TmpCServer2 =
dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes,
TmpCServer1),
- TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2),
?timing(State#analysis_state.timing_server, "remote",
- dialyzer_contracts:process_contract_remote_types(TmpCServer3))
+ begin
+ TmpCServer3 =
+ dialyzer_utils:process_record_remote_types(TmpCServer2),
+ dialyzer_contracts:process_contract_remote_types(TmpCServer3)
+ end)
catch
throw:{error, _ErrorMsg} = Error -> exit(Error)
end,
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 0c29d524b5..7251de8b10 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -46,7 +46,7 @@
-type file_contract() :: {file_line(), #contract{}, Extra :: [_]}.
--type plt_contracts() :: [{mfa(), #contract{}}]. % actually, an orddict()
+-type plt_contracts() :: orddict:orddict(mfa(), #contract{}).
%%-----------------------------------------------------------------------
%% Internal record for contracts whose components have not been processed
@@ -395,22 +395,21 @@ insert_constraints([], Dict) -> Dict.
store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecDict, RecordsDict) ->
%% io:format("contract from form: ~p\n", [TypeSpec]),
- {Module, _, _} = MFA,
- TmpContract = contract_from_form(TypeSpec, Module, RecordsDict, FileLine),
+ TmpContract = contract_from_form(TypeSpec, MFA, RecordsDict, FileLine),
%% io:format("contract: ~p\n", [TmpContract]),
dict:store(MFA, {FileLine, TmpContract, Xtra}, SpecDict).
-contract_from_form(Forms, Module, RecDict, FileLine) ->
- {CFuns, Forms1} = contract_from_form(Forms, Module, RecDict, FileLine, [], []),
+contract_from_form(Forms, MFA, RecDict, FileLine) ->
+ {CFuns, Forms1} = contract_from_form(Forms, MFA, RecDict, FileLine, [], []),
#tmp_contract{contract_funs = CFuns, forms = Forms1}.
-contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], Module, RecDict,
+contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], MFA, RecDict,
FileLine, TypeAcc, FormAcc) ->
TypeFun =
fun(ExpTypes, AllRecords) ->
NewType =
try
- from_form_with_check(Form, ExpTypes, Module, AllRecords)
+ from_form_with_check(Form, ExpTypes, MFA, AllRecords)
catch
throw:{error, Msg} ->
{File, Line} = FileLine,
@@ -423,55 +422,55 @@ contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], Module, RecDict,
end,
NewTypeAcc = [TypeFun | TypeAcc],
NewFormAcc = [{Form, []} | FormAcc],
- contract_from_form(Left, Module, RecDict, FileLine, NewTypeAcc, NewFormAcc);
+ contract_from_form(Left, MFA, RecDict, FileLine, NewTypeAcc, NewFormAcc);
contract_from_form([{type, _L1, bounded_fun,
[{type, _L2, 'fun', [_, _]} = Form, Constr]}| Left],
- Module, RecDict, FileLine, TypeAcc, FormAcc) ->
+ MFA, RecDict, FileLine, TypeAcc, FormAcc) ->
TypeFun =
fun(ExpTypes, AllRecords) ->
{Constr1, VarDict} =
- process_constraints(Constr, Module, RecDict, ExpTypes, AllRecords),
- NewType = from_form_with_check(Form, ExpTypes, Module, AllRecords,
+ process_constraints(Constr, MFA, RecDict, ExpTypes, AllRecords),
+ NewType = from_form_with_check(Form, ExpTypes, MFA, AllRecords,
VarDict),
NewTypeNoVars = erl_types:subst_all_vars_to_any(NewType),
{NewTypeNoVars, Constr1}
end,
NewTypeAcc = [TypeFun | TypeAcc],
NewFormAcc = [{Form, Constr} | FormAcc],
- contract_from_form(Left, Module, RecDict, FileLine, NewTypeAcc, NewFormAcc);
-contract_from_form([], _Module, _RecDict, _FileLine, TypeAcc, FormAcc) ->
+ contract_from_form(Left, MFA, RecDict, FileLine, NewTypeAcc, NewFormAcc);
+contract_from_form([], _MFA, _RecDict, _FileLine, TypeAcc, FormAcc) ->
{lists:reverse(TypeAcc), lists:reverse(FormAcc)}.
-process_constraints(Constrs, Module, RecDict, ExpTypes, AllRecords) ->
- Init0 = initialize_constraints(Constrs, Module, RecDict, ExpTypes, AllRecords),
+process_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords) ->
+ Init0 = initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords),
Init = remove_cycles(Init0),
- constraints_fixpoint(Init, Module, RecDict, ExpTypes, AllRecords).
+ constraints_fixpoint(Init, MFA, RecDict, ExpTypes, AllRecords).
-initialize_constraints(Constrs, Module, RecDict, ExpTypes, AllRecords) ->
- initialize_constraints(Constrs, Module, RecDict, ExpTypes, AllRecords, []).
+initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords) ->
+ initialize_constraints(Constrs, MFA, RecDict, ExpTypes, AllRecords, []).
-initialize_constraints([], _Module, _RecDict, _ExpTypes, _AllRecords, Acc) ->
+initialize_constraints([], _MFA, _RecDict, _ExpTypes, _AllRecords, Acc) ->
Acc;
-initialize_constraints([Constr|Rest], Module, RecDict, ExpTypes, AllRecords, Acc) ->
+initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, AllRecords, Acc) ->
case Constr of
{type, _, constraint, [{atom, _, is_subtype}, [Type1, Type2]]} ->
- T1 = final_form(Type1, ExpTypes, Module, AllRecords, dict:new()),
+ T1 = final_form(Type1, ExpTypes, MFA, AllRecords, dict:new()),
Entry = {T1, Type2},
- initialize_constraints(Rest, Module, RecDict, ExpTypes, AllRecords, [Entry|Acc]);
+ initialize_constraints(Rest, MFA, RecDict, ExpTypes, AllRecords, [Entry|Acc]);
{type, _, constraint, [{atom,_,Name}, List]} ->
N = length(List),
throw({error,
io_lib:format("Unsupported type guard ~w/~w\n", [Name, N])})
end.
-constraints_fixpoint(Constrs, Module, RecDict, ExpTypes, AllRecords) ->
+constraints_fixpoint(Constrs, MFA, RecDict, ExpTypes, AllRecords) ->
VarDict =
- constraints_to_dict(Constrs, Module, RecDict, ExpTypes, AllRecords, dict:new()),
- constraints_fixpoint(VarDict, Module, Constrs, RecDict, ExpTypes, AllRecords).
+ constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, dict:new()),
+ constraints_fixpoint(VarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords).
-constraints_fixpoint(OldVarDict, Module, Constrs, RecDict, ExpTypes, AllRecords) ->
+constraints_fixpoint(OldVarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords) ->
NewVarDict =
- constraints_to_dict(Constrs, Module, RecDict, ExpTypes, AllRecords, OldVarDict),
+ constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, OldVarDict),
case NewVarDict of
OldVarDict ->
DictFold =
@@ -481,33 +480,33 @@ constraints_fixpoint(OldVarDict, Module, Constrs, RecDict, ExpTypes, AllRecords)
FinalConstrs = dict:fold(DictFold, [], NewVarDict),
{FinalConstrs, NewVarDict};
_Other ->
- constraints_fixpoint(NewVarDict, Module, Constrs, RecDict, ExpTypes, AllRecords)
+ constraints_fixpoint(NewVarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords)
end.
-final_form(Form, ExpTypes, Module, AllRecords, VarDict) ->
- from_form_with_check(Form, ExpTypes, Module, AllRecords, VarDict).
+final_form(Form, ExpTypes, MFA, AllRecords, VarDict) ->
+ from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarDict).
-from_form_with_check(Form, ExpTypes, Module, AllRecords) ->
- erl_types:t_check_record_fields(Form, ExpTypes, Module, AllRecords),
- erl_types:t_from_form(Form, ExpTypes, Module, AllRecords).
+from_form_with_check(Form, ExpTypes, MFA, AllRecords) ->
+ from_form_with_check(Form, ExpTypes, MFA, AllRecords, dict:new()).
-from_form_with_check(Form, ExpTypes, Module, AllRecords, VarDict) ->
- erl_types:t_check_record_fields(Form, ExpTypes, Module, AllRecords,
+from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarDict) ->
+ Site = {spec, MFA},
+ erl_types:t_check_record_fields(Form, ExpTypes, Site, AllRecords,
VarDict),
- erl_types:t_from_form(Form, ExpTypes, Module, AllRecords, VarDict).
+ erl_types:t_from_form(Form, ExpTypes, Site, AllRecords, VarDict).
-constraints_to_dict(Constrs, Module, RecDict, ExpTypes, AllRecords, VarDict) ->
+constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, VarDict) ->
Subtypes =
- constraints_to_subs(Constrs, Module, RecDict, ExpTypes, AllRecords, VarDict, []),
+ constraints_to_subs(Constrs, MFA, RecDict, ExpTypes, AllRecords, VarDict, []),
insert_constraints(Subtypes, dict:new()).
-constraints_to_subs([], _Module, _RecDict, _ExpTypes, _AllRecords, _VarDict, Acc) ->
+constraints_to_subs([], _MFA, _RecDict, _ExpTypes, _AllRecords, _VarDict, Acc) ->
Acc;
-constraints_to_subs([C|Rest], Module, RecDict, ExpTypes, AllRecords, VarDict, Acc) ->
+constraints_to_subs([C|Rest], MFA, RecDict, ExpTypes, AllRecords, VarDict, Acc) ->
{T1, Form2} = C,
- T2 = final_form(Form2, ExpTypes, Module, AllRecords, VarDict),
+ T2 = final_form(Form2, ExpTypes, MFA, AllRecords, VarDict),
NewAcc = [{subtype, T1, T2}|Acc],
- constraints_to_subs(Rest, Module, RecDict, ExpTypes, AllRecords, VarDict, NewAcc).
+ constraints_to_subs(Rest, MFA, RecDict, ExpTypes, AllRecords, VarDict, NewAcc).
%% Replaces variables with '_' when necessary to break up cycles among
%% the constraints.
@@ -630,7 +629,7 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left],
{error, {extra_range, ExtraRanges, STRange}} ->
Warn =
case t_from_forms_without_remote(Contract#contract.forms,
- RecDict) of
+ MFA, RecDict) of
{ok, NoRemoteType} ->
CRet = erl_types:t_fun_range(NoRemoteType),
erl_types:t_is_subtype(ExtraRanges, CRet);
@@ -705,7 +704,7 @@ picky_contract_check(CSig0, Sig0, MFA, WarningInfo, Contract, RecDict, Acc) ->
end
end.
-extra_contract_warning({M, F, A}, WarningInfo, Contract, CSig, Sig, RecDict) ->
+extra_contract_warning(MFA, WarningInfo, Contract, CSig, Sig, RecDict) ->
%% We do not want to depend upon erl_types:t_to_string() possibly
%% hiding the contents of opaque types.
SigUnopaque = erl_types:t_unopaque(Sig),
@@ -717,11 +716,12 @@ extra_contract_warning({M, F, A}, WarningInfo, Contract, CSig, Sig, RecDict) ->
%% The only difference is in record fields containing 'undefined' or not.
IsUndefRecordFieldsRelated = SigString0 =:= ContractString0,
{IsRemoteTypesRelated, SubtypeRelation} =
- is_remote_types_related(Contract, CSig, Sig, RecDict),
+ is_remote_types_related(Contract, CSig, Sig, MFA, RecDict),
case IsUndefRecordFieldsRelated orelse IsRemoteTypesRelated of
true ->
no_warning;
false ->
+ {M, F, A} = MFA,
SigString = lists:flatten(dialyzer_utils:format_sig(Sig, RecDict)),
ContractString = contract_to_string(Contract),
{Tag, Msg} =
@@ -739,14 +739,15 @@ extra_contract_warning({M, F, A}, WarningInfo, Contract, CSig, Sig, RecDict) ->
{warning, {Tag, WarningInfo, Msg}}
end.
-is_remote_types_related(Contract, CSig, Sig, RecDict) ->
+is_remote_types_related(Contract, CSig, Sig, MFA, RecDict) ->
case erl_types:t_is_subtype(CSig, Sig) of
true ->
{false, contract_is_subtype};
false ->
case erl_types:t_is_subtype(Sig, CSig) of
true ->
- case t_from_forms_without_remote(Contract#contract.forms, RecDict) of
+ case t_from_forms_without_remote(Contract#contract.forms, MFA,
+ RecDict) of
{ok, NoRemoteTypeSig} ->
case blame_remote(CSig, NoRemoteTypeSig, Sig) of
true ->
@@ -762,13 +763,14 @@ is_remote_types_related(Contract, CSig, Sig, RecDict) ->
end
end.
-t_from_forms_without_remote([{FType, []}], RecDict) ->
- Type1 = erl_types:t_from_form_without_remote(FType, RecDict),
+t_from_forms_without_remote([{FType, []}], MFA, RecDict) ->
+ Site = {spec, MFA},
+ Type1 = erl_types:t_from_form_without_remote(FType, Site, RecDict),
{ok, erl_types:subst_all_vars_to_any(Type1)};
-t_from_forms_without_remote([{_FType, _Constrs}], _RecDict) ->
+t_from_forms_without_remote([{_FType, _Constrs}], _MFA, _RecDict) ->
%% 'When' constraints
unsupported;
-t_from_forms_without_remote(_Forms, _RecDict) ->
+t_from_forms_without_remote(_Forms, _MFA, _RecDict) ->
%% Lots of forms
unsupported.
diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index b585646fde..7fe982a992 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -304,15 +304,16 @@ process_record_remote_types(CServer) ->
RecordFun =
fun(Key, Value) ->
case Key of
- {record, _Name} ->
+ {record, Name} ->
FieldFun =
- fun(_Arity, Fields) ->
- [{Name, Field,
+ fun(Arity, Fields) ->
+ Site = {record, {Module, Name, Arity}},
+ [{FieldName, Field,
erl_types:t_from_form(Field,
TempExpTypes,
- Module,
+ Site,
TempRecords1)}
- || {Name, Field, _} <- Fields]
+ || {FieldName, Field, _} <- Fields]
end,
{FileLine, Fields} = Value,
{FileLine, orddict:map(FieldFun, Fields)};
@@ -340,9 +341,10 @@ process_opaque_types(TempRecords, TempExpTypes) ->
RecordFun =
fun(Key, Value) ->
case Key of
- {opaque, _Name, _NArgs} ->
+ {opaque, Name, NArgs} ->
{{_Module, _FileLine, Form, _ArgNames}=F, _Type} = Value,
- Type = erl_types:t_from_form(Form, TempExpTypes, Module,
+ Site = {type, {Module, Name, NArgs}},
+ Type = erl_types:t_from_form(Form, TempExpTypes, Site,
TempRecords),
{F, Type};
_Other -> Value
@@ -355,25 +357,28 @@ process_opaque_types(TempRecords, TempExpTypes) ->
check_record_fields(Records, TempExpTypes) ->
CheckFun =
fun({Module, Element}) ->
- CheckForm = fun(F) ->
- erl_types:t_check_record_fields(F, TempExpTypes,
- Module, Records)
+ CheckForm = fun(Form, Site) ->
+ erl_types:t_check_record_fields(Form, TempExpTypes,
+ Site, Records)
end,
ElemFun =
fun({Key, Value}) ->
case Key of
- {record, _Name} ->
+ {record, Name} ->
FieldFun =
- fun({_Arity, Fields}) ->
- _ = [ok = CheckForm(Field) || {_, Field, _} <- Fields],
+ fun({Arity, Fields}) ->
+ Site = {record, {Module, Name, Arity}},
+ _ = [ok = CheckForm(Field, Site) ||
+ {_, Field, _} <- Fields],
ok
end,
{FileLine, Fields} = Value,
Fun = fun() -> lists:foreach(FieldFun, Fields) end,
msg_with_position(Fun, FileLine);
- {_OpaqueOrType, _Name, _} ->
+ {_OpaqueOrType, Name, NArgs} ->
+ Site = {type, {Module, Name, NArgs}},
{{_Module, FileLine, Form, _ArgNames}, _Type} = Value,
- Fun = fun() -> ok = CheckForm(Form) end,
+ Fun = fun() -> ok = CheckForm(Form, Site) end,
msg_with_position(Fun, FileLine)
end
end,
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/big_external_type.erl b/lib/dialyzer/test/opaque_SUITE_data/src/big_external_type.erl
new file mode 100644
index 0000000000..d286a378ed
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/big_external_type.erl
@@ -0,0 +1,526 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2015. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%% A copy of small_SUITE_data/src/big_external_type.erl, where
+%%% abstract_expr() is opaque. The transformation of forms to types is
+%%% now much faster than it used to be, for this module.
+
+-module(big_external_type).
+
+-export([parse_form/1,parse_exprs/1,parse_term/1]).
+-export([normalise/1,tokens/1,tokens/2]).
+-export([inop_prec/1,preop_prec/1,func_prec/0,max_prec/0]).
+
+-export_type([abstract_clause/0, abstract_expr/0, abstract_form/0,
+ error_info/0]).
+
+%% Start of Abstract Format
+
+-type line() :: erl_anno:line().
+
+-export_type([af_record_index/0, af_record_field/1, af_record_name/0,
+ af_field_name/0, af_function_decl/0]).
+
+-export_type([af_module/0, af_export/0, af_import/0, af_fa_list/0,
+ af_compile/0, af_file/0, af_record_decl/0,
+ af_field_decl/0, af_wild_attribute/0,
+ af_record_update/1, af_catch/0, af_local_call/0,
+ af_remote_call/0, af_args/0, af_local_function/0,
+ af_remote_function/0, af_list_comprehension/0,
+ af_binary_comprehension/0, af_template/0,
+ af_qualifier_seq/0, af_qualifier/0, af_generator/0,
+ af_filter/0, af_block/0, af_if/0, af_case/0, af_try/0,
+ af_clause_seq/0, af_catch_clause_seq/0, af_receive/0,
+ af_local_fun/0, af_remote_fun/0, af_fun/0, af_query/0,
+ af_query_access/0, af_clause/0,
+ af_catch_clause/0, af_catch_pattern/0, af_catch_class/0,
+ af_body/0, af_guard_seq/0, af_guard/0, af_guard_test/0,
+ af_record_access/1, af_guard_call/0,
+ af_remote_guard_call/0, af_pattern/0, af_literal/0,
+ af_atom/0, af_lit_atom/1, af_integer/0, af_float/0,
+ af_string/0, af_match/1, af_variable/0,
+ af_anon_variable/0, af_tuple/1, af_nil/0, af_cons/1,
+ af_bin/1, af_binelement/1, af_binelement_size/0,
+ af_binary_op/1, af_binop/0, af_unary_op/1, af_unop/0]).
+
+-type abstract_form() :: ?MODULE:af_module()
+ | ?MODULE:af_export()
+ | ?MODULE:af_import()
+ | ?MODULE:af_compile()
+ | ?MODULE:af_file()
+ | ?MODULE:af_record_decl()
+ | ?MODULE:af_wild_attribute()
+ | ?MODULE:af_function_decl().
+
+-type af_module() :: {attribute, line(), module, module()}.
+
+-type af_export() :: {attribute, line(), export, ?MODULE:af_fa_list()}.
+
+-type af_import() :: {attribute, line(), import, ?MODULE:af_fa_list()}.
+
+-type af_fa_list() :: [{function(), arity()}].
+
+-type af_compile() :: {attribute, line(), compile, any()}.
+
+-type af_file() :: {attribute, line(), file, {string(), line()}}.
+
+-type af_record_decl() ::
+ {attribute, line(), record, ?MODULE:af_record_name(), [?MODULE:af_field_decl()]}.
+
+-type af_field_decl() :: {record_field, line(), ?MODULE:af_atom()}
+ | {record_field, line(), ?MODULE:af_atom(), ?MODULE:abstract_expr()}.
+
+%% Types and specs, among other things...
+-type af_wild_attribute() :: {attribute, line(), ?MODULE:af_atom(), any()}.
+
+-type af_function_decl() ::
+ {function, line(), function(), arity(), ?MODULE:af_clause_seq()}.
+
+-opaque abstract_expr() :: ?MODULE:af_literal()
+ | ?MODULE:af_match(?MODULE:abstract_expr())
+ | ?MODULE:af_variable()
+ | ?MODULE:af_tuple(?MODULE:abstract_expr())
+ | ?MODULE:af_nil()
+ | ?MODULE:af_cons(?MODULE:abstract_expr())
+ | ?MODULE:af_bin(?MODULE:abstract_expr())
+ | ?MODULE:af_binary_op(?MODULE:abstract_expr())
+ | ?MODULE:af_unary_op(?MODULE:abstract_expr())
+ | ?MODULE:af_record_access(?MODULE:abstract_expr())
+ | ?MODULE:af_record_update(?MODULE:abstract_expr())
+ | ?MODULE:af_record_index()
+ | ?MODULE:af_record_field(?MODULE:abstract_expr())
+ | ?MODULE:af_catch()
+ | ?MODULE:af_local_call()
+ | ?MODULE:af_remote_call()
+ | ?MODULE:af_list_comprehension()
+ | ?MODULE:af_binary_comprehension()
+ | ?MODULE:af_block()
+ | ?MODULE:af_if()
+ | ?MODULE:af_case()
+ | ?MODULE:af_try()
+ | ?MODULE:af_receive()
+ | ?MODULE:af_local_fun()
+ | ?MODULE:af_remote_fun()
+ | ?MODULE:af_fun()
+ | ?MODULE:af_query()
+ | ?MODULE:af_query_access().
+
+-type af_record_update(T) :: {record,
+ line(),
+ ?MODULE:abstract_expr(),
+ ?MODULE:af_record_name(),
+ [?MODULE:af_record_field(T)]}.
+
+-type af_catch() :: {'catch', line(), ?MODULE:abstract_expr()}.
+
+-type af_local_call() :: {call, line(), ?MODULE:af_local_function(), ?MODULE:af_args()}.
+
+-type af_remote_call() :: {call, line(), ?MODULE:af_remote_function(), ?MODULE:af_args()}.
+
+-type af_args() :: [?MODULE:abstract_expr()].
+
+-type af_local_function() :: ?MODULE:abstract_expr().
+
+-type af_remote_function() ::
+ {remote, line(), ?MODULE:abstract_expr(), ?MODULE:abstract_expr()}.
+
+-type af_list_comprehension() ::
+ {lc, line(), ?MODULE:af_template(), ?MODULE:af_qualifier_seq()}.
+
+-type af_binary_comprehension() ::
+ {bc, line(), ?MODULE:af_template(), ?MODULE:af_qualifier_seq()}.
+
+-type af_template() :: ?MODULE:abstract_expr().
+
+-type af_qualifier_seq() :: [?MODULE:af_qualifier()].
+
+-type af_qualifier() :: ?MODULE:af_generator() | ?MODULE:af_filter().
+
+-type af_generator() :: {generate, line(), ?MODULE:af_pattern(), ?MODULE:abstract_expr()}
+ | {b_generate, line(), ?MODULE:af_pattern(), ?MODULE:abstract_expr()}.
+
+-type af_filter() :: ?MODULE:abstract_expr().
+
+-type af_block() :: {block, line(), ?MODULE:af_body()}.
+
+-type af_if() :: {'if', line(), ?MODULE:af_clause_seq()}.
+
+-type af_case() :: {'case', line(), ?MODULE:abstract_expr(), ?MODULE:af_clause_seq()}.
+
+-type af_try() :: {'try',
+ line(),
+ ?MODULE:af_body(),
+ ?MODULE:af_clause_seq(),
+ ?MODULE:af_catch_clause_seq(),
+ ?MODULE:af_body()}.
+
+-type af_clause_seq() :: [?MODULE:af_clause(), ...].
+
+-type af_catch_clause_seq() :: [?MODULE:af_clause(), ...].
+
+-type af_receive() ::
+ {'receive', line(), ?MODULE:af_clause_seq()}
+ | {'receive', line(), ?MODULE:af_clause_seq(), ?MODULE:abstract_expr(), ?MODULE:af_body()}.
+
+-type af_local_fun() :: {'fun', line(), {function, function(), arity()}}.
+
+-type af_remote_fun() ::
+ {'fun', line(), {function, module(), function(), arity()}}
+ | {'fun', line(), {function, ?MODULE:af_atom(), ?MODULE:af_atom(), ?MODULE:af_integer()}}.
+
+-type af_fun() :: {'fun', line(), {clauses, ?MODULE:af_clause_seq()}}.
+
+-type af_query() :: {'query', line(), ?MODULE:af_list_comprehension()}.
+
+-type af_query_access() ::
+ {record_field, line(), ?MODULE:abstract_expr(), ?MODULE:af_field_name()}.
+
+-type abstract_clause() :: ?MODULE:af_clause() | ?MODULE:af_catch_clause().
+
+-type af_clause() ::
+ {clause, line(), [?MODULE:af_pattern()], ?MODULE:af_guard_seq(), ?MODULE:af_body()}.
+
+-type af_catch_clause() ::
+ {clause, line(), [?MODULE:af_catch_pattern()], ?MODULE:af_guard_seq(), ?MODULE:af_body()}.
+
+-type af_catch_pattern() ::
+ {?MODULE:af_catch_class(), ?MODULE:af_pattern(), ?MODULE:af_anon_variable()}.
+
+-type af_catch_class() ::
+ ?MODULE:af_variable()
+ | ?MODULE:af_lit_atom(throw) | ?MODULE:af_lit_atom(error) | ?MODULE:af_lit_atom(exit).
+
+-type af_body() :: [?MODULE:abstract_expr(), ...].
+
+-type af_guard_seq() :: [?MODULE:af_guard()].
+
+-type af_guard() :: [?MODULE:af_guard_test(), ...].
+
+-type af_guard_test() :: ?MODULE:af_literal()
+ | ?MODULE:af_variable()
+ | ?MODULE:af_tuple(?MODULE:af_guard_test())
+ | ?MODULE:af_nil()
+ | ?MODULE:af_cons(?MODULE:af_guard_test())
+ | ?MODULE:af_bin(?MODULE:af_guard_test())
+ | ?MODULE:af_binary_op(?MODULE:af_guard_test())
+ | ?MODULE:af_unary_op(?MODULE:af_guard_test())
+ | ?MODULE:af_record_access(?MODULE:af_guard_test())
+ | ?MODULE:af_record_index()
+ | ?MODULE:af_record_field(?MODULE:af_guard_test())
+ | ?MODULE:af_guard_call()
+ | ?MODULE:af_remote_guard_call().
+
+-type af_record_access(T) ::
+ {record, line(), ?MODULE:af_record_name(), [?MODULE:af_record_field(T)]}.
+
+-type af_guard_call() :: {call, line(), function(), [?MODULE:af_guard_test()]}.
+
+-type af_remote_guard_call() ::
+ {call, line(), atom(), ?MODULE:af_lit_atom(erlang), [?MODULE:af_guard_test()]}.
+
+-type af_pattern() :: ?MODULE:af_literal()
+ | ?MODULE:af_match(?MODULE:af_pattern())
+ | ?MODULE:af_variable()
+ | ?MODULE:af_anon_variable()
+ | ?MODULE:af_tuple(?MODULE:af_pattern())
+ | ?MODULE:af_nil()
+ | ?MODULE:af_cons(?MODULE:af_pattern())
+ | ?MODULE:af_bin(?MODULE:af_pattern())
+ | ?MODULE:af_binary_op(?MODULE:af_pattern())
+ | ?MODULE:af_unary_op(?MODULE:af_pattern())
+ | ?MODULE:af_record_index()
+ | ?MODULE:af_record_field(?MODULE:af_pattern()).
+
+-type af_literal() :: ?MODULE:af_atom() | ?MODULE:af_integer() | ?MODULE:af_float() | ?MODULE:af_string().
+
+-type af_atom() :: ?MODULE:af_lit_atom(atom()).
+
+-type af_lit_atom(A) :: {atom, line(), A}.
+
+-type af_integer() :: {integer, line(), non_neg_integer()}.
+
+-type af_float() :: {float, line(), float()}.
+
+-type af_string() :: {string, line(), [byte()]}.
+
+-type af_match(T) :: {match, line(), T, T}.
+
+-type af_variable() :: {var, line(), atom()}.
+
+-type af_anon_variable() :: {var, line(), '_'}.
+
+-type af_tuple(T) :: {tuple, line(), [T]}.
+
+-type af_nil() :: {nil, line()}.
+
+-type af_cons(T) :: {cons, line, T, T}.
+
+-type af_bin(T) :: {bin, line(), [?MODULE:af_binelement(T)]}.
+
+-type af_binelement(T) :: {bin_element,
+ line(),
+ T,
+ ?MODULE:af_binelement_size(),
+ type_specifier_list()}.
+
+-type af_binelement_size() :: default | ?MODULE:abstract_expr().
+
+-type af_binary_op(T) :: {op, line(), T, ?MODULE:af_binop(), T}.
+
+-type af_binop() :: '/' | '*' | 'div' | 'rem' | 'band' | 'and' | '+' | '-'
+ | 'bor' | 'bxor' | 'bsl' | 'bsr' | 'or' | 'xor' | '++'
+ | '--' | '==' | '/=' | '=<' | '<' | '>=' | '>' | '=:='
+ | '=/='.
+
+-type af_unary_op(T) :: {op, line(), ?MODULE:af_unop(), T}.
+
+-type af_unop() :: '+' | '*' | 'bnot' | 'not'.
+
+%% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}.
+-type type_specifier_list() :: default | [type_specifier(), ...].
+
+-type type_specifier() :: af_type()
+ | af_signedness()
+ | af_endianness()
+ | af_unit().
+
+-type af_type() :: integer
+ | float
+ | binary
+ | bytes
+ | bitstring
+ | bits
+ | utf8
+ | utf16
+ | utf32.
+
+-type af_signedness() :: signed | unsigned.
+
+-type af_endianness() :: big | little | native.
+
+-type af_unit() :: {unit, 1..256}.
+
+-type af_record_index() ::
+ {record_index, line(), af_record_name(), af_field_name()}.
+
+-type af_record_field(T) :: {record_field, line(), af_field_name(), T}.
+
+-type af_record_name() :: atom().
+
+-type af_field_name() :: atom().
+
+%% End of Abstract Format
+
+-type error_description() :: term().
+-type error_info() :: {erl_anno:line(), module(), error_description()}.
+-type token() :: {Tag :: atom(), Line :: erl_anno:line()}.
+
+%% mkop(Op, Arg) -> {op,Line,Op,Arg}.
+%% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}.
+
+-define(mkop2(L, OpPos, R),
+ begin
+ {Op,Pos} = OpPos,
+ {op,Pos,Op,L,R}
+ end).
+
+-define(mkop1(OpPos, A),
+ begin
+ {Op,Pos} = OpPos,
+ {op,Pos,Op,A}
+ end).
+
+%% keep track of line info in tokens
+-define(line(Tup), element(2, Tup)).
+
+%% Entry points compatible to old erl_parse.
+%% These really suck and are only here until Calle gets multiple
+%% entry points working.
+
+-spec parse_form(Tokens) -> {ok, AbsForm} | {error, ErrorInfo} when
+ Tokens :: [token()],
+ AbsForm :: abstract_form(),
+ ErrorInfo :: error_info().
+parse_form([{'-',L1},{atom,L2,spec}|Tokens]) ->
+ parse([{'-',L1},{'spec',L2}|Tokens]);
+parse_form([{'-',L1},{atom,L2,callback}|Tokens]) ->
+ parse([{'-',L1},{'callback',L2}|Tokens]);
+parse_form(Tokens) ->
+ parse(Tokens).
+
+-spec parse_exprs(Tokens) -> {ok, ExprList} | {error, ErrorInfo} when
+ Tokens :: [token()],
+ ExprList :: [abstract_expr()],
+ ErrorInfo :: error_info().
+parse_exprs(Tokens) ->
+ case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of
+ {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],Exprs}]}} ->
+ {ok,Exprs};
+ {error,_} = Err -> Err
+ end.
+
+-spec parse_term(Tokens) -> {ok, Term} | {error, ErrorInfo} when
+ Tokens :: [token()],
+ Term :: term(),
+ ErrorInfo :: error_info().
+parse_term(Tokens) ->
+ case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of
+ {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[Expr]}]}} ->
+ try normalise(Expr) of
+ Term -> {ok,Term}
+ catch
+ _:_R -> {error,{?line(Expr),?MODULE,"bad term"}}
+ end;
+ {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[_E1,E2|_Es]}]}} ->
+ {error,{?line(E2),?MODULE,"bad term"}};
+ {error,_} = Err -> Err
+ end.
+
+%% Convert between the abstract form of a term and a term.
+
+-spec normalise(AbsTerm) -> Data when
+ AbsTerm :: abstract_expr(),
+ Data :: term().
+normalise({char,_,C}) -> C;
+normalise({integer,_,I}) -> I;
+normalise({float,_,F}) -> F;
+normalise({atom,_,A}) -> A;
+normalise({string,_,S}) -> S;
+normalise({nil,_}) -> [];
+normalise({bin,_,Fs}) ->
+ {value, B, _} =
+ eval_bits:expr_grp(Fs, [],
+ fun(E, _) ->
+ {value, normalise(E), []}
+ end, [], true),
+ B;
+normalise({cons,_,Head,Tail}) ->
+ [normalise(Head)|normalise(Tail)];
+normalise({tuple,_,Args}) ->
+ list_to_tuple(normalise_list(Args));
+%% Atom dot-notation, as in 'foo.bar.baz'
+%% Special case for unary +/-.
+normalise({op,_,'+',{char,_,I}}) -> I;
+normalise({op,_,'+',{integer,_,I}}) -> I;
+normalise({op,_,'+',{float,_,F}}) -> F;
+normalise({op,_,'-',{char,_,I}}) -> -I; %Weird, but compatible!
+normalise({op,_,'-',{integer,_,I}}) -> -I;
+normalise({op,_,'-',{float,_,F}}) -> -F;
+normalise(X) -> erlang:error({badarg, X}).
+
+normalise_list([H|T]) ->
+ [normalise(H)|normalise_list(T)];
+normalise_list([]) ->
+ [].
+
+%% Generate a list of tokens representing the abstract term.
+
+-spec tokens(AbsTerm) -> Tokens when
+ AbsTerm :: abstract_expr(),
+ Tokens :: [token()].
+tokens(Abs) ->
+ tokens(Abs, []).
+
+-spec tokens(AbsTerm, MoreTokens) -> Tokens when
+ AbsTerm :: abstract_expr(),
+ MoreTokens :: [token()],
+ Tokens :: [token()].
+tokens({char,L,C}, More) -> [{char,L,C}|More];
+tokens({integer,L,N}, More) -> [{integer,L,N}|More];
+tokens({float,L,F}, More) -> [{float,L,F}|More];
+tokens({atom,L,A}, More) -> [{atom,L,A}|More];
+tokens({var,L,V}, More) -> [{var,L,V}|More];
+tokens({string,L,S}, More) -> [{string,L,S}|More];
+tokens({nil,L}, More) -> [{'[',L},{']',L}|More];
+tokens({cons,L,Head,Tail}, More) ->
+ [{'[',L}|tokens(Head, tokens_tail(Tail, More))];
+tokens({tuple,L,[]}, More) ->
+ [{'{',L},{'}',L}|More];
+tokens({tuple,L,[E|Es]}, More) ->
+ [{'{',L}|tokens(E, tokens_tuple(Es, ?line(E), More))].
+
+tokens_tail({cons,L,Head,Tail}, More) ->
+ [{',',L}|tokens(Head, tokens_tail(Tail, More))];
+tokens_tail({nil,L}, More) ->
+ [{']',L}|More];
+tokens_tail(Other, More) ->
+ L = ?line(Other),
+ [{'|',L}|tokens(Other, [{']',L}|More])].
+
+tokens_tuple([E|Es], Line, More) ->
+ [{',',Line}|tokens(E, tokens_tuple(Es, ?line(E), More))];
+tokens_tuple([], Line, More) ->
+ [{'}',Line}|More].
+
+%% Give the relative precedences of operators.
+
+inop_prec('=') -> {150,100,100};
+inop_prec('!') -> {150,100,100};
+inop_prec('orelse') -> {160,150,150};
+inop_prec('andalso') -> {200,160,160};
+inop_prec('==') -> {300,200,300};
+inop_prec('/=') -> {300,200,300};
+inop_prec('=<') -> {300,200,300};
+inop_prec('<') -> {300,200,300};
+inop_prec('>=') -> {300,200,300};
+inop_prec('>') -> {300,200,300};
+inop_prec('=:=') -> {300,200,300};
+inop_prec('=/=') -> {300,200,300};
+inop_prec('++') -> {400,300,300};
+inop_prec('--') -> {400,300,300};
+inop_prec('+') -> {400,400,500};
+inop_prec('-') -> {400,400,500};
+inop_prec('bor') -> {400,400,500};
+inop_prec('bxor') -> {400,400,500};
+inop_prec('bsl') -> {400,400,500};
+inop_prec('bsr') -> {400,400,500};
+inop_prec('or') -> {400,400,500};
+inop_prec('xor') -> {400,400,500};
+inop_prec('*') -> {500,500,600};
+inop_prec('/') -> {500,500,600};
+inop_prec('div') -> {500,500,600};
+inop_prec('rem') -> {500,500,600};
+inop_prec('band') -> {500,500,600};
+inop_prec('and') -> {500,500,600};
+inop_prec('#') -> {800,700,800};
+inop_prec(':') -> {900,800,900};
+inop_prec('.') -> {900,900,1000}.
+
+-type pre_op() :: 'catch' | '+' | '-' | 'bnot' | 'not' | '#'.
+
+-spec preop_prec(pre_op()) -> {0 | 600 | 700, 100 | 700 | 800}.
+
+preop_prec('catch') -> {0,100};
+preop_prec('+') -> {600,700};
+preop_prec('-') -> {600,700};
+preop_prec('bnot') -> {600,700};
+preop_prec('not') -> {600,700};
+preop_prec('#') -> {700,800}.
+
+-spec func_prec() -> {800,700}.
+
+func_prec() -> {800,700}.
+
+-spec max_prec() -> 1000.
+
+max_prec() -> 1000.
+
+parse(T) ->
+ bar:foo(T).
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/big_local_type.erl b/lib/dialyzer/test/opaque_SUITE_data/src/big_local_type.erl
new file mode 100644
index 0000000000..7daceb5260
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/big_local_type.erl
@@ -0,0 +1,523 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2015. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%% A copy of small_SUITE_data/src/big_local_type.erl, where
+%%% abstract_expr() is opaque. The transformation of forms to types is
+%%% now much faster than it used to be, for this module.
+
+-module(big_local_type).
+
+-export([parse_form/1,parse_exprs/1,parse_term/1]).
+-export([normalise/1,tokens/1,tokens/2]).
+-export([inop_prec/1,preop_prec/1,func_prec/0,max_prec/0]).
+
+-export_type([abstract_clause/0, abstract_expr/0, abstract_form/0,
+ error_info/0]).
+
+%% Start of Abstract Format
+
+-type line() :: erl_anno:line().
+
+-export_type([af_module/0, af_export/0, af_import/0, af_fa_list/0,
+ af_compile/0, af_file/0, af_record_decl/0,
+ af_field_decl/0, af_wild_attribute/0,
+ af_record_update/1, af_catch/0, af_local_call/0,
+ af_remote_call/0, af_args/0, af_local_function/0,
+ af_remote_function/0, af_list_comprehension/0,
+ af_binary_comprehension/0, af_template/0,
+ af_qualifier_seq/0, af_qualifier/0, af_generator/0,
+ af_filter/0, af_block/0, af_if/0, af_case/0, af_try/0,
+ af_clause_seq/0, af_catch_clause_seq/0, af_receive/0,
+ af_local_fun/0, af_remote_fun/0, af_fun/0, af_query/0,
+ af_query_access/0, af_clause/0,
+ af_catch_clause/0, af_catch_pattern/0, af_catch_class/0,
+ af_body/0, af_guard_seq/0, af_guard/0, af_guard_test/0,
+ af_record_access/1, af_guard_call/0,
+ af_remote_guard_call/0, af_pattern/0, af_literal/0,
+ af_atom/0, af_lit_atom/1, af_integer/0, af_float/0,
+ af_string/0, af_match/1, af_variable/0,
+ af_anon_variable/0, af_tuple/1, af_nil/0, af_cons/1,
+ af_bin/1, af_binelement/1, af_binelement_size/0,
+ af_binary_op/1, af_binop/0, af_unary_op/1, af_unop/0]).
+
+-type abstract_form() :: af_module()
+ | af_export()
+ | af_import()
+ | af_compile()
+ | af_file()
+ | af_record_decl()
+ | af_wild_attribute()
+ | af_function_decl().
+
+-type af_module() :: {attribute, line(), module, module()}.
+
+-type af_export() :: {attribute, line(), export, af_fa_list()}.
+
+-type af_import() :: {attribute, line(), import, af_fa_list()}.
+
+-type af_fa_list() :: [{function(), arity()}].
+
+-type af_compile() :: {attribute, line(), compile, any()}.
+
+-type af_file() :: {attribute, line(), file, {string(), line()}}.
+
+-type af_record_decl() ::
+ {attribute, line(), record, af_record_name(), [af_field_decl()]}.
+
+-type af_field_decl() :: {record_field, line(), af_atom()}
+ | {record_field, line(), af_atom(), abstract_expr()}.
+
+%% Types and specs, among other things...
+-type af_wild_attribute() :: {attribute, line(), af_atom(), any()}.
+
+-type af_function_decl() ::
+ {function, line(), function(), arity(), af_clause_seq()}.
+
+-opaque abstract_expr() :: af_literal()
+ | af_match(abstract_expr())
+ | af_variable()
+ | af_tuple(abstract_expr())
+ | af_nil()
+ | af_cons(abstract_expr())
+ | af_bin(abstract_expr())
+ | af_binary_op(abstract_expr())
+ | af_unary_op(abstract_expr())
+ | af_record_access(abstract_expr())
+ | af_record_update(abstract_expr())
+ | af_record_index()
+ | af_record_field(abstract_expr())
+ | af_catch()
+ | af_local_call()
+ | af_remote_call()
+ | af_list_comprehension()
+ | af_binary_comprehension()
+ | af_block()
+ | af_if()
+ | af_case()
+ | af_try()
+ | af_receive()
+ | af_local_fun()
+ | af_remote_fun()
+ | af_fun()
+ | af_query()
+ | af_query_access().
+
+-type af_record_update(T) :: {record,
+ line(),
+ abstract_expr(),
+ af_record_name(),
+ [af_record_field(T)]}.
+
+-type af_catch() :: {'catch', line(), abstract_expr()}.
+
+-type af_local_call() :: {call, line(), af_local_function(), af_args()}.
+
+-type af_remote_call() :: {call, line(), af_remote_function(), af_args()}.
+
+-type af_args() :: [abstract_expr()].
+
+-type af_local_function() :: abstract_expr().
+
+-type af_remote_function() ::
+ {remote, line(), abstract_expr(), abstract_expr()}.
+
+-type af_list_comprehension() ::
+ {lc, line(), af_template(), af_qualifier_seq()}.
+
+-type af_binary_comprehension() ::
+ {bc, line(), af_template(), af_qualifier_seq()}.
+
+-type af_template() :: abstract_expr().
+
+-type af_qualifier_seq() :: [af_qualifier()].
+
+-type af_qualifier() :: af_generator() | af_filter().
+
+-type af_generator() :: {generate, line(), af_pattern(), abstract_expr()}
+ | {b_generate, line(), af_pattern(), abstract_expr()}.
+
+-type af_filter() :: abstract_expr().
+
+-type af_block() :: {block, line(), af_body()}.
+
+-type af_if() :: {'if', line(), af_clause_seq()}.
+
+-type af_case() :: {'case', line(), abstract_expr(), af_clause_seq()}.
+
+-type af_try() :: {'try',
+ line(),
+ af_body(),
+ af_clause_seq(),
+ af_catch_clause_seq(),
+ af_body()}.
+
+-type af_clause_seq() :: [af_clause(), ...].
+
+-type af_catch_clause_seq() :: [af_clause(), ...].
+
+-type af_receive() ::
+ {'receive', line(), af_clause_seq()}
+ | {'receive', line(), af_clause_seq(), abstract_expr(), af_body()}.
+
+-type af_local_fun() :: {'fun', line(), {function, function(), arity()}}.
+
+-type af_remote_fun() ::
+ {'fun', line(), {function, module(), function(), arity()}}
+ | {'fun', line(), {function, af_atom(), af_atom(), af_integer()}}.
+
+-type af_fun() :: {'fun', line(), {clauses, af_clause_seq()}}.
+
+-type af_query() :: {'query', line(), af_list_comprehension()}.
+
+-type af_query_access() ::
+ {record_field, line(), abstract_expr(), af_field_name()}.
+
+-type abstract_clause() :: af_clause() | af_catch_clause().
+
+-type af_clause() ::
+ {clause, line(), [af_pattern()], af_guard_seq(), af_body()}.
+
+-type af_catch_clause() ::
+ {clause, line(), [af_catch_pattern()], af_guard_seq(), af_body()}.
+
+-type af_catch_pattern() ::
+ {af_catch_class(), af_pattern(), af_anon_variable()}.
+
+-type af_catch_class() ::
+ af_variable()
+ | af_lit_atom(throw) | af_lit_atom(error) | af_lit_atom(exit).
+
+-type af_body() :: [abstract_expr(), ...].
+
+-type af_guard_seq() :: [af_guard()].
+
+-type af_guard() :: [af_guard_test(), ...].
+
+-type af_guard_test() :: af_literal()
+ | af_variable()
+ | af_tuple(af_guard_test())
+ | af_nil()
+ | af_cons(af_guard_test())
+ | af_bin(af_guard_test())
+ | af_binary_op(af_guard_test())
+ | af_unary_op(af_guard_test())
+ | af_record_access(af_guard_test())
+ | af_record_index()
+ | af_record_field(af_guard_test())
+ | af_guard_call()
+ | af_remote_guard_call().
+
+-type af_record_access(T) ::
+ {record, line(), af_record_name(), [af_record_field(T)]}.
+
+-type af_guard_call() :: {call, line(), function(), [af_guard_test()]}.
+
+-type af_remote_guard_call() ::
+ {call, line(), atom(), af_lit_atom(erlang), [af_guard_test()]}.
+
+-type af_pattern() :: af_literal()
+ | af_match(af_pattern())
+ | af_variable()
+ | af_anon_variable()
+ | af_tuple(af_pattern())
+ | af_nil()
+ | af_cons(af_pattern())
+ | af_bin(af_pattern())
+ | af_binary_op(af_pattern())
+ | af_unary_op(af_pattern())
+ | af_record_index()
+ | af_record_field(af_pattern()).
+
+-type af_literal() :: af_atom() | af_integer() | af_float() | af_string().
+
+-type af_atom() :: af_lit_atom(atom()).
+
+-type af_lit_atom(A) :: {atom, line(), A}.
+
+-type af_integer() :: {integer, line(), non_neg_integer()}.
+
+-type af_float() :: {float, line(), float()}.
+
+-type af_string() :: {string, line(), [byte()]}.
+
+-type af_match(T) :: {match, line(), T, T}.
+
+-type af_variable() :: {var, line(), atom()}.
+
+-type af_anon_variable() :: {var, line(), '_'}.
+
+-type af_tuple(T) :: {tuple, line(), [T]}.
+
+-type af_nil() :: {nil, line()}.
+
+-type af_cons(T) :: {cons, line, T, T}.
+
+-type af_bin(T) :: {bin, line(), [af_binelement(T)]}.
+
+-type af_binelement(T) :: {bin_element,
+ line(),
+ T,
+ af_binelement_size(),
+ type_specifier_list()}.
+
+-type af_binelement_size() :: default | abstract_expr().
+
+-type af_binary_op(T) :: {op, line(), T, af_binop(), T}.
+
+-type af_binop() :: '/' | '*' | 'div' | 'rem' | 'band' | 'and' | '+' | '-'
+ | 'bor' | 'bxor' | 'bsl' | 'bsr' | 'or' | 'xor' | '++'
+ | '--' | '==' | '/=' | '=<' | '<' | '>=' | '>' | '=:='
+ | '=/='.
+
+-type af_unary_op(T) :: {op, line(), af_unop(), T}.
+
+-type af_unop() :: '+' | '*' | 'bnot' | 'not'.
+
+%% See also lib/stdlib/{src/erl_bits.erl,include/erl_bits.hrl}.
+-type type_specifier_list() :: default | [type_specifier(), ...].
+
+-type type_specifier() :: af_type()
+ | af_signedness()
+ | af_endianness()
+ | af_unit().
+
+-type af_type() :: integer
+ | float
+ | binary
+ | bytes
+ | bitstring
+ | bits
+ | utf8
+ | utf16
+ | utf32.
+
+-type af_signedness() :: signed | unsigned.
+
+-type af_endianness() :: big | little | native.
+
+-type af_unit() :: {unit, 1..256}.
+
+-type af_record_index() ::
+ {record_index, line(), af_record_name(), af_field_name()}.
+
+-type af_record_field(T) :: {record_field, line(), af_field_name(), T}.
+
+-type af_record_name() :: atom().
+
+-type af_field_name() :: atom().
+
+%% End of Abstract Format
+
+-type error_description() :: term().
+-type error_info() :: {erl_anno:line(), module(), error_description()}.
+-type token() :: {Tag :: atom(), Line :: erl_anno:line()}.
+
+%% mkop(Op, Arg) -> {op,Line,Op,Arg}.
+%% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}.
+
+-define(mkop2(L, OpPos, R),
+ begin
+ {Op,Pos} = OpPos,
+ {op,Pos,Op,L,R}
+ end).
+
+-define(mkop1(OpPos, A),
+ begin
+ {Op,Pos} = OpPos,
+ {op,Pos,Op,A}
+ end).
+
+%% keep track of line info in tokens
+-define(line(Tup), element(2, Tup)).
+
+%% Entry points compatible to old erl_parse.
+%% These really suck and are only here until Calle gets multiple
+%% entry points working.
+
+-spec parse_form(Tokens) -> {ok, AbsForm} | {error, ErrorInfo} when
+ Tokens :: [token()],
+ AbsForm :: abstract_form(),
+ ErrorInfo :: error_info().
+parse_form([{'-',L1},{atom,L2,spec}|Tokens]) ->
+ parse([{'-',L1},{'spec',L2}|Tokens]);
+parse_form([{'-',L1},{atom,L2,callback}|Tokens]) ->
+ parse([{'-',L1},{'callback',L2}|Tokens]);
+parse_form(Tokens) ->
+ parse(Tokens).
+
+-spec parse_exprs(Tokens) -> {ok, ExprList} | {error, ErrorInfo} when
+ Tokens :: [token()],
+ ExprList :: [abstract_expr()],
+ ErrorInfo :: error_info().
+parse_exprs(Tokens) ->
+ case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of
+ {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],Exprs}]}} ->
+ {ok,Exprs};
+ {error,_} = Err -> Err
+ end.
+
+-spec parse_term(Tokens) -> {ok, Term} | {error, ErrorInfo} when
+ Tokens :: [token()],
+ Term :: term(),
+ ErrorInfo :: error_info().
+parse_term(Tokens) ->
+ case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of
+ {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[Expr]}]}} ->
+ try normalise(Expr) of
+ Term -> {ok,Term}
+ catch
+ _:_R -> {error,{?line(Expr),?MODULE,"bad term"}}
+ end;
+ {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[_E1,E2|_Es]}]}} ->
+ {error,{?line(E2),?MODULE,"bad term"}};
+ {error,_} = Err -> Err
+ end.
+
+%% Convert between the abstract form of a term and a term.
+
+-spec normalise(AbsTerm) -> Data when
+ AbsTerm :: abstract_expr(),
+ Data :: term().
+normalise({char,_,C}) -> C;
+normalise({integer,_,I}) -> I;
+normalise({float,_,F}) -> F;
+normalise({atom,_,A}) -> A;
+normalise({string,_,S}) -> S;
+normalise({nil,_}) -> [];
+normalise({bin,_,Fs}) ->
+ {value, B, _} =
+ eval_bits:expr_grp(Fs, [],
+ fun(E, _) ->
+ {value, normalise(E), []}
+ end, [], true),
+ B;
+normalise({cons,_,Head,Tail}) ->
+ [normalise(Head)|normalise(Tail)];
+normalise({tuple,_,Args}) ->
+ list_to_tuple(normalise_list(Args));
+%% Atom dot-notation, as in 'foo.bar.baz'
+%% Special case for unary +/-.
+normalise({op,_,'+',{char,_,I}}) -> I;
+normalise({op,_,'+',{integer,_,I}}) -> I;
+normalise({op,_,'+',{float,_,F}}) -> F;
+normalise({op,_,'-',{char,_,I}}) -> -I; %Weird, but compatible!
+normalise({op,_,'-',{integer,_,I}}) -> -I;
+normalise({op,_,'-',{float,_,F}}) -> -F;
+normalise(X) -> erlang:error({badarg, X}).
+
+normalise_list([H|T]) ->
+ [normalise(H)|normalise_list(T)];
+normalise_list([]) ->
+ [].
+
+%% Generate a list of tokens representing the abstract term.
+
+-spec tokens(AbsTerm) -> Tokens when
+ AbsTerm :: abstract_expr(),
+ Tokens :: [token()].
+tokens(Abs) ->
+ tokens(Abs, []).
+
+-spec tokens(AbsTerm, MoreTokens) -> Tokens when
+ AbsTerm :: abstract_expr(),
+ MoreTokens :: [token()],
+ Tokens :: [token()].
+tokens({char,L,C}, More) -> [{char,L,C}|More];
+tokens({integer,L,N}, More) -> [{integer,L,N}|More];
+tokens({float,L,F}, More) -> [{float,L,F}|More];
+tokens({atom,L,A}, More) -> [{atom,L,A}|More];
+tokens({var,L,V}, More) -> [{var,L,V}|More];
+tokens({string,L,S}, More) -> [{string,L,S}|More];
+tokens({nil,L}, More) -> [{'[',L},{']',L}|More];
+tokens({cons,L,Head,Tail}, More) ->
+ [{'[',L}|tokens(Head, tokens_tail(Tail, More))];
+tokens({tuple,L,[]}, More) ->
+ [{'{',L},{'}',L}|More];
+tokens({tuple,L,[E|Es]}, More) ->
+ [{'{',L}|tokens(E, tokens_tuple(Es, ?line(E), More))].
+
+tokens_tail({cons,L,Head,Tail}, More) ->
+ [{',',L}|tokens(Head, tokens_tail(Tail, More))];
+tokens_tail({nil,L}, More) ->
+ [{']',L}|More];
+tokens_tail(Other, More) ->
+ L = ?line(Other),
+ [{'|',L}|tokens(Other, [{']',L}|More])].
+
+tokens_tuple([E|Es], Line, More) ->
+ [{',',Line}|tokens(E, tokens_tuple(Es, ?line(E), More))];
+tokens_tuple([], Line, More) ->
+ [{'}',Line}|More].
+
+%% Give the relative precedences of operators.
+
+inop_prec('=') -> {150,100,100};
+inop_prec('!') -> {150,100,100};
+inop_prec('orelse') -> {160,150,150};
+inop_prec('andalso') -> {200,160,160};
+inop_prec('==') -> {300,200,300};
+inop_prec('/=') -> {300,200,300};
+inop_prec('=<') -> {300,200,300};
+inop_prec('<') -> {300,200,300};
+inop_prec('>=') -> {300,200,300};
+inop_prec('>') -> {300,200,300};
+inop_prec('=:=') -> {300,200,300};
+inop_prec('=/=') -> {300,200,300};
+inop_prec('++') -> {400,300,300};
+inop_prec('--') -> {400,300,300};
+inop_prec('+') -> {400,400,500};
+inop_prec('-') -> {400,400,500};
+inop_prec('bor') -> {400,400,500};
+inop_prec('bxor') -> {400,400,500};
+inop_prec('bsl') -> {400,400,500};
+inop_prec('bsr') -> {400,400,500};
+inop_prec('or') -> {400,400,500};
+inop_prec('xor') -> {400,400,500};
+inop_prec('*') -> {500,500,600};
+inop_prec('/') -> {500,500,600};
+inop_prec('div') -> {500,500,600};
+inop_prec('rem') -> {500,500,600};
+inop_prec('band') -> {500,500,600};
+inop_prec('and') -> {500,500,600};
+inop_prec('#') -> {800,700,800};
+inop_prec(':') -> {900,800,900};
+inop_prec('.') -> {900,900,1000}.
+
+-type pre_op() :: 'catch' | '+' | '-' | 'bnot' | 'not' | '#'.
+
+-spec preop_prec(pre_op()) -> {0 | 600 | 700, 100 | 700 | 800}.
+
+preop_prec('catch') -> {0,100};
+preop_prec('+') -> {600,700};
+preop_prec('-') -> {600,700};
+preop_prec('bnot') -> {600,700};
+preop_prec('not') -> {600,700};
+preop_prec('#') -> {700,800}.
+
+-spec func_prec() -> {800,700}.
+
+func_prec() -> {800,700}.
+
+-spec max_prec() -> 1000.
+
+max_prec() -> 1000.
+
+parse(T) ->
+ bar:foo(T).
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/para/myqueue.erl b/lib/dialyzer/test/opaque_SUITE_data/src/para/myqueue.erl
new file mode 100644
index 0000000000..0f76680464
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/para/myqueue.erl
@@ -0,0 +1,17 @@
+-module(myqueue).
+
+-export([new/0, in/2]).
+
+-record(myqueue, {queue = queue:new() :: queue:queue({integer(), _})}).
+
+-opaque myqueue(Item) :: #myqueue{queue :: queue:queue({integer(), Item})}.
+
+-export_type([myqueue/1]).
+
+-spec new() -> myqueue(_).
+new() ->
+ #myqueue{queue=queue:new()}.
+
+-spec in(Item, myqueue(Item)) -> myqueue(Item).
+in(Item, #myqueue{queue=Q}) ->
+ #myqueue{queue=queue:in({1, Item}, Q)}.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/para/myqueue_params.erl b/lib/dialyzer/test/opaque_SUITE_data/src/para/myqueue_params.erl
new file mode 100644
index 0000000000..8d766b7804
--- /dev/null
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/para/myqueue_params.erl
@@ -0,0 +1,15 @@
+-module(myqueue_params).
+
+-export([new/0, in/2]).
+
+-record(myqueue_params, {myqueue = myqueue:new() :: myqueue:myqueue(integer())}).
+
+-type myqueue_params() :: #myqueue_params{myqueue ::
+ myqueue:myqueue(integer())}.
+-spec new() -> myqueue_params().
+new() ->
+ #myqueue_params{myqueue=myqueue:new()}.
+
+-spec in(integer(), myqueue_params()) -> myqueue_params().
+in(Item, #myqueue_params{myqueue=Q} = P) when is_integer(Item) ->
+ P#myqueue_params{myqueue=myqueue:in(Item, Q)}.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/keydel.erl b/lib/dialyzer/test/small_SUITE_data/src/keydel.erl
new file mode 100644
index 0000000000..18a5c0670c
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/keydel.erl
@@ -0,0 +1,29 @@
+-module(keydel).
+
+-export([store/3]).
+
+-record(att, {f}).
+
+-type attachment() :: list().
+
+-opaque att() :: #att{} | attachment().
+
+-spec store(atom(), any(), att()) -> att().
+store(Field, undefined, Att) when is_list(Att) ->
+ lists:keydelete(Field, 1, Att);
+store(Field, Value, Att) when is_list(Att) ->
+ lists:keystore(Field, 1, Att, {Field, Value});
+store(Field, Value, Att) ->
+ store(Field, Value, upgrade(Att)).
+
+
+-spec upgrade(#att{}) -> attachment().
+upgrade(#att{} = Att) ->
+ Map = lists:zip(
+ record_info(fields, att),
+ lists:seq(2, record_info(size, att))
+ ),
+ %% Don't store undefined elements since that is default
+ [{F, element(I, Att)} || {F, I} <- Map, element(I, Att) /= undefined];
+upgrade(Att) ->
+ Att.
diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 1e1206aa2d..47247bc2ff 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -795,14 +795,6 @@ Messages larger than the specified number of bytes are discarded.</p>
Defaults to <c>16777215</c>, the maximum value of the 24-bit Message
Length field in a Diameter Header.</p>
-<warning>
-<p>
-This option should be set to as low a value as is sufficient for the
-Diameter applications and peers in question, since decoding incoming
-messages from a malicious peer can otherwise generate significant
-load.</p>
-</warning>
-
</item>
<tag><c>{restrict_connections, false
@@ -1232,9 +1224,7 @@ is not the length of the message in question, as received over the
transport interface documented in &man_transport;.</p>
<p>
-If <c>exit</c> then a warning report is emitted and the parent of the
-transport process in question exits, which causes the transport
-process itself to exit as described in &man_transport;.
+If <c>exit</c> then the transport process in question exits.
If <c>handle</c> then the message is processed as usual, a resulting
&app_handle_request; or &app_handle_answer; callback (if one takes
place) indicating the <c>5015</c> error (DIAMETER_INVALID_MESSAGE_LENGTH).
diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml
index 299d4093da..c5f0d66f10 100644
--- a/lib/diameter/doc/src/notes.xml
+++ b/lib/diameter/doc/src/notes.xml
@@ -43,6 +43,67 @@ first.</p>
<!-- ===================================================================== -->
+<section><title>diameter 1.11</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Don't report 5005 (DIAMETER_AVP_MISSING) errors
+ unnecessarily.</p>
+ <p>
+ An AVP whose decode failed was reported as missing,
+ despite having been reported with another error as a
+ consequence of the failure.</p>
+ <p>
+ Own Id: OTP-12871</p>
+ </item>
+ <item>
+ <p>
+ Fix relay encode of nested, Grouped AVPs.</p>
+ <p>
+ A fault in OTP-12475 caused encode to fail if the first
+ AVP in a Grouped AVP was itself Grouped.</p>
+ <p>
+ Own Id: OTP-12879 Aux Id: OTP-12475 </p>
+ </item>
+ <item>
+ <p>
+ Improve decode performance.</p>
+ <p>
+ The time required to decode a message increased
+ quadratically with the number of AVPs in the worst case,
+ leading to extremely long execution times.</p>
+ <p>
+ Own Id: OTP-12891</p>
+ </item>
+ <item>
+ <p>
+ Match acceptable peer addresses case insensitively.</p>
+ <p>
+ Regular expressions passed in an 'accept' tuple to
+ diameter_tcp or diameter_sctp inappropriately matched
+ case.</p>
+ <p>
+ Own Id: OTP-12902</p>
+ </item>
+ <item>
+ <p>
+ Improve watchdog and statistics performance.</p>
+ <p>
+ Inefficient use of timers contributed to poor performance
+ at high load, as did ordering of the table statistics are
+ written to.</p>
+ <p>
+ Own Id: OTP-12912</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<!-- ===================================================================== -->
+
<section><title>diameter 1.10</title>
<section><title>Fixed Bugs and Malfunctions</title>
@@ -134,7 +195,7 @@ first.</p>
<item>
<p>
Change license text from Erlang Public License to Apache
- Public License v2</p>
+ Public License v2.</p>
<p>
Own Id: OTP-12845</p>
</item>
diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl
index a43ab4edb2..5624ee6626 100644
--- a/lib/diameter/include/diameter_gen.hrl
+++ b/lib/diameter/include/diameter_gen.hrl
@@ -186,9 +186,10 @@ decode_avps(Name, Recs) ->
= lists:foldl(fun(T,A) -> decode(Name, T, A) end,
{[], {newrec(Name), []}},
Recs),
- {Rec, Avps, Failed ++ missing(Rec, Name)}.
-%% Append 5005 errors so that a 5014 for the same AVP will take
-%% precedence in a Result-Code/Failed-AVP setting.
+ {Rec, Avps, Failed ++ missing(Rec, Name, Failed)}.
+%% Append 5005 errors so that errors are reported in the order
+%% encountered. Failed-AVP should typically contain the first
+%% encountered error accordg to the RFC.
newrec(Name) ->
'#new-'(name2rec(Name)).
@@ -201,20 +202,36 @@ newrec(Name) ->
%% Failed-AVP AVP SHOULD be included in the message. The Failed-AVP
%% AVP MUST contain an example of the missing AVP complete with the
%% Vendor-Id if applicable. The value field of the missing AVP
-%% should be of correct minimum length and contain zeroes.
-
-missing(Rec, Name) ->
- [{5005, empty_avp(F)} || F <- '#info-'(element(1, Rec), fields),
- A <- [avp_arity(Name, F)],
- false <- [have_arity(A, '#get-'(F, Rec))]].
+%% should be of correct minimum length and contain zeros.
+
+missing(Rec, Name, Failed) ->
+ Avps = lists:foldl(fun({_, #diameter_avp{code = C, vendor_id = V}}, A) ->
+ sets:add_element({C,V}, A)
+ end,
+ sets:new(),
+ Failed),
+ [{5005, A} || F <- '#info-'(element(1, Rec), fields),
+ not has_arity(avp_arity(Name, F), '#get-'(F, Rec)),
+ #diameter_avp{code = C, vendor_id = V}
+ = A <- [empty_avp(F)],
+ not sets:is_element({C,V}, Avps)].
%% Maximum arities have already been checked in building the record.
-have_arity({Min, _}, L) ->
- Min =< length(L);
-have_arity(N, V) ->
+has_arity({Min, _}, L) ->
+ has_prefix(Min, L);
+has_arity(N, V) ->
N /= 1 orelse V /= undefined.
+%% Compare a non-negative integer and the length of a list without
+%% computing the length.
+has_prefix(0, _) ->
+ true;
+has_prefix(_, []) ->
+ false;
+has_prefix(N, L) ->
+ has_prefix(N-1, tl(L)).
+
%% empty_avp/1
empty_avp(Name) ->
@@ -608,14 +625,17 @@ pack(undefined, 1, FieldName, Avp, Acc) ->
%% AVP MUST be included and contain a copy of the first instance of
%% the offending AVP that exceeded the maximum number of occurrences
%%
+
pack(_, 1, _, Avp, {Rec, Failed}) ->
{Rec, [{5009, Avp} | Failed]};
-pack(L, {_, Max}, _, Avp, {Rec, Failed})
- when length(L) == Max ->
- {Rec, [{5009, Avp} | Failed]};
-
-pack(L, _, FieldName, Avp, Acc) ->
- p(FieldName, fun(V) -> [V|L] end, Avp, Acc).
+pack(L, {_, Max}, FieldName, Avp, Acc) ->
+ case '*' /= Max andalso has_prefix(Max, L) of
+ true ->
+ {Rec, Failed} = Acc,
+ {Rec, [{5009, Avp} | Failed]};
+ false ->
+ p(FieldName, fun(V) -> [V|L] end, Avp, Acc)
+ end.
%% p/4
diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl
index 34276a1674..bcdc5b3005 100644
--- a/lib/diameter/src/base/diameter_codec.erl
+++ b/lib/diameter/src/base/diameter_codec.erl
@@ -657,16 +657,23 @@ split_data(Bin, Len) ->
%% The normal case here is data as an #diameter_avp{} list or an
%% iolist, which are the cases that generated codec modules use. The
-%% other case is as a convenience in the relay case in which the
+%% other cases are a convenience in the relay case in which the
%% dictionary doesn't know about specific AVP's.
-%% Grouped AVP whose components need packing ...
-pack_avp([#diameter_avp{} = A | Avps]) ->
- pack_avp(A#diameter_avp{data = Avps});
-pack_avp(#diameter_avp{data = [#diameter_avp{} | _] = Avps} = A) ->
- pack_avp(A#diameter_avp{data = encode_avps(Avps)});
+%% Decoded Grouped AVP with decoded components: ignore components
+%% since they're already encoded in the Grouped AVP.
+pack_avp([#diameter_avp{} = Grouped | _Components]) ->
+ pack_avp(Grouped);
-%% ... data as a type/value tuple ...
+%% Grouped AVP whose components need packing. It's intentional that
+%% this isn't equivalent to [Grouped | Components]: here the
+%% components need to be encoded before wrapping with the Grouped AVP,
+%% and the list is flat, nesting being accomplished in the data
+%% fields.
+pack_avp(#diameter_avp{data = [#diameter_avp{} | _] = Components} = Grouped) ->
+ pack_avp(Grouped#diameter_avp{data = encode_avps(Components)});
+
+%% Data as a type/value tuple ...
pack_avp(#diameter_avp{data = {Type, Value}} = A)
when is_atom(Type) ->
pack_avp(A#diameter_avp{data = diameter_types:Type(encode, Value)});
diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl
index 5ae4ff1f46..b7d8345b6c 100644
--- a/lib/diameter/src/base/diameter_config.erl
+++ b/lib/diameter/src/base/diameter_config.erl
@@ -38,8 +38,7 @@
-module(diameter_config).
-behaviour(gen_server).
--compile({no_auto_import, [monitor/2, now/0]}).
--import(diameter_lib, [now/0]).
+-compile({no_auto_import, [monitor/2]}).
-export([start_service/2,
stop_service/1,
@@ -70,7 +69,7 @@
-include("diameter_internal.hrl").
%% Server state.
--record(state, {id = now()}).
+-record(state, {id = diameter_lib:now()}).
%% Registered name of the server.
-define(SERVER, ?MODULE).
diff --git a/lib/diameter/src/base/diameter_lib.erl b/lib/diameter/src/base/diameter_lib.erl
index b5b37dcf62..43b0ca24ab 100644
--- a/lib/diameter/src/base/diameter_lib.erl
+++ b/lib/diameter/src/base/diameter_lib.erl
@@ -103,32 +103,18 @@ fmt(T) ->
%% # now/0
%% ---------------------------------------------------------------------------
--type timestamp() :: {non_neg_integer(), 0..999999, 0..999999}.
--type now() :: integer() %% monotonic time
- | timestamp().
-
-spec now()
- -> now().
-
-%% Use monotonic time if it exists, fall back to erlang:now()
-%% otherwise.
+ -> integer().
now() ->
- try
- erlang:monotonic_time()
- catch
- error: undef -> erlang:now()
- end.
+ erlang:monotonic_time().
%% ---------------------------------------------------------------------------
%% # timestamp/1
%% ---------------------------------------------------------------------------
--spec timestamp(NowT :: now())
- -> timestamp().
-
-timestamp({_,_,_} = T) -> %% erlang:now()
- T;
+-spec timestamp(integer())
+ -> erlang:timestamp().
timestamp(MonoT) -> %% monotonic time
MicroSecs = monotonic_to_microseconds(MonoT + erlang:time_offset()),
@@ -142,30 +128,27 @@ monotonic_to_microseconds(MonoT) ->
%% # now_diff/1
%% ---------------------------------------------------------------------------
--spec now_diff(NowT :: now())
+-spec now_diff(T0 :: integer())
-> {Hours, Mins, Secs, MicroSecs}
when Hours :: non_neg_integer(),
Mins :: 0..59,
Secs :: 0..59,
MicroSecs :: 0..999999.
-%% Return timer:now_diff(now(), NowT) as an {H, M, S, MicroS} tuple
-%% instead of as integer microseconds.
+%% Return time difference as an {H, M, S, MicroS} tuple instead of as
+%% integer microseconds.
-now_diff(Time) ->
- time(micro_diff(Time)).
+now_diff(T0) ->
+ time(micro_diff(T0)).
%% ---------------------------------------------------------------------------
%% # micro_diff/1
%% ---------------------------------------------------------------------------
--spec micro_diff(NowT :: now())
+-spec micro_diff(T0 :: integer())
-> MicroSecs
when MicroSecs :: non_neg_integer().
-micro_diff({_,_,_} = T0) ->
- timer:now_diff(erlang:now(), T0);
-
micro_diff(T0) -> %% monotonic time
monotonic_to_microseconds(erlang:monotonic_time() - T0).
@@ -173,16 +156,12 @@ micro_diff(T0) -> %% monotonic time
%% # micro_diff/2
%% ---------------------------------------------------------------------------
--spec micro_diff(T1 :: now(), T0 :: now())
+-spec micro_diff(T1 :: integer(), T0 :: integer())
-> MicroSecs
when MicroSecs :: non_neg_integer().
-micro_diff(T1, T0)
- when is_integer(T1), is_integer(T0) -> %% monotonic time
- monotonic_to_microseconds(T1 - T0);
-
-micro_diff(T1, T0) -> %% at least one erlang:now()
- timer:now_diff(timestamp(T1), timestamp(T0)).
+micro_diff(T1, T0) -> %% monotonic time
+ monotonic_to_microseconds(T1 - T0).
%% ---------------------------------------------------------------------------
%% # time/1
@@ -190,19 +169,13 @@ micro_diff(T1, T0) -> %% at least one erlang:now()
%% Return an elapsed time as an {H, M, S, MicroS} tuple.
%% ---------------------------------------------------------------------------
--spec time(NowT | Diff)
+-spec time(Diff :: non_neg_integer())
-> {Hours, Mins, Secs, MicroSecs}
- when NowT :: timestamp(),
- Diff :: non_neg_integer(),
- Hours :: non_neg_integer(),
+ when Hours :: non_neg_integer(),
Mins :: 0..59,
Secs :: 0..59,
MicroSecs :: 0..999999.
-time({_,_,_} = NowT) -> %% time of day
- %% 24 hours = 24*60*60*1000000 = 86400000000 microsec
- time(timer:now_diff(NowT, {0,0,0}) rem 86400000000);
-
time(Micro) -> %% elapsed time
Seconds = Micro div 1000000,
H = Seconds div 3600,
@@ -215,7 +188,7 @@ time(Micro) -> %% elapsed time
%% ---------------------------------------------------------------------------
-spec seed()
- -> {timestamp(), {integer(), integer(), integer()}}.
+ -> {erlang:timestamp(), {integer(), integer(), integer()}}.
%% Return an argument for random:seed/1.
@@ -225,9 +198,6 @@ seed() ->
%% seed/1
-seed({_,_,_} = T) ->
- T;
-
seed(T) -> %% monotonic time
{erlang:phash2(node()), T, erlang:unique_integer()}.
diff --git a/lib/diameter/src/base/diameter_peer.erl b/lib/diameter/src/base/diameter_peer.erl
index acec91c43f..2759f17e64 100644
--- a/lib/diameter/src/base/diameter_peer.erl
+++ b/lib/diameter/src/base/diameter_peer.erl
@@ -21,9 +21,6 @@
-module(diameter_peer).
-behaviour(gen_server).
--compile({no_auto_import, [now/0]}).
--import(diameter_lib, [now/0]).
-
%% Interface towards transport modules ...
-export([recv/2,
up/1,
@@ -60,7 +57,7 @@
-define(SERVER, ?MODULE).
%% Server state.
--record(state, {id = now()}).
+-record(state, {id = diameter_lib:now()}).
%% Default transport_module/config.
-define(DEFAULT_TMOD, diameter_tcp).
diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl
index f5e04d3eae..2b23183d18 100644
--- a/lib/diameter/src/base/diameter_peer_fsm.erl
+++ b/lib/diameter/src/base/diameter_peer_fsm.erl
@@ -315,7 +315,7 @@ handle_info(T, #state{} = State) ->
?LOG(stop, Reason),
{stop, {shutdown, Reason}, State};
stop ->
- ?LOG(stop, T),
+ ?LOG(stop, truncate(T)),
{stop, {shutdown, T}, State}
catch
exit: {diameter_codec, encode, T} = Reason ->
@@ -348,6 +348,11 @@ code_change(_, State, _) ->
%% ---------------------------------------------------------------------------
%% ---------------------------------------------------------------------------
+truncate({'DOWN' = T, _, process, Pid, _}) ->
+ {T, Pid};
+truncate(T) ->
+ T.
+
putr(Key, Val) ->
put({?MODULE, Key}, Val).
diff --git a/lib/diameter/src/base/diameter_reg.erl b/lib/diameter/src/base/diameter_reg.erl
index ce29baae45..7f198080ba 100644
--- a/lib/diameter/src/base/diameter_reg.erl
+++ b/lib/diameter/src/base/diameter_reg.erl
@@ -25,8 +25,7 @@
-module(diameter_reg).
-behaviour(gen_server).
--compile({no_auto_import, [monitor/2, now/0]}).
--import(diameter_lib, [now/0]).
+-compile({no_auto_import, [monitor/2]}).
-export([add/1,
add_new/1,
@@ -68,7 +67,7 @@
%% Table entry containing the Term -> Pid mapping.
-define(MAPPING(Term, Pid), {Term, Pid}).
--record(state, {id = now(),
+-record(state, {id = diameter_lib:now(),
q = []}). %% [{From, Pat}]
%% ===========================================================================
diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl
index 5cb7fa5abe..e47b975768 100644
--- a/lib/diameter/src/base/diameter_service.erl
+++ b/lib/diameter/src/base/diameter_service.erl
@@ -25,9 +25,6 @@
-module(diameter_service).
-behaviour(gen_server).
--compile({no_auto_import, [now/0]}).
--import(diameter_lib, [now/0]).
-
%% towards diameter_service_sup
-export([start_link/1]).
@@ -115,7 +112,7 @@
%% to determine whether or not we need to call the process for a
%% pick_peer callback in the statefull case.
-record(state,
- {id = now(),
+ {id = diameter_lib:now(),
service_name :: diameter:service_name(), %% key in ?STATE_TABLE
service :: #diameter_service{},
watchdogT = ets_new(watchdogs) %% #watchdog{} at start
@@ -144,7 +141,7 @@
ref :: match(reference()), %% key into diameter_config
options :: match([diameter:transport_opt()]),%% from start_transport
state = ?WD_INITIAL :: match(wd_state()),
- started = now(), %% at process start
+ started = diameter_lib:now(),%% at process start
peer = false :: match(boolean() | pid())}).
%% true at accepted, pid() at okay/reopen
@@ -154,7 +151,7 @@
{pid :: pid(),
apps :: [{0..16#FFFFFFFF, diameter:app_alias()}], %% {Id, Alias}
caps :: #diameter_caps{},
- started = now(), %% at process start
+ started = diameter_lib:now(), %% at process start
watchdog :: pid()}). %% key into watchdogT
%% ---------------------------------------------------------------------------
diff --git a/lib/diameter/src/base/diameter_stats.erl b/lib/diameter/src/base/diameter_stats.erl
index 83e562e7fe..8c10464e98 100644
--- a/lib/diameter/src/base/diameter_stats.erl
+++ b/lib/diameter/src/base/diameter_stats.erl
@@ -25,9 +25,6 @@
-module(diameter_stats).
-behaviour(gen_server).
--compile({no_auto_import, [now/0]}).
--import(diameter_lib, [now/0]).
-
-export([reg/2, reg/1,
incr/3, incr/1,
read/1,
@@ -61,7 +58,7 @@
-define(SERVER, ?MODULE).
%% Server state.
--record(state, {id = now()}).
+-record(state, {id = diameter_lib:now()}).
-type counter() :: any().
-type ref() :: any().
@@ -143,9 +140,14 @@ read(Refs, B) ->
L.
to_refdict(L) ->
- lists:foldl(fun({{C,R}, N}, D) -> orddict:append(R, {C,N}, D) end,
- orddict:new(),
- L).
+ lists:foldl(fun append/2, orddict:new(), L).
+
+%% Order both references and counters in the returned list.
+append({{Ctr, Ref}, N}, Dict) ->
+ orddict:update(Ref,
+ fun(D) -> orddict:store(Ctr, N, D) end,
+ [{Ctr, N}],
+ Dict).
%% ---------------------------------------------------------------------------
%% # sum(Refs)
@@ -221,7 +223,7 @@ uptime() ->
%% ----------------------------------------------------------
init([]) ->
- ets:new(?TABLE, [named_table, ordered_set, public]),
+ ets:new(?TABLE, [named_table, set, public, {write_concurrency, true}]),
{ok, #state{}}.
%% ----------------------------------------------------------
diff --git a/lib/diameter/src/base/diameter_sync.erl b/lib/diameter/src/base/diameter_sync.erl
index 3309224399..7fb6888e21 100644
--- a/lib/diameter/src/base/diameter_sync.erl
+++ b/lib/diameter/src/base/diameter_sync.erl
@@ -28,9 +28,6 @@
-module(diameter_sync).
-behaviour(gen_server).
--compile({no_auto_import, [now/0]}).
--import(diameter_lib, [now/0]).
-
-export([call/4, call/5,
cast/4, cast/5,
carp/1, carp/2]).
@@ -73,7 +70,7 @@
%% Server state.
-record(state,
- {time = now(),
+ {time = diameter_lib:now(),
pending = 0 :: non_neg_integer(), %% outstanding requests
monitor = new() :: ets:tid(), %% MonitorRef -> {Name, From}
queue = new() :: ets:tid()}). %% Name -> queue of {Pid, Ref}
diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl
index c6d0a0b6ed..3c0d8f6f6e 100644
--- a/lib/diameter/src/base/diameter_watchdog.erl
+++ b/lib/diameter/src/base/diameter_watchdog.erl
@@ -66,7 +66,9 @@
%% end PCB
parent = self() :: pid(), %% service process
transport :: pid() | undefined, %% peer_fsm process
- tref :: reference(), %% reference for current watchdog timer
+ tref :: reference() %% reference for current watchdog timer
+ | integer() %% monotonic time
+ | undefined,
dictionary :: module(), %% common dictionary
receive_data :: term(),
%% term passed into diameter_service with incoming message
@@ -94,7 +96,7 @@ start({_,_} = Type, T) ->
Ack = make_ref(),
{ok, Pid} = diameter_watchdog_sup:start_child({Ack, Type, self(), T}),
try
- {erlang:monitor(process, Pid), Pid}
+ {monitor(process, Pid), Pid}
after
send(Pid, Ack)
end.
@@ -121,7 +123,7 @@ i({Ack, T, Pid, {RecvData,
#diameter_service{applications = Apps,
capabilities = Caps}
= Svc}}) ->
- erlang:monitor(process, Pid),
+ monitor(process, Pid),
wait(Ack, Pid),
{_, Seed} = diameter_lib:seed(),
random:seed(Seed),
@@ -246,11 +248,16 @@ handle_info(T, #watchdog{} = State) ->
event(T, State, S), %% before 'watchdog'
{noreply, S};
stop ->
- ?LOG(stop, T),
+ ?LOG(stop, truncate(T)),
event(T, State, State#watchdog{status = down}),
{stop, {shutdown, T}, State}
end.
+truncate({'DOWN' = T, _, process, Pid, _}) ->
+ {T, Pid};
+truncate(T) ->
+ T.
+
close({'DOWN', _, process, TPid, {shutdown, Reason}},
#watchdog{transport = TPid,
parent = Pid}) ->
@@ -447,11 +454,12 @@ transition({recv, TPid, Name, Pkt}, #watchdog{transport = TPid} = S) ->
%% Current watchdog has timed out.
transition({timeout, TRef, tw}, #watchdog{tref = TRef} = S) ->
- set_watchdog(timeout(S));
+ set_watchdog(0, timeout(S));
-%% Timer was canceled after message was already sent.
-transition({timeout, _, tw}, #watchdog{}) ->
- ok;
+%% Message has arrived since the timer was started: subtract time
+%% already elapsed from new timer.
+transition({timeout, _, tw}, #watchdog{tref = T0} = S) ->
+ set_watchdog(diameter_lib:micro_diff(T0) div 1000, S);
%% State query.
transition({state, Pid}, #watchdog{status = S}) ->
@@ -527,18 +535,27 @@ role() ->
%% set_watchdog/1
-set_watchdog(#watchdog{tw = TwInit,
- tref = TRef}
- = S) ->
- cancel(TRef),
- S#watchdog{tref = erlang:start_timer(tw(TwInit), self(), tw)};
+%% Timer not yet set.
+set_watchdog(#watchdog{tref = undefined} = S) ->
+ set_watchdog(0, S);
+
+%% Timer already set: start at new one only at expiry.
+set_watchdog(#watchdog{} = S) ->
+ S#watchdog{tref = diameter_lib:now()};
+
set_watchdog(stop = No) ->
No.
-cancel(undefined) ->
- ok;
-cancel(TRef) ->
- erlang:cancel_timer(TRef).
+%% set_watchdog/2
+
+set_watchdog(Ms, #watchdog{tw = TwInit} = S) ->
+ S#watchdog{tref = erlang:start_timer(tw(TwInit, Ms), self(), tw)}.
+
+%% A callback could return anything, so ensure the result isn't
+%% negative. Don't prevent abuse, even though the smallest valid
+%% timeout is 4000.
+tw(TwInit, Ms) ->
+ max(tw(TwInit) - Ms, 0).
tw(T)
when is_integer(T), T >= 6000 ->
diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src
index 86d231179c..788ea790fa 100644
--- a/lib/diameter/src/diameter.appup.src
+++ b/lib/diameter/src/diameter.appup.src
@@ -42,7 +42,23 @@
{"1.8", [{restart_application, diameter}]}, %% 17.4
{"1.9", [{restart_application, diameter}]}, %% 17.5
{"1.9.1", [{restart_application, diameter}]}, %% 17.5.3
- {"1.9.2", [{restart_application, diameter}]} %% 17.5.5
+ {"1.9.2", [{restart_application, diameter}]}, %% 17.5.5
+ {"1.9.2.1", [{restart_application, diameter}]}, %% 17.5.6.3
+ {"1.10", [{load_module, diameter_codec}, %% 18.0
+ {load_module, diameter_peer_fsm},
+ {load_module, diameter_watchdog},
+ {load_module, diameter_stats},
+ {load_module, diameter_config},
+ {load_module, diameter_lib},
+ {load_module, diameter_peer},
+ {load_module, diameter_reg},
+ {load_module, diameter_service},
+ {load_module, diameter_sync},
+ {load_module, diameter_gen_base_rfc6733},
+ {load_module, diameter_gen_acct_rfc6733},
+ {load_module, diameter_gen_base_rfc3588},
+ {load_module, diameter_gen_base_accounting},
+ {load_module, diameter_gen_relay}]}
],
[
{"0.9", [{restart_application, diameter}]},
@@ -66,6 +82,22 @@
{"1.8", [{restart_application, diameter}]},
{"1.9", [{restart_application, diameter}]},
{"1.9.1", [{restart_application, diameter}]},
- {"1.9.2", [{restart_application, diameter}]}
+ {"1.9.2", [{restart_application, diameter}]},
+ {"1.9.2.1", [{restart_application, diameter}]},
+ {"1.10", [{load_module, diameter_gen_relay},
+ {load_module, diameter_gen_base_accounting},
+ {load_module, diameter_gen_base_rfc3588},
+ {load_module, diameter_gen_acct_rfc6733},
+ {load_module, diameter_gen_base_rfc6733},
+ {load_module, diameter_sync},
+ {load_module, diameter_service},
+ {load_module, diameter_reg},
+ {load_module, diameter_peer},
+ {load_module, diameter_lib},
+ {load_module, diameter_config},
+ {load_module, diameter_stats},
+ {load_module, diameter_watchdog},
+ {load_module, diameter_peer_fsm},
+ {load_module, diameter_codec}]}
]
}.
diff --git a/lib/diameter/src/info/diameter_info.erl b/lib/diameter/src/info/diameter_info.erl
index 2e08662a9e..59a3b94ee4 100644
--- a/lib/diameter/src/info/diameter_info.erl
+++ b/lib/diameter/src/info/diameter_info.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2015. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -52,8 +52,6 @@
p/1,
p/3]).
--compile({no_auto_import,[max/2]}).
-
-export([collect/2]).
-define(LONG_TIMEOUT, 30000).
@@ -684,9 +682,6 @@ pt(T) ->
recsplit(SFun, Rec) ->
fun(Fs,Vs) -> SFun(element(1, Rec), Fs, Vs) end.
-max(A, B) ->
- if A > B -> A; true -> B end.
-
keyfetch(Key, List) ->
{Key,V} = lists:keyfind(Key, 1, List),
V.
diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl
index 3e08b78ea1..678dc9b5d6 100644
--- a/lib/diameter/src/transport/diameter_sctp.erl
+++ b/lib/diameter/src/transport/diameter_sctp.erl
@@ -21,9 +21,6 @@
-module(diameter_sctp).
-behaviour(gen_server).
--compile({no_auto_import, [now/0]}).
--import(diameter_lib, [now/0]).
-
%% interface
-export([start/3]).
diff --git a/lib/diameter/test/diameter_examples_SUITE.erl b/lib/diameter/test/diameter_examples_SUITE.erl
index 2c10daec50..e4ed2b227d 100644
--- a/lib/diameter/test/diameter_examples_SUITE.erl
+++ b/lib/diameter/test/diameter_examples_SUITE.erl
@@ -299,7 +299,7 @@ slave(_) ->
T0 = diameter_lib:now(),
{ok, Node} = ct_slave:start(?MODULE, ?TIMEOUTS),
T1 = diameter_lib:now(),
- T2 = rpc:call(Node, erlang, now, []),
+ T2 = rpc:call(Node, diameter_lib, now, []),
{ok, Node} = ct_slave:stop(?MODULE),
now_diff([T0, T1, T2, diameter_lib:now()]).
diff --git a/lib/diameter/test/diameter_gen_sctp_SUITE.erl b/lib/diameter/test/diameter_gen_sctp_SUITE.erl
index c739643dbe..cbd7fc8ec5 100644
--- a/lib/diameter/test/diameter_gen_sctp_SUITE.erl
+++ b/lib/diameter/test/diameter_gen_sctp_SUITE.erl
@@ -300,10 +300,10 @@ connect2(Pid, PortNr, Bin) ->
%% T2 = time after listening process received our message
%% T3 = time after reply is received
- T1 = diameter_util:timestamp(),
+ T1 = diameter_lib:now(),
ok = send(Sock, Id, Bin),
T2 = unmark(recv(Sock, Id)),
- T3 = diameter_util:timestamp(),
+ T3 = diameter_lib:now(),
{diameter_lib:micro_diff(T2, T1), %% Outbound
diameter_lib:micro_diff(T3, T2)}. %% Inbound
@@ -330,13 +330,13 @@ send(Sock, Id, Bin) ->
%% mark/1
mark(Bin) ->
- Info = term_to_binary(diameter_util:timestamp()),
+ Info = term_to_binary(diameter_lib:now()),
<<Info/binary, Bin/binary>>.
%% unmark/1
unmark(Bin) ->
- {_,_,_} = binary_to_term(Bin).
+ binary_to_term(Bin).
%% ===========================================================================
diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl
index fd83c2cd7f..f766f54a80 100644
--- a/lib/diameter/test/diameter_relay_SUITE.erl
+++ b/lib/diameter/test/diameter_relay_SUITE.erl
@@ -334,13 +334,39 @@ realm(Host) ->
call(Server) ->
Realm = realm(Server),
+ %% Include some arbitrary AVPs to exercise encode/decode, that
+ %% are received back in the STA.
+ Avps = [#diameter_avp{code = 111,
+ data = [#diameter_avp{code = 222,
+ data = <<222:24>>},
+ #diameter_avp{code = 333,
+ data = <<333:16>>}]},
+ #diameter_avp{code = 444,
+ data = <<444:24>>},
+ #diameter_avp{code = 555,
+ data = [#diameter_avp{code = 666,
+ data = [#diameter_avp
+ {code = 777,
+ data = <<7>>}]},
+ #diameter_avp{code = 888,
+ data = <<8>>},
+ #diameter_avp{code = 999,
+ data = <<9>>}]}],
+
Req = ['STR', {'Destination-Realm', Realm},
{'Destination-Host', [Server]},
{'Termination-Cause', ?LOGOUT},
- {'Auth-Application-Id', ?APP_ID}],
+ {'Auth-Application-Id', ?APP_ID},
+ {'AVP', Avps}],
+
#diameter_base_STA{'Result-Code' = ?SUCCESS,
'Origin-Host' = Server,
- 'Origin-Realm' = Realm}
+ 'Origin-Realm' = Realm,
+ %% Unknown AVPs can't be decoded as Grouped since
+ %% types aren't known.
+ 'AVP' = [#diameter_avp{code = 111},
+ #diameter_avp{code = 444},
+ #diameter_avp{code = 555}]}
= call(Req, [{filter, realm}]).
call(Req, Opts) ->
@@ -434,9 +460,18 @@ request(_Pkt, #diameter_caps{origin_host = {OH, _}})
request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId,
'Origin-Host' = Host,
'Origin-Realm' = Realm,
- 'Route-Record' = Route}},
+ 'Route-Record' = Route,
+ 'AVP' = Avps}},
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}) ->
+
+ %% Payloads of unknown AVPs aren't decoded, so we don't know that
+ %% some types here are Grouped.
+ [#diameter_avp{code = 111, vendor_id = undefined},
+ #diameter_avp{code = 444, vendor_id = undefined, data = <<444:24>>},
+ #diameter_avp{code = 555, vendor_id = undefined}]
+ = Avps,
+
%% The request should have the Origin-Host/Realm of the original
%% sender.
R = realm(?CLIENT),
@@ -447,4 +482,5 @@ request(#diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId,
{reply, #diameter_base_STA{'Result-Code' = ?SUCCESS,
'Session-Id' = SId,
'Origin-Host' = OH,
- 'Origin-Realm' = OR}}.
+ 'Origin-Realm' = OR,
+ 'AVP' = Avps}}.
diff --git a/lib/diameter/test/diameter_stats_SUITE.erl b/lib/diameter/test/diameter_stats_SUITE.erl
index 39cb6ae30d..4716082394 100644
--- a/lib/diameter/test/diameter_stats_SUITE.erl
+++ b/lib/diameter/test/diameter_stats_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2015. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -96,7 +96,7 @@ read(_) ->
7 = ?stat:incr(C1, Ref, 7),
Self = self(),
[{Ref, [{C1,7}]}, {Self, [{C1,2}, {C2,1}]}]
- = lists:sort(?stat:read([self(), Ref, make_ref()])),
+ = ?stat:read([self(), Ref, make_ref()]),
[] = ?stat:read([]),
[] = ?stat:read([make_ref()]),
?stat:flush([self(), Ref, make_ref()]).
@@ -116,7 +116,7 @@ sum(_) ->
[{Self, [{C1,1}, {C2,2}]}]
= ?stat:sum([self()]),
[{Ref, [{C1,7}]}, {Self, [{C1,1}, {C2,2}]}]
- = lists:sort(?stat:flush([self(), Ref])).
+ = ?stat:flush([self(), Ref]).
flush(_) ->
Ref = make_ref(),
diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl
index 701fe070d0..53d2d6660e 100644
--- a/lib/diameter/test/diameter_transport_SUITE.erl
+++ b/lib/diameter/test/diameter_transport_SUITE.erl
@@ -54,7 +54,7 @@
%% Receive a message.
-define(RECV(Pat, Ret), receive Pat -> Ret end).
--define(RECV(Pat), ?RECV(Pat, diameter_util:timestamp())).
+-define(RECV(Pat), ?RECV(Pat, diameter_lib:now())).
%% Sockets are opened on the loopback address.
-define(ADDR, {127,0,0,1}).
@@ -417,8 +417,7 @@ gen_accept(tcp, LSock) ->
gen_send(sctp, Sock, Bin) ->
{OS, _IS, Id} = getr(assoc),
- {_, _, Us} = diameter_util:timestamp(),
- gen_sctp:send(Sock, Id, Us rem OS, Bin);
+ gen_sctp:send(Sock, Id, erlang:unique_integer([positive]) rem OS, Bin);
gen_send(tcp, Sock, Bin) ->
gen_tcp:send(Sock, Bin).
diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl
index c727d10ddf..52b747e99c 100644
--- a/lib/diameter/test/diameter_util.erl
+++ b/lib/diameter/test/diameter_util.erl
@@ -31,7 +31,6 @@
fold/3,
foldl/3,
scramble/1,
- timestamp/0,
seed/0,
unique_string/0,
have_sctp/0]).
@@ -189,12 +188,6 @@ s(Acc, L) ->
s([T|Acc], H ++ Rest).
%% ---------------------------------------------------------------------------
-%% timestamp/0
-
-timestamp() ->
- diameter_lib:timestamp(diameter_lib:now()).
-
-%% ---------------------------------------------------------------------------
%% seed/0
seed() ->
@@ -205,14 +198,7 @@ seed() ->
%% unique_string/0
unique_string() ->
- try erlang:unique_integer() of
- N ->
- integer_to_list(N)
- catch
- error: undef -> %% OTP < 18
- {M,S,U} = timestamp(),
- tl(lists:append(["-" ++ integer_to_list(N) || N <- [M,S,U]]))
- end.
+ integer_to_list(erlang:unique_integer()).
%% ---------------------------------------------------------------------------
%% have_sctp/0
diff --git a/lib/diameter/test/diameter_watchdog_SUITE.erl b/lib/diameter/test/diameter_watchdog_SUITE.erl
index 016801383b..6d22ddcc18 100644
--- a/lib/diameter/test/diameter_watchdog_SUITE.erl
+++ b/lib/diameter/test/diameter_watchdog_SUITE.erl
@@ -49,7 +49,8 @@
accept/1,
connect/3,
send/2,
- setopts/2]).
+ setopts/2,
+ close/1]).
-include("diameter.hrl").
-include("diameter_ct.hrl").
@@ -421,7 +422,6 @@ suspect(TRef, false, SvcName, N) ->
%% abuse/1
abuse(F) ->
-
[] = run([[abuse, F, T] || T <- [listen, connect]]).
abuse(F, [_,_,_|_] = Args) ->
@@ -546,6 +546,9 @@ setopts(Sock, Opts) ->
send(Sock, Bin) ->
send(getr(config), Sock, Bin).
+close(Sock) ->
+ gen_tcp:close(Sock).
+
%% send/3
%% First outgoing message from a new transport process is CER/CEA.
diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk
index 1e3135680d..041d21b261 100644
--- a/lib/diameter/vsn.mk
+++ b/lib/diameter/vsn.mk
@@ -17,5 +17,5 @@
# %CopyrightEnd%
APPLICATION = diameter
-DIAMETER_VSN = 1.10
+DIAMETER_VSN = 1.11
APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN)
diff --git a/lib/eunit/src/eunit_tty.erl b/lib/eunit/src/eunit_tty.erl
index 699d2adaca..f604ca5ba3 100644
--- a/lib/eunit/src/eunit_tty.erl
+++ b/lib/eunit/src/eunit_tty.erl
@@ -67,6 +67,8 @@ terminate({ok, Data}, St) ->
end,
if Pass =:= 1 ->
fwrite(" Test passed.\n");
+ Pass =:= 2 ->
+ fwrite(" 2 tests passed.\n");
true ->
fwrite(" All ~w tests passed.\n", [Pass])
end
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index 41a6c731c9..f49089d41c 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2015. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -93,7 +93,7 @@
t_list/0,
t_list/1,
t_list_elements/2,
- t_list_termination/1,
+ t_list_termination/2,
t_mfa/0,
t_module/0,
t_nil/0,
@@ -1336,8 +1336,8 @@ type(lists, foldr, 3, Xs, _Opaques) -> type(lists, foldl, 3, Xs); % same
type(lists, keydelete, 3, Xs, Opaques) ->
strict(lists, keydelete, 3, Xs,
fun ([_, _, L]) ->
- Term = t_list_termination(L),
- t_sup(Term, erl_types:lift_list_to_pos_empty(L))
+ Term = t_list_termination(L, Opaques),
+ t_sup(Term, erl_types:lift_list_to_pos_empty(L, Opaques))
end, Opaques);
type(lists, keyfind, 3, Xs, Opaques) ->
strict(lists, keyfind, 3, Xs,
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 25cf1a7ae1..56ec757dbf 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -82,7 +82,7 @@
t_form_to_string/1,
t_from_form/4,
t_from_form/5,
- t_from_form_without_remote/2,
+ t_from_form_without_remote/3,
t_check_record_fields/4,
t_check_record_fields/5,
t_from_range/2,
@@ -150,7 +150,7 @@
t_list/0,
t_list/1,
t_list_elements/1, t_list_elements/2,
- t_list_termination/1,
+ t_list_termination/1, t_list_termination/2,
t_map/0,
t_map/1,
t_matchstate/0,
@@ -209,7 +209,7 @@
record_field_diffs_to_string/2,
subst_all_vars_to_any/1,
subst_all_remote/2,
- lift_list_to_pos_empty/1,
+ lift_list_to_pos_empty/1, lift_list_to_pos_empty/2,
is_opaque_type/2,
is_erl_type/1,
atom_to_string/1
@@ -1510,6 +1510,11 @@ t_list_elements(Type, Opaques) ->
list_elements(?list(Contents, _, _)) -> Contents;
list_elements(?nil) -> ?none.
+-spec t_list_termination(erl_type(), opaques()) -> erl_type().
+
+t_list_termination(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun t_list_termination/1).
+
-spec t_list_termination(erl_type()) -> erl_type().
t_list_termination(?nil) -> ?nil;
@@ -1585,6 +1590,11 @@ is_maybe_improper_list(_) -> false.
%% %% false = t_is_subtype(t_nil(), Termination),
%% ?list(Content, Termination, ?any).
+-spec lift_list_to_pos_empty(erl_type(), opaques()) -> erl_type().
+
+lift_list_to_pos_empty(Type, Opaques) ->
+ do_opaque(Type, Opaques, fun lift_list_to_pos_empty/1).
+
-spec lift_list_to_pos_empty(erl_type()) -> erl_type().
lift_list_to_pos_empty(?nil) -> ?nil;
@@ -3961,27 +3971,32 @@ mod_name(Mod, Name) ->
-type type_names() :: [type_key() | record_key()].
+-type mta() :: {module(), atom(), arity()}.
+-type mra() :: {module(), atom(), arity()}.
+-type site() :: {'type', mta()} | {'spec', mfa()} | {'record', mra()}.
+
-spec t_from_form(parse_form(), sets:set(mfa()),
- module(), mod_records()) -> erl_type().
+ site(), mod_records()) -> erl_type().
-t_from_form(Form, ExpTypes, Module, RecDict) ->
- t_from_form(Form, ExpTypes, Module, RecDict, dict:new()).
+t_from_form(Form, ExpTypes, Site, RecDict) ->
+ t_from_form(Form, ExpTypes, Site, RecDict, dict:new()).
-spec t_from_form(parse_form(), sets:set(mfa()),
- module(), mod_records(), var_table()) -> erl_type().
+ site(), mod_records(), var_table()) -> erl_type().
-t_from_form(Form, ExpTypes, Module, RecDict, VarDict) ->
- {T, _} = t_from_form1(Form, [], ExpTypes, Module, RecDict, VarDict),
+t_from_form(Form, ExpTypes, Site, RecDict, VarDict) ->
+ {T, _} = t_from_form1(Form, ExpTypes, Site, RecDict, VarDict),
T.
%% Replace external types with with none().
--spec t_from_form_without_remote(parse_form(), type_table()) -> erl_type().
+-spec t_from_form_without_remote(parse_form(), site(), type_table()) ->
+ erl_type().
-t_from_form_without_remote(Form, TypeTable) ->
- Module = mod,
+t_from_form_without_remote(Form, Site, TypeTable) ->
+ Module = site_module(Site),
RecDict = dict:from_list([{Module, TypeTable}]),
ExpTypes = replace_by_none,
- {T, _} = t_from_form1(Form, [], ExpTypes, Module, RecDict, dict:new()),
+ {T, _} = t_from_form1(Form, ExpTypes, Site, RecDict, dict:new()),
T.
%% REC_TYPE_LIMIT is used for limiting the depth of recursive types.
@@ -3995,23 +4010,32 @@ t_from_form_without_remote(Form, TypeTable) ->
-type expand_depth() :: integer().
-t_from_form1(Form, TypeNames, ET, M, MR, V) ->
- t_from_form1(Form, TypeNames, ET, M, MR, V, ?EXPAND_DEPTH).
+-spec t_from_form1(parse_form(), sets:set(mfa()) | 'replace_by_none',
+ site(), mod_records(), var_table()) ->
+ {erl_type(), expand_limit()}.
+
+t_from_form1(Form, ET, Site, MR, V) ->
+ TypeNames = initial_typenames(Site),
+ t_from_form1(Form, TypeNames, ET, Site, MR, V, ?EXPAND_DEPTH).
-t_from_form1(Form, TypeNames, ET, M, MR, V, D) ->
+initial_typenames({type, _MTA}=Site) -> [Site];
+initial_typenames({spec, _MFA}) -> [];
+initial_typenames({record, _MRA}) -> [].
+
+t_from_form1(Form, TypeNames, ET, Site, MR, V, D) ->
L = ?EXPAND_LIMIT,
- {T, L1} = t_from_form(Form, TypeNames, ET, M, MR, V, D, L),
+ {T, L1} = t_from_form(Form, TypeNames, ET, Site, MR, V, D, L),
if
L1 =< 0, D > 1 ->
D1 = D div 2,
- t_from_form1(Form, TypeNames, ET, M, MR, V, D1);
+ t_from_form1(Form, TypeNames, ET, Site, MR, V, D1);
true ->
{T, L1}
end.
-spec t_from_form(parse_form(), type_names(),
sets:set(mfa()) | 'replace_by_none',
- module(), mod_records(), var_table(),
+ site(), mod_records(), var_table(),
expand_depth(), expand_limit())
-> {erl_type(), expand_limit()}.
@@ -4021,193 +4045,194 @@ t_from_form1(Form, TypeNames, ET, M, MR, V, D) ->
%% self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}
%% is called, unless 'replace_by_none' is given.
%%
-%% It is assumed that M can be found in MR.
+%% It is assumed that site_module(S) can be found in MR.
-t_from_form(_, _TypeNames, _ET, _M, _MR, _V, D, L) when D =< 0 ; L =< 0 ->
+t_from_form(_, _TypeNames, _ET, _S, _MR, _V, D, L) when D =< 0 ; L =< 0 ->
{t_any(), L};
-t_from_form({var, _L, '_'}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({var, _L, '_'}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_any(), L};
-t_from_form({var, _L, Name}, _TypeNames, _ET, _M, _MR, V, _D, L) ->
+t_from_form({var, _L, Name}, _TypeNames, _ET, _S, _MR, V, _D, L) ->
case dict:find(Name, V) of
error -> {t_var(Name), L};
{ok, Val} -> {Val, L}
end;
-t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, ET, M, MR, V, D, L) ->
- t_from_form(Type, TypeNames, ET, M, MR, V, D, L);
-t_from_form({paren_type, _L, [Type]}, TypeNames, ET, M, MR, V, D, L) ->
- t_from_form(Type, TypeNames, ET, M, MR, V, D, L);
+t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, ET, S, MR, V, D, L) ->
+ t_from_form(Type, TypeNames, ET, S, MR, V, D, L);
+t_from_form({paren_type, _L, [Type]}, TypeNames, ET, S, MR, V, D, L) ->
+ t_from_form(Type, TypeNames, ET, S, MR, V, D, L);
t_from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]},
- TypeNames, ET, M, MR, V, D, L) ->
- remote_from_form(Module, Type, Args, TypeNames, ET, M, MR, V, D, L);
-t_from_form({atom, _L, Atom}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ TypeNames, ET, S, MR, V, D, L) ->
+ remote_from_form(Module, Type, Args, TypeNames, ET, S, MR, V, D, L);
+t_from_form({atom, _L, Atom}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_atom(Atom), L};
-t_from_form({integer, _L, Int}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({integer, _L, Int}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_integer(Int), L};
-t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
case erl_eval:partial_eval(Op) of
{integer, _, Val} ->
{t_integer(Val), L};
_ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])})
end;
t_from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _TypeNames,
- _ET, _M, _MR, _V, _D, L) ->
+ _ET, _S, _MR, _V, _D, L) ->
case erl_eval:partial_eval(Op) of
{integer, _, Val} ->
{t_integer(Val), L};
_ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])})
end;
-t_from_form({type, _L, any, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, any, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_any(), L};
-t_from_form({type, _L, arity, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, arity, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_arity(), L};
-t_from_form({type, _L, atom, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, atom, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_atom(), L};
-t_from_form({type, _L, binary, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, binary, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_binary(), L};
t_from_form({type, _L, binary, [Base, Unit]} = Type,
- _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ _TypeNames, _ET, _S, _MR, _V, _D, L) ->
case {erl_eval:partial_eval(Base), erl_eval:partial_eval(Unit)} of
{{integer, _, B}, {integer, _, U}} when B >= 0, U >= 0 ->
{t_bitstr(U, B), L};
_ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])})
end;
-t_from_form({type, _L, bitstring, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, bitstring, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_bitstr(), L};
-t_from_form({type, _L, bool, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, bool, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_boolean(), L}; % XXX: Temporarily
-t_from_form({type, _L, boolean, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, boolean, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_boolean(), L};
-t_from_form({type, _L, byte, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, byte, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_byte(), L};
-t_from_form({type, _L, char, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, char, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_char(), L};
-t_from_form({type, _L, float, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, float, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_float(), L};
-t_from_form({type, _L, function, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, function, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_fun(), L};
-t_from_form({type, _L, 'fun', []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, 'fun', []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_fun(), L};
t_from_form({type, _L, 'fun', [{type, _, any}, Range]}, TypeNames,
- ET, M, MR, V, D, L) ->
- {T, L1} = t_from_form(Range, TypeNames, ET, M, MR, V, D - 1, L - 1),
+ ET, S, MR, V, D, L) ->
+ {T, L1} = t_from_form(Range, TypeNames, ET, S, MR, V, D - 1, L - 1),
{t_fun(T), L1};
t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]},
- TypeNames, ET, M, MR, V, D, L) ->
- {Dom1, L1} = list_from_form(Domain, TypeNames, ET, M, MR, V, D, L),
- {Ran1, L2} = t_from_form(Range, TypeNames, ET, M, MR, V, D - 1, L1),
+ TypeNames, ET, S, MR, V, D, L) ->
+ {Dom1, L1} = list_from_form(Domain, TypeNames, ET, S, MR, V, D, L),
+ {Ran1, L2} = t_from_form(Range, TypeNames, ET, S, MR, V, D - 1, L1),
{t_fun(Dom1, Ran1), L2};
-t_from_form({type, _L, identifier, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, identifier, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_identifier(), L};
-t_from_form({type, _L, integer, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, integer, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_integer(), L};
-t_from_form({type, _L, iodata, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, iodata, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_iodata(), L};
-t_from_form({type, _L, iolist, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, iolist, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_iolist(), L};
-t_from_form({type, _L, list, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, list, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_list(), L};
-t_from_form({type, _L, list, [Type]}, TypeNames, ET, M, MR, V, D, L) ->
- {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D - 1, L - 1),
+t_from_form({type, _L, list, [Type]}, TypeNames, ET, S, MR, V, D, L) ->
+ {T, L1} = t_from_form(Type, TypeNames, ET, S, MR, V, D - 1, L - 1),
{t_list(T), L1};
-t_from_form({type, _L, map, _}, TypeNames, ET, M, MR, V, D, L) ->
- builtin_type(map, t_map([]), TypeNames, ET, M, MR, V, D, L);
-t_from_form({type, _L, mfa, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, map, _}, TypeNames, ET, S, MR, V, D, L) ->
+ builtin_type(map, t_map([]), TypeNames, ET, S, MR, V, D, L);
+t_from_form({type, _L, mfa, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_mfa(), L};
-t_from_form({type, _L, module, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, module, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_module(), L};
-t_from_form({type, _L, nil, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, nil, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_nil(), L};
-t_from_form({type, _L, neg_integer, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, neg_integer, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_neg_integer(), L};
-t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _ET, _M, _MR,
+t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _ET, _S, _MR,
_V, _D, L) ->
{t_non_neg_integer(), L};
-t_from_form({type, _L, no_return, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, no_return, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_unit(), L};
-t_from_form({type, _L, node, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, node, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_node(), L};
-t_from_form({type, _L, none, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, none, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_none(), L};
-t_from_form({type, _L, nonempty_list, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, nonempty_list, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_nonempty_list(), L};
-t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, ET, M, MR, V, D, L) ->
- {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D, L - 1),
+t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, ET, S, MR, V, D, L) ->
+ {T, L1} = t_from_form(Type, TypeNames, ET, S, MR, V, D, L - 1),
{t_nonempty_list(T), L1};
t_from_form({type, _L, nonempty_improper_list, [Cont, Term]}, TypeNames,
- ET, M, MR, V, D, L) ->
- {T1, L1} = t_from_form(Cont, TypeNames, ET, M, MR, V, D, L - 1),
- {T2, L2} = t_from_form(Term, TypeNames, ET, M, MR, V, D, L1),
+ ET, S, MR, V, D, L) ->
+ {T1, L1} = t_from_form(Cont, TypeNames, ET, S, MR, V, D, L - 1),
+ {T2, L2} = t_from_form(Term, TypeNames, ET, S, MR, V, D, L1),
{t_cons(T1, T2), L2};
t_from_form({type, _L, nonempty_maybe_improper_list, []}, _TypeNames,
- _ET, _M, _MR, _V, _D, L) ->
+ _ET, _S, _MR, _V, _D, L) ->
{t_cons(?any, ?any), L};
t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]},
- TypeNames, ET, M, MR, V, D, L) ->
- {T1, L1} = t_from_form(Cont, TypeNames, ET, M, MR, V, D, L - 1),
- {T2, L2} = t_from_form(Term, TypeNames, ET, M, MR, V, D, L1),
+ TypeNames, ET, S, MR, V, D, L) ->
+ {T1, L1} = t_from_form(Cont, TypeNames, ET, S, MR, V, D, L - 1),
+ {T2, L2} = t_from_form(Term, TypeNames, ET, S, MR, V, D, L1),
{t_cons(T1, T2), L2};
-t_from_form({type, _L, nonempty_string, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, nonempty_string, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_nonempty_string(), L};
-t_from_form({type, _L, number, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, number, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_number(), L};
-t_from_form({type, _L, pid, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, pid, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_pid(), L};
-t_from_form({type, _L, port, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, port, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_port(), L};
-t_from_form({type, _L, pos_integer, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, pos_integer, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_pos_integer(), L};
t_from_form({type, _L, maybe_improper_list, []}, _TypeNames,
- _ET, _M, _MR, _V, _D, L) ->
+ _ET, _S, _MR, _V, _D, L) ->
{t_maybe_improper_list(), L};
t_from_form({type, _L, maybe_improper_list, [Content, Termination]},
- TypeNames, ET, M, MR, V, D, L) ->
- {T1, L1} = t_from_form(Content, TypeNames, ET, M, MR, V, D, L - 1),
- {T2, L2} = t_from_form(Termination, TypeNames, ET, M, MR, V, D, L1),
+ TypeNames, ET, S, MR, V, D, L) ->
+ {T1, L1} = t_from_form(Content, TypeNames, ET, S, MR, V, D, L - 1),
+ {T2, L2} = t_from_form(Termination, TypeNames, ET, S, MR, V, D, L1),
{t_maybe_improper_list(T1, T2), L2};
-t_from_form({type, _L, product, Elements}, TypeNames, ET, M, MR, V, D, L) ->
- {Lst, L1} = list_from_form(Elements, TypeNames, ET, M, MR, V, D - 1, L),
+t_from_form({type, _L, product, Elements}, TypeNames, ET, S, MR, V, D, L) ->
+ {Lst, L1} = list_from_form(Elements, TypeNames, ET, S, MR, V, D - 1, L),
{t_product(Lst), L1};
t_from_form({type, _L, range, [From, To]} = Type,
- _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+ _TypeNames, _ET, _S, _MR, _V, _D, L) ->
case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of
{{integer, _, FromVal}, {integer, _, ToVal}} ->
{t_from_range(FromVal, ToVal), L};
_ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])})
end;
-t_from_form({type, _L, record, [Name|Fields]}, TypeNames, ET, M, MR, V, D, L) ->
- record_from_form(Name, Fields, TypeNames, ET, M, MR, V, D, L);
-t_from_form({type, _L, reference, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, record, [Name|Fields]}, TypeNames, ET, S, MR, V, D, L) ->
+ record_from_form(Name, Fields, TypeNames, ET, S, MR, V, D, L);
+t_from_form({type, _L, reference, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_reference(), L};
-t_from_form({type, _L, string, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, string, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_string(), L};
-t_from_form({type, _L, term, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, term, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_any(), L};
-t_from_form({type, _L, timeout, []}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, timeout, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_timeout(), L};
-t_from_form({type, _L, tuple, any}, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+t_from_form({type, _L, tuple, any}, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{t_tuple(), L};
-t_from_form({type, _L, tuple, Args}, TypeNames, ET, M, MR, V, D, L) ->
- {Lst, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D - 1, L),
+t_from_form({type, _L, tuple, Args}, TypeNames, ET, S, MR, V, D, L) ->
+ {Lst, L1} = list_from_form(Args, TypeNames, ET, S, MR, V, D - 1, L),
{t_tuple(Lst), L1};
-t_from_form({type, _L, union, Args}, TypeNames, ET, M, MR, V, D, L) ->
- {Lst, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L),
+t_from_form({type, _L, union, Args}, TypeNames, ET, S, MR, V, D, L) ->
+ {Lst, L1} = list_from_form(Args, TypeNames, ET, S, MR, V, D, L),
{t_sup(Lst), L1};
-t_from_form({user_type, _L, Name, Args}, TypeNames, ET, M, MR, V, D, L) ->
- type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L);
-t_from_form({type, _L, Name, Args}, TypeNames, ET, M, MR, V, D, L) ->
+t_from_form({user_type, _L, Name, Args}, TypeNames, ET, S, MR, V, D, L) ->
+ type_from_form(Name, Args, TypeNames, ET, S, MR, V, D, L);
+t_from_form({type, _L, Name, Args}, TypeNames, ET, S, MR, V, D, L) ->
%% Compatibility: modules compiled before Erlang/OTP 18.0.
- type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L);
+ type_from_form(Name, Args, TypeNames, ET, S, MR, V, D, L);
t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames,
- _ET, _M, _MR, _V, _D, L) ->
+ _ET, _S, _MR, _V, _D, L) ->
%% XXX. To be removed.
{t_opaque(Mod, Name, Args, Rep), L}.
-builtin_type(Name, Type, TypeNames, ET, M, MR, V, D, L) ->
+builtin_type(Name, Type, TypeNames, ET, Site, MR, V, D, L) ->
+ M = site_module(Site),
case dict:find(M, MR) of
{ok, R} ->
case lookup_type(Name, 0, R) of
{_, {{_M, _FL, _F, _A}, _T}} ->
- type_from_form(Name, [], TypeNames, ET, M, MR, V, D, L);
+ type_from_form(Name, [], TypeNames, ET, Site, MR, V, D, L);
error ->
{Type, L}
end;
@@ -4215,92 +4240,107 @@ builtin_type(Name, Type, TypeNames, ET, M, MR, V, D, L) ->
{Type, L}
end.
-type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L) ->
+type_from_form(Name, Args, TypeNames, ET, Site0, MR, V, D, L) ->
ArgsLen = length(Args),
- {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L),
- {ok, R} = dict:find(M, MR),
+ Module = site_module(Site0),
+ {ok, R} = dict:find(Module, MR),
+ TypeName = {type, {Module, Name, ArgsLen}},
case lookup_type(Name, ArgsLen, R) of
{type, {{Module, _FileName, Form, ArgNames}, _Type}} ->
- TypeName = {type, Module, Name, ArgsLen},
case can_unfold_more(TypeName, TypeNames) of
true ->
+ NewTypeNames = [TypeName|TypeNames],
+ {ArgTypes, L1} =
+ list_from_form(Args, TypeNames, ET, Site0, MR, V, D, L),
List = lists:zip(ArgNames, ArgTypes),
TmpV = dict:from_list(List),
- t_from_form(Form, [TypeName|TypeNames], ET, M, MR, TmpV, D, L1);
+ Site = TypeName,
+ t_from_form(Form, NewTypeNames, ET, Site, MR, TmpV, D, L1);
false ->
- {t_any(), L1}
+ {t_any(), L}
end;
{opaque, {{Module, _FileName, Form, ArgNames}, Type}} ->
- TypeName = {opaque, Module, Name, ArgsLen},
- {Rep, L2} =
- case can_unfold_more(TypeName, TypeNames) of
- true ->
- List = lists:zip(ArgNames, ArgTypes),
- TmpV = dict:from_list(List),
- t_from_form(Form, [TypeName|TypeNames], ET, M, MR, TmpV, D, L1);
- false -> {t_any(), L1}
- end,
- Rep1 = choose_opaque_type(Rep, Type),
- Rep2 = case t_is_none(Rep1) of
- true -> Rep1;
- false ->
- Args2 = [subst_all_vars_to_any(ArgType) ||
- ArgType <- ArgTypes],
- t_opaque(Module, Name, Args2, Rep1)
- end,
- {Rep2, L2};
+ case can_unfold_more(TypeName, TypeNames) of
+ true ->
+ NewTypeNames = [TypeName|TypeNames],
+ {ArgTypes, L1} =
+ list_from_form(Args, NewTypeNames, ET, Site0, MR, V, D, L),
+ List = lists:zip(ArgNames, ArgTypes),
+ TmpV = dict:from_list(List),
+ Site = TypeName,
+ {Rep, L2} =
+ t_from_form(Form, NewTypeNames, ET, Site, MR, TmpV, D, L1),
+ Rep1 = choose_opaque_type(Rep, Type),
+ Rep2 = case cannot_have_opaque(Rep1, TypeName, TypeNames) of
+ true -> Rep1;
+ false ->
+ ArgTypes2 = subst_all_vars_to_any_list(ArgTypes),
+ t_opaque(Module, Name, ArgTypes2, Rep1)
+ end,
+ {Rep2, L2};
+ false -> {t_any(), L}
+ end;
error ->
Msg = io_lib:format("Unable to find type ~w/~w\n", [Name, ArgsLen]),
throw({error, Msg})
end.
-remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) ->
- {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L),
+remote_from_form(RemMod, Name, Args, TypeNames, ET, S, MR, V, D, L) ->
if
ET =:= replace_by_none ->
- {t_none(), L1};
+ {t_none(), L};
true ->
ArgsLen = length(Args),
+ MFA = {RemMod, Name, ArgsLen},
case dict:find(RemMod, MR) of
error ->
- self() ! {self(), ext_types, {RemMod, Name, ArgsLen}},
- {t_any(), L1};
+ self() ! {self(), ext_types, MFA},
+ {t_any(), L};
{ok, RemDict} ->
- MFA = {RemMod, Name, ArgsLen},
+ RemType = {type, MFA},
case sets:is_element(MFA, ET) of
true ->
case lookup_type(Name, ArgsLen, RemDict) of
{type, {{_Mod, _FileLine, Form, ArgNames}, _Type}} ->
- RemType = {type, RemMod, Name, ArgsLen},
case can_unfold_more(RemType, TypeNames) of
true ->
+ NewTypeNames = [RemType|TypeNames],
+ {ArgTypes, L1} = list_from_form(Args, TypeNames,
+ ET, S, MR, V, D, L),
List = lists:zip(ArgNames, ArgTypes),
TmpVarDict = dict:from_list(List),
- NewTypeNames = [RemType|TypeNames],
+ Site = RemType,
t_from_form(Form, NewTypeNames, ET,
- RemMod, MR, TmpVarDict, D, L1);
+ Site, MR, TmpVarDict, D, L1);
false ->
- {t_any(), L1}
+ {t_any(), L}
end;
{opaque, {{Mod, _FileLine, Form, ArgNames}, Type}} ->
- RemType = {opaque, RemMod, Name, ArgsLen},
- List = lists:zip(ArgNames, ArgTypes),
- TmpVarDict = dict:from_list(List),
- {NewRep, L2} =
- case can_unfold_more(RemType, TypeNames) of
- true ->
- NewTypeNames = [RemType|TypeNames],
- t_from_form(Form, NewTypeNames, ET, RemMod, MR,
- TmpVarDict, D, L1);
- false ->
- {t_any(), L1}
- end,
- NewRep1 = choose_opaque_type(NewRep, Type),
- NewRep2 = case t_is_none(NewRep1) of
- true -> NewRep1;
- false -> t_opaque(Mod, Name, ArgTypes, NewRep1)
- end,
- {NewRep2, L2};
+ case can_unfold_more(RemType, TypeNames) of
+ true ->
+ NewTypeNames = [RemType|TypeNames],
+ {ArgTypes, L1} = list_from_form(Args, NewTypeNames,
+ ET, S, MR, V, D, L),
+ List = lists:zip(ArgNames, ArgTypes),
+ TmpVarDict = dict:from_list(List),
+ Site = RemType,
+ {NewRep, L2} =
+ t_from_form(Form, NewTypeNames, ET, Site, MR,
+ TmpVarDict, D, L1),
+ NewRep1 = choose_opaque_type(NewRep, Type),
+ NewRep2 =
+ case
+ cannot_have_opaque(NewRep1, RemType, TypeNames)
+ of
+ true -> NewRep1;
+ false ->
+ ArgTypes2 = subst_all_vars_to_any_list(ArgTypes),
+ t_opaque(Mod, Name, ArgTypes2, NewRep1)
+ end,
+ {NewRep2, L2};
+ false ->
+ {t_any(), L}
+ end;
error ->
Msg = io_lib:format("Unable to find remote type ~w:~w()\n",
[RemMod, Name]),
@@ -4308,11 +4348,14 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) ->
end;
false ->
self() ! {self(), ext_types, {RemMod, Name, ArgsLen}},
- {t_any(), L1}
+ {t_any(), L}
end
end
end.
+subst_all_vars_to_any_list(Types) ->
+ [subst_all_vars_to_any(Type) || Type <- Types].
+
%% Opaque types (both local and remote) are problematic when it comes
%% to the limits (TypeNames, D, and L). The reason is that if any() is
%% substituted for a more specialized subtype of an opaque type, the
@@ -4332,22 +4375,24 @@ choose_opaque_type(Type, DeclType) ->
false -> DeclType
end.
-record_from_form({atom, _, Name}, ModFields, TypeNames, ET, M, MR, V, D, L) ->
+record_from_form({atom, _, Name}, ModFields, TypeNames, ET, S, MR, V, D, L) ->
case can_unfold_more({record, Name}, TypeNames) of
true ->
+ M = site_module(S),
{ok, R} = dict:find(M, MR),
case lookup_record(Name, R) of
{ok, DeclFields} ->
NewTypeNames = [{record, Name}|TypeNames],
+ S1 = {record, {M, Name, length(DeclFields)}},
{GetModRec, L1} = get_mod_record(ModFields, DeclFields,
- NewTypeNames, ET, M, MR, V, D, L),
+ NewTypeNames, ET, S1, MR, V, D, L),
case GetModRec of
{error, FieldName} ->
throw({error, io_lib:format("Illegal declaration of #~w{~w}\n",
[Name, FieldName])});
{ok, NewFields} ->
{NewFields1, L2} =
- fields_from_form(NewFields, NewTypeNames, ET, M, MR,
+ fields_from_form(NewFields, NewTypeNames, ET, S1, MR,
dict:new(), D, L1),
Rec = t_tuple(
[t_atom(Name)|[Type
@@ -4361,12 +4406,12 @@ record_from_form({atom, _, Name}, ModFields, TypeNames, ET, M, MR, V, D, L) ->
{t_any(), L}
end.
-get_mod_record([], DeclFields, _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+get_mod_record([], DeclFields, _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{{ok, DeclFields}, L};
-get_mod_record(ModFields, DeclFields, TypeNames, ET, M, MR, V, D, L) ->
+get_mod_record(ModFields, DeclFields, TypeNames, ET, S, MR, V, D, L) ->
DeclFieldsDict = lists:keysort(1, DeclFields),
{ModFieldsDict, L1} =
- build_field_dict(ModFields, TypeNames, ET, M, MR, V, D, L),
+ build_field_dict(ModFields, TypeNames, ET, S, MR, V, D, L),
case get_mod_record_types(DeclFieldsDict, ModFieldsDict, []) of
{error, _FieldName} = Error -> {Error, L1};
{ok, FinalKeyDict} ->
@@ -4375,17 +4420,17 @@ get_mod_record(ModFields, DeclFields, TypeNames, ET, M, MR, V, D, L) ->
{{ok, Fields}, L1}
end.
-build_field_dict(FieldTypes, TypeNames, ET, M, MR, V, D, L) ->
- build_field_dict(FieldTypes, TypeNames, ET, M, MR, V, D, L, []).
+build_field_dict(FieldTypes, TypeNames, ET, S, MR, V, D, L) ->
+ build_field_dict(FieldTypes, TypeNames, ET, S, MR, V, D, L, []).
build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left],
- TypeNames, ET, M, MR, V, D, L, Acc) ->
- {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D, L - 1),
+ TypeNames, ET, S, MR, V, D, L, Acc) ->
+ {T, L1} = t_from_form(Type, TypeNames, ET, S, MR, V, D, L - 1),
NewAcc = [{Name, Type, T}|Acc],
{Dict, L2} =
- build_field_dict(Left, TypeNames, ET, M, MR, V, D, L1, NewAcc),
+ build_field_dict(Left, TypeNames, ET, S, MR, V, D, L1, NewAcc),
{Dict, L2};
-build_field_dict([], _TypeNames, _ET, _M, _MR, _V, _D, L, Acc) ->
+build_field_dict([], _TypeNames, _ET, _S, _MR, _V, _D, L, Acc) ->
{lists:keysort(1, Acc), L}.
get_mod_record_types([{FieldName, _Abstr, _DeclType}|Left1],
@@ -4404,88 +4449,94 @@ get_mod_record_types(_, [{FieldName2, _FormType, _ModType}|_], _Acc) ->
%% It is important to create a limited version of the record type
%% since nested record types can otherwise easily result in huge
%% terms.
-fields_from_form([], _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+fields_from_form([], _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{[], L};
-fields_from_form([{Name, Abstr, _Type}|Tail], TypeNames, ET, M, MR,
+fields_from_form([{Name, Abstr, _Type}|Tail], TypeNames, ET, S, MR,
V, D, L) ->
- {T, L1} = t_from_form(Abstr, TypeNames, ET, M, MR, V, D, L),
- {F, L2} = fields_from_form(Tail, TypeNames, ET, M, MR, V, D, L1),
+ {T, L1} = t_from_form(Abstr, TypeNames, ET, S, MR, V, D, L),
+ {F, L2} = fields_from_form(Tail, TypeNames, ET, S, MR, V, D, L1),
{[{Name, T}|F], L2}.
-list_from_form([], _TypeNames, _ET, _M, _MR, _V, _D, L) ->
+list_from_form([], _TypeNames, _ET, _S, _MR, _V, _D, L) ->
{[], L};
-list_from_form([H|Tail], TypeNames, ET, M, MR, V, D, L) ->
- {H1, L1} = t_from_form(H, TypeNames, ET, M, MR, V, D, L - 1),
- {T1, L2} = list_from_form(Tail, TypeNames, ET, M, MR, V, D, L1),
+list_from_form([H|Tail], TypeNames, ET, S, MR, V, D, L) ->
+ {H1, L1} = t_from_form(H, TypeNames, ET, S, MR, V, D, L - 1),
+ {T1, L2} = list_from_form(Tail, TypeNames, ET, S, MR, V, D, L1),
{[H1|T1], L2}.
--spec t_check_record_fields(parse_form(), sets:set(mfa()), module(),
+-spec t_check_record_fields(parse_form(), sets:set(mfa()), site(),
mod_records()) -> ok.
-t_check_record_fields(Form, ExpTypes, Module, RecDict) ->
- t_check_record_fields(Form, ExpTypes, Module, RecDict, dict:new()).
+t_check_record_fields(Form, ExpTypes, Site, RecDict) ->
+ t_check_record_fields(Form, ExpTypes, Site, RecDict, dict:new()).
--spec t_check_record_fields(parse_form(), sets:set(mfa()), module(),
+-spec t_check_record_fields(parse_form(), sets:set(mfa()), site(),
mod_records(), var_table()) -> ok.
%% If there is something wrong with parse_form()
%% throw({error, io_lib:chars()} is called.
-t_check_record_fields({var, _L, _}, _ET, _M, _MR, _V) -> ok;
-t_check_record_fields({ann_type, _L, [_Var, Type]}, ET, M, MR, V) ->
- t_check_record_fields(Type, ET, M, MR, V);
-t_check_record_fields({paren_type, _L, [Type]}, ET, M, MR, V) ->
- t_check_record_fields(Type, ET, M, MR, V);
+t_check_record_fields({var, _L, _}, _ET, _S, _MR, _V) -> ok;
+t_check_record_fields({ann_type, _L, [_Var, Type]}, ET, S, MR, V) ->
+ t_check_record_fields(Type, ET, S, MR, V);
+t_check_record_fields({paren_type, _L, [Type]}, ET, S, MR, V) ->
+ t_check_record_fields(Type, ET, S, MR, V);
t_check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]},
- ET, M, MR, V) ->
- list_check_record_fields(Args, ET, M, MR, V);
-t_check_record_fields({atom, _L, _}, _ET, _M, _MR, _V) -> ok;
-t_check_record_fields({integer, _L, _}, _ET, _M, _MR, _V) -> ok;
-t_check_record_fields({op, _L, _Op, _Arg}, _ET, _M, _MR, _V) -> ok;
-t_check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _ET, _M, _MR, _V) -> ok;
-t_check_record_fields({type, _L, tuple, any}, _ET, _M, _MR, _V) -> ok;
-t_check_record_fields({type, _L, map, any}, _ET, _M, _MR, _V) -> ok;
-t_check_record_fields({type, _L, binary, [_Base, _Unit]}, _ET, _M, _MR, _V) ->
+ ET, S, MR, V) ->
+ list_check_record_fields(Args, ET, S, MR, V);
+t_check_record_fields({atom, _L, _}, _ET, _S, _MR, _V) -> ok;
+t_check_record_fields({integer, _L, _}, _ET, _S, _MR, _V) -> ok;
+t_check_record_fields({op, _L, _Op, _Arg}, _ET, _S, _MR, _V) -> ok;
+t_check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _ET, _S, _MR, _V) -> ok;
+t_check_record_fields({type, _L, tuple, any}, _ET, _S, _MR, _V) -> ok;
+t_check_record_fields({type, _L, map, any}, _ET, _S, _MR, _V) -> ok;
+t_check_record_fields({type, _L, binary, [_Base, _Unit]}, _ET, _S, _MR, _V) ->
ok;
t_check_record_fields({type, _L, 'fun', [{type, _, any}, Range]},
- ET, M, MR, V) ->
- t_check_record_fields(Range, ET, M, MR, V);
-t_check_record_fields({type, _L, range, [_From, _To]}, _ET, _M, _MR, _V) ->
+ ET, S, MR, V) ->
+ t_check_record_fields(Range, ET, S, MR, V);
+t_check_record_fields({type, _L, range, [_From, _To]}, _ET, _S, _MR, _V) ->
ok;
-t_check_record_fields({type, _L, record, [Name|Fields]}, ET, M, MR, V) ->
- check_record(Name, Fields, ET, M, MR, V);
-t_check_record_fields({type, _L, _, Args}, ET, M, MR, V) ->
- list_check_record_fields(Args, ET, M, MR, V);
-t_check_record_fields({user_type, _L, _Name, Args}, ET, M, MR, V) ->
- list_check_record_fields(Args, ET, M, MR, V).
-
-check_record({atom, _, Name}, ModFields, ET, M, MR, V) ->
+t_check_record_fields({type, _L, record, [Name|Fields]}, ET, S, MR, V) ->
+ check_record(Name, Fields, ET, S, MR, V);
+t_check_record_fields({type, _L, _, Args}, ET, S, MR, V) ->
+ list_check_record_fields(Args, ET, S, MR, V);
+t_check_record_fields({user_type, _L, _Name, Args}, ET, S, MR, V) ->
+ list_check_record_fields(Args, ET, S, MR, V).
+
+check_record({atom, _, Name}, ModFields, ET, Site, MR, V) ->
+ M = site_module(Site),
{ok, R} = dict:find(M, MR),
{ok, DeclFields} = lookup_record(Name, R),
- case check_fields(ModFields, DeclFields, ET, M, MR, V) of
+ case check_fields(Name, ModFields, DeclFields, ET, Site, MR, V) of
{error, FieldName} ->
throw({error, io_lib:format("Illegal declaration of #~w{~w}\n",
[Name, FieldName])});
ok -> ok
end.
-check_fields([{type, _, field_type, [{atom, _, Name}, Abstr]}|Left],
- DeclFields, ET, M, MR, V) ->
- Type = t_from_form(Abstr, ET, M, MR, V),
+check_fields(RecName, [{type, _, field_type, [{atom, _, Name}, Abstr]}|Left],
+ DeclFields, ET, Site0, MR, V) ->
+ M = site_module(Site0),
+ Site = {record, {M, RecName, length(DeclFields)}},
+ Type = t_from_form(Abstr, ET, Site, MR, V),
{Name, _, DeclType} = lists:keyfind(Name, 1, DeclFields),
TypeNoVars = subst_all_vars_to_any(Type),
case t_is_subtype(TypeNoVars, DeclType) of
false -> {error, Name};
- true -> check_fields(Left, DeclFields, ET, M, MR, V)
+ true -> check_fields(RecName, Left, DeclFields, ET, Site0, MR, V)
end;
-check_fields([], _Decl, _ET, _M, _MR, _V) ->
+check_fields(_RecName, [], _Decl, _ET, _Site, _MR, _V) ->
ok.
-list_check_record_fields([], _ET, _M, _MR, _V) ->
+list_check_record_fields([], _ET, _S, _MR, _V) ->
ok;
-list_check_record_fields([H|Tail], ET, M, MR, V) ->
- ok = t_check_record_fields(H, ET, M, MR, V),
- list_check_record_fields(Tail, ET, M, MR, V).
+list_check_record_fields([H|Tail], ET, S, MR, V) ->
+ ok = t_check_record_fields(H, ET, S, MR, V),
+ list_check_record_fields(Tail, ET, S, MR, V).
+
+site_module({_, {Module, _, _}}) ->
+ Module.
-spec t_var_names([erl_type()]) -> [atom()].
@@ -4580,8 +4631,9 @@ t_form_to_string({type, _L, Name, []} = T) ->
M = mod,
D0 = dict:new(),
MR = dict:from_list([{M, D0}]),
+ S = {type, {M,Name,0}},
{T1, _} =
- t_from_form(T, [], sets:new(), M, MR, D0, _Deep=1000, _ALot=100000),
+ t_from_form(T, [], sets:new(), S, MR, D0, _Deep=1000, _ALot=100000),
t_to_string(T1)
catch throw:{error, _} -> atom_to_string(Name) ++ "()"
end;
@@ -4673,6 +4725,12 @@ lookup_type(Name, Arity, RecDict) ->
type_is_defined(TypeOrOpaque, Name, Arity, RecDict) ->
dict:is_key({TypeOrOpaque, Name, Arity}, RecDict).
+cannot_have_opaque(Type, TypeName, TypeNames) ->
+ t_is_none(Type) orelse is_recursive(TypeName, TypeNames).
+
+is_recursive(TypeName, TypeNames) ->
+ lists:member(TypeName, TypeNames).
+
can_unfold_more(TypeName, TypeNames) ->
Fun = fun(E, Acc) -> case E of TypeName -> Acc + 1; _ -> Acc end end,
lists:foldl(Fun, 0, TypeNames) < ?REC_TYPE_LIMIT.
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index 3f979de078..205348524a 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -421,6 +421,16 @@ handle_cast({cancel, RequestId},
{profile, ProfileName},
{canceled, Canceled}]),
{noreply, State#state{canceled = [RequestId | Canceled]}};
+handle_cast({cancel, RequestId},
+ #state{profile_name = ProfileName,
+ request = undefined,
+ canceled = Canceled} = State) ->
+ ?hcrv("cancel", [{request_id, RequestId},
+ {curr_req_id, undefined},
+ {profile, ProfileName},
+ {canceled, Canceled}]),
+ {noreply, State};
+
handle_cast(stream_next, #state{session = Session} = State) ->
activate_once(Session),
diff --git a/lib/kernel/test/standard_error_SUITE.erl b/lib/kernel/test/standard_error_SUITE.erl
index e8917bbd47..97ead9b9fd 100644
--- a/lib/kernel/test/standard_error_SUITE.erl
+++ b/lib/kernel/test/standard_error_SUITE.erl
@@ -21,13 +21,13 @@
-module(standard_error_SUITE).
-export([all/0,suite/0]).
--export([badarg/1,getopts/1]).
+-export([badarg/1,getopts/1,output/1]).
suite() ->
[{ct_hooks,[ts_install_cth]}].
all() ->
- [badarg,getopts].
+ [badarg,getopts,output].
badarg(Config) when is_list(Config) ->
{'EXIT',{badarg,_}} = (catch io:put_chars(standard_error, [oops])),
@@ -37,3 +37,30 @@ badarg(Config) when is_list(Config) ->
getopts(Config) when is_list(Config) ->
[{encoding,latin1}] = io:getopts(standard_error),
ok.
+
+%% Test that writing a lot of output to standard_error does not cause the
+%% processes handling it to terminate like this:
+%%
+%% =ERROR REPORT==== 9-Aug-2015::23:19:23 ===
+%% ** Generic server standard_error_sup terminating
+%% ** Last message in was {'EXIT',<0.28.0>,eagain}
+%% ** When Server state == {state,standard_error,undefined,<0.28.0>,
+%% {local,standard_error_sup}}
+%% ** Reason for termination ==
+%% ** eagain
+%%
+%% This problem, observed with Erlang 18.0.2, was fixed in fd_driver by
+%% properly handling EAGAIN if it arises on file descriptor writes.
+%%
+output(Config) when is_list(Config) ->
+ Ref = monitor(process, standard_error_sup),
+ Chars = [ [["1234567890" || _ <- lists:seq(1,10)], $\s,
+ integer_to_list(L), $\r, $\n] || L <- lists:seq(1, 100) ],
+ ok = io:put_chars(standard_error, Chars),
+ receive
+ {'DOWN', Ref, process, _, _} ->
+ error(standard_error_noproc)
+ after
+ 500 ->
+ ok
+ end.
diff --git a/lib/mnesia/examples/bench/bench_generate.erl b/lib/mnesia/examples/bench/bench_generate.erl
index 7a701812a7..e838f07fbb 100644
--- a/lib/mnesia/examples/bench/bench_generate.erl
+++ b/lib/mnesia/examples/bench/bench_generate.erl
@@ -153,9 +153,7 @@ generator_init(Monitor, C) ->
process_flag(trap_exit, true),
Tables = mnesia:system_info(tables),
ok = mnesia:wait_for_tables(Tables, infinity),
- {_Mega, Sec, Micro} = erlang:now(),
- Uniq = lists:sum(binary_to_list(term_to_binary(make_ref()))),
- random:seed(Uniq, Sec, Micro),
+ rand:seed(exsplus),
Counters = reset_counters(C, C#config.statistics_detail),
SessionTab = ets:new(bench_sessions, [public, {keypos, 1}]),
generator_loop(Monitor, C, SessionTab, Counters).
@@ -189,9 +187,9 @@ generator_loop(Monitor, C, SessionTab, Counters) ->
after 0 ->
{Name, {Nodes, Activity, Wlock}, Fun, CommitSessions} =
gen_trans(C, SessionTab),
- Before = erlang:now(),
+ Before = erlang:monotonic_time(),
Res = call_worker(Nodes, Activity, Fun, Wlock, mnesia_frag),
- After = erlang:now(),
+ After = erlang:monotonic_time(),
Elapsed = elapsed(Before, After),
post_eval(Monitor, C, Elapsed, Res, Name, CommitSessions, SessionTab, Counters)
end.
@@ -253,10 +251,8 @@ worker_loop(Parent) ->
end.
-elapsed({Before1, Before2, Before3}, {After1, After2, After3}) ->
- After = After1 * 1000000000000 + After2 * 1000000 + After3,
- Before = Before1 * 1000000000000 + Before2 * 1000000 + Before3,
- After - Before.
+elapsed(Before, After) ->
+ erlang:convert_time_unit(After-Before, native, micro_seconds).
%% Lookup counters
get_counters(_C, {table, Tab}) ->
@@ -351,7 +347,7 @@ commit_session(Fun) when is_function(Fun, 0) ->
%% Randlomly choose a transaction type according to benchmar spec
gen_trans(C, SessionTab) when C#config.generator_profile == random ->
- case random:uniform(100) of
+ case rand:uniform(100) of
Rand when Rand > 0, Rand =< 25 -> gen_t1(C, SessionTab);
Rand when Rand > 25, Rand =< 50 -> gen_t2(C, SessionTab);
Rand when Rand > 50, Rand =< 70 -> gen_t3(C, SessionTab);
@@ -369,7 +365,7 @@ gen_trans(C, SessionTab) ->
end.
gen_t1(C, _SessionTab) ->
- SubscrId = random:uniform(C#config.n_subscribers) - 1,
+ SubscrId = rand:uniform(C#config.n_subscribers) - 1,
SubscrKey = bench_trans:number_to_key(SubscrId, C),
Location = 4711,
ChangedBy = <<4711:(8*25)>>,
@@ -381,7 +377,7 @@ gen_t1(C, _SessionTab) ->
}.
gen_t2(C, _SessionTab) ->
- SubscrId = random:uniform(C#config.n_subscribers) - 1,
+ SubscrId = rand:uniform(C#config.n_subscribers) - 1,
SubscrKey = bench_trans:number_to_key(SubscrId, C),
{t2,
nearest_node(SubscrId, sync_dirty, C),
@@ -395,9 +391,9 @@ gen_t3(C, SessionTab) ->
'$end_of_table' ->
%% This generator does not have any session,
%% try reading someone elses session details
- SubscrId = random:uniform(C#config.n_subscribers) - 1,
+ SubscrId = rand:uniform(C#config.n_subscribers) - 1,
SubscrKey = bench_trans:number_to_key(SubscrId, C),
- ServerId = random:uniform(C#config.n_servers) - 1,
+ ServerId = rand:uniform(C#config.n_servers) - 1,
ServerBit = 1 bsl ServerId,
{t3,
nearest_node(SubscrId, transaction, C),
@@ -419,12 +415,12 @@ gen_t4(C, SessionTab) ->
%% This generator may already have sessions,
%% create a new session and hope that no other
%% generator already has occupied it
- SubscrId = random:uniform(C#config.n_subscribers) - 1,
+ SubscrId = rand:uniform(C#config.n_subscribers) - 1,
SubscrKey = bench_trans:number_to_key(SubscrId, C),
- ServerId = random:uniform(C#config.n_servers) - 1,
+ ServerId = rand:uniform(C#config.n_servers) - 1,
ServerBit = 1 bsl ServerId,
Details = <<4711:(8*2000)>>,
- DoRollback = (random:uniform(100) =< 2),
+ DoRollback = (rand:uniform(100) =< 2),
Insert = fun() -> ets:insert(SessionTab, {{SubscrId, SubscrKey, ServerId}, self()}) end,
{t4,
nearest_node(SubscrId, transaction, C),
@@ -437,11 +433,11 @@ gen_t5(C, SessionTab) ->
'$end_of_table' ->
%% This generator does not have any session,
%% try to delete someone elses session details
- SubscrId = random:uniform(C#config.n_subscribers) - 1,
+ SubscrId = rand:uniform(C#config.n_subscribers) - 1,
SubscrKey = bench_trans:number_to_key(SubscrId, C),
- ServerId = random:uniform(C#config.n_servers) - 1,
+ ServerId = rand:uniform(C#config.n_servers) - 1,
ServerBit = 1 bsl ServerId,
- DoRollback = (random:uniform(100) =< 2),
+ DoRollback = (rand:uniform(100) =< 2),
{t5,
nearest_node(SubscrId, transaction, C),
fun(Wlock) -> bench_trans:delete_session_from_server(Wlock, SubscrKey, ServerBit, ServerId, DoRollback) end,
@@ -451,7 +447,7 @@ gen_t5(C, SessionTab) ->
%% This generator do have at least one session,
%% delete it.
ServerBit = 1 bsl ServerId,
- DoRollback = (random:uniform(100) =< 2),
+ DoRollback = (rand:uniform(100) =< 2),
Delete = fun() -> ets:delete(SessionTab, {SubscrId, SubscrKey, ServerId}) end,
{t5,
nearest_node(SubscrId, transaction, C),
@@ -461,7 +457,7 @@ gen_t5(C, SessionTab) ->
end.
gen_ping(C, _SessionTab) ->
- SubscrId = random:uniform(C#config.n_subscribers) - 1,
+ SubscrId = rand:uniform(C#config.n_subscribers) - 1,
{ping,
nearest_node(SubscrId, transaction, C),
fun(_Wlock) -> {do_commit, true, []} end,
diff --git a/lib/mnesia/examples/mnesia_tpcb.erl b/lib/mnesia/examples/mnesia_tpcb.erl
index fde6cf402e..c6eda1c448 100644
--- a/lib/mnesia/examples/mnesia_tpcb.erl
+++ b/lib/mnesia/examples/mnesia_tpcb.erl
@@ -164,7 +164,7 @@
-record(history,
{
history_id = {0, 0}, % {DriverId, DriverLocalHistoryid}
- time_stamp = now(), % Time point during active transaction
+ time_stamp = erlang:system_time(), % Time point during active transaction
branch_id = 0, % Branch associated with teller
teller_id = 0, % Teller invlolved in transaction
account_id = 0, % Account updated by transaction
@@ -412,9 +412,8 @@ config(remote_frag2_test, ReplicaType) ->
config(conflict_benchmark, ReplicaType) ->
Remote = nodes(),
Local = node(),
- Nodes = [Local | Remote],
- [{seed, {1326,448637,337711}},
- {db_nodes, Nodes},
+ Nodes = [Local | Remote],
+ [{db_nodes, Nodes},
{driver_nodes, Nodes},
{replica_nodes, Nodes},
{n_drivers_per_node, 10},
@@ -758,7 +757,7 @@ reporter_init(Starter, RC) ->
replica_type = Type
},
Drivers = start_drivers(RC, TC),
- Now = now_to_micros(erlang:now()),
+ Now = erlang:monotonic_time(),
State = #reporter_state{driver_pids = Drivers,
run_config = RC,
starter_pid = Starter,
@@ -896,7 +895,7 @@ add_time(Acc, New) ->
-define(AVOID_DIV_ZERO(_What_), try (_What_) catch _:_ -> 0 end).
show_report(State) ->
- Now = now_to_micros(erlang:now()),
+ Now = erlang:timestamp(),
Iters = State#reporter_state.n_iters,
Cfg = State#reporter_state.run_config,
Time = State#reporter_state.curr,
@@ -924,14 +923,14 @@ show_report(State) ->
case Cfg#run_config.send_bench_report of
true ->
ct_event:notify(
- #event{name = benchmark_data,
+ #event{name = benchmark_data,
data = [{suite,"mnesia_tpcb"},
{value,Tps}]});
_ ->
ok
end,
- State#reporter_state{prev_tps = Tps, prev_micros = Now}.
+ State#reporter_state{prev_tps = Tps, prev_micros = Now}.
signed_diff(Iters, Curr, Prev) ->
case Iters > 1 of
@@ -941,11 +940,6 @@ signed_diff(Iters, Curr, Prev) ->
sign(N) when N > 0 -> {"+", N};
sign(N) -> {"", N}.
-
-now_to_micros({Mega, Secs, Micros}) ->
- DT = calendar:now_to_datetime({Mega, Secs, 0}),
- S = calendar:datetime_to_gregorian_seconds(DT),
- (S * ?SECOND) + Micros.
start_drivers(RC, TC) ->
LastHistoryId = table_info(history, size),
@@ -998,13 +992,11 @@ alloc_local_branches([], Specs, OrphanBranches) ->
{Specs, OrphanBranches}.
driver_init(DS, AllBranches) ->
- case (DS#driver_state.run_config)#run_config.seed of
- undefined ->
- Seed = erlang:now();
- Seed ->
- Seed
+ Seed = case (DS#driver_state.run_config)#run_config.seed of
+ undefined -> rand:seed(exsplus);
+ ExpSeed -> rand:seed(ExpSeed)
end,
-
+
DS2 =
if
DS#driver_state.n_local_branches =:= 0 ->
@@ -1058,14 +1050,7 @@ calc_trans(DS) ->
%% Generate teller_id, account_id and delta
%% Time the TPC-B transaction
time_trans(DS) ->
- OldSeed = get(random_seed), % Avoid interference with Mnesia
- put(random_seed, DS#driver_state.seed),
- Random = random:uniform(),
- NewSeed = get(random_seed),
- case OldSeed of
- undefined -> erase(random_seed);
- _ -> put(random_seed, OldSeed)
- end,
+ {Random, NewSeed} = rand:uniform_s(DS#driver_state.seed),
TC = DS#driver_state.tab_config,
RC = DS#driver_state.run_config,
diff --git a/lib/mnesia/test/mnesia_atomicity_test.erl b/lib/mnesia/test/mnesia_atomicity_test.erl
index 1d9d9c35bc..e3e0eaaf75 100644
--- a/lib/mnesia/test/mnesia_atomicity_test.erl
+++ b/lib/mnesia/test/mnesia_atomicity_test.erl
@@ -557,8 +557,8 @@ start_lock_waiter(BlockOpA, BlockOpB, Config) ->
?verify_mnesia([N1], [N2]).
mk_tab_name(Prefix) ->
- {Mega, Sec, Micro} = erlang:now(),
- list_to_atom(lists:concat([Prefix , Mega, '_', Sec, '_', Micro])).
+ Count = erlang:unique_integer([monotonic,positive]),
+ list_to_atom(lists:concat([Prefix , '_', Count])).
lock_waiter_fun(Op, TabName, Val) ->
case Op of
diff --git a/lib/mnesia/test/mnesia_config_test.erl b/lib/mnesia/test/mnesia_config_test.erl
index c8a6a000c6..089fbc06dc 100644
--- a/lib/mnesia/test/mnesia_config_test.erl
+++ b/lib/mnesia/test/mnesia_config_test.erl
@@ -1206,7 +1206,7 @@ dynamic_ext(Config) when is_list(Config) ->
end,
[Check(Test) || Test <- [{tab1, ram_copies},{tab2, disc_copies},{tab3, disc_only_copies}]],
- T = now(),
+ T = erlang:unique_integer(),
?match(ok, mnesia:dirty_write({tab0, 42, T})),
?match(ok, mnesia:dirty_write({tab1, 42, T})),
?match(ok, mnesia:dirty_write({tab2, 42, T})),
@@ -1284,7 +1284,7 @@ check_storage(Me, Orig, Other) ->
mnesia_test_lib:kill_mnesia([Orig]),
mnesia_test_lib:kill_mnesia(Other),
- T = now(),
+ T = erlang:unique_integer(),
?match(ok, rpc:call(Me, mnesia, dirty_write, [{tab2, 42, T}])),
?match(stopped, rpc:call(Me, mnesia, stop, [])),
?match(ok, rpc:call(Me, mnesia, start, [])),
diff --git a/lib/mnesia/test/mnesia_cost.erl b/lib/mnesia/test/mnesia_cost.erl
index ff0108ced1..714dbaef27 100644
--- a/lib/mnesia/test/mnesia_cost.erl
+++ b/lib/mnesia/test/mnesia_cost.erl
@@ -108,11 +108,11 @@ run(What, OtherInfo, Ops, F) ->
run(t, What, OtherInfo, Ops, F).
run(How, What, OtherInfo, Ops, F) ->
- T1 = erlang:now(),
+ T1 = erlang:monotonic_time(),
statistics(runtime),
do_times(How, ?TIMES, F),
{_, RunTime} = statistics(runtime),
- T2 = erlang:now(),
+ T2 = erlang:monotonic_time(),
RealTime = subtr(T1, T2),
report(How, What, OtherInfo, Ops, RunTime, RealTime).
@@ -140,11 +140,7 @@ report(dirty, What, OtherInfo, Ops, RunTime, RealTime) ->
subtr(Before, After) ->
- E =(element(1,After)*1000000000000
- +element(2,After)*1000000+element(3,After)) -
- (element(1,Before)*1000000000000
- +element(2,Before)*1000000+element(3,Before)),
- E div 1000.
+ erlang:convert_time_unit(After-Before, native, milli_seconds).
do_times(t, I, F) ->
do_trans_times(I, F);
diff --git a/lib/mnesia/test/mnesia_dbn_meters.erl b/lib/mnesia/test/mnesia_dbn_meters.erl
index f97bd973fc..5c3ea08a1d 100644
--- a/lib/mnesia/test/mnesia_dbn_meters.erl
+++ b/lib/mnesia/test/mnesia_dbn_meters.erl
@@ -93,7 +93,7 @@ some_meters() ->
report_meter(Meter) ->
Times = 100,
Micros = repeat_meter(Meter,{atomic,{0,ignore}},Times) div Times,
- io:format("\t~-30w ~-10w micro seconds (mean of ~p repetitions)~n",[Meter,Micros,Times]).
+ io:format("\t~-30w ~-10w nano seconds (mean of ~p repetitions)~n",[Meter,Micros,Times]).
repeat_meter(_Meter,{atomic,{Micros,_Result}},0) ->
Micros;
@@ -110,9 +110,9 @@ meter(create) ->
Key = 1,
mnesia:transaction(fun() -> mnesia:delete({simple,Key}) end),
Fun = fun() ->
- BeforeT = erlang:now(),
+ BeforeT = erlang:monotonic_time(),
R = mnesia:write(#simple{key=Key}),
- AfterT = erlang:now(),
+ AfterT = erlang:monotonic_time(),
elapsed_time(BeforeT,AfterT,R)
end,
mnesia:transaction(Fun);
@@ -121,9 +121,9 @@ meter(open_safe_read) ->
Key = 2,
mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end),
Fun = fun() ->
- BeforeT = erlang:now(),
+ BeforeT = erlang:monotonic_time(),
R = mnesia:read({simple,Key}),
- AfterT = erlang:now(),
+ AfterT = erlang:monotonic_time(),
elapsed_time(BeforeT,AfterT,R)
end,
mnesia:transaction(Fun);
@@ -132,9 +132,9 @@ meter(open_dirty_read) ->
Key = 21,
mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end),
Fun = fun() ->
- BeforeT = erlang:now(),
+ BeforeT = erlang:monotonic_time(),
R = mnesia:dirty_read({simple,Key}),
- AfterT = erlang:now(),
+ AfterT = erlang:monotonic_time(),
elapsed_time(BeforeT,AfterT,R)
end,
mnesia:transaction(Fun);
@@ -144,9 +144,9 @@ meter(get_int) ->
mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end),
Fun = fun() ->
[Simple] = mnesia:read({simple,Key}),
- BeforeT = erlang:now(),
+ BeforeT = erlang:monotonic_time(),
Int = Simple#simple.val,
- AfterT = erlang:now(),
+ AfterT = erlang:monotonic_time(),
elapsed_time(BeforeT,AfterT,Int)
end,
mnesia:transaction(Fun);
@@ -155,9 +155,9 @@ meter(open_update) ->
Key = 3,
mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end),
Fun = fun() ->
- BeforeT = erlang:now(),
+ BeforeT = erlang:monotonic_time(),
R = mnesia:wread({simple,Key}),
- AfterT = erlang:now(),
+ AfterT = erlang:monotonic_time(),
elapsed_time(BeforeT,AfterT,R)
end,
mnesia:transaction(Fun);
@@ -167,9 +167,9 @@ meter(put_int) ->
mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end),
Fun = fun() ->
[Simple] = mnesia:wread({simple,Key}),
- BeforeT = erlang:now(),
+ BeforeT = erlang:monotonic_time(),
R = Simple#simple{val=7},
- AfterT = erlang:now(),
+ AfterT = erlang:monotonic_time(),
elapsed_time(BeforeT,AfterT,R)
end,
mnesia:transaction(Fun);
@@ -179,10 +179,10 @@ meter(put_int_and_copy) ->
mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end),
Fun = fun() ->
[Simple] = mnesia:wread({simple,Key}),
- BeforeT = erlang:now(),
+ BeforeT = erlang:monotonic_time(),
Simple2 = Simple#simple{val=17},
R = mnesia:write(Simple2),
- AfterT = erlang:now(),
+ AfterT = erlang:monotonic_time(),
elapsed_time(BeforeT,AfterT,R)
end,
mnesia:transaction(Fun);
@@ -191,15 +191,15 @@ meter(dirty_put_int_and_copy) ->
Key = 55,
mnesia:dirty_write(#simple{key=Key}),
[Simple] = mnesia:dirty_read({simple,Key}),
- BeforeT = erlang:now(),
+ BeforeT = erlang:monotonic_time(),
Simple2 = Simple#simple{val=17},
R = mnesia:dirty_write(Simple2),
- AfterT = erlang:now(),
+ AfterT = erlang:monotonic_time(),
{atomic,elapsed_time(BeforeT,AfterT,R)};
meter(start_trans) ->
- BeforeT = erlang:now(),
- {atomic,AfterT} = mnesia:transaction(fun() -> erlang:now() end),
+ BeforeT = erlang:monotonic_time(),
+ {atomic,AfterT} = mnesia:transaction(fun() -> erlang:monotonic_time() end),
{atomic,elapsed_time(BeforeT,AfterT,ok)};
meter(commit_one_update) ->
@@ -209,19 +209,19 @@ meter(commit_one_update) ->
[Simple] = mnesia:wread({simple,Key}),
Simple2 = Simple#simple{val=27},
_R = mnesia:write(Simple2),
- erlang:now()
+ erlang:monotonic_time()
end,
{atomic,BeforeT} = mnesia:transaction(Fun),
- AfterT = erlang:now(),
+ AfterT = erlang:monotonic_time(),
{atomic,elapsed_time(BeforeT,AfterT,ok)};
meter(delete) ->
Key = 7,
mnesia:transaction(fun() -> mnesia:write(#simple{key=Key}) end),
Fun = fun() ->
- BeforeT = erlang:now(),
+ BeforeT = erlang:monotonic_time(),
R = mnesia:delete({simple,Key}),
- AfterT = erlang:now(),
+ AfterT = erlang:monotonic_time(),
elapsed_time(BeforeT,AfterT,R)
end,
mnesia:transaction(Fun);
@@ -229,15 +229,12 @@ meter(delete) ->
meter(dirty_delete) ->
Key = 75,
mnesia:dirty_write(#simple{key=Key}),
- BeforeT = erlang:now(),
+ BeforeT = erlang:monotonic_time(),
R = mnesia:dirty_delete({simple,Key}),
- AfterT = erlang:now(),
+ AfterT = erlang:monotonic_time(),
{atomic, elapsed_time(BeforeT,AfterT,R)}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Calculate the elapsed time
elapsed_time(BeforeT,AfterT,Result) ->
- {(element(1,AfterT)*1000000000000
- +element(2,AfterT)*1000000+element(3,AfterT)) -
- (element(1,BeforeT)*1000000000000
- +element(2,BeforeT)*1000000+element(3,BeforeT)),Result}.
+ {erlang:convert_time_unit(AfterT-BeforeT, native, nano_seconds),Result}.
diff --git a/lib/mnesia/test/mnesia_evil_backup.erl b/lib/mnesia/test/mnesia_evil_backup.erl
index 5392267f79..89f2861661 100644
--- a/lib/mnesia/test/mnesia_evil_backup.erl
+++ b/lib/mnesia/test/mnesia_evil_backup.erl
@@ -229,7 +229,7 @@ restore(Config, Op) ->
[mnesia:dirty_write({Tab1, N, N+1}) || N <- lists:seq(1, 11)],
[mnesia:dirty_write({Tab2, N, N+1}) || N <- lists:seq(1, 11)],
[mnesia:dirty_write({Tab3, N, N+1}) || N <- lists:seq(1, 11)],
- _Res11 = [{Tab1, N, N+1} || N <- lists:seq(1, 11)],
+
Res21 = [{Tab2, N, N+1} || N <- lists:seq(1, 11)],
Res31 = [[{Tab3, N, N+1}, {Tab3, N, N+44}] || N <- lists:seq(1, 10)],
diff --git a/lib/mnesia/test/mnesia_isolation_test.erl b/lib/mnesia/test/mnesia_isolation_test.erl
index 6abb1f7cdc..b66da6e390 100644
--- a/lib/mnesia/test/mnesia_isolation_test.erl
+++ b/lib/mnesia/test/mnesia_isolation_test.erl
@@ -1127,7 +1127,9 @@ update_shared(Tab, Me, Acc) ->
0 ->
case mnesia:transaction(Update) of
{atomic, {ok,Term,W2}} ->
- io:format("~p:~p:(~p,~p) ~w@~w~n", [erlang:now(),node(),Me,Acc,Term,W2]),
+ io:format("~p:~p:(~p,~p) ~w@~w~n",
+ [erlang:unique_integer([monotonic,positive]),
+ node(),Me,Acc,Term,W2]),
update_shared(Tab, Me, Acc+1);
Else ->
?error("Trans failed on ~p with ~p~n"
diff --git a/lib/mnesia/test/mnesia_test_lib.erl b/lib/mnesia/test/mnesia_test_lib.erl
index 035d6bde87..9d3b277e07 100644
--- a/lib/mnesia/test/mnesia_test_lib.erl
+++ b/lib/mnesia/test/mnesia_test_lib.erl
@@ -238,8 +238,8 @@ slave_start_link() ->
slave_start_link(Node) ->
[Local, Host] = node_to_name_and_host(Node),
- {Mega, Sec, Micro} = erlang:now(),
- List = [Local, "_", Mega, "_", Sec, "_", Micro],
+ Count = erlang:unique_integer([positive]),
+ List = [Local, "_", Count],
Name = list_to_atom(lists:concat(List)),
slave_start_link(list_to_atom(Host), Name).
diff --git a/lib/mnesia/test/mnesia_tpcb.erl b/lib/mnesia/test/mnesia_tpcb.erl
index 3f936591b0..c6eda1c448 100644
--- a/lib/mnesia/test/mnesia_tpcb.erl
+++ b/lib/mnesia/test/mnesia_tpcb.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -100,9 +100,13 @@
replica_test/1,
sticky_replica_test/1,
remote_test/1,
- remote_frag2_test/1
+ remote_frag2_test/1,
+
+ conflict_benchmark/1
]).
+-include_lib("common_test/include/ct_event.hrl").
+
-define(SECOND, 1000000).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -160,7 +164,7 @@
-record(history,
{
history_id = {0, 0}, % {DriverId, DriverLocalHistoryid}
- time_stamp = now(), % Time point during active transaction
+ time_stamp = erlang:system_time(), % Time point during active transaction
branch_id = 0, % Branch associated with teller
teller_id = 0, % Teller invlolved in transaction
account_id = 0, % Account updated by transaction
@@ -192,8 +196,10 @@
driver_nodes = [node()],
n_drivers_per_node = 1,
use_running_mnesia = false,
+ seed,
stop_after = timer:minutes(15), % Minimum 15 min
report_interval = timer:minutes(1),
+ send_bench_report = false,
use_sticky_locks = false,
spawn_near_branch = false,
activity_type = transaction,
@@ -398,8 +404,29 @@ config(remote_frag2_test, ReplicaType) ->
{stop_after, timer:minutes(1)},
{report_interval, timer:seconds(10)},
{reuse_history_id, true}
+ ];
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Ten drivers per node, tables replicated to all nodes, single branch
+
+config(conflict_benchmark, ReplicaType) ->
+ Remote = nodes(),
+ Local = node(),
+ Nodes = [Local | Remote],
+ [{db_nodes, Nodes},
+ {driver_nodes, Nodes},
+ {replica_nodes, Nodes},
+ {n_drivers_per_node, 10},
+ {n_branches, 1},
+ {n_accounts_per_branch, 10},
+ {replica_type, ReplicaType},
+ {stop_after, timer:minutes(1)},
+ {report_interval, timer:seconds(10)},
+ {send_bench_report, true},
+ {reuse_history_id, true}
].
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
start(What, ReplicaType) ->
@@ -423,6 +450,9 @@ remote_test(ReplicaType) ->
remote_frag2_test(ReplicaType) ->
start(remote_frag2_test, ReplicaType).
+conflict_benchmark(ReplicaType) ->
+ start(config(conflict_benchmark, ReplicaType)).
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Args is a list of {Key, Val} tuples where Key is a field name
%% in either the record tab_config or run_config. Unknown keys are ignored.
@@ -727,7 +757,7 @@ reporter_init(Starter, RC) ->
replica_type = Type
},
Drivers = start_drivers(RC, TC),
- Now = now_to_micros(erlang:now()),
+ Now = erlang:monotonic_time(),
State = #reporter_state{driver_pids = Drivers,
run_config = RC,
starter_pid = Starter,
@@ -865,8 +895,9 @@ add_time(Acc, New) ->
-define(AVOID_DIV_ZERO(_What_), try (_What_) catch _:_ -> 0 end).
show_report(State) ->
- Now = now_to_micros(erlang:now()),
+ Now = erlang:timestamp(),
Iters = State#reporter_state.n_iters,
+ Cfg = State#reporter_state.run_config,
Time = State#reporter_state.curr,
Max = Time#time.max_time,
N = Time#time.n_trans,
@@ -889,6 +920,16 @@ show_report(State) ->
"duration of longest transaction was ~p milliseconds~n",
[Tps, BruttoTps, Max div 1000])
end,
+ case Cfg#run_config.send_bench_report of
+ true ->
+ ct_event:notify(
+ #event{name = benchmark_data,
+ data = [{suite,"mnesia_tpcb"},
+ {value,Tps}]});
+ _ ->
+ ok
+ end,
+
State#reporter_state{prev_tps = Tps, prev_micros = Now}.
signed_diff(Iters, Curr, Prev) ->
@@ -899,11 +940,6 @@ signed_diff(Iters, Curr, Prev) ->
sign(N) when N > 0 -> {"+", N};
sign(N) -> {"", N}.
-
-now_to_micros({Mega, Secs, Micros}) ->
- DT = calendar:now_to_datetime({Mega, Secs, 0}),
- S = calendar:datetime_to_gregorian_seconds(DT),
- (S * ?SECOND) + Micros.
start_drivers(RC, TC) ->
LastHistoryId = table_info(history, size),
@@ -956,7 +992,11 @@ alloc_local_branches([], Specs, OrphanBranches) ->
{Specs, OrphanBranches}.
driver_init(DS, AllBranches) ->
- Seed = erlang:now(),
+ Seed = case (DS#driver_state.run_config)#run_config.seed of
+ undefined -> rand:seed(exsplus);
+ ExpSeed -> rand:seed(ExpSeed)
+ end,
+
DS2 =
if
DS#driver_state.n_local_branches =:= 0 ->
@@ -1010,14 +1050,7 @@ calc_trans(DS) ->
%% Generate teller_id, account_id and delta
%% Time the TPC-B transaction
time_trans(DS) ->
- OldSeed = get(random_seed), % Avoid interference with Mnesia
- put(random_seed, DS#driver_state.seed),
- Random = random:uniform(),
- NewSeed = get(random_seed),
- case OldSeed of
- undefined -> erase(random_seed);
- _ -> put(random_seed, OldSeed)
- end,
+ {Random, NewSeed} = rand:uniform_s(DS#driver_state.seed),
TC = DS#driver_state.tab_config,
RC = DS#driver_state.run_config,
diff --git a/lib/odbc/doc/src/odbc.xml b/lib/odbc/doc/src/odbc.xml
index 01bc0cb7ff..6a2a3587e4 100644
--- a/lib/odbc/doc/src/odbc.xml
+++ b/lib/odbc/doc/src/odbc.xml
@@ -221,6 +221,18 @@
and their meanings are dependent on the database being used.</item>
<item><c>Reason</c> is as per the <c>Reason</c> field when extended errors are not enabled.</item>
</list>
+
+ <note>
+ <p>The current implementation spawns a port programm
+ written in C that utilizes the actual ODBC driver. There
+ is a default timeout of 5000 msec for this port programm
+ to connect to the Erlang ODBC application. This timeout
+ can be changed by setting an application specific
+ environment variable 'port_timeout' with the number of
+ milliseconds for the ODBC application. E.g.: [{odbc,
+ [{port_timeout, 60000}]}] to set it to 60 seconds.
+ </p>
+ </note>
</desc>
</func>
<func>
diff --git a/lib/odbc/src/odbc.erl b/lib/odbc/src/odbc.erl
index 4901821e9c..12560bfb6e 100644
--- a/lib/odbc/src/odbc.erl
+++ b/lib/odbc/src/odbc.erl
@@ -26,6 +26,8 @@
-include("odbc_internal.hrl").
+-define(ODBC_PORT_TIMEOUT, 5000).
+
%% API --------------------------------------------------------------------
-export([start/0, start/1, stop/0,
@@ -523,10 +525,10 @@ handle_msg({connect, ODBCCmd, AutoCommitMode, SrollableCursors},
NewState = State#state{auto_commit_mode = AutoCommitMode,
scrollable_cursors = SrollableCursors},
- case gen_tcp:accept(ListenSocketSup, 5000) of
+ case gen_tcp:accept(ListenSocketSup, port_timeout()) of
{ok, SupSocket} ->
gen_tcp:close(ListenSocketSup),
- case gen_tcp:accept(ListenSocketOdbc, 5000) of
+ case gen_tcp:accept(ListenSocketOdbc, port_timeout()) of
{ok, OdbcSocket} ->
gen_tcp:close(ListenSocketOdbc),
odbc_send(OdbcSocket, ODBCCmd),
@@ -983,3 +985,6 @@ string_terminate_value(Binary) when is_binary(Binary) ->
<<Binary/binary,0:16>>;
string_terminate_value(null) ->
null.
+
+port_timeout() ->
+ application:get_env(?MODULE, port_timeout, ?ODBC_PORT_TIMEOUT).
diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl
index 93e949faf6..2d4173a008 100644
--- a/lib/odbc/test/odbc_connect_SUITE.erl
+++ b/lib/odbc/test/odbc_connect_SUITE.erl
@@ -120,7 +120,16 @@ end_per_suite(_Config) ->
%% Note: This function is free to add any key/value pairs to the Config
%% variable, but should NOT alter/remove any existing entries.
%%--------------------------------------------------------------------
+init_per_testcase(connect_port_timeout, Config) ->
+ odbc:stop(),
+ application:load(odbc),
+ application:set_env(odbc, port_timeout, 0),
+ odbc:start(),
+ init_per_testcase_common(Config);
init_per_testcase(_TestCase, Config) ->
+ init_per_testcase_common(Config).
+
+init_per_testcase_common(Config) ->
test_server:format("ODBCINI = ~p~n", [os:getenv("ODBCINI")]),
Dog = test_server:timetrap(?default_timeout),
Temp = lists:keydelete(connection_ref, 1, Config),
@@ -135,7 +144,16 @@ init_per_testcase(_TestCase, Config) ->
%% A list of key/value pairs, holding the test case configuration.
%% Description: Cleanup after each test case
%%--------------------------------------------------------------------
+
+end_per_testcase(connect_port_timeout, Config) ->
+ application:unset_env(odbc, port_timeout),
+ odbc:stop(),
+ odbc:start(),
+ end_per_testcase_common(Config);
end_per_testcase(_TestCase, Config) ->
+ end_per_testcase_common(Config).
+
+end_per_testcase_common(Config) ->
Table = ?config(tableName, Config),
{ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()),
Result = odbc:sql_query(Ref, "DROP TABLE " ++ Table),
@@ -423,6 +441,18 @@ connect_timeout(Config) when is_list(Config) ->
%% Need to return ok here "{'EXIT',timeout} return value" will
%% be interpreted as that the testcase has timed out.
ok.
+
+%%-------------------------------------------------------------------------
+connect_port_timeout(doc) ->
+ ["Test the timeout for the port program to connect back to the odbc "
+ "application within the connect function."];
+connect_port_timeout(suite) -> [];
+connect_port_timeout(Config) when is_list(Config) ->
+ %% Application environment var 'port_timeout' has been set to 0 by
+ %% init_per_testcase/2.
+ {error,timeout} = odbc:connect(?RDBMS:connection_string(),
+ odbc_test_lib:platform_options()).
+
%%-------------------------------------------------------------------------
timeout(doc) ->
["Test that timeouts don't cause unwanted behavior sush as receiving"
diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml
index 394fe54428..209de2bdf7 100644
--- a/lib/public_key/doc/src/public_key.xml
+++ b/lib/public_key/doc/src/public_key.xml
@@ -108,8 +108,9 @@
<p><c>| 'SubjectPublicKeyInfo'</c></p>
<p><c>| 'PrivateKeyInfo'</c></p>
<p><c>| 'CertificationRequest'</c></p>
+ <p><c>| 'CertificateList'</c></p>
<p><c>| 'ECPrivateKey'</c></p>
- <p><c>| 'EcpkParameters'</c></p>
+ <p><c>| 'EcpkParameters'</c></p>
</item>
<tag><c>pem_entry () =</c></tag>
@@ -433,7 +434,7 @@
<name>pkix_is_issuer(Cert, IssuerCert) -> boolean()</name>
<fsummary>Checks if <c>IssuerCert</c> issued <c>Cert</c>.</fsummary>
<type>
- <v>Cert = der_encoded() | #'OTPCertificate'{}</v>
+ <v>Cert = der_encoded() | #'OTPCertificate'{} | #'CertificateList'{}</v>
<v>IssuerCert = der_encoded() | #'OTPCertificate'{}</v>
</type>
<desc>
@@ -698,7 +699,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
<name>pkix_sign(#'OTPTBSCertificate'{}, Key) -> der_encoded()</name>
<fsummary>Signs certificate.</fsummary>
<type>
- <v>Key = rsa_public_key() | dsa_public_key()</v>
+ <v>Key = rsa_private_key() | dsa_private_key()</v>
</type>
<desc>
<p>Signs an 'OTPTBSCertificate'. Returns the corresponding
@@ -713,7 +714,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
<v>AlgorithmId = oid()</v>
<d>Signature OID from a certificate or a certificate revocation list.</d>
<v>DigestType = rsa_digest_type() | dss_digest_type()</v>
- <v>SignatureType = rsa | dsa</v>
+ <v>SignatureType = rsa | dsa | ecdsa</v>
</type>
<desc>
<p>Translates signature algorithm OID to Erlang digest and signature types.
@@ -726,7 +727,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
<fsummary>Verifies PKIX x.509 certificate signature.</fsummary>
<type>
<v>Cert = der_encoded()</v>
- <v>Key = rsa_public_key() | dsa_public_key()</v>
+ <v>Key = rsa_public_key() | dsa_public_key() | ec_public_key()</v>
</type>
<desc>
<p>Verifies PKIX x.509 certificate signature.</p>
diff --git a/lib/runtime_tools/doc/src/notes.xml b/lib/runtime_tools/doc/src/notes.xml
index 71b244ec6b..5aebea98ce 100644
--- a/lib/runtime_tools/doc/src/notes.xml
+++ b/lib/runtime_tools/doc/src/notes.xml
@@ -32,6 +32,23 @@
<p>This document describes the changes made to the Runtime_Tools
application.</p>
+<section><title>Runtime_Tools 1.9.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ The <c>trace_file_drv</c> did not handle <c>EINTR</c>
+ correct which caused it to fail when the runtime system
+ received a signal.</p>
+ <p>
+ Own Id: OTP-12890 Aux Id: seq12885 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Runtime_Tools 1.9</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/runtime_tools/vsn.mk b/lib/runtime_tools/vsn.mk
index 3aadc46ab6..83e3612561 100644
--- a/lib/runtime_tools/vsn.mk
+++ b/lib/runtime_tools/vsn.mk
@@ -1 +1 @@
-RUNTIME_TOOLS_VSN = 1.9
+RUNTIME_TOOLS_VSN = 1.9.1
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index d24025ca4d..cf5e8f1aff 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -43,7 +43,7 @@
<item>Supported public key algorithms: ssh-rsa and ssh-dss.</item>
<item>Supported MAC algorithms: hmac-sha2-256 and hmac-sha1.</item>
<item>Supported encryption algorithms: aes128-ctr, aes128-cb and 3des-cbc.</item>
- <item>Supported key exchange algorithms: diffie-hellman-group1-sha1.</item>
+ <item>Supported key exchange algorithms: diffie-hellman-group1-sha1, diffie-hellman-group14-sha1, diffie-hellman-group-exchange-sha1 and diffie-hellman-group-exchange-sha256.</item>
<item>Supported compression algorithms: none, zlib, [email protected],</item>
<item>Supports unicode filenames if the emulator and the underlaying OS support it.
See section DESCRIPTION in the
@@ -240,6 +240,13 @@ kex is implicit but public_key is set explicitly.</p>
</warning>
</item>
+ <tag><c><![CDATA[{dh_gex_limits,{Min=integer(),I=integer(),Max=integer()}}]]></c></tag>
+ <item>
+ <p>Sets the three diffie-hellman-group-exchange parameters that guides the connected server in choosing a group.
+ See RFC 4419 for the function of thoose. The default value is <c>{512, 1024, 4096}</c>.
+ </p>
+ </item>
+
<tag><c><![CDATA[{connect_timeout, timeout()}]]></c></tag>
<item>
<p>Sets a time-out on the transport layer
@@ -449,6 +456,15 @@ kex is implicit but public_key is set explicitly.</p>
</warning>
</item>
+ <tag><c><![CDATA[{dh_gex_groups, [{Size=integer(),G=integer(),P=integer()}] | {file,filename()} }]]></c></tag>
+ <item>
+ <p>Sets the groups that the server may choose among when diffie-hellman-group-exchange is negotiated.
+ See RFC 4419 for details.
+ </p>
+ <p>If the parameter is <c>{file,filename()}</c>, the file must exist and have one or more three-tuples terminated by a dot. The interpretation is as if the tuples had been given directly in the option. The file is read when the daemon starts.
+ </p>
+ </item>
+
<tag><c><![CDATA[{pwdfun, fun(User::string(), password::string()) -> boolean()}]]></c></tag>
<item>
<p>Provides a function for password validation. This function is called
diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile
index 61d71d2cf7..b44c8eef35 100644
--- a/lib/ssh/src/Makefile
+++ b/lib/ssh/src/Makefile
@@ -67,7 +67,6 @@ MODULES= \
ssh_file \
ssh_io \
ssh_info \
- ssh_math \
ssh_message \
ssh_no_io \
ssh_sftp \
@@ -145,3 +144,78 @@ release_spec: opt
release_docs_spec:
+
+deps:
+ erlc -M $(ERL_FILES) \
+ | sed 's@$(ERL_TOP)/lib@../..@g' \
+ | sed 's/\.$(EMULATOR)/\.$$\(EMULATOR\)/' \
+ | sed 's@^ssh_@$$(EBIN)/ssh_@'
+
+ssh.$(EMULATOR): ssh.erl ssh.hrl ssh_connect.hrl \
+ ../../public_key/include/public_key.hrl \
+ ../../public_key/include/OTP-PUB-KEY.hrl \
+ ../../public_key/include/PKCS-FRAME.hrl \
+ ../../kernel/include/file.hrl
+$(EBIN)/ssh_sup.$(EMULATOR): ssh_sup.erl
+sshc_sup.$(EMULATOR): sshc_sup.erl
+sshd_sup.$(EMULATOR): sshd_sup.erl ssh.hrl
+$(EBIN)/ssh_connection_sup.$(EMULATOR): ssh_connection_sup.erl
+$(EBIN)/ssh_connection.$(EMULATOR): ssh_connection.erl ssh.hrl ssh_connect.hrl \
+ ssh_transport.hrl
+$(EBIN)/ssh_connection_handler.$(EMULATOR): ssh_connection_handler.erl ssh.hrl \
+ ssh_transport.hrl ssh_auth.hrl ssh_connect.hrl
+$(EBIN)/ssh_shell.$(EMULATOR): ssh_shell.erl ssh_connect.hrl
+$(EBIN)/ssh_system_sup.$(EMULATOR): ssh_system_sup.erl ssh.hrl
+$(EBIN)/ssh_subsystem_sup.$(EMULATOR): ssh_subsystem_sup.erl
+$(EBIN)/ssh_channel_sup.$(EMULATOR): ssh_channel_sup.erl
+$(EBIN)/ssh_acceptor_sup.$(EMULATOR): ssh_acceptor_sup.erl ssh.hrl
+$(EBIN)/ssh_acceptor.$(EMULATOR): ssh_acceptor.erl ssh.hrl
+$(EBIN)/ssh_app.$(EMULATOR): ssh_app.erl
+$(EBIN)/ssh_auth.$(EMULATOR): ssh_auth.erl \
+ ../../public_key/include/public_key.hrl \
+ ../../public_key/include/OTP-PUB-KEY.hrl \
+ ../../public_key/include/PKCS-FRAME.hrl \
+ ssh.hrl ssh_auth.hrl ssh_transport.hrl
+$(EBIN)/ssh_bits.$(EMULATOR): ssh_bits.erl ssh.hrl
+$(EBIN)/ssh_cli.$(EMULATOR): ssh_cli.erl ssh.hrl ssh_connect.hrl
+$(EBIN)/ssh_file.$(EMULATOR): ssh_file.erl \
+ ../../public_key/include/public_key.hrl \
+ ../../public_key/include/OTP-PUB-KEY.hrl \
+ ../../public_key/include/PKCS-FRAME.hrl \
+ ../../kernel/include/file.hrl ssh.hrl
+$(EBIN)/ssh_io.$(EMULATOR): ssh_io.erl ssh.hrl
+$(EBIN)/ssh_info.$(EMULATOR): ssh_info.erl
+$(EBIN)/ssh_message.$(EMULATOR): ssh_message.erl \
+ ../../public_key/include/public_key.hrl \
+ ../../public_key/include/OTP-PUB-KEY.hrl \
+ ../../public_key/include/PKCS-FRAME.hrl \
+ ssh.hrl ssh_connect.hrl ssh_auth.hrl ssh_transport.hrl
+$(EBIN)/ssh_no_io.$(EMULATOR): ssh_no_io.erl ssh_transport.hrl
+$(EBIN)/ssh_sftp.$(EMULATOR): ssh_sftp.erl \
+ ../../kernel/include/file.hrl ssh.hrl \
+ ssh_xfer.hrl
+$(EBIN)/ssh_sftpd.$(EMULATOR): ssh_sftpd.erl \
+ ../../kernel/include/file.hrl ssh.hrl \
+ ssh_xfer.hrl
+$(EBIN)/ssh_sftpd_file.$(EMULATOR): ssh_sftpd_file.erl
+$(EBIN)/ssh_transport.$(EMULATOR): ssh_transport.erl \
+ ../../public_key/include/public_key.hrl \
+ ../../public_key/include/OTP-PUB-KEY.hrl \
+ ../../public_key/include/PKCS-FRAME.hrl \
+ ../../kernel/include/inet.hrl \
+ ssh_transport.hrl ssh.hrl
+$(EBIN)/ssh_xfer.$(EMULATOR): ssh_xfer.erl ssh.hrl ssh_xfer.hrl
+$(EBIN)/ssh_sftpd_file_api.$(EMULATOR): ssh_sftpd_file_api.erl
+$(EBIN)/ssh_channel.$(EMULATOR): ssh_channel.erl ssh_connect.hrl
+$(EBIN)/ssh_daemon_channel.$(EMULATOR): ssh_daemon_channel.erl
+$(EBIN)/ssh_client_key_api.$(EMULATOR): ssh_client_key_api.erl \
+ ../../public_key/include/public_key.hrl \
+ ../../public_key/include/OTP-PUB-KEY.hrl \
+ ../../public_key/include/PKCS-FRAME.hrl \
+ ssh.hrl
+$(EBIN)/ssh_server_key_api.$(EMULATOR): ssh_server_key_api.erl \
+ ../../public_key/include/public_key.hrl \
+ ../../public_key/include/OTP-PUB-KEY.hrl \
+ ../../public_key/include/PKCS-FRAME.hrl \
+ ssh.hrl
+
diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src
index bc01c539e0..4a76fd9cd3 100644
--- a/lib/ssh/src/ssh.app.src
+++ b/lib/ssh/src/ssh.app.src
@@ -24,7 +24,6 @@
ssh_file,
ssh_io,
ssh_info,
- ssh_math,
ssh_no_io,
ssh_server_key_api,
ssh_sftp,
diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl
index 370f086600..132de71aed 100644
--- a/lib/ssh/src/ssh.erl
+++ b/lib/ssh/src/ssh.erl
@@ -373,6 +373,10 @@ handle_option([{auth_method_kb_interactive_data, _} = Opt | Rest], SocketOptions
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([{preferred_algorithms,_} = Opt | Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
+handle_option([{dh_gex_groups,_} = Opt | Rest], SocketOptions, SshOptions) ->
+ handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
+handle_option([{dh_gex_limits,_} = Opt | Rest], SocketOptions, SshOptions) ->
+ handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([{quiet_mode, _} = Opt|Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([{idle_time, _} = Opt | Rest], SocketOptions, SshOptions) ->
@@ -393,6 +397,8 @@ handle_option([{id_string, _ID} = Opt|Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([{profile, _ID} = Opt|Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
+handle_option([{max_random_length_padding, _Bool} = Opt|Rest], SocketOptions, SshOptions) ->
+ handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([Opt | Rest], SocketOptions, SshOptions) ->
handle_option(Rest, [handle_inet_option(Opt) | SocketOptions], SshOptions).
@@ -411,6 +417,28 @@ handle_ssh_option({user_interaction, Value} = Opt) when is_boolean(Value) ->
Opt;
handle_ssh_option({preferred_algorithms,[_|_]} = Opt) ->
handle_pref_algs(Opt);
+handle_ssh_option({dh_gex_groups,L=[{I1,I2,I3}|_]}) when is_integer(I1), I1>0,
+ is_integer(I2), I2>0,
+ is_integer(I3), I3>0 ->
+ {dh_gex_groups, lists:map(fun({N,G,P}) -> {N,{G,P}} end, L)};
+handle_ssh_option({dh_gex_groups,{file,File=[C|_]}}=Opt) when is_integer(C), C>0 ->
+ %% A string, (file name)
+ case file:consult(File) of
+ {ok, List} ->
+ try handle_ssh_option({dh_gex_groups,List}) of
+ {dh_gex_groups,_} = NewOpt ->
+ NewOpt
+ catch
+ _:_ ->
+ throw({error, {{eoptions, Opt}, "Bad format in file"}})
+ end;
+ Error ->
+ throw({error, {{eoptions, Opt},{"Error reading file",Error}}})
+ end;
+handle_ssh_option({dh_gex_limits,{Min,I,Max}} = Opt) when is_integer(Min), Min>0,
+ is_integer(I), I>=Min,
+ is_integer(Max), Max>=I ->
+ Opt;
handle_ssh_option({connect_timeout, Value} = Opt) when is_integer(Value); Value == infinity ->
Opt;
handle_ssh_option({max_sessions, Value} = Opt) when is_integer(Value), Value>0 ->
@@ -489,6 +517,9 @@ handle_ssh_option({id_string, random}) ->
{id_string, {random,2,5}}; %% 2 - 5 random characters
handle_ssh_option({id_string, ID} = Opt) when is_list(ID) ->
Opt;
+handle_ssh_option({max_random_length_padding, Value} = Opt) when is_integer(Value),
+ Value =< 255 ->
+ Opt;
handle_ssh_option({profile, Value} = Opt) when is_atom(Value) ->
Opt;
handle_ssh_option(Opt) ->
diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl
index 8df5ee820c..462c98f503 100644
--- a/lib/ssh/src/ssh.hrl
+++ b/lib/ssh/src/ssh.hrl
@@ -124,6 +124,7 @@
recv_sequence = 0,
keyex_key,
keyex_info,
+ random_length_padding = 255, % From RFC 4253 section 6.
%% User auth
user,
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index a9c60d0674..180698d741 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -46,7 +46,9 @@
get_print_info/1]).
%% gen_fsm callbacks
--export([hello/2, kexinit/2, key_exchange/2, new_keys/2,
+-export([hello/2, kexinit/2, key_exchange/2,
+ key_exchange_dh_gex_init/2, key_exchange_dh_gex_reply/2,
+ new_keys/2,
userauth/2, connected/2,
error/2]).
@@ -417,27 +419,39 @@ key_exchange(#ssh_msg_kexdh_reply{} = Msg,
send_msg(NewKeys, State),
{next_state, new_keys, next_packet(State#state{ssh_params = Ssh})};
-key_exchange(#ssh_msg_kex_dh_gex_group{} = Msg,
+key_exchange(#ssh_msg_kex_dh_gex_request{} = Msg,
#state{ssh_params = #ssh{role = server} = Ssh0} = State) ->
- {ok, NextKexMsg, Ssh1} = ssh_transport:handle_kex_dh_gex_group(Msg, Ssh0),
- send_msg(NextKexMsg, State),
- {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1),
- send_msg(NewKeys, State),
- {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})};
+ {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, Ssh0),
+ send_msg(GexGroup, State),
+ {next_state, key_exchange_dh_gex_init, next_packet(State#state{ssh_params = Ssh})};
-key_exchange(#ssh_msg_kex_dh_gex_request{} = Msg,
+key_exchange(#ssh_msg_kex_dh_gex_group{} = Msg,
#state{ssh_params = #ssh{role = client} = Ssh0} = State) ->
- {ok, NextKexMsg, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, Ssh0),
- send_msg(NextKexMsg, State),
- {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})};
+ {ok, KexGexInit, Ssh} = ssh_transport:handle_kex_dh_gex_group(Msg, Ssh0),
+ send_msg(KexGexInit, State),
+ {next_state, key_exchange_dh_gex_reply, next_packet(State#state{ssh_params = Ssh})}.
-key_exchange(#ssh_msg_kex_dh_gex_reply{} = Msg,
- #state{ssh_params = #ssh{role = client} = Ssh0} = State) ->
- {ok, NewKeys, Ssh} = ssh_transport:handle_kex_dh_gex_reply(Msg, Ssh0),
+%%--------------------------------------------------------------------
+-spec key_exchange_dh_gex_init(#ssh_msg_kex_dh_gex_init{}, #state{}) -> gen_fsm_state_return().
+%%--------------------------------------------------------------------
+key_exchange_dh_gex_init(#ssh_msg_kex_dh_gex_init{} = Msg,
+ #state{ssh_params = #ssh{role = server} = Ssh0} = State) ->
+ {ok, KexGexReply, Ssh1} = ssh_transport:handle_kex_dh_gex_init(Msg, Ssh0),
+ send_msg(KexGexReply, State),
+ {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1),
send_msg(NewKeys, State),
{next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}.
%%--------------------------------------------------------------------
+-spec key_exchange_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{}, #state{}) -> gen_fsm_state_return().
+%%--------------------------------------------------------------------
+key_exchange_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{} = Msg,
+ #state{ssh_params = #ssh{role = client} = Ssh0} = State) ->
+ {ok, NewKeys, Ssh1} = ssh_transport:handle_kex_dh_gex_reply(Msg, Ssh0),
+ send_msg(NewKeys, State),
+ {next_state, new_keys, next_packet(State#state{ssh_params = Ssh1})}.
+
+%%--------------------------------------------------------------------
-spec new_keys(#ssh_msg_newkeys{}, #state{}) -> gen_fsm_state_return().
%%--------------------------------------------------------------------
@@ -1173,7 +1187,10 @@ init_ssh(client = Role, Vsn, Version, Options, Socket) ->
opts = Options,
userauth_supported_methods = AuthMethods,
peer = {PeerName, PeerAddr},
- available_host_keys = supported_host_keys(Role, KeyCb, Options)
+ available_host_keys = supported_host_keys(Role, KeyCb, Options),
+ random_length_padding = proplists:get_value(max_random_length_padding,
+ Options,
+ (#ssh{})#ssh.random_length_padding)
};
init_ssh(server = Role, Vsn, Version, Options, Socket) ->
@@ -1193,7 +1210,10 @@ init_ssh(server = Role, Vsn, Version, Options, Socket) ->
userauth_methods = AuthMethodsAsList,
kb_tries_left = 3,
peer = {undefined, PeerAddr},
- available_host_keys = supported_host_keys(Role, KeyCb, Options)
+ available_host_keys = supported_host_keys(Role, KeyCb, Options),
+ random_length_padding = proplists:get_value(max_random_length_padding,
+ Options,
+ (#ssh{})#ssh.random_length_padding)
}.
supported_host_keys(client, _, Options) ->
diff --git a/lib/ssh/src/ssh_math.erl b/lib/ssh/src/ssh_math.erl
deleted file mode 100644
index cace85bc93..0000000000
--- a/lib/ssh/src/ssh_math.erl
+++ /dev/null
@@ -1,42 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2005-2013. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
-
-%%% Description: SSH math utilities
-
--module(ssh_math).
-
--export([ipow/3]).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% INTEGER utils
-%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% calculate A^B mod M
-ipow(A, B, M) when M > 0, B >= 0 ->
- crypto:bytes_to_integer(crypto:mod_pow(A, B, M)).
-
-
-
-
-
diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl
index 1f0f6fb15f..7b786b8fff 100644
--- a/lib/ssh/src/ssh_message.erl
+++ b/lib/ssh/src/ssh_message.erl
@@ -237,7 +237,7 @@ encode(#ssh_msg_kex_dh_gex_request{
max = Max
}) ->
ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REQUEST, Min, N, Max],
- [byte, uint32, uint32, uint32, uint32]);
+ [byte, uint32, uint32, uint32]);
encode(#ssh_msg_kex_dh_gex_request_old{n = N}) ->
ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REQUEST_OLD, N],
[byte, uint32]);
@@ -257,7 +257,7 @@ encode(#ssh_msg_kex_dh_gex_reply{
}) ->
EncKey = encode_host_key(Key),
EncSign = encode_sign(Key, Signature),
- ssh_bits:encode([?SSH_MSG_KEXDH_REPLY, EncKey, F, EncSign], [byte, binary, mpint, binary]);
+ ssh_bits:encode([?SSH_MSG_KEX_DH_GEX_REPLY, EncKey, F, EncSign], [byte, binary, mpint, binary]);
encode(#ssh_msg_ignore{data = Data}) ->
ssh_bits:encode([?SSH_MSG_IGNORE, Data], [byte, string]);
@@ -442,6 +442,19 @@ decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_GROUP),
p = Prime,
g = Generator
};
+decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_INIT), ?UINT32(Len), E:Len/big-signed-integer-unit:8>>) ->
+ #ssh_msg_kex_dh_gex_init{
+ e = E
+ };
+decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_REPLY),
+ ?UINT32(Len0), Key:Len0/binary,
+ ?UINT32(Len1), F:Len1/big-signed-integer-unit:8,
+ ?UINT32(Len2), Hashsign:Len2/binary>>) ->
+ #ssh_msg_kex_dh_gex_reply{
+ public_host_key = decode_host_key(Key),
+ f = F,
+ h_sig = decode_sign(Hashsign)
+ };
decode(<<?BYTE(?SSH_MSG_KEXDH_REPLY), ?UINT32(Len0), Key:Len0/binary,
?UINT32(Len1), F:Len1/big-signed-integer-unit:8,
?UINT32(Len2), Hashsign:Len2/binary>>) ->
diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl
index 2e7391e1f8..9ed6c85ff7 100644
--- a/lib/ssh/src/ssh_transport.erl
+++ b/lib/ssh/src/ssh_transport.erl
@@ -39,7 +39,7 @@
key_exchange_init_msg/1,
key_init/3, new_keys_message/1,
handle_kexinit_msg/3, handle_kexdh_init/2,
- handle_kex_dh_gex_group/2, handle_kex_dh_gex_reply/2,
+ handle_kex_dh_gex_group/2, handle_kex_dh_gex_init/2, handle_kex_dh_gex_reply/2,
handle_new_keys/2, handle_kex_dh_gex_request/2,
handle_kexdh_reply/2,
unpack/3, decompress/2, ssh_packet/2, pack/2, msg_data/1,
@@ -66,6 +66,8 @@ algo_classes() -> [kex, public_key, cipher, mac, compression].
default_algorithms(compression) ->
%% Do not announce '[email protected]' because there seem to be problems
supported_algorithms(compression, same(['[email protected]']));
+default_algorithms(kex) ->
+ supported_algorithms(kex, []);
default_algorithms(Alg) ->
supported_algorithms(Alg).
@@ -73,23 +75,29 @@ default_algorithms(Alg) ->
supported_algorithms() -> [{K,supported_algorithms(K)} || K <- algo_classes()].
supported_algorithms(kex) ->
- ['diffie-hellman-group1-sha1'];
+ select_crypto_supported(
+ [{'diffie-hellman-group14-sha1', [{hashs,sha}]},
+ {'diffie-hellman-group1-sha1', [{hashs,sha}]},
+ {'diffie-hellman-group-exchange-sha256', [{hashs,sha256}]},
+ {'diffie-hellman-group-exchange-sha1', [{hashs,sha}]}
+ ]);
supported_algorithms(public_key) ->
ssh_auth:default_public_key_algorithms();
supported_algorithms(cipher) ->
- Supports = crypto:supports(),
- CipherAlgos = [{aes_ctr, 'aes128-ctr'}, {aes_cbc128, 'aes128-cbc'}, {des3_cbc, '3des-cbc'}],
- Algs = [SshAlgo ||
- {CryptoAlgo, SshAlgo} <- CipherAlgos,
- lists:member(CryptoAlgo, proplists:get_value(ciphers, Supports, []))],
- same(Algs);
+ same(
+ select_crypto_supported(
+ [{'aes128-ctr', [{ciphers,aes_ctr}]},
+ {'aes128-cbc', [{ciphers,aes_cbc128}]},
+ {'3des-cbc', [{ciphers,des3_cbc}]}
+ ]
+ ));
supported_algorithms(mac) ->
- Supports = crypto:supports(),
- HashAlgos = [{sha256, 'hmac-sha2-256'}, {sha, 'hmac-sha1'}],
- Algs = [SshAlgo ||
- {CryptoAlgo, SshAlgo} <- HashAlgos,
- lists:member(CryptoAlgo, proplists:get_value(hashs, Supports, []))],
- same(Algs);
+ same(
+ select_crypto_supported(
+ [{'hmac-sha2-256', [{hashs,sha256}]},
+ {'hmac-sha1', [{hashs,sha}]}
+ ]
+ ));
supported_algorithms(compression) ->
same(['none','zlib','[email protected]']).
@@ -100,7 +108,15 @@ supported_algorithms(Key, [{client2server,BL1},{server2client,BL2}]) ->
supported_algorithms(Key, BlackList) ->
supported_algorithms(Key) -- BlackList.
-
+select_crypto_supported(L) ->
+ Sup = crypto:supports(),
+ [Name || {Name,CryptoRequires} <- L,
+ crypto_supported(CryptoRequires, Sup)].
+
+crypto_supported(Conditions, Supported) ->
+ lists:all(fun({Tag,CryptoName}) ->
+ lists:member(CryptoName, proplists:get_value(Tag,Supported,[]))
+ end, Conditions).
same(Algs) -> [{client2server,Algs}, {server2client,Algs}].
@@ -135,7 +151,7 @@ ssh_vsn() ->
_:_ -> ""
end.
-random_id(Nlo, Nup) ->
+random_id(Nlo, Nup) ->
[crypto:rand_uniform($a,$z+1) || _<- lists:duplicate(crypto:rand_uniform(Nlo,Nup+1),x) ].
hello_version_msg(Data) ->
@@ -144,7 +160,7 @@ hello_version_msg(Data) ->
next_seqnum(SeqNum) ->
(SeqNum + 1) band 16#ffffffff.
-decrypt_first_block(Bin, #ssh{decrypt_block_size = BlockSize} = Ssh0) ->
+decrypt_first_block(Bin, #ssh{decrypt_block_size = BlockSize} = Ssh0) ->
<<EncBlock:BlockSize/binary, EncData/binary>> = Bin,
{Ssh, <<?UINT32(PacketLen), _/binary>> = DecData} =
decrypt(Ssh0, EncBlock),
@@ -279,34 +295,50 @@ verify_algorithm(#alg{compress = undefined}) -> false;
verify_algorithm(#alg{decompress = undefined}) -> false;
verify_algorithm(#alg{kex = 'diffie-hellman-group1-sha1'}) -> true;
+verify_algorithm(#alg{kex = 'diffie-hellman-group14-sha1'}) -> true;
verify_algorithm(#alg{kex = 'diffie-hellman-group-exchange-sha1'}) -> true;
+verify_algorithm(#alg{kex = 'diffie-hellman-group-exchange-sha256'}) -> true;
verify_algorithm(_) -> false.
-key_exchange_first_msg('diffie-hellman-group1-sha1', Ssh0) ->
- {G, P} = dh_group1(),
+%%%----------------------------------------------------------------
+%%%
+%%% Key exchange initialization
+%%%
+key_exchange_first_msg(Kex, Ssh0) when Kex == 'diffie-hellman-group1-sha1' ;
+ Kex == 'diffie-hellman-group14-sha1' ->
+ {G, P} = dh_group(Kex),
{Private, Public} = dh_gen_key(G, P, 1024),
+ %% Public = G^Private mod P (def)
{SshPacket, Ssh1} = ssh_packet(#ssh_msg_kexdh_init{e = Public}, Ssh0),
{ok, SshPacket,
Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}}};
-key_exchange_first_msg('diffie-hellman-group-exchange-sha1', Ssh0) ->
+key_exchange_first_msg(Kex, Ssh0) when Kex == 'diffie-hellman-group-exchange-sha1' ;
+ Kex == 'diffie-hellman-group-exchange-sha256' ->
Min = ?DEFAULT_DH_GROUP_MIN,
NBits = ?DEFAULT_DH_GROUP_NBITS,
Max = ?DEFAULT_DH_GROUP_MAX,
{SshPacket, Ssh1} =
ssh_packet(#ssh_msg_kex_dh_gex_request{min = Min,
- n = NBits, max = Max},
+ n = NBits,
+ max = Max},
Ssh0),
{ok, SshPacket,
Ssh1#ssh{keyex_info = {Min, Max, NBits}}}.
-
-handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, Ssh0) ->
- {G, P} = dh_group1(),
+%%%----------------------------------------------------------------
+%%%
+%%% diffie-hellman-group1-sha1
+%%% diffie-hellman-group14-sha1
+%%%
+handle_kexdh_init(#ssh_msg_kexdh_init{e = E},
+ Ssh0 = #ssh{algorithms = #alg{kex=Kex}}) ->
+ %% server
+ {G, P} = dh_group(Kex),
if
1=<E, E=<(P-1) ->
{Private, Public} = dh_gen_key(G, P, 1024),
- K = ssh_math:ipow(E, Private, P),
+ K = dh_compute_key(G, P, E, Private),
Key = get_host_key(Ssh0),
H = kex_h(Ssh0, Key, E, Public, K),
H_SIG = sign_host_key(Ssh0, Key, H),
@@ -314,27 +346,173 @@ handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, Ssh0) ->
f = Public,
h_sig = H_SIG
}, Ssh0),
-
{ok, SshPacket, Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}},
shared_secret = K,
exchanged_hash = H,
session_id = sid(Ssh1, H)}};
+
true ->
- Error = {error,bad_e_from_peer},
- Disconnect = #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed, 'f' out of bounds",
- language = "en"},
- throw({Error, Disconnect})
+ throw({{error,bad_e_from_peer},
+ #ssh_msg_disconnect{
+ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ description = "Key exchange failed, 'e' out of bounds",
+ language = ""}
+ })
end.
+handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = HostKey,
+ f = F,
+ h_sig = H_SIG},
+ #ssh{keyex_key = {{Private, Public}, {G, P}}} = Ssh0) ->
+ %% client
+ if
+ 1=<F, F=<(P-1)->
+ K = dh_compute_key(G, P, F, Private),
+ H = kex_h(Ssh0, HostKey, Public, F, K),
+
+ case verify_host_key(Ssh0, HostKey, H, H_SIG) of
+ ok ->
+ {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0),
+ {ok, SshPacket, Ssh#ssh{shared_secret = K,
+ exchanged_hash = H,
+ session_id = sid(Ssh, H)}};
+ Error ->
+ throw({Error,
+ #ssh_msg_disconnect{
+ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ description = "Key exchange failed",
+ language = "en"}
+ })
+ end;
+
+ true ->
+ throw({{error,bad_f_from_peer},
+ #ssh_msg_disconnect{
+ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ description = "Key exchange failed, 'f' out of bounds",
+ language = ""}
+ })
+ end.
+
+
+%%%----------------------------------------------------------------
+%%%
+%%% diffie-hellman-group-exchange-sha1
+%%%
+handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = Min,
+ n = NBits,
+ max = Max},
+ Ssh0=#ssh{opts=Opts}) when Min=<NBits, NBits=<Max ->
+ %% server
+ {G, P} = dh_gex_group(Min, NBits, Max, proplists:get_value(dh_gex_groups,Opts)),
+ {Private, Public} = dh_gen_key(G, P, 1024),
+ {SshPacket, Ssh} =
+ ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0),
+ {ok, SshPacket,
+ Ssh#ssh{keyex_key = {{Private, Public}, {G, P}},
+ keyex_info = {Min, Max, NBits}
+ }};
+handle_kex_dh_gex_request(_, _) ->
+ throw({{error,bad_ssh_msg_kex_dh_gex_request},
+ #ssh_msg_disconnect{
+ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ description = "Key exchange failed, bad values in ssh_msg_kex_dh_gex_request",
+ language = ""}
+ }).
+
handle_kex_dh_gex_group(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0) ->
- {Private, Public} = dh_gen_key(G,P,1024),
+ %% client
+ {Private, Public} = dh_gen_key(G, P, 1024),
{SshPacket, Ssh1} =
- ssh_packet(#ssh_msg_kex_dh_gex_init{e = Public}, Ssh0),
+ ssh_packet(#ssh_msg_kex_dh_gex_init{e = Public}, Ssh0), % Pub = G^Priv mod P (def)
+
{ok, SshPacket,
Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}}}.
+handle_kex_dh_gex_init(#ssh_msg_kex_dh_gex_init{e = E},
+ #ssh{keyex_key = {{Private, Public}, {G, P}},
+ keyex_info = {Min, Max, NBits}} =
+ Ssh0) ->
+ %% server
+ if
+ 1=<E, E=<(P-1) ->
+ K = dh_compute_key(G, P, E, Private),
+ if
+ 1<K, K<(P-1) ->
+ HostKey = get_host_key(Ssh0),
+ H = kex_h(Ssh0, HostKey, Min, NBits, Max, P, G, E, Public, K),
+ H_SIG = sign_host_key(Ssh0, HostKey, H),
+ {SshPacket, Ssh} =
+ ssh_packet(#ssh_msg_kex_dh_gex_reply{public_host_key = HostKey,
+ f = Public,
+ h_sig = H_SIG}, Ssh0),
+ {ok, SshPacket, Ssh#ssh{shared_secret = K,
+ exchanged_hash = H,
+ session_id = sid(Ssh, H)
+ }};
+ true ->
+ throw({{error,bad_K},
+ #ssh_msg_disconnect{
+ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ description = "Key exchange failed, 'K' out of bounds",
+ language = ""}
+ })
+ end;
+ true ->
+ throw({{error,bad_e_from_peer},
+ #ssh_msg_disconnect{
+ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ description = "Key exchange failed, 'e' out of bounds",
+ language = ""}
+ })
+ end.
+
+handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = HostKey,
+ f = F,
+ h_sig = H_SIG},
+ #ssh{keyex_key = {{Private, Public}, {G, P}},
+ keyex_info = {Min, Max, NBits}} =
+ Ssh0) ->
+ %% client
+ if
+ 1=<F, F=<(P-1)->
+ K = dh_compute_key(G, P, F, Private),
+ if
+ 1<K, K<(P-1) ->
+ H = kex_h(Ssh0, HostKey, Min, NBits, Max, P, G, Public, F, K),
+
+ case verify_host_key(Ssh0, HostKey, H, H_SIG) of
+ ok ->
+ {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0),
+ {ok, SshPacket, Ssh#ssh{shared_secret = K,
+ exchanged_hash = H,
+ session_id = sid(Ssh, H)}};
+ _Error ->
+ throw(#ssh_msg_disconnect{
+ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ description = "Key exchange failed",
+ language = ""}
+ )
+ end;
+
+ true ->
+ throw({{error,bad_K},
+ #ssh_msg_disconnect{
+ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ description = "Key exchange failed, 'K' out of bounds",
+ language = ""}
+ })
+ end;
+ true ->
+ throw({{error,bad_f_from_peer},
+ #ssh_msg_disconnect{
+ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
+ description = "Key exchange failed, 'f' out of bounds",
+ language = ""}
+ })
+ end.
+
+%%%----------------------------------------------------------------
handle_new_keys(#ssh_msg_newkeys{}, Ssh0) ->
try install_alg(Ssh0) of
#ssh{} = Ssh ->
@@ -346,69 +524,6 @@ handle_new_keys(#ssh_msg_newkeys{}, Ssh0) ->
language = "en"})
end.
-
-%% %% Select algorithms
-handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = HostKey, f = F,
- h_sig = H_SIG},
- #ssh{keyex_key = {{Private, Public}, {_G, P}}} = Ssh0) when 1=<F, F=<(P-1)->
- K = ssh_math:ipow(F, Private, P),
- H = kex_h(Ssh0, HostKey, Public, F, K),
-
- case verify_host_key(Ssh0, HostKey, H, H_SIG) of
- ok ->
- {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0),
- {ok, SshPacket, Ssh#ssh{shared_secret = K,
- exchanged_hash = H,
- session_id = sid(Ssh, H)}};
- Error ->
- Disconnect = #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed",
- language = "en"},
- throw({Error, Disconnect})
- end;
-handle_kexdh_reply(#ssh_msg_kexdh_reply{}, _SSH) ->
- Error = {error,bad_f_from_peer},
- Disconnect = #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed, 'f' out of bounds",
- language = "en"},
- throw({Error, Disconnect}).
-
-
-handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = _Min,
- n = _NBits,
- max = _Max}, Ssh0) ->
- {G,P} = dh_group1(), %% TODO real imp this seems to be a hack?!
- {Private, Public} = dh_gen_key(G, P, 1024),
- {SshPacket, Ssh} =
- ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0),
- {ok, SshPacket,
- Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}}}.
-
-handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = HostKey,
- f = F,
- h_sig = H_SIG},
- #ssh{keyex_key = {{Private, Public}, {G, P}},
- keyex_info = {Min, Max, NBits}} =
- Ssh0) ->
- K = ssh_math:ipow(F, Private, P),
- H = kex_h(Ssh0, HostKey, Min, NBits, Max, P, G, Public, F, K),
-
- case verify_host_key(Ssh0, HostKey, H, H_SIG) of
- ok ->
- {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0),
- {ok, SshPacket, Ssh#ssh{shared_secret = K,
- exchanged_hash = H,
- session_id = sid(Ssh, H)}};
- _Error ->
- Disconnect = #ssh_msg_disconnect{
- code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED,
- description = "Key exchange failed",
- language = "en"},
- throw(Disconnect)
- end.
-
%% select session id
sid(#ssh{session_id = undefined}, H) ->
H;
@@ -511,7 +626,6 @@ select_algorithm(Role, Client, Server) ->
decompress = Decompression,
c_lng = C_Lng,
s_lng = S_Lng},
-%%ct:pal("~p~n Client=~p~n Server=~p~n Alg=~p~n",[Role,Client,Server,Alg]),
{ok, Alg}.
select_encrypt_decrypt(client, Client, Server) ->
@@ -631,13 +745,20 @@ ssh_packet(Msg, Ssh) ->
pack(Data0, #ssh{encrypt_block_size = BlockSize,
send_sequence = SeqNum, send_mac = MacAlg,
- send_mac_key = MacKey}
+ send_mac_key = MacKey,
+ random_length_padding = RandomLengthPadding}
= Ssh0) when is_binary(Data0) ->
{Ssh1, Data} = compress(Ssh0, Data0),
PL = (BlockSize - ((4 + 1 + size(Data)) rem BlockSize)) rem BlockSize,
- PaddingLen = if PL < 4 -> PL + BlockSize;
- true -> PL
- end,
+ MinPaddingLen = if PL < 4 -> PL + BlockSize;
+ true -> PL
+ end,
+ PadBlockSize = max(BlockSize,4),
+ MaxExtraBlocks = (max(RandomLengthPadding,MinPaddingLen) - MinPaddingLen) div PadBlockSize,
+ ExtraPaddingLen = try crypto:rand_uniform(0,MaxExtraBlocks)*PadBlockSize
+ catch _:_ -> 0
+ end,
+ PaddingLen = MinPaddingLen + ExtraPaddingLen,
Padding = ssh_bits:random(PaddingLen),
PacketLen = 1 + PaddingLen + size(Data),
PacketData = <<?UINT32(PacketLen),?BYTE(PaddingLen),
@@ -706,6 +827,7 @@ verify(PlainText, Hash, Sig, Key) ->
%% key exchange
%%
%% diffie-hellman-group1-sha1 REQUIRED
+%% diffie-hellman-group14-sha1 REQUIRED
%%
%%
@@ -1001,7 +1123,7 @@ recv_mac_init(SSH) ->
recv_mac_final(SSH) ->
{ok, SSH#ssh { recv_mac = none, recv_mac_key = undefined }}.
-mac(none, _ , _, _) ->
+mac(none, _ , _, _) ->
<<>>;
mac('hmac-sha1', Key, SeqNum, Data) ->
crypto:hmac(sha, Key, [<<?UINT32(SeqNum)>>, Data]);
@@ -1020,8 +1142,12 @@ hash(SSH, Char, Bits) ->
case SSH#ssh.kex of
'diffie-hellman-group1-sha1' ->
fun(Data) -> crypto:hash(sha, Data) end;
+ 'diffie-hellman-group14-sha1' ->
+ fun(Data) -> crypto:hash(sha, Data) end;
'diffie-hellman-group-exchange-sha1' ->
fun(Data) -> crypto:hash(sha, Data) end;
+ 'diffie-hellman-group-exchange-sha256' ->
+ fun(Data) -> crypto:hash(sha256, Data) end;
_ ->
exit({bad_algorithm,SSH#ssh.kex})
end,
@@ -1071,8 +1197,11 @@ kex_h(SSH, Key, Min, NBits, Max, Prime, Gen, E, F, K) ->
ssh_message:encode_host_key(Key), Min, NBits, Max,
Prime, Gen, E,F,K], Ts)
end,
- crypto:hash(sha,L).
+ crypto:hash(sha((SSH#ssh.algorithms)#alg.kex), L).
+sha('diffie-hellman-group-exchange-sha1') -> sha;
+sha('diffie-hellman-group-exchange-sha256') -> sha256.
+
mac_key_size('hmac-sha1') -> 20*8;
mac_key_size('hmac-sha1-96') -> 20*8;
mac_key_size('hmac-md5') -> 16*8;
@@ -1096,13 +1225,63 @@ peer_name({Host, _}) ->
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-dh_group1() ->
- {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE65381FFFFFFFFFFFFFFFF}.
+dh_group('diffie-hellman-group1-sha1') -> ?dh_group1;
+dh_group('diffie-hellman-group14-sha1') -> ?dh_group14.
+
+dh_gex_default_groups() ->
+ [{1024, ?dh_group1 },
+ {2048, ?dh_group14},
+ {3072, ?dh_group15},
+ {4096, ?dh_group16}].
+
+
+dh_gex_group(Min, N, Max, undefined) ->
+ dh_gex_group(Min, N, Max, dh_gex_default_groups());
+dh_gex_group(Min, N, Max, Groups) ->
+ %% First try to find an exact match. If not an exact match, select the largest possible.
+ {_,Group} =
+ lists:foldl(
+ fun(_, {I,G}) when I==N ->
+ %% If we have an exact match already: use that one
+ {I,G};
+ ({I,G}, _) when I==N ->
+ %% If we now found an exact match: use that very one
+ {I,G};
+ ({I,G}, {Imax,_Gmax}) when Min=<I,I=<Max, % a) {I,G} fullfills the requirements
+ I>Imax -> % b) {I,G} is larger than current max
+ %% A group within the limits and better than the one we have
+ {I,G};
+ (_, IGmax) ->
+ %% Keep the one we have
+ IGmax
+ end, {-1,undefined}, Groups),
+
+ case Group of
+ undefined ->
+ throw(#ssh_msg_disconnect{
+ code = ?SSH_DISCONNECT_PROTOCOL_ERROR,
+ description = "No possible diffie-hellman-group-exchange group found",
+ language = ""});
+ _ ->
+ Group
+ end.
+
dh_gen_key(G, P, _) ->
{Public, Private} = crypto:generate_key(dh, [P, G]),
{crypto:bytes_to_integer(Private), crypto:bytes_to_integer(Public)}.
+dh_compute_key(G, P, OthersPublic, MyPrivate) ->
+ crypto:bytes_to_integer(
+ crypto:compute_key(dh, OthersPublic, MyPrivate, [P,G])
+ ).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Other utils
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
trim_tail(Str) ->
lists:reverse(trim_head(lists:reverse(Str))).
diff --git a/lib/ssh/src/ssh_transport.hrl b/lib/ssh/src/ssh_transport.hrl
index 2faf8a9316..9e1de171c2 100644
--- a/lib/ssh/src/ssh_transport.hrl
+++ b/lib/ssh/src/ssh_transport.hrl
@@ -188,49 +188,24 @@
-define(SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE, 14).
-define(SSH_DISCONNECT_ILLEGAL_USER_NAME, 15).
+%% groups
+
+%%% rfc 2489, ch 6.2
+-define(dh_group1,
+ {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE65381FFFFFFFFFFFFFFFF}).
+
+%%% rfc 3526, ch3
+-define(dh_group14,
+ {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AACAA68FFFFFFFFFFFFFFFF}).
+
+%%% rfc 3526, ch4
+-define(dh_group15,
+ {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7DB3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D2261AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200CBBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFCE0FD108E4B82D120A93AD2CAFFFFFFFFFFFFFFFF}).
+
+%%% rfc 3526, ch5
+-define(dh_group16,
+ {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AAAC42DAD33170D04507A33A85521ABDF1CBA64ECFB850458DBEF0A8AEA71575D060C7DB3970F85A6E1E4C7ABF5AE8CDB0933D71E8C94E04A25619DCEE3D2261AD2EE6BF12FFA06D98A0864D87602733EC86A64521F2B18177B200CBBE117577A615D6C770988C0BAD946E208E24FA074E5AB3143DB5BFCE0FD108E4B82D120A92108011A723C12A787E6D788719A10BDBA5B2699C327186AF4E23C1A946834B6150BDA2583E9CA2AD44CE8DBBBC2DB04DE8EF92E8EFC141FBECAA6287C59474E6BC05D99B2964FA090C3A2233BA186515BE7ED1F612970CEE2D7AFB81BDD762170481CD0069127D5B05AA993B4EA988D8FDDC186FFB7DC90A6C08F4DF435C934063199FFFFFFFFFFFFFFFF}).
+
-%%%----------------------------------------------------------------------
-%%% # DH_14_xxx
-%%% Description: Oakley group 14 prime numbers and generator. Used in
-%%% diffie-hellman-group1-sha1 key exchange method.
-%%%----------------------------------------------------------------------
-%%%----------------------------------------------------------------------
-%%% # DH_14_P
-%%% Description: Prime for this group
-%%%----------------------------------------------------------------------
-
--define(DH_14_P,
- <<000,000,000,129,000,255,255,255,255,255,255,255,255,201,015,218,
- 162,033,104,194,052,196,198,098,139,128,220,028,209,041,002,078,
- 008,138,103,204,116,002,011,190,166,059,019,155,034,081,074,008,
- 121,142,052,004,221,239,149,025,179,205,058,067,027,048,043,010,
- 109,242,095,020,055,079,225,053,109,109,081,194,069,228,133,181,
- 118,098,094,126,198,244,076,066,233,166,055,237,107,011,255,092,
- 182,244,006,183,237,238,056,107,251,090,137,159,165,174,159,036,
- 017,124,075,031,230,073,040,102,081,236,230,083,129,255,255,255,
- 255,255,255,255,255>>).
-
-%%%----------------------------------------------------------------------
-%%% # DH_14_G
-%%% Description: Generator for DH_14_P.
-%%%----------------------------------------------------------------------
-
--define(DH_14_G, <<0,0,0,1,2>>).
-
-%%%----------------------------------------------------------------------
-%%% # DH_14_Q
-%%% Description: Group order (DH_14_P - 1) / 2.
-%%%----------------------------------------------------------------------
-
--define(DH_14_Q,
- <<000,000,000,128,127,255,255,255,255,255,255,255,228,135,237,081,
- 016,180,097,026,098,099,049,069,192,110,014,104,148,129,039,004,
- 069,051,230,058,001,005,223,083,029,137,205,145,040,165,004,060,
- 199,026,002,110,247,202,140,217,230,157,033,141,152,021,133,054,
- 249,047,138,027,167,240,154,182,182,168,225,034,242,066,218,187,
- 049,047,063,099,122,038,033,116,211,027,246,181,133,255,174,091,
- 122,003,091,246,247,028,053,253,173,068,207,210,215,079,146,008,
- 190,037,143,243,036,148,051,040,246,115,041,192,255,255,255,255,
- 255,255,255,255>>).
-endif. % -ifdef(ssh_transport).
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index bf9fe54c57..6dfff945ac 100644
--- a/lib/ssh/test/ssh_basic_SUITE.erl
+++ b/lib/ssh/test/ssh_basic_SUITE.erl
@@ -42,6 +42,7 @@ suite() ->
all() ->
[app_test,
appup_test,
+ {group, key_exchange},
{group, dsa_key},
{group, rsa_key},
{group, dsa_pass_key},
@@ -92,6 +93,11 @@ groups() ->
max_sessions_sftp_start_channel_parallel,
max_sessions_sftp_start_channel_sequential
]},
+ {key_exchange, [], ['diffie-hellman-group-exchange-sha1',
+ 'diffie-hellman-group-exchange-sha256',
+ 'diffie-hellman-group1-sha1',
+ 'diffie-hellman-group14-sha1'
+ ]},
{dir_options, [], [user_dir_option,
system_dir_option]}
].
@@ -146,6 +152,11 @@ init_per_group(internal_error, Config) ->
ssh_test_lib:setup_dsa(DataDir, PrivDir),
file:delete(filename:join(PrivDir, "system/ssh_host_dsa_key")),
Config;
+init_per_group(key_exchange, Config) ->
+ DataDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
+ ssh_test_lib:setup_rsa(DataDir, PrivDir),
+ Config;
init_per_group(dir_options, Config) ->
PrivDir = ?config(priv_dir, Config),
%% Make unreadable dir:
@@ -193,6 +204,8 @@ init_per_group(_, Config) ->
end_per_group(hardening_tests, Config) ->
end_per_group(dsa_key, Config);
+end_per_group(key_exchange, Config) ->
+ end_per_group(rsa_key, Config);
end_per_group(dsa_key, Config) ->
PrivDir = ?config(priv_dir, Config),
ssh_test_lib:clean_dsa(PrivDir),
@@ -232,8 +245,8 @@ init_per_testcase(TC, Config) when TC==shell_no_unicode ;
Shell = ssh_test_lib:start_shell(Port, IO, UserDir,
[{silently_accept_hosts, true},
{user,"foo"},{password,"bar"}]),
- ct:pal("IO=~p, Shell=~p, self()=~p",[IO,Shell,self()]),
- ct:pal("file:native_name_encoding() = ~p,~nio:getopts() = ~p",
+ ct:log("IO=~p, Shell=~p, self()=~p",[IO,Shell,self()]),
+ ct:log("file:native_name_encoding() = ~p,~nio:getopts() = ~p",
[file:native_name_encoding(),io:getopts()]),
wait_for_erlang_first_line([{io,IO}, {shell,Shell}, {sftpd, Sftpd} | Config]);
init_per_testcase(_TestCase, Config) ->
@@ -453,6 +466,7 @@ rekey_limit(Config) ->
DataFile = filename:join(UserDir, "rekey.data"),
{Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {max_random_length_padding, 0},
{user_dir, UserDir},
{user_passwords,
[{"simon", "says"}]}]),
@@ -462,6 +476,7 @@ rekey_limit(Config) ->
{user, "simon"},
{password, "says"},
{rekey_limit, 2500},
+ {max_random_length_padding, 0},
{user_interaction, false},
{silently_accept_hosts, true}]),
@@ -607,7 +622,7 @@ shell(Config) when is_list(Config) ->
{'EXIT', _, _} ->
ct:fail(no_ssh_connection);
ErlShellStart ->
- ct:pal("Erlang shell start: ~p~n", [ErlShellStart]),
+ ct:log("Erlang shell start: ~p~n", [ErlShellStart]),
do_shell(IO, Shell)
end.
@@ -691,7 +706,7 @@ server_password_option(Config) when is_list(Config) ->
{user_interaction, false},
{user_dir, UserDir}]),
- ct:pal("Test of wrong password: Error msg: ~p ~n", [Reason]),
+ ct:log("Test of wrong password: Error msg: ~p ~n", [Reason]),
ssh:close(ConnectionRef),
ssh:stop_daemon(Pid).
@@ -818,6 +833,59 @@ ssh_msg_debug_fun_option_client(Config) ->
end.
%%--------------------------------------------------------------------
+'diffie-hellman-group-exchange-sha1'(Config) ->
+ kextest('diffie-hellman-group-exchange-sha1',Config).
+
+'diffie-hellman-group-exchange-sha256'(Config) ->
+ kextest('diffie-hellman-group-exchange-sha256',Config).
+
+'diffie-hellman-group1-sha1'(Config) ->
+ kextest('diffie-hellman-group1-sha1',Config).
+
+'diffie-hellman-group14-sha1'(Config) ->
+ kextest('diffie-hellman-group14-sha1',Config).
+
+
+kextest(Kex, Config) ->
+ case lists:member(Kex, ssh_transport:supported_algorithms(kex)) of
+ true ->
+ 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},
+ {user_passwords, [{"foo", "bar"}]},
+ {preferred_algorithms,
+ [{kex, [Kex]}]},
+ {failfun, fun ssh_test_lib:failfun/2}]),
+
+ ConnectionRef =
+ ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user, "foo"},
+ {password, "bar"},
+ {user_dir, UserDir},
+ {preferred_algorithms,
+ [{kex, [Kex]}]},
+ {user_interaction, false}]),
+
+ {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity),
+ success = ssh_connection:exec(ConnectionRef, ChannelId,
+ "1+1.", infinity),
+ Data = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"2\n">>}},
+ case ssh_test_lib:receive_exec_result(Data) of
+ expected ->
+ ok;
+ Other ->
+ ct:fail(Other)
+ end,
+ ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId),
+ ssh:stop_daemon(Pid);
+ false ->
+ {skip, lists:concat([Kex, " is not supported"])}
+ end.
+
+%%--------------------------------------------------------------------
connectfun_disconnectfun_server(Config) ->
PrivDir = ?config(priv_dir, Config),
UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
@@ -1193,13 +1261,13 @@ peername_sockname(Config) when is_list(Config) ->
ssh:connection_info(ConnectionRef, [peer]),
[{sockname, {HostSockClient,PortSockClient} = ClientSock}] =
ssh:connection_info(ConnectionRef, [sockname]),
- ct:pal("Client: ~p ~p", [ClientPeer, ClientSock]),
+ ct:log("Client: ~p ~p", [ClientPeer, ClientSock]),
receive
{ssh_cm, ConnectionRef, {data, ChannelId, _, Response}} ->
{PeerNameSrv,SockNameSrv} = binary_to_term(Response),
{HostPeerSrv,PortPeerSrv} = PeerNameSrv,
{HostSockSrv,PortSockSrv} = SockNameSrv,
- ct:pal("Server: ~p ~p", [PeerNameSrv, SockNameSrv]),
+ ct:log("Server: ~p ~p", [PeerNameSrv, SockNameSrv]),
host_equal(HostPeerSrv, HostSockClient),
PortPeerSrv = PortSockClient,
host_equal(HostSockSrv, HostPeerClient),
@@ -1377,7 +1445,7 @@ packet_size_zero(Config) ->
receive
{ssh_cm,Conn,{data,Chan,_Type,_Msg1}} = M ->
- ct:pal("Got ~p",[M]),
+ ct:log("Got ~p",[M]),
ct:fail(doesnt_obey_max_packet_size_0)
after 5000 ->
ok
@@ -1454,7 +1522,7 @@ chan_exec(ConnectionRef, Cmnd, Expected) ->
ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId0);
{unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId0, 0}}
= ExitStatus0} ->
- ct:pal("0: Collected data ~p", [ExitStatus0]),
+ ct:log("0: Collected data ~p", [ExitStatus0]),
ssh_test_lib:receive_exec_result(Data0,
ConnectionRef, ChannelId0);
Other0 ->
@@ -1546,7 +1614,7 @@ ssh_connect_negtimeout(Config, Parallel) ->
{ok,Socket} = gen_tcp:connect(Host, Port, []),
Factor = 2,
- ct:pal("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]),
+ ct:log("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]),
ct:sleep(round(Factor * NegTimeOut)),
case inet:sockname(Socket) of
@@ -1577,22 +1645,22 @@ ssh_connect_nonegtimeout_connected(Config, Parallel) ->
{parallel_login, Parallel},
{negotiation_timeout, NegTimeOut},
{failfun, fun ssh_test_lib:failfun/2}]),
- ct:pal("~p Listen ~p:~p",[_Pid,_Host,Port]),
+ ct:log("~p Listen ~p:~p",[_Pid,_Host,Port]),
ct:sleep(500),
IO = ssh_test_lib:start_io_server(),
Shell = ssh_test_lib:start_shell(Port, IO, UserDir),
receive
Error = {'EXIT', _, _} ->
- ct:pal("~p",[Error]),
+ ct:log("~p",[Error]),
ct:fail(no_ssh_connection);
ErlShellStart ->
- ct:pal("---Erlang shell start: ~p~n", [ErlShellStart]),
+ ct:log("---Erlang shell start: ~p~n", [ErlShellStart]),
one_shell_op(IO, NegTimeOut),
one_shell_op(IO, NegTimeOut),
Factor = 2,
- ct:pal("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]),
+ ct:log("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]),
ct:sleep(round(Factor * NegTimeOut)),
one_shell_op(IO, NegTimeOut)
@@ -1601,7 +1669,7 @@ ssh_connect_nonegtimeout_connected(Config, Parallel) ->
one_shell_op(IO, TimeOut) ->
- ct:pal("One shell op: Waiting for prompter"),
+ ct:log("One shell op: Waiting for prompter"),
receive
ErlPrompt0 -> ct:log("Erlang prompt: ~p~n", [ErlPrompt0])
after TimeOut -> ct:fail("Timeout waiting for promter")
@@ -1704,7 +1772,7 @@ connect_fun(ssh_sftp__start_channel, _Config) ->
max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) ->
Connect = fun(Host,Port) ->
R = Connect0(Host,Port),
- ct:pal("Connect(~p,~p) -> ~p",[Host,Port,R]),
+ ct:log("Connect(~p,~p) -> ~p",[Host,Port,R]),
R
end,
SystemDir = filename:join(?config(priv_dir, Config), system),
@@ -1717,7 +1785,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) ->
{parallel_login, ParallelLogin},
{max_sessions, MaxSessions}
]),
- ct:pal("~p Listen ~p:~p for max ~p sessions",[Pid,Host,Port,MaxSessions]),
+ ct:log("~p Listen ~p:~p for max ~p sessions",[Pid,Host,Port,MaxSessions]),
try [Connect(Host,Port) || _ <- lists:seq(1,MaxSessions)]
of
Connections ->
@@ -1726,7 +1794,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) ->
[_|_] = Connections,
%% Now try one more than alowed:
- ct:pal("Info Report might come here...",[]),
+ ct:log("Info Report might come here...",[]),
try Connect(Host,Port)
of
_ConnectionRef1 ->
@@ -1855,12 +1923,12 @@ basic_test(Config) ->
do_shell(IO, Shell) ->
receive
ErlPrompt0 ->
- ct:pal("Erlang prompt: ~p~n", [ErlPrompt0])
+ ct:log("Erlang prompt: ~p~n", [ErlPrompt0])
end,
IO ! {input, self(), "1+1.\r\n"},
receive
Echo0 ->
- ct:pal("Echo: ~p ~n", [Echo0])
+ ct:log("Echo: ~p ~n", [Echo0])
end,
receive
?NEWLINE ->
@@ -1868,7 +1936,7 @@ do_shell(IO, Shell) ->
end,
receive
Result0 = <<"2">> ->
- ct:pal("Result: ~p~n", [Result0])
+ ct:log("Result: ~p~n", [Result0])
end,
receive
?NEWLINE ->
@@ -1876,7 +1944,7 @@ do_shell(IO, Shell) ->
end,
receive
ErlPrompt1 ->
- ct:pal("Erlang prompt: ~p~n", [ErlPrompt1])
+ ct:log("Erlang prompt: ~p~n", [ErlPrompt1])
end,
exit(Shell, kill).
%%Does not seem to work in the testserver!
@@ -1887,7 +1955,7 @@ do_shell(IO, Shell) ->
%% end,
%% receive
%% Echo1 ->
- %% ct:pal("Echo: ~p ~n", [Echo1])
+ %% ct:log("Echo: ~p ~n", [Echo1])
%% end,
%% receive
%% ?NEWLINE ->
@@ -1895,7 +1963,7 @@ do_shell(IO, Shell) ->
%% end,
%% receive
%% Result1 ->
- %% ct:pal("Result: ~p~n", [Result1])
+ %% ct:log("Result: ~p~n", [Result1])
%% end,
%% receive
%% {'EXIT', Shell, killed} ->
@@ -1909,13 +1977,13 @@ wait_for_erlang_first_line(Config) ->
{'EXIT', _, _} ->
{fail,no_ssh_connection};
<<"Eshell ",_/binary>> = _ErlShellStart ->
- ct:pal("Erlang shell start: ~p~n", [_ErlShellStart]),
+ ct:log("Erlang shell start: ~p~n", [_ErlShellStart]),
Config;
Other ->
- ct:pal("Unexpected answer from ssh server: ~p",[Other]),
+ ct:log("Unexpected answer from ssh server: ~p",[Other]),
{fail,unexpected_answer}
after 10000 ->
- ct:pal("No answer from ssh-server"),
+ ct:log("No answer from ssh-server"),
{fail,timeout}
end.
@@ -1931,7 +1999,7 @@ new_do_shell(IO, N, Ops=[{Order,Arg}|More]) ->
PfxSize = size(Pfx),
receive
_X = <<"\r\n">> ->
- ct:pal("Skip newline ~p",[_X]),
+ ct:log("Skip newline ~p",[_X]),
new_do_shell(IO, N, Ops);
<<Pfx:PfxSize/binary,P1,"> ">> when (P1-$0)==N ->
@@ -1947,15 +2015,15 @@ new_do_shell(IO, N, Ops=[{Order,Arg}|More]) ->
ct:fail("new_do_shell error: ~p~n",[Err]);
RecBin when Order==expect ; Order==expect_echo ->
- ct:pal("received ~p",[RecBin]),
+ ct:log("received ~p",[RecBin]),
RecStr = string:strip(unicode:characters_to_list(RecBin)),
ExpStr = string:strip(Arg),
case lists:prefix(ExpStr, RecStr) of
true when Order==expect ->
- ct:pal("Matched ~ts",[RecStr]),
+ ct:log("Matched ~ts",[RecStr]),
new_do_shell(IO, N, More);
true when Order==expect_echo ->
- ct:pal("Matched echo ~ts",[RecStr]),
+ ct:log("Matched echo ~ts",[RecStr]),
new_do_shell(IO, N, More);
false ->
ct:fail("*** Expected ~p, but got ~p",[string:strip(ExpStr),RecStr])
@@ -1981,12 +2049,12 @@ prompt_prefix() ->
new_do_shell_prompt(IO, N, type, Str, More) ->
- ct:pal("Matched prompt ~p to trigger sending of next line to server",[N]),
+ ct:log("Matched prompt ~p to trigger sending of next line to server",[N]),
IO ! {input, self(), Str++"\r\n"},
- ct:pal("Promt '~p> ', Sent ~ts",[N,Str++"\r\n"]),
+ ct:log("Promt '~p> ', Sent ~ts",[N,Str++"\r\n"]),
new_do_shell(IO, N, [{expect_echo,Str}|More]); % expect echo of the sent line
new_do_shell_prompt(IO, N, Op, Str, More) ->
- ct:pal("Matched prompt ~p",[N]),
+ ct:log("Matched prompt ~p",[N]),
new_do_shell(IO, N, [{Op,Str}|More]).
%%--------------------------------------------------------------------
diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl
index eb7c641d8a..fbcf06290a 100644
--- a/lib/ssh/test/ssh_connection_SUITE.erl
+++ b/lib/ssh/test/ssh_connection_SUITE.erl
@@ -186,7 +186,7 @@ big_cat(Config) when is_list(Config) ->
%% pre-adjust receive window so the other end doesn't block
ssh_connection:adjust_window(ConnectionRef, ChannelId0, size(Data)),
- ct:pal("sending ~p byte binary~n",[size(Data)]),
+ ct:log("sending ~p byte binary~n",[size(Data)]),
ok = ssh_connection:send(ConnectionRef, ChannelId0, Data, 10000),
ok = ssh_connection:send_eof(ConnectionRef, ChannelId0),
@@ -197,10 +197,10 @@ big_cat(Config) when is_list(Config) ->
{ok, Other} ->
case size(Data) =:= size(Other) of
true ->
- ct:pal("received and sent data are same"
+ ct:log("received and sent data are same"
"size but do not match~n",[]);
false ->
- ct:pal("sent ~p but only received ~p~n",
+ ct:log("sent ~p but only received ~p~n",
[size(Data), size(Other)])
end,
ct:fail(receive_data_mismatch);
@@ -450,7 +450,7 @@ gracefull_invalid_version(Config) when is_list(Config) ->
ok = gen_tcp:send(S, ["SSH-8.-1","\r\n"]),
receive
Verstring ->
- ct:pal("Server version: ~p~n", [Verstring]),
+ ct:log("Server version: ~p~n", [Verstring]),
receive
{tcp_closed, S} ->
ok
@@ -470,7 +470,7 @@ gracefull_invalid_start(Config) when is_list(Config) ->
ok = gen_tcp:send(S, ["foobar","\r\n"]),
receive
Verstring ->
- ct:pal("Server version: ~p~n", [Verstring]),
+ ct:log("Server version: ~p~n", [Verstring]),
receive
{tcp_closed, S} ->
ok
@@ -490,7 +490,7 @@ gracefull_invalid_long_start(Config) when is_list(Config) ->
ok = gen_tcp:send(S, [lists:duplicate(257, $a), "\r\n"]),
receive
Verstring ->
- ct:pal("Server version: ~p~n", [Verstring]),
+ ct:log("Server version: ~p~n", [Verstring]),
receive
{tcp_closed, S} ->
ok
@@ -511,7 +511,7 @@ gracefull_invalid_long_start_no_nl(Config) when is_list(Config) ->
ok = gen_tcp:send(S, [lists:duplicate(257, $a), "\r\n"]),
receive
Verstring ->
- ct:pal("Server version: ~p~n", [Verstring]),
+ ct:log("Server version: ~p~n", [Verstring]),
receive
{tcp_closed, S} ->
ok
diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl
index d82cdaf2c7..dc02b940d7 100644
--- a/lib/ssh/test/ssh_protocol_SUITE.erl
+++ b/lib/ssh/test/ssh_protocol_SUITE.erl
@@ -56,7 +56,11 @@ groups() ->
lib_no_match
]},
{kex, [], [no_common_alg_server_disconnects,
- no_common_alg_client_disconnects
+ no_common_alg_client_disconnects,
+ gex_client_init_default_noexact,
+ gex_client_init_default_exact,
+ gex_client_init_option_groups,
+ gex_client_init_option_groups_file
]}
].
@@ -68,9 +72,32 @@ end_per_suite(Config) ->
stop_apps(Config).
+
+init_per_testcase(TC, Config) when TC == gex_client_init_default_noexact ;
+ TC == gex_client_init_default_exact ;
+ TC == gex_client_init_option_groups ;
+ TC == gex_client_init_option_groups_file ->
+ Opts = case TC of
+ gex_client_init_option_groups ->
+ [{dh_gex_groups, [{2345, 3, 41}]}];
+ gex_client_init_option_groups_file ->
+ DataDir = ?config(data_dir, Config),
+ F = filename:join(DataDir, "dh_group_test"),
+ [{dh_gex_groups, {file,F}}];
+ _ ->
+ []
+ end,
+ start_std_daemon(Config,
+ [{preferred_algorithms, ssh_transport:supported_algorithms()}
+ | Opts]);
init_per_testcase(_TestCase, Config) ->
check_std_daemon_works(Config, ?LINE).
+end_per_testcase(TC, Config) when TC == gex_client_init_default_noexact ;
+ TC == gex_client_init_default_exact ;
+ TC == gex_client_init_option_groups ;
+ TC == gex_client_init_option_groups_file ->
+ stop_std_daemon(Config);
end_per_testcase(_TestCase, Config) ->
check_std_daemon_works(Config, ?LINE).
@@ -213,7 +240,7 @@ lib_no_match(_Config) ->
no_common_alg_server_disconnects(Config) ->
{ok,_} =
ssh_trpt_test_lib:exec(
- [{set_options, [print_ops, print_seqnums, print_messages]},
+ [{set_options, [print_ops, {print_messages,detail}]},
{connect,
server_host(Config),server_port(Config),
[{silently_accept_hosts, true},
@@ -224,7 +251,7 @@ no_common_alg_server_disconnects(Config) ->
receive_hello,
{send, hello},
{match, #ssh_msg_kexinit{_='_'}, receive_msg},
- {send, ssh_msg_kexinit},
+ {send, ssh_msg_kexinit}, % with server unsupported 'ssh-dss' !
{match,
{'or',[#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, _='_'},
tcp_closed]},
@@ -248,17 +275,16 @@ no_common_alg_client_disconnects(Config) ->
Parent !
{result,self(),
ssh_trpt_test_lib:exec(
- [{set_options, [print_ops, print_messages]},
+ [{set_options, [print_ops, {print_messages,detail}]},
{accept, [{system_dir, system_dir(Config)},
{user_dir, user_dir(Config)}]},
receive_hello,
{send, hello},
-
{match, #ssh_msg_kexinit{_='_'}, receive_msg},
- {send, #ssh_msg_kexinit{
+ {send, #ssh_msg_kexinit{ % with unsupported "SOME-UNSUPPORTED"
cookie = 247381486335508958743193106082599558706,
kex_algorithms = ["diffie-hellman-group1-sha1"],
- server_host_key_algorithms = ["some-unknown"],
+ server_host_key_algorithms = ["SOME-UNSUPPORTED"], % SIC!
encryption_algorithms_client_to_server = ["aes128-ctr"],
encryption_algorithms_server_to_client = ["aes128-ctr"],
mac_algorithms_client_to_server = ["hmac-sha2-256"],
@@ -279,7 +305,8 @@ no_common_alg_client_disconnects(Config) ->
}
end),
- %% and finally connect to it with a regular Erlang SSH client:
+ %% and finally connect to it with a regular Erlang SSH client
+ %% which of course does not support SOME-UNSUPPORTED as pub key algo:
Result = std_connect(HostPort, Config, [{preferred_algorithms,[{public_key,['ssh-dss']}]}]),
ct:log("Result of connect is ~p",[Result]),
@@ -287,12 +314,56 @@ no_common_alg_client_disconnects(Config) ->
{result,Pid,{ok,_}} ->
ok;
{result,Pid,{error,{Op,ExecResult,S}}} ->
- ct:pal("ERROR!~nOp = ~p~nExecResult = ~p~nState =~n~s",
+ ct:log("ERROR!~nOp = ~p~nExecResult = ~p~nState =~n~s",
[Op,ExecResult,ssh_trpt_test_lib:format_msg(S)]),
{fail, ExecResult};
- X -> ct:fail(X)
+ X ->
+ ct:log("¤¤¤¤¤"),
+ ct:fail(X)
end.
+%%%--------------------------------------------------------------------
+gex_client_init_default_noexact(Config) ->
+ do_gex_client_init(Config, {2000, 3000, 4000},
+ %% Warning, app knowledege:
+ ?dh_group15).
+
+
+gex_client_init_default_exact(Config) ->
+ do_gex_client_init(Config, {2000, 2048, 4000},
+ %% Warning, app knowledege:
+ ?dh_group14).
+
+
+gex_client_init_option_groups(Config) ->
+ do_gex_client_init(Config, {2000, 2048, 4000}, {3,41}).
+
+
+gex_client_init_option_groups_file(Config) ->
+ do_gex_client_init(Config, {2000, 2048, 4000}, {5,61}).
+
+do_gex_client_init(Config, {Min,N,Max}, {G,P}) ->
+ {ok,_} =
+ ssh_trpt_test_lib:exec(
+ [{set_options, [print_ops, print_seqnums, print_messages]},
+ {connect,
+ server_host(Config),server_port(Config),
+ [{silently_accept_hosts, true},
+ {user_dir, user_dir(Config)},
+ {user_interaction, false},
+ {preferred_algorithms,[{kex,['diffie-hellman-group-exchange-sha1']}]}
+ ]},
+ receive_hello,
+ {send, hello},
+ {send, ssh_msg_kexinit},
+ {match, #ssh_msg_kexinit{_='_'}, receive_msg},
+ {send, #ssh_msg_kex_dh_gex_request{min = Min,
+ n = N,
+ max = Max}},
+ {match, #ssh_msg_kex_dh_gex_group{p=P, g=G, _='_'}, receive_msg}
+ ]
+ ).
+
%%%================================================================
%%%==== Internal functions ========================================
%%%================================================================
@@ -353,6 +424,7 @@ stop_std_daemon(Config) ->
ct:log("Std server ~p at ~p:~p stopped", [server_pid(Config), server_host(Config), server_port(Config)]),
lists:keydelete(server, 1, Config).
+
check_std_daemon_works(Config, Line) ->
case std_connect(Config) of
{ok,C} ->
@@ -362,13 +434,9 @@ check_std_daemon_works(Config, Line) ->
ok = ssh:close(C),
Config;
Error = {error,_} ->
- {fail,
- lists:flatten(
- io_lib:format("Standard server ~p:~p ~p is ill at line ~p: ~p",
- [server_host(Config), server_port(Config),
- server_pid(Config), Line, Error])
- )
- }
+ ct:fail("Standard server ~p:~p ~p is ill at line ~p: ~p",
+ [server_host(Config), server_port(Config),
+ server_pid(Config), Line, Error])
end.
server_pid(Config) -> element(1,?v(server,Config)).
diff --git a/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test
new file mode 100644
index 0000000000..2887bb4b60
--- /dev/null
+++ b/lib/ssh/test/ssh_protocol_SUITE_data/dh_group_test
@@ -0,0 +1,3 @@
+{2222, 5, 61}.
+{1111, 7, 91}.
+
diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl
index 6c631e6f6e..8d0b887d83 100644
--- a/lib/ssh/test/ssh_sftp_SUITE.erl
+++ b/lib/ssh/test/ssh_sftp_SUITE.erl
@@ -47,7 +47,7 @@ init_per_suite(Config) ->
catch crypto:stop(),
case (catch crypto:start()) of
ok ->
- ct:pal("file:native_name_encoding() = ~p,~nio:getopts() = ~p",
+ ct:log("file:native_name_encoding() = ~p,~nio:getopts() = ~p",
[file:native_name_encoding(),io:getopts()]),
ssh:start(),
Config;
@@ -64,12 +64,20 @@ end_per_suite(Config) ->
groups() ->
[{not_unicode, [], [{group,erlang_server},
{group,openssh_server},
+ {group,'diffie-hellman-group-exchange-sha1'},
+ {group,'diffie-hellman-group-exchange-sha256'},
sftp_nonexistent_subsystem]},
{unicode, [], [{group,erlang_server},
{group,openssh_server},
sftp_nonexistent_subsystem]},
+ {'diffie-hellman-group-exchange-sha1', [], [{group,erlang_server},
+ {group,openssh_server}]},
+
+ {'diffie-hellman-group-exchange-sha256', [], [{group,erlang_server},
+ {group,openssh_server}]},
+
{erlang_server, [], [{group,write_read_tests},
version_option,
{group,remote_tar}]},
@@ -77,7 +85,12 @@ groups() ->
{openssh_server, [], [{group,write_read_tests},
{group,remote_tar}]},
- {remote_tar, [], [create_empty_tar, files_to_tar, big_file_to_tar, files_chunked_to_tar,
+ {remote_tar, [], [create_empty_tar,
+ ascii_filename_ascii_contents_to_tar,
+ ascii_filename_unicode_contents_to_tar,
+ unicode_filename_ascii_contents_to_tar,
+ files_to_tar,
+ big_file_to_tar, files_chunked_to_tar,
directory_to_tar, binaries_to_tar, null_crypto_tar,
simple_crypto_tar_small, simple_crypto_tar_big,
read_tar, read_null_crypto_tar, read_crypto_tar,
@@ -113,23 +126,35 @@ init_per_group(unicode, Config) ->
ct:comment("Begin ~p",[grps(Config)]),
DataDir = ?config(data_dir, Config),
PrivDir = ?config(priv_dir, Config),
- [{user, "åke高兴"},
- {passwd, "ärlig日本じん"},
- {data, <<"foobar å 一二三四いちにさんち">>},
- {filename, filename:join(PrivDir, "sftp瑞点.txt")},
- {testfile, filename:join(PrivDir, "testハンス.txt")},
- {linktest, filename:join(PrivDir, "link_test語.txt")},
- {tar_filename, filename:join(PrivDir, "sftp_tar_test一二三.tar")},
- {tar_F1_txt, "F一.txt"},
- {datadir_tar, filename:join(DataDir,"sftp_tar_test_data_高兴")}
- | lists:foldl(fun(K,Cf) -> lists:keydelete(K,1,Cf) end,
- Config,
- [user, passwd, data,
- filename, testfile, linktest,
- tar_filename, tar_F1_txt, datadir_tar
- ]
- )
- ];
+ NewConfig =
+ [{user, "åke高兴"},
+ {passwd, "ärlig日本じん"},
+ {data, <<"foobar å 一二三四いちにさんち">>},
+ {filename, filename:join(PrivDir, "sftp瑞点.txt")},
+ {testfile, filename:join(PrivDir, "testハンス.txt")},
+ {linktest, filename:join(PrivDir, "link_test語.txt")},
+ {tar_filename, filename:join(PrivDir, "sftp_tar_test一二三.tar")},
+ {tar_F1_txt, "F一.txt"},
+ {tar_F3_txt, "f3.txt"},
+ {tar_F4_txt, "g四.txt"},
+ {datadir_tar, filename:join(DataDir,"sftp_tar_test_data_高兴")}
+ | lists:foldl(fun(K,Cf) -> lists:keydelete(K,1,Cf) end,
+ Config,
+ [user, passwd, data,
+ filename, testfile, linktest,
+ tar_filename, tar_F1_txt, datadir_tar
+ ]
+ )
+ ],
+ FN = fn(?config(tar_F1_txt,NewConfig), NewConfig),
+ case catch file:read_file(FN) of
+ {ok,FN_contents} ->
+ ct:log("Readable file:read_file(~tp) ->~n~tp",[FN,FN_contents]),
+ NewConfig;
+ Other ->
+ ct:log("Unreadable file:read_file(~tp) ->~n~p",[FN,Other]),
+ {skip, "Not unicode file reading"}
+ end;
_ ->
{skip, "Not unicode file encoding"}
@@ -142,22 +167,26 @@ init_per_group(erlang_server, Config) ->
User = ?config(user, Config),
Passwd = ?config(passwd, Config),
Sftpd = {_, HostX, PortX} =
- ssh_test_lib:daemon([{system_dir, SysDir},
- {user_dir, PrivDir},
- {user_passwords,
- [{User, Passwd}]}]),
+ ssh_test_lib:daemon(extra_opts(Config) ++
+ [{system_dir, SysDir},
+ {user_dir, PrivDir},
+ {user_passwords,
+ [{User, Passwd}]}]),
[{peer, {fmt_host(HostX),PortX}}, {group, erlang_server}, {sftpd, Sftpd} | Config];
init_per_group(openssh_server, Config) ->
ct:comment("Begin ~p",[grps(Config)]),
Host = ssh_test_lib:hostname(),
- case (catch ssh_sftp:start_channel(Host,
- [{user_interaction, false},
- {silently_accept_hosts, true}])) of
+ case (catch ssh_sftp:start_channel(Host,
+ extra_opts(Config) ++
+ [{user_interaction, false},
+ {silently_accept_hosts, true}])) of
{ok, _ChannelPid, Connection} ->
[{peer, {_HostName,{IPx,Portx}}}] = ssh:connection_info(Connection,[peer]),
ssh:close(Connection),
[{peer, {fmt_host(IPx),Portx}}, {group, openssh_server} | Config];
+ {error,"Key exchange failed"} ->
+ {skip, "openssh server doesn't support the tested kex algorithm"};
_ ->
{skip, "No openssh server"}
end;
@@ -172,10 +201,11 @@ init_per_group(remote_tar, Config) ->
case ?config(group, Config) of
erlang_server ->
ssh:connect(Host, Port,
- [{user, User},
- {password, Passwd},
- {user_interaction, false},
- {silently_accept_hosts, true}]);
+ extra_opts(Config) ++
+ [{user, User},
+ {password, Passwd},
+ {user_interaction, false},
+ {silently_accept_hosts, true}]);
openssh_server ->
ssh:connect(Host, Port,
[{user_interaction, false},
@@ -184,6 +214,28 @@ init_per_group(remote_tar, Config) ->
[{remote_tar, true},
{connection, Connection} | Config];
+init_per_group('diffie-hellman-group-exchange-sha1', Config) ->
+ case lists:member('diffie-hellman-group-exchange-sha1',
+ ssh_transport:supported_algorithms(kex)) of
+ true ->
+ [{extra_opts, [{preferred_algorithms, [{kex,['diffie-hellman-group-exchange-sha1']}]}]}
+ | Config];
+
+ false ->
+ {skip,"'diffie-hellman-group-exchange-sha1' not supported by this version of erlang ssh"}
+ end;
+
+init_per_group('diffie-hellman-group-exchange-sha256', Config) ->
+ case lists:member('diffie-hellman-group-exchange-sha256',
+ ssh_transport:supported_algorithms(kex)) of
+ true ->
+ [{extra_opts, [{preferred_algorithms, [{kex,['diffie-hellman-group-exchange-sha256']}]}]}
+ | Config];
+
+ false ->
+ {skip,"'diffie-hellman-group-exchange-sha256' not supported by this version of erlang ssh"}
+ end;
+
init_per_group(write_read_tests, Config) ->
ct:comment("Begin ~p",[grps(Config)]),
Config.
@@ -194,7 +246,6 @@ grps(Config) ->
lists:flatten([proplists:get_value(tc_group_properties,Config,[]),
proplists:get_value(tc_group_path,Config,[])])).
-
end_per_group(erlang_server, Config) ->
ct:comment("End ~p",[grps(Config)]),
Config;
@@ -227,11 +278,12 @@ init_per_testcase(version_option, Config) ->
Passwd = ?config(passwd, Config),
{ok, ChannelPid, Connection} =
ssh_sftp:start_channel(Host, Port,
- [{sftp_vsn, 3},
- {user, User},
- {password, Passwd},
- {user_interaction, false},
- {silently_accept_hosts, true}]),
+ extra_opts(Config) ++
+ [{sftp_vsn, 3},
+ {user, User},
+ {password, Passwd},
+ {user_interaction, false},
+ {silently_accept_hosts, true}]),
Sftp = {ChannelPid, Connection},
[{sftp,Sftp}, {watchdog, Dog} | TmpConfig];
@@ -239,7 +291,7 @@ init_per_testcase(Case, Config0) ->
prep(Config0),
Config1 = lists:keydelete(watchdog, 1, Config0),
Config2 = lists:keydelete(sftp, 1, Config1),
- Dog = ct:timetrap(?default_timeout),
+ Dog = ct:timetrap(2 * ?default_timeout),
User = ?config(user, Config0),
Passwd = ?config(passwd, Config0),
@@ -249,10 +301,12 @@ init_per_testcase(Case, Config0) ->
{_,Host, Port} = ?config(sftpd, Config2),
{ok, ChannelPid, Connection} =
ssh_sftp:start_channel(Host, Port,
- [{user, User},
- {password, Passwd},
- {user_interaction, false},
- {silently_accept_hosts, true}]),
+ extra_opts(Config2) ++
+ [{user, User},
+ {password, Passwd},
+ {user_interaction, false},
+ {silently_accept_hosts, true}]
+ ),
Sftp = {ChannelPid, Connection},
[{sftp, Sftp}, {watchdog, Dog} | Config2];
openssh_server when Case == links ->
@@ -261,8 +315,9 @@ init_per_testcase(Case, Config0) ->
Host = ssh_test_lib:hostname(),
{ok, ChannelPid, Connection} =
ssh_sftp:start_channel(Host,
- [{user_interaction, false},
- {silently_accept_hosts, true}]),
+ extra_opts(Config2) ++
+ [{user_interaction, false},
+ {silently_accept_hosts, true}]),
Sftp = {ChannelPid, Connection},
[{sftp, Sftp}, {watchdog, Dog} | Config2]
end,
@@ -342,7 +397,7 @@ read_dir(Config) when is_list(Config) ->
PrivDir = ?config(priv_dir, Config),
{Sftp, _} = ?config(sftp, Config),
{ok, Files} = ssh_sftp:list_dir(Sftp, PrivDir),
- ct:pal("sftp list dir: ~p~n", [Files]).
+ ct:log("sftp list dir: ~p~n", [Files]).
%%--------------------------------------------------------------------
write_file() ->
@@ -423,12 +478,12 @@ rename_file(Config) when is_list(Config) ->
{Sftp, _} = ?config(sftp, Config),
{ok, Files} = ssh_sftp:list_dir(Sftp, PrivDir),
- ct:pal("FileName: ~p, Files: ~p~n", [FileName, Files]),
+ ct:log("FileName: ~p, Files: ~p~n", [FileName, Files]),
true = lists:member(filename:basename(FileName), Files),
false = lists:member(filename:basename(NewFileName), Files),
ok = ssh_sftp:rename(Sftp, FileName, NewFileName),
{ok, NewFiles} = ssh_sftp:list_dir(Sftp, PrivDir),
- ct:pal("FileName: ~p, Files: ~p~n", [FileName, NewFiles]),
+ ct:log("FileName: ~p, Files: ~p~n", [FileName, NewFiles]),
false = lists:member(filename:basename(FileName), NewFiles),
true = lists:member(filename:basename(NewFileName), NewFiles).
@@ -474,7 +529,7 @@ retrieve_attributes(Config) when is_list(Config) ->
{ok, NewFileInfo} = file:read_file_info(FileName),
%% TODO comparison. There are some differences now is that ok?
- ct:pal("SFTP: ~p FILE: ~p~n", [FileInfo, NewFileInfo]).
+ ct:log("SFTP: ~p FILE: ~p~n", [FileInfo, NewFileInfo]).
%%--------------------------------------------------------------------
set_attributes() ->
@@ -503,7 +558,7 @@ async_read(Config) when is_list(Config) ->
receive
{async_reply, Ref, {ok, Data}} ->
- ct:pal("Data: ~p~n", [Data]),
+ ct:log("Data: ~p~n", [Data]),
ok;
Msg ->
ct:fail(Msg)
@@ -648,6 +703,43 @@ files_to_tar(Config) ->
chk_tar([F1, "f2.txt"], Config).
%%--------------------------------------------------------------------
+ascii_filename_ascii_contents_to_tar(Config) ->
+ ChPid2 = ?config(channel_pid2, Config),
+ TarFileName = ?config(tar_filename, Config),
+ {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]),
+ ok = erl_tar:add(Handle, fn("f2.txt",Config), "f2.txt", [verbose]),
+ ok = erl_tar:close(Handle),
+ chk_tar(["f2.txt"], Config).
+
+%%--------------------------------------------------------------------
+ascii_filename_unicode_contents_to_tar(Config) ->
+ case ?config(tar_F3_txt, Config) of
+ undefined ->
+ {skip, "Unicode test"};
+ Fn ->
+ ChPid2 = ?config(channel_pid2, Config),
+ TarFileName = ?config(tar_filename, Config),
+ {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]),
+ ok = erl_tar:add(Handle, fn(Fn,Config), Fn, [verbose]),
+ ok = erl_tar:close(Handle),
+ chk_tar([Fn], Config)
+ end.
+
+%%--------------------------------------------------------------------
+unicode_filename_ascii_contents_to_tar(Config) ->
+ case ?config(tar_F4_txt, Config) of
+ undefined ->
+ {skip, "Unicode test"};
+ Fn ->
+ ChPid2 = ?config(channel_pid2, Config),
+ TarFileName = ?config(tar_filename, Config),
+ {ok,Handle} = ssh_sftp:open_tar(ChPid2, TarFileName, [write]),
+ ok = erl_tar:add(Handle, fn(Fn,Config), Fn, [verbose]),
+ ok = erl_tar:close(Handle),
+ chk_tar([Fn], Config)
+ end.
+
+%%--------------------------------------------------------------------
big_file_to_tar(Config) ->
ChPid2 = ?config(channel_pid2, Config),
TarFileName = ?config(tar_filename, Config),
@@ -910,7 +1002,8 @@ prep(Config) ->
ok = file:write_file_info(TestFile,
FileInfo#file_info{mode = Mode}).
-
+extra_opts(Config) ->
+ proplists:get_value(extra_opts, Config, []).
chk_tar(Items, Config) ->
chk_tar(Items, Config, []).
diff --git a/lib/ssh/test/ssh_sftp_SUITE_data/sftp_tar_test_data_高兴/f3.txt b/lib/ssh/test/ssh_sftp_SUITE_data/sftp_tar_test_data_高兴/f3.txt
new file mode 100644
index 0000000000..e6076a05b5
--- /dev/null
+++ b/lib/ssh/test/ssh_sftp_SUITE_data/sftp_tar_test_data_高兴/f3.txt
@@ -0,0 +1 @@
+你好
diff --git a/lib/ssh/test/ssh_sftp_SUITE_data/sftp_tar_test_data_高兴/g四.txt b/lib/ssh/test/ssh_sftp_SUITE_data/sftp_tar_test_data_高兴/g四.txt
new file mode 100644
index 0000000000..d18c6b11fc
--- /dev/null
+++ b/lib/ssh/test/ssh_sftp_SUITE_data/sftp_tar_test_data_高兴/g四.txt
@@ -0,0 +1 @@
+How are you?
diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl
index f38fcc5521..94a54ec9db 100644
--- a/lib/ssh/test/ssh_sftpd_SUITE.erl
+++ b/lib/ssh/test/ssh_sftpd_SUITE.erl
@@ -152,7 +152,7 @@ init_per_testcase(TestCase, Config) ->
{ok, <<?SSH_FXP_VERSION, ?UINT32(Version), _Ext/binary>>, _}
= reply(Cm, Channel),
- ct:pal("Client: ~p Server ~p~n", [ProtocolVer, Version]),
+ ct:log("Client: ~p Server ~p~n", [ProtocolVer, Version]),
[{sftp, {Cm, Channel}}, {sftpd, Sftpd }| Config].
@@ -418,7 +418,7 @@ real_path(Config) when is_list(Config) ->
RealPath = filename:absname(binary_to_list(Path)),
AbsPrivDir = filename:absname(PrivDir),
- ct:pal("Path: ~p PrivDir: ~p~n", [RealPath, AbsPrivDir]),
+ ct:log("Path: ~p PrivDir: ~p~n", [RealPath, AbsPrivDir]),
true = RealPath == AbsPrivDir
end.
@@ -447,7 +447,7 @@ links(Config) when is_list(Config) ->
true = binary_to_list(Path) == FileName,
- ct:pal("Path: ~p~n", [binary_to_list(Path)])
+ ct:log("Path: ~p~n", [binary_to_list(Path)])
end.
%%--------------------------------------------------------------------
@@ -548,10 +548,10 @@ set_attributes(Config) when is_list(Config) ->
%% Can not test that NewPermissions = Permissions as
%% on Unix platforms, other bits than those listed in the
%% API may be set.
- ct:pal("Org: ~p New: ~p~n", [OrigPermissions, NewPermissions]),
+ ct:log("Org: ~p New: ~p~n", [OrigPermissions, NewPermissions]),
true = OrigPermissions =/= NewPermissions,
- ct:pal("Try to open the file"),
+ ct:log("Try to open the file"),
NewReqId = 2,
{ok, <<?SSH_FXP_HANDLE, ?UINT32(NewReqId), Handle/binary>>, _} =
open_file(FileName, Cm, Channel, NewReqId,
@@ -563,7 +563,7 @@ set_attributes(Config) when is_list(Config) ->
NewReqId1 = 3,
- ct:pal("Set original permissions on the now open file"),
+ ct:log("Set original permissions on the now open file"),
{ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId1),
?UINT32(?SSH_FX_OK), _/binary>>, _} =
@@ -786,7 +786,7 @@ read_dir(Handle, Cm, Channel, ReqId) ->
case reply(Cm, Channel) of
{ok, <<?SSH_FXP_NAME, ?UINT32(ReqId), ?UINT32(Count),
?UINT32(Len), Listing:Len/binary, _/binary>>, _} ->
- ct:pal("Count: ~p Listing: ~p~n",
+ ct:log("Count: ~p Listing: ~p~n",
[Count, binary_to_list(Listing)]),
read_dir(Handle, Cm, Channel, ReqId);
{ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId),
diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl
index 321e3546cf..7a025a6518 100644
--- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl
+++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl
@@ -159,7 +159,7 @@ close_file(Config) when is_list(Config) ->
NumOfPorts = length(erlang:ports()),
- ct:pal("Number of open ports: ~p~n", [NumOfPorts]),
+ ct:log("Number of open ports: ~p~n", [NumOfPorts]),
{ok, <<_/binary>>} = ssh_sftp:read_file(Sftp, FileName),
@@ -255,14 +255,14 @@ root_dir(Config) when is_list(Config) ->
{ok, Bin} = ssh_sftp:read_file(Sftp, FileName),
{ok, Listing} =
ssh_sftp:list_dir(Sftp, "."),
- ct:pal("Listing: ~p~n", [Listing]).
+ ct:log("Listing: ~p~n", [Listing]).
%%--------------------------------------------------------------------
list_dir_limited(Config) when is_list(Config) ->
{Sftp, _} = ?config(sftp, Config),
{ok, Listing} =
ssh_sftp:list_dir(Sftp, "."),
- ct:pal("Listing: ~p~n", [Listing]).
+ ct:log("Listing: ~p~n", [Listing]).
%%--------------------------------------------------------------------
ver6_basic() ->
diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl
index 97c35e549c..988ea47bd8 100644
--- a/lib/ssh/test/ssh_test_lib.erl
+++ b/lib/ssh/test/ssh_test_lib.erl
@@ -97,10 +97,10 @@ loop_io_server(TestCase, Buff0) ->
{input, TestCase, Line} ->
loop_io_server(TestCase, Buff0 ++ [Line]);
{io_request, From, ReplyAs, Request} ->
-%%ct:pal("~p",[{io_request, From, ReplyAs, Request}]),
+%%ct:log("~p",[{io_request, From, ReplyAs, Request}]),
{ok, Reply, Buff} = io_request(Request, TestCase, From,
ReplyAs, Buff0),
-%%ct:pal("io_request(~p)-->~p",[Request,{ok, Reply, Buff}]),
+%%ct:log("io_request(~p)-->~p",[Request,{ok, Reply, Buff}]),
io_reply(From, ReplyAs, Reply),
loop_io_server(TestCase, Buff);
{'EXIT',_, _} ->
@@ -134,26 +134,26 @@ io_request({get_line, _Enc,_}, _, _, _, [Line | Buff]) ->
io_reply(_, _, []) ->
ok;
io_reply(From, ReplyAs, Reply) ->
-%%ct:pal("io_reply ~p sending ~p ! ~p",[self(),From, {io_reply, ReplyAs, Reply}]),
+%%ct:log("io_reply ~p sending ~p ! ~p",[self(),From, {io_reply, ReplyAs, Reply}]),
From ! {io_reply, ReplyAs, Reply}.
reply(_, []) ->
ok;
reply(TestCase, Result) ->
-%%ct:pal("reply ~p sending ~p ! ~p",[self(), TestCase, Result]),
+%%ct:log("reply ~p sending ~p ! ~p",[self(), TestCase, Result]),
TestCase ! Result.
receive_exec_result(Msg) ->
- ct:pal("Expect data! ~p", [Msg]),
+ ct:log("Expect data! ~p", [Msg]),
receive
{ssh_cm,_,{data,_,1, Data}} ->
- ct:pal("StdErr: ~p~n", [Data]),
+ ct:log("StdErr: ~p~n", [Data]),
receive_exec_result(Msg);
Msg ->
- ct:pal("1: Collected data ~p", [Msg]),
+ ct:log("1: Collected data ~p", [Msg]),
expected;
Other ->
- ct:pal("Other ~p", [Other]),
+ ct:log("Other ~p", [Other]),
{unexpected_msg, Other}
end.
@@ -165,15 +165,15 @@ receive_exec_end(ConnectionRef, ChannelId) ->
case receive_exec_result(ExitStatus) of
{unexpected_msg, Eof} -> %% Open ssh seems to not allways send these messages
%% in the same order!
- ct:pal("2: Collected data ~p", [Eof]),
+ ct:log("2: Collected data ~p", [Eof]),
case receive_exec_result(ExitStatus) of
expected ->
expected = receive_exec_result(Closed);
{unexpected_msg, Closed} ->
- ct:pal("3: Collected data ~p", [Closed])
+ ct:log("3: Collected data ~p", [Closed])
end;
expected ->
- ct:pal("4: Collected data ~p", [ExitStatus]),
+ ct:log("4: Collected data ~p", [ExitStatus]),
expected = receive_exec_result(Eof),
expected = receive_exec_result(Closed);
Other ->
diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl
index b7283202a3..06bf264033 100644
--- a/lib/ssh/test/ssh_to_openssh_SUITE.erl
+++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl
@@ -51,13 +51,15 @@ groups() ->
erlang_client_openssh_server_publickey_rsa,
erlang_client_openssh_server_publickey_dsa,
erlang_client_openssh_server_password,
+ erlang_client_openssh_server_kexs,
erlang_client_openssh_server_nonexistent_subsystem
]},
{erlang_server, [], [erlang_server_openssh_client_exec,
erlang_server_openssh_client_exec_compressed,
erlang_server_openssh_client_pulic_key_dsa,
erlang_server_openssh_client_cipher_suites,
- erlang_server_openssh_client_macs]}
+ erlang_server_openssh_client_macs,
+ erlang_server_openssh_client_kexs]}
].
init_per_suite(Config) ->
@@ -99,6 +101,12 @@ init_per_testcase(erlang_server_openssh_client_cipher_suites, Config) ->
init_per_testcase(erlang_server_openssh_client_macs, Config) ->
check_ssh_client_support(Config);
+init_per_testcase(erlang_server_openssh_client_kexs, Config) ->
+ check_ssh_client_support(Config);
+
+init_per_testcase(erlang_client_openssh_server_kexs, Config) ->
+ check_ssh_client_support(Config);
+
init_per_testcase(_TestCase, Config) ->
ssh:start(),
Config.
@@ -140,7 +148,7 @@ erlang_client_openssh_server_exec(Config) when is_list(Config) ->
ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId0);
{unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId0, 0}}
= ExitStatus0} ->
- ct:pal("0: Collected data ~p", [ExitStatus0]),
+ ct:log("0: Collected data ~p", [ExitStatus0]),
ssh_test_lib:receive_exec_result(Data0,
ConnectionRef, ChannelId0);
Other0 ->
@@ -156,7 +164,7 @@ erlang_client_openssh_server_exec(Config) when is_list(Config) ->
ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId1);
{unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId1, 0}}
= ExitStatus1} ->
- ct:pal("0: Collected data ~p", [ExitStatus1]),
+ ct:log("0: Collected data ~p", [ExitStatus1]),
ssh_test_lib:receive_exec_result(Data1,
ConnectionRef, ChannelId1);
Other1 ->
@@ -182,13 +190,55 @@ erlang_client_openssh_server_exec_compressed(Config) when is_list(Config) ->
ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId);
{unexpected_msg,{ssh_cm, ConnectionRef,
{exit_status, ChannelId, 0}} = ExitStatus} ->
- ct:pal("0: Collected data ~p", [ExitStatus]),
+ ct:log("0: Collected data ~p", [ExitStatus]),
ssh_test_lib:receive_exec_result(Data, ConnectionRef, ChannelId);
Other ->
ct:fail(Other)
end.
%%--------------------------------------------------------------------
+erlang_client_openssh_server_kexs() ->
+ [{doc, "Test that we can connect with different KEXs."}].
+
+erlang_client_openssh_server_kexs(Config) when is_list(Config) ->
+ Success =
+ lists:foldl(
+ fun(Kex, Acc) ->
+ ConnectionRef =
+ ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true},
+ {user_interaction, false},
+ {preferred_algorithms,
+ [{kex,[Kex]}]}]),
+
+ {ok, ChannelId} =
+ ssh_connection:session_channel(ConnectionRef, infinity),
+ success =
+ ssh_connection:exec(ConnectionRef, ChannelId,
+ "echo testing", infinity),
+
+ ExpectedData = {ssh_cm, ConnectionRef, {data, ChannelId, 0, <<"testing\n">>}},
+ case ssh_test_lib:receive_exec_result(ExpectedData) of
+ expected ->
+ ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId),
+ Acc;
+ {unexpected_msg,{ssh_cm, ConnectionRef,
+ {exit_status, ChannelId, 0}} = ExitStatus} ->
+ ct:log("0: Collected data ~p", [ExitStatus]),
+ ssh_test_lib:receive_exec_result(ExpectedData, ConnectionRef, ChannelId),
+ Acc;
+ Other ->
+ ct:log("~p failed: ~p",[Kex,Other]),
+ false
+ end
+ end, true, ssh_transport:supported_algorithms(kex)),
+ case Success of
+ true ->
+ ok;
+ false ->
+ {fail, "Kex failed for one or more algos"}
+ end.
+
+%%--------------------------------------------------------------------
erlang_server_openssh_client_exec() ->
[{doc, "Test that exec command works."}].
@@ -206,7 +256,7 @@ erlang_server_openssh_client_exec(Config) when is_list(Config) ->
Cmd = "ssh -p " ++ integer_to_list(Port) ++
" -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " 1+1.",
- ct:pal("Cmd: ~p~n", [Cmd]),
+ ct:log("Cmd: ~p~n", [Cmd]),
SshPort = open_port({spawn, Cmd}, [binary]),
@@ -247,7 +297,7 @@ erlang_server_openssh_client_cipher_suites(Config) when is_list(Config) ->
" -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " " ++
" -c " ++ Cipher ++ " 1+1.",
- ct:pal("Cmd: ~p~n", [Cmd]),
+ ct:log("Cmd: ~p~n", [Cmd]),
SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]),
@@ -297,7 +347,7 @@ erlang_server_openssh_client_macs(Config) when is_list(Config) ->
" -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " " ++
" -o MACs=" ++ MAC ++ " 1+1.",
- ct:pal("Cmd: ~p~n", [Cmd]),
+ ct:log("Cmd: ~p~n", [Cmd]),
SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]),
@@ -322,6 +372,70 @@ erlang_server_openssh_client_macs(Config) when is_list(Config) ->
ssh:stop_daemon(Pid).
%%--------------------------------------------------------------------
+erlang_server_openssh_client_kexs() ->
+ [{doc, "Test that we can connect with different KEXs."}].
+
+erlang_server_openssh_client_kexs(Config) when is_list(Config) ->
+ SystemDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
+ KnownHosts = filename:join(PrivDir, "known_hosts"),
+
+ {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {failfun, fun ssh_test_lib:failfun/2},
+ {preferred_algorithms,
+ [{kex,ssh_transport:supported_algorithms(kex)}]}
+ ]),
+ ct:sleep(500),
+
+ ErlKexs = lists:map(fun erlang:atom_to_list/1,
+ ssh_transport:supported_algorithms(kex)),
+ OpenSshKexs = string:tokens(os:cmd("ssh -Q kex"), "\n"),
+
+ Kexs = [{OpenSshKex,lists:member(OpenSshKex,ErlKexs)}
+ || OpenSshKex <- OpenSshKexs],
+
+ Success =
+ lists:foldl(
+ fun({Kex, Expect}, Acc) ->
+ Cmd = "ssh -p " ++ integer_to_list(Port) ++
+ " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " " ++
+ " -o KexAlgorithms=" ++ Kex ++ " 1+1.",
+
+ ct:log("Cmd: ~p~n", [Cmd]),
+
+ SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]),
+
+ case Expect of
+ true ->
+ receive
+ {SshPort,{data, <<"2\n">>}} ->
+ Acc
+ after ?TIMEOUT ->
+ ct:log("Did not receive answer for ~p",[Kex]),
+ false
+ end;
+ false ->
+ receive
+ {SshPort,{data, <<"Unable to negotiate a key exchange method", _/binary>>}} ->
+ Acc
+ after ?TIMEOUT ->
+ ct:log("Did not receive no matching kex message for ~p",[Kex]),
+ false
+ end
+ end
+ end, true, Kexs),
+
+ ssh:stop_daemon(Pid),
+
+ case Success of
+ true ->
+ ok;
+ false ->
+ {fail, "Kex failed for one or more algos"}
+ end.
+
+
+%%--------------------------------------------------------------------
erlang_server_openssh_client_exec_compressed() ->
[{doc, "Test that exec command works."}].
@@ -380,11 +494,11 @@ erlang_client_openssh_server_setenv(Config) when is_list(Config) ->
{data,0,1, UnxpectedData}}} ->
%% Some os may return things as
%% ENV_TEST: Undefined variable.\n"
- ct:pal("UnxpectedData: ~p", [UnxpectedData]),
+ ct:log("UnxpectedData: ~p", [UnxpectedData]),
ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId);
{unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId, 0}}
= ExitStatus} ->
- ct:pal("0: Collected data ~p", [ExitStatus]),
+ ct:log("0: Collected data ~p", [ExitStatus]),
ssh_test_lib:receive_exec_result(Data,
ConnectionRef, ChannelId);
Other ->
@@ -487,7 +601,7 @@ erlang_client_openssh_server_password(Config) when is_list(Config) ->
{user_interaction, false},
{user_dir, UserDir}]),
- ct:pal("Test of user foo that does not exist. "
+ ct:log("Test of user foo that does not exist. "
"Error msg: ~p~n", [Reason0]),
User = string:strip(os:cmd("whoami"), right, $\n),
@@ -501,10 +615,10 @@ erlang_client_openssh_server_password(Config) when is_list(Config) ->
{password, "foo"},
{user_interaction, false},
{user_dir, UserDir}]),
- ct:pal("Test of wrong Pasword. "
+ ct:log("Test of wrong Pasword. "
"Error msg: ~p~n", [Reason1]);
_ ->
- ct:pal("Whoami failed reason: ~n", [])
+ ct:log("Whoami failed reason: ~n", [])
end.
%%--------------------------------------------------------------------
@@ -532,19 +646,19 @@ erlang_client_openssh_server_nonexistent_subsystem(Config) when is_list(Config)
receive_hej() ->
receive
<<"Hej", _binary>> = Hej ->
- ct:pal("Expected result: ~p~n", [Hej]);
+ ct:log("Expected result: ~p~n", [Hej]);
<<"Hej\n", _binary>> = Hej ->
- ct:pal("Expected result: ~p~n", [Hej]);
+ ct:log("Expected result: ~p~n", [Hej]);
<<"Hej\r\n", _/binary>> = Hej ->
- ct:pal("Expected result: ~p~n", [Hej]);
+ ct:log("Expected result: ~p~n", [Hej]);
Info ->
Lines = binary:split(Info, [<<"\r\n">>], [global]),
case lists:member(<<"Hej">>, Lines) of
true ->
- ct:pal("Expected result found in lines: ~p~n", [Lines]),
+ ct:log("Expected result found in lines: ~p~n", [Lines]),
ok;
false ->
- ct:pal("Extra info: ~p~n", [Info]),
+ ct:log("Extra info: ~p~n", [Info]),
receive_hej()
end
end.
@@ -558,7 +672,7 @@ receive_logout() ->
ok
end;
Info ->
- ct:pal("Extra info when logging out: ~p~n", [Info]),
+ ct:log("Extra info when logging out: ~p~n", [Info]),
receive_logout()
end.
@@ -601,6 +715,6 @@ check_ssh_client_support2(P) ->
{P, {exit_status, E}} ->
E
after 5000 ->
- ct:pal("Openssh command timed out ~n"),
+ ct:log("Openssh command timed out ~n"),
-1
end.
diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl
index 75f495b6d7..38b2789742 100644
--- a/lib/ssh/test/ssh_trpt_test_lib.erl
+++ b/lib/ssh/test/ssh_trpt_test_lib.erl
@@ -42,8 +42,8 @@
seen_hello = false,
enc = <<>>,
ssh = #ssh{}, % #ssh{}
- own_kexinit,
- peer_kexinit,
+ alg_neg = {undefined,undefined}, % {own_kexinit, peer_kexinit}
+ alg, % #alg{}
vars = dict:new(),
reply = [], % Some repy msgs are generated hidden in ssh_transport :[
prints = [],
@@ -140,7 +140,10 @@ op(receive_hello, S0) when S0#s.seen_hello =/= true ->
op(receive_msg, S) when S#s.seen_hello == true ->
try recv(S)
catch
- {tcp,Exc} -> S#s{return_value=Exc}
+ {tcp,Exc} ->
+ S1 = opt(print_messages, S,
+ fun(X) when X==true;X==detail -> {"Recv~n~p~n",[Exc]} end),
+ S1#s{return_value=Exc}
end;
@@ -206,6 +209,9 @@ op_val(E, S0) ->
end.
+fail(Reason, {Fmt,Args}, S) when is_list(Fmt), is_list(Args) ->
+ fail(Reason, save_prints({Fmt,Args}, S)).
+
fail(Reason, S) ->
throw({fail, Reason, S}).
@@ -312,38 +318,51 @@ send(S=#s{ssh=C}, hello) ->
send(S, list_to_binary(Hello));
send(S0, ssh_msg_kexinit) ->
- {Msg, Bytes, C0} = ssh_transport:key_exchange_init_msg(S0#s.ssh),
- S1 = opt(print_messages, S0,
- fun(X) when X==true;X==detail -> {"Send~n~s~n",[format_msg(Msg)]} end),
- S = case ?role(S1) of
- server when is_record(S1#s.peer_kexinit, ssh_msg_kexinit) ->
- {ok, C} =
- ssh_transport:handle_kexinit_msg(S1#s.peer_kexinit, Msg, C0),
- S1#s{peer_kexinit = used,
- own_kexinit = used,
- ssh = C};
- _ ->
- S1#s{ssh = C0,
- own_kexinit = Msg}
- end,
- send_bytes(Bytes, S#s{return_value = Msg});
+ {Msg, _Bytes, _C0} = ssh_transport:key_exchange_init_msg(S0#s.ssh),
+ send(S0, Msg);
-send(S0, ssh_msg_kexdh_init) when ?role(S0) == client,
- is_record(S0#s.peer_kexinit, ssh_msg_kexinit),
- is_record(S0#s.own_kexinit, ssh_msg_kexinit) ->
+send(S0=#s{alg_neg={undefined,PeerMsg}}, Msg=#ssh_msg_kexinit{}) ->
+ S1 = opt(print_messages, S0,
+ fun(X) when X==true;X==detail -> {"Send~n~s~n",[format_msg(Msg)]} end),
+ S2 = case PeerMsg of
+ #ssh_msg_kexinit{} ->
+ try ssh_transport:handle_kexinit_msg(PeerMsg, Msg, S1#s.ssh) of
+ {ok,Cx} when ?role(S1) == server ->
+ S1#s{alg = Cx#ssh.algorithms};
+ {ok,_NextKexMsgBin,Cx} when ?role(S1) == client ->
+ S1#s{alg = Cx#ssh.algorithms}
+ catch
+ Class:Exc ->
+ save_prints({"Algoritm negotiation failed at line ~p:~p~n~p:~s~nPeer: ~s~n Own: ~s~n",
+ [?MODULE,?LINE,Class,format_msg(Exc),format_msg(PeerMsg),format_msg(Msg)]},
+ S1)
+ end;
+ undefined ->
+ S1
+ end,
+ {Bytes, C} = ssh_transport:ssh_packet(Msg, S2#s.ssh),
+ send_bytes(Bytes, S2#s{return_value = Msg,
+ alg_neg = {Msg,PeerMsg},
+ ssh = C});
+
+send(S0, ssh_msg_kexdh_init) when ?role(S0) == client ->
+ {OwnMsg, PeerMsg} = S0#s.alg_neg,
{ok, NextKexMsgBin, C} =
- ssh_transport:handle_kexinit_msg(S0#s.peer_kexinit, S0#s.own_kexinit, S0#s.ssh),
-
+ try ssh_transport:handle_kexinit_msg(PeerMsg, OwnMsg, S0#s.ssh)
+ catch
+ Class:Exc ->
+ fail("Algoritm negotiation failed!",
+ {"Algoritm negotiation failed at line ~p:~p~n~p:~s~nPeer: ~s~n Own: ~s",
+ [?MODULE,?LINE,Class,format_msg(Exc),format_msg(PeerMsg),format_msg(OwnMsg)]},
+ S0)
+ end,
S = opt(print_messages, S0,
fun(X) when X==true;X==detail ->
#ssh{keyex_key = {{_Private, Public}, {_G, _P}}} = C,
Msg = #ssh_msg_kexdh_init{e = Public},
{"Send (reconstructed)~n~s~n",[format_msg(Msg)]}
end),
-
- send_bytes(NextKexMsgBin, S#s{ssh = C,
- peer_kexinit = used,
- own_kexinit = used});
+ send_bytes(NextKexMsgBin, S#s{ssh = C});
send(S0, ssh_msg_kexdh_reply) ->
Bytes = proplists:get_value(ssh_msg_kexdh_reply, S0#s.reply),
@@ -389,26 +408,42 @@ recv(S0 = #s{}) ->
true ->
%% Has seen hello, therefore no more crlf-messages are alowed.
S = receive_binary_msg(S1),
- case M=S#s.return_value of
- #ssh_msg_kexinit{} when ?role(S) == server,
- S#s.own_kexinit =/= undefined ->
- {ok, C} =
- ssh_transport:handle_kexinit_msg(M, S#s.own_kexinit, S#s.ssh),
- S#s{peer_kexinit = used,
- own_kexinit = used,
- ssh = C};
- #ssh_msg_kexinit{} ->
- S#s{peer_kexinit = M};
+ case PeerMsg = S#s.return_value of
+ #ssh_msg_kexinit{} ->
+ case S#s.alg_neg of
+ {undefined,undefined} ->
+ S#s{alg_neg = {undefined,PeerMsg}};
+
+ {undefined,_} ->
+ fail("2 kexint received!!", S);
+
+ {OwnMsg, _} ->
+ try ssh_transport:handle_kexinit_msg(PeerMsg, OwnMsg, S#s.ssh) of
+ {ok,C} when ?role(S) == server ->
+ S#s{alg_neg = {OwnMsg, PeerMsg},
+ alg = C#ssh.algorithms,
+ ssh = C};
+ {ok,_NextKexMsgBin,C} when ?role(S) == client ->
+ S#s{alg_neg = {OwnMsg, PeerMsg},
+ alg = C#ssh.algorithms}
+ catch
+ Class:Exc ->
+ save_prints({"Algoritm negotiation failed at line ~p:~p~n~p:~s~nPeer: ~s~n Own: ~s~n",
+ [?MODULE,?LINE,Class,format_msg(Exc),format_msg(PeerMsg),format_msg(OwnMsg)]},
+ S#s{alg_neg = {OwnMsg, PeerMsg}})
+ end
+ end;
+
#ssh_msg_kexdh_init{} -> % Always the server
- {ok, Reply, C} = ssh_transport:handle_kexdh_init(M, S#s.ssh),
+ {ok, Reply, C} = ssh_transport:handle_kexdh_init(PeerMsg, S#s.ssh),
S#s{ssh = C,
reply = [{ssh_msg_kexdh_reply,Reply} | S#s.reply]
};
#ssh_msg_kexdh_reply{} ->
- {ok, _NewKeys, C} = ssh_transport:handle_kexdh_reply(M, S#s.ssh),
+ {ok, _NewKeys, C} = ssh_transport:handle_kexdh_reply(PeerMsg, S#s.ssh),
S#s{ssh=C#ssh{send_sequence=S#s.ssh#ssh.send_sequence}}; % Back the number
#ssh_msg_newkeys{} ->
- {ok, C} = ssh_transport:handle_new_keys(M, S#s.ssh),
+ {ok, C} = ssh_transport:handle_new_keys(PeerMsg, S#s.ssh),
S#s{ssh=C};
_ ->
S
@@ -682,10 +717,18 @@ seqnum_trace(S) ->
print_traces(S) when S#s.prints == [] -> S;
print_traces(S) ->
+ Len = length(S#s.prints),
ct:log("~s",
- [lists:foldl(fun({Fmt,Args}, Acc) ->
- [io_lib:format(Fmt,Args) | Acc]
- end, "", S#s.prints)]
+ [lists:foldl(
+ fun({Fmt,Args}, Acc) ->
+ [case Len-length(Acc)-1 of
+ 0 ->
+ io_lib:format(Fmt,Args);
+ N ->
+ io_lib:format(lists:concat(['~p --------~n',Fmt]),
+ [Len-length(Acc)-1|Args])
+ end | Acc]
+ end, "", S#s.prints)]
).
opt(Flag, S, Fun) when is_function(Fun,1) ->
diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl
index c0645f3b01..85f4d36258 100644
--- a/lib/ssh/test/ssh_upgrade_SUITE.erl
+++ b/lib/ssh/test/ssh_upgrade_SUITE.erl
@@ -94,8 +94,8 @@ minor_upgrade(Config) when is_list(Config) ->
%%% Called by ct_release_test:upgrade/4
upgrade_init(CTData, State) ->
{ok, AppUp={_, _, Up, _Down}} = ct_release_test:get_appup(CTData, ssh),
- ct:pal("AppUp: ~p", [AppUp]),
- ct:pal("Up: ~p", [Up]),
+ ct:log("AppUp: ~p", [AppUp]),
+ ct:log("Up: ~p", [Up]),
case Soft = is_soft(Up) of
%% It is symmetrical, if upgrade is soft so is downgrade
true ->
@@ -134,12 +134,12 @@ is_soft(_) ->
test_hard(State0, FileName) ->
- ct:pal("test_hard State0=~p, FileName=~p",[State0, FileName]),
+ ct:log("test_hard State0=~p, FileName=~p",[State0, FileName]),
State = setup_server_client(State0),
test_connection(FileName, random_contents(), State).
test_soft(State0, FileName) ->
- ct:pal("test_soft State0=~p, FileName=~p",[State0, FileName]),
+ ct:log("test_soft State0=~p, FileName=~p",[State0, FileName]),
State = test_connection(FileName, random_contents(), State0),
setup_server_client( close(State) ).
@@ -171,7 +171,7 @@ setup_server_client(#state{config=Config} = State) ->
test_connection(FileName, FileContents,
#state{client = ChannelPid,
root_dir = FtpRootDir} = State) ->
- ct:pal("test_connection Writing with ssh_sftp:write_file",[]),
+ ct:log("test_connection Writing with ssh_sftp:write_file",[]),
case ssh_sftp:write_file(ChannelPid, FileName, FileContents) of
ok ->
case ssh_sftp:read_file(ChannelPid, FileName) of
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index f23b71e28b..6c977bdb74 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -88,7 +88,8 @@
<item>
<p><c>{verify, verify_type()}</c></p>
<p><c>| {verify_fun, {fun(), term()}}</c></p>
- <p><c>| {fail_if_no_peer_cert, boolean()} {depth, integer()}</c></p>
+ <p><c>| {fail_if_no_peer_cert, boolean()}</c></p>
+ <p><c>| {depth, integer()}</c></p>
<p><c>| {cert, public_key:der_encoded()}</c></p>
<p><c>| {certfile, path()}</c></p>
<p><c>| {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey'
@@ -663,11 +664,6 @@ fun(srp, Username :: string(), UserState :: term()) ->
cipher suite can encipher.
</item>
- <tag><c>{psk_identity, string()}</c></tag>
- <item>Specifies the server identity hint the server presents to the client.
- </item>
- <tag><c>{log_alert, boolean()}</c></tag>
- <item>If false, error reports will not be displayed.</item>
<tag><c>{honor_cipher_order, boolean()}</c></tag>
<item>If true, use the server's preference for cipher selection. If false
(the default), use the client's preference.
diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml
index ab1a5900b9..03b995e4de 100644
--- a/lib/stdlib/doc/src/ets.xml
+++ b/lib/stdlib/doc/src/ets.xml
@@ -610,7 +610,7 @@ ets:is_compiled_ms(Broken).</code>
<p>Returns the last key <c><anno>Key</anno></c> according to Erlang term
order in the table <c>Tab</c> of the <c>ordered_set</c> type.
If the table is of any other type, the function is synonymous
- to <c>first/2</c>. If the table is empty,
+ to <c>first/1</c>. If the table is empty,
<c>'$end_of_table'</c> is returned.</p>
<p>Use <c>prev/2</c> to find preceding keys in the table.</p>
</desc>
diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl
index 4e81e2c2dd..9577d17a85 100644
--- a/lib/stdlib/src/qlc_pt.erl
+++ b/lib/stdlib/src/qlc_pt.erl
@@ -428,7 +428,13 @@ compile_errors(FormsNoShadows) ->
end.
compile_forms(Forms0, Options) ->
- Forms = [F || F <- Forms0, element(1, F) =/= eof] ++ [{eof,anno0()}],
+ Exclude = fun(eof) -> true;
+ (warning) -> true;
+ (error) -> true;
+ (_) -> false
+ end,
+ Forms = ([F || F <- Forms0, not Exclude(element(1, F))]
+ ++ [{eof,anno0()}]),
try
case compile:noenv_forms(Forms, compile_options(Options)) of
{ok, _ModName, Ws0} ->
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index 72216bfa0d..52fdb69b73 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -74,6 +74,7 @@
otp_5644/1, otp_5195/1, otp_6038_bug/1, otp_6359/1, otp_6562/1,
otp_6590/1, otp_6673/1, otp_6964/1, otp_7114/1, otp_7238/1,
otp_7232/1, otp_7552/1, otp_6674/1, otp_7714/1, otp_11758/1,
+ otp_12946/1,
manpage/1,
@@ -143,7 +144,7 @@ groups() ->
{tickets, [],
[otp_5644, otp_5195, otp_6038_bug, otp_6359, otp_6562,
otp_6590, otp_6673, otp_6964, otp_7114, otp_7232,
- otp_7238, otp_7552, otp_6674, otp_7714, otp_11758]},
+ otp_7238, otp_7552, otp_6674, otp_7714, otp_11758, otp_12946]},
{compat, [], [backward, forward]}].
init_per_suite(Config) ->
@@ -7154,6 +7155,18 @@ otp_6674(Config) when is_list(Config) ->
?line run(Config, Ts).
+otp_12946(doc) ->
+ ["Syntax error."];
+otp_12946(suite) -> [];
+otp_12946(Config) when is_list(Config) ->
+ Text =
+ <<"-export([init/0]).
+ init() ->
+ ok.
+ y">>,
+ {errors,[{4,erl_parse,_}],[]} = compile_file(Config, Text, []),
+ ok.
+
manpage(doc) ->
"Examples from qlc(3).";
manpage(suite) -> [];
diff --git a/lib/tools/doc/src/make.xml b/lib/tools/doc/src/make.xml
index e63163d689..5c2e5e5d62 100644
--- a/lib/tools/doc/src/make.xml
+++ b/lib/tools/doc/src/make.xml
@@ -76,7 +76,7 @@
Load mode. Loads all recompiled modules.</item>
<item><c>netload</c> <br></br>
- Net load mode. Loads all recompiled modules an all known nodes.</item>
+ Net load mode. Loads all recompiled modules on all known nodes.</item>
</list>
<p>All items in <c>Options</c> that are not make options are assumed
to be compiler options and are passed as-is to