aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/emulator/drivers/common/inet_drv.c16
-rw-r--r--lib/eunit/include/eunit.hrl264
-rw-r--r--lib/eunit/src/Makefile2
-rw-r--r--lib/hipe/main/hipe.erl70
-rw-r--r--lib/kernel/src/code.erl9
-rw-r--r--lib/kernel/src/code_server.erl70
-rw-r--r--lib/kernel/src/hipe_unified_loader.erl231
-rw-r--r--lib/kernel/test/code_SUITE.erl16
-rw-r--r--lib/kernel/test/gen_tcp_misc_SUITE.erl94
-rw-r--r--lib/ssh/src/ssh.hrl6
-rw-r--r--lib/ssh/src/ssh_auth.erl164
-rw-r--r--lib/ssh/src/ssh_bits.erl8
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl31
-rw-r--r--lib/ssh/src/ssh_message.erl34
-rw-r--r--lib/ssh/test/Makefile1
-rw-r--r--lib/ssh/test/ssh_upgrade_SUITE.erl206
-rw-r--r--lib/ssh/test/ssh_upgrade_SUITE_data/id_dsa13
-rw-r--r--lib/ssh/test/ssh_upgrade_SUITE_data/id_rsa15
-rw-r--r--lib/ssh/test/ssh_upgrade_SUITE_data/known_hosts1
-rw-r--r--lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key13
-rw-r--r--lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key.pub11
-rw-r--r--lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key16
-rw-r--r--lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key.pub5
-rw-r--r--lib/ssl/doc/src/ssl.xml21
-rw-r--r--lib/ssl/src/dtls_connection.erl1
-rw-r--r--lib/ssl/src/ssl.appup.src10
-rw-r--r--lib/ssl/src/ssl.erl7
-rw-r--r--lib/ssl/src/ssl_internal.hrl1
-rw-r--r--lib/ssl/src/tls_connection.erl1
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl57
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl2
-rw-r--r--lib/stdlib/doc/src/Makefile2
-rw-r--r--lib/stdlib/doc/src/assert_hrl.xml160
-rw-r--r--lib/stdlib/doc/src/ref_man.xml1
-rw-r--r--lib/stdlib/include/assert.hrl260
-rw-r--r--lib/stdlib/src/Makefile1
-rw-r--r--lib/stdlib/test/Makefile3
-rw-r--r--lib/stdlib/test/stdlib_SUITE.erl67
38 files changed, 1324 insertions, 566 deletions
diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c
index e001f31932..10ef20fc82 100644
--- a/erts/emulator/drivers/common/inet_drv.c
+++ b/erts/emulator/drivers/common/inet_drv.c
@@ -12172,6 +12172,8 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port,
void (*timeout_fun)(ErlDrvData drv_data,
ErlDrvTermData caller))
{
+#define eq_mega(a, b) ((a)->when.megasecs == (b)->when.megasecs)
+#define eq_sec(a, b) ((a)->when.secs == (b)->when.secs)
MultiTimerData *mtd, *p, *s;
mtd = ALLOC(sizeof(MultiTimerData));
absolute_timeout(timeout, &(mtd->when));
@@ -12183,23 +12185,17 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port,
break;
}
}
- if (!p || p->when.megasecs > mtd->when.megasecs) {
- goto found;
- }
- for (; p!= NULL; s = p, p = p->next) {
+ for (; p!= NULL && eq_mega(p, mtd); s = p, p = p->next) {
if (p->when.secs >= mtd->when.secs) {
break;
}
}
- if (!p || p->when.secs > mtd->when.secs) {
- goto found;
- }
- for (; p!= NULL; s = p, p = p->next) {
+ for (; p!= NULL && eq_mega(p, mtd) && eq_sec(p, mtd); s = p, p = p->next) {
if (p->when.microsecs >= mtd->when.microsecs) {
break;
}
}
- found:
+
if (!p) {
if (!s) {
*first = mtd;
@@ -12225,6 +12221,8 @@ static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port,
}
return mtd;
}
+#undef eq_mega
+#undef eq_sec
diff --git a/lib/eunit/include/eunit.hrl b/lib/eunit/include/eunit.hrl
index 53d291430d..88e9d6c19b 100644
--- a/lib/eunit/include/eunit.hrl
+++ b/lib/eunit/include/eunit.hrl
@@ -15,11 +15,14 @@
%%
%% Copyright (C) 2004-2006 Mickaël Rémond, Richard Carlsson
+-ifndef(EUNIT_HRL).
+-define(EUNIT_HRL, true).
+
%% Including this file turns on testing and defines TEST, unless NOTEST
%% is defined before the file is included. If both NOTEST and TEST are
%% already defined, then TEST takes precedence, and NOTEST will become
%% undefined.
-%%
+%%
%% If NODEBUG is defined before this file is included, the debug macros
%% are disabled, unless DEBUG is also defined, in which case NODEBUG
%% will become undefined. NODEBUG also implies NOASSERT, unless testing
@@ -31,14 +34,10 @@
%% even if NODEBUG is defined. If both ASSERT and NOASSERT are defined
%% before the file is included, then ASSERT takes precedence, and NOASSERT
%% will become undefined regardless of TEST.
-%%
+%%
%% After including this file, EUNIT will be defined if and only if TEST
%% is defined.
--ifndef(EUNIT_HRL).
--define(EUNIT_HRL, true).
-
-
%% allow defining TEST to override NOTEST
-ifdef(TEST).
-undef(NOTEST).
@@ -49,13 +48,6 @@
-undef(NODEBUG).
-endif.
-%% allow NODEBUG to imply NOASSERT, unless overridden below
--ifdef(NODEBUG).
--ifndef(NOASSERT).
--define(NOASSERT, true).
--endif.
--endif.
-
%% note that the main switch used within this file is NOTEST; however,
%% both TEST and EUNIT may be used to check whether testing is enabled
-ifndef(NOTEST).
@@ -70,10 +62,8 @@
-undef(EUNIT).
-endif.
-%% allow ASSERT to override NOASSERT (regardless of TEST/NOTEST)
--ifdef(ASSERT).
--undef(NOASSERT).
--endif.
+%% include the assert macros; ASSERT overrides NOASSERT if defined
+-include_lib("stdlib/include/assert.hrl").
%% Parse transforms for automatic exporting/stripping of test functions.
%% (Note that although automatic stripping is convenient, it will make
@@ -91,7 +81,7 @@
%% All macros should be available even if testing is turned off, and
%% should preferably not require EUnit to be present at runtime.
-%%
+%%
%% We must use fun-call wrappers ((fun () -> ... end)()) to avoid
%% exporting local variables, and furthermore we only use variable names
%% prefixed with "__", that hopefully will not be bound outside the fun.
@@ -128,211 +118,24 @@
current_function)))).
-endif.
-%% The plain assert macro should be defined to do nothing if this file
-%% is included when debugging/testing is turned off.
--ifdef(NOASSERT).
--ifndef(assert).
--define(assert(BoolExpr),ok).
--endif.
--else.
-%% The assert macro is written the way it is so as not to cause warnings
-%% for clauses that cannot match, even if the expression is a constant.
--undef(assert).
--define(assert(BoolExpr),
- begin
- ((fun () ->
- case (BoolExpr) of
- true -> ok;
- __V -> erlang:error({assertion_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??BoolExpr)},
- {expected, true},
- {value, case __V of false -> __V;
- _ -> {not_a_boolean,__V}
- end}]})
- end
- end)())
- end).
--endif.
--define(assertNot(BoolExpr), ?assert(not (BoolExpr))).
+%% General test macros
-define(_test(Expr), {?LINE, fun () -> (Expr) end}).
-
-define(_assert(BoolExpr), ?_test(?assert(BoolExpr))).
-
-define(_assertNot(BoolExpr), ?_assert(not (BoolExpr))).
-
-%% This is mostly a convenience which gives more detailed reports.
-%% Note: Guard is a guarded pattern, and can not be used for value.
--ifdef(NOASSERT).
--define(assertMatch(Guard, Expr), ok).
--else.
--define(assertMatch(Guard, Expr),
- begin
- ((fun () ->
- case (Expr) of
- Guard -> ok;
- __V -> erlang:error({assertMatch_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {pattern, (??Guard)},
- {value, __V}]})
- end
- end)())
- end).
--endif.
-define(_assertMatch(Guard, Expr), ?_test(?assertMatch(Guard, Expr))).
-
-%% This is the inverse case of assertMatch, for convenience.
--ifdef(NOASSERT).
--define(assertNotMatch(Guard, Expr), ok).
--else.
--define(assertNotMatch(Guard, Expr),
- begin
- ((fun () ->
- __V = (Expr),
- case __V of
- Guard -> erlang:error({assertNotMatch_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {pattern, (??Guard)},
- {value, __V}]});
- _ -> ok
- end
- end)())
- end).
--endif.
-define(_assertNotMatch(Guard, Expr), ?_test(?assertNotMatch(Guard, Expr))).
-
-%% This is a convenience macro which gives more detailed reports when
-%% the expected LHS value is not a pattern, but a computed value
--ifdef(NOASSERT).
--define(assertEqual(Expect, Expr), ok).
--else.
--define(assertEqual(Expect, Expr),
- begin
- ((fun (__X) ->
- case (Expr) of
- __X -> ok;
- __V -> erlang:error({assertEqual_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {expected, __X},
- {value, __V}]})
- end
- end)(Expect))
- end).
--endif.
-define(_assertEqual(Expect, Expr), ?_test(?assertEqual(Expect, Expr))).
-
-%% This is the inverse case of assertEqual, for convenience.
--ifdef(NOASSERT).
--define(assertNotEqual(Unexpected, Expr), ok).
--else.
--define(assertNotEqual(Unexpected, Expr),
- begin
- ((fun (__X) ->
- case (Expr) of
- __X -> erlang:error({assertNotEqual_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {value, __X}]});
- _ -> ok
- end
- end)(Unexpected))
- end).
--endif.
-define(_assertNotEqual(Unexpected, Expr),
?_test(?assertNotEqual(Unexpected, Expr))).
-
-%% Note: Class and Term are patterns, and can not be used for value.
-%% Term can be a guarded pattern, but Class cannot.
--ifdef(NOASSERT).
--define(assertException(Class, Term, Expr), ok).
--else.
--define(assertException(Class, Term, Expr),
- begin
- ((fun () ->
- try (Expr) of
- __V -> erlang:error({assertException_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {pattern,
- "{ "++(??Class)++" , "++(??Term)
- ++" , [...] }"},
- {unexpected_success, __V}]})
- catch
- Class:Term -> ok;
- __C:__T ->
- erlang:error({assertException_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {pattern,
- "{ "++(??Class)++" , "++(??Term)
- ++" , [...] }"},
- {unexpected_exception,
- {__C, __T,
- erlang:get_stacktrace()}}]})
- end
- end)())
- end).
--endif.
-
--define(assertError(Term, Expr), ?assertException(error, Term, Expr)).
--define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)).
--define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)).
-
-define(_assertException(Class, Term, Expr),
?_test(?assertException(Class, Term, Expr))).
-define(_assertError(Term, Expr), ?_assertException(error, Term, Expr)).
-define(_assertExit(Term, Expr), ?_assertException(exit, Term, Expr)).
-define(_assertThrow(Term, Expr), ?_assertException(throw, Term, Expr)).
-
-%% This is the inverse case of assertException, for convenience.
-%% Note: Class and Term are patterns, and can not be used for value.
-%% Both Class and Term can be guarded patterns.
--ifdef(NOASSERT).
--define(assertNotException(Class, Term, Expr), ok).
--else.
--define(assertNotException(Class, Term, Expr),
- begin
- ((fun () ->
- try (Expr) of
- _ -> ok
- catch
- __C:__T ->
- case __C of
- Class ->
- case __T of
- Term ->
- erlang:error({assertNotException_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {pattern,
- "{ "++(??Class)++" , "
- ++(??Term)++" , [...] }"},
- {unexpected_exception,
- {__C, __T,
- erlang:get_stacktrace()
- }}]});
- _ -> ok
- end;
- _ -> ok
- end
- end
- end)())
- end).
--endif.
-define(_assertNotException(Class, Term, Expr),
?_test(?assertNotException(Class, Term, Expr))).
+-define(_assertReceive(Guard, Expr), ?_test(?assertReceive(Guard, Expr))).
%% Macros for running operating system commands. (Note that these
%% require EUnit to be present at runtime, or at least eunit_lib.)
@@ -364,18 +167,18 @@
-else.
-define(assertCmdStatus(N, Cmd),
begin
- ((fun () ->
- case ?_cmd_(Cmd) of
- {(N), _} -> ok;
- {__N, _} -> erlang:error({assertCmd_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {command, (Cmd)},
- {expected_status,(N)},
- {status,__N}]})
- end
- end)())
- end).
+ ((fun () ->
+ case ?_cmd_(Cmd) of
+ {(N), _} -> ok;
+ {__N, _} -> erlang:error({assertCmd_failed,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {command, (Cmd)},
+ {expected_status,(N)},
+ {status,__N}]})
+ end
+ end)())
+ end).
-endif.
-define(assertCmd(Cmd), ?assertCmdStatus(0, Cmd)).
@@ -384,17 +187,17 @@
-else.
-define(assertCmdOutput(T, Cmd),
begin
- ((fun () ->
- case ?_cmd_(Cmd) of
- {_, (T)} -> ok;
- {_, __T} -> erlang:error({assertCmdOutput_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {command,(Cmd)},
- {expected_output,(T)},
- {output,__T}]})
- end
- end)())
+ ((fun () ->
+ case ?_cmd_(Cmd) of
+ {_, (T)} -> ok;
+ {_, __T} -> erlang:error({assertCmdOutput_failed,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {command,(Cmd)},
+ {expected_output,(T)},
+ {output,__T}]})
+ end
+ end)())
end).
-endif.
@@ -439,5 +242,4 @@
end).
-endif.
-
-endif. % EUNIT_HRL
diff --git a/lib/eunit/src/Makefile b/lib/eunit/src/Makefile
index 47aef104ff..86a6d8831e 100644
--- a/lib/eunit/src/Makefile
+++ b/lib/eunit/src/Makefile
@@ -24,7 +24,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/eunit-$(VSN)
EBIN = ../ebin
INCLUDE=../include
-ERL_COMPILE_FLAGS += -pa $(EBIN) -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard
+ERL_COMPILE_FLAGS += -pa $(EBIN) -pa ../../stdlib/ebin -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard
PARSE_TRANSFORM = eunit_autoexport.erl
diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl
index 539ce883c0..b614f5f1ab 100644
--- a/lib/hipe/main/hipe.erl
+++ b/lib/hipe/main/hipe.erl
@@ -649,8 +649,9 @@ run_compiler_1(DisasmFun, IcodeFun, Options) ->
%% The full option expansion is not done
%% until the DisasmFun returns.
{Code, CompOpts} = DisasmFun(Options),
- Opts0 = expand_options(Options ++ CompOpts),
- Opts =
+ Opts0 = expand_options(Options ++ CompOpts,
+ get(hipe_target_arch)),
+ Opts =
case proplists:get_bool(to_llvm, Opts0) andalso
not llvm_support_available() of
true ->
@@ -895,8 +896,7 @@ do_load(Mod, Bin, BeamBinOrPath) when is_binary(BeamBinOrPath);
code:load_native_sticky(Mod, Bin, Beam);
false ->
%% Normal loading of a whole module
- Architecture = erlang:system_info(hipe_architecture),
- ChunkName = hipe_unified_loader:chunk_name(Architecture),
+ ChunkName = hipe_unified_loader:chunk_name(HostArch),
{ok, _, Chunks0} = beam_lib:all_chunks(BeamBinOrPath),
Chunks = [{ChunkName, Bin}|lists:keydelete(ChunkName, 1, Chunks0)],
{ok, BeamPlusNative} = beam_lib:build_module(Chunks),
@@ -933,9 +933,9 @@ assemble(CompiledCode, Closures, Exports, Options) ->
%% but can be overridden by passing an option {target, Target}.
set_architecture(Options) ->
- put(hipe_host_arch, erlang:system_info(hipe_architecture)),
- put(hipe_target_arch,
- proplists:get_value(target, Options, get(hipe_host_arch))),
+ HostArch = erlang:system_info(hipe_architecture),
+ put(hipe_host_arch, HostArch),
+ put(hipe_target_arch, proplists:get_value(target, Options, HostArch)),
ok.
%% This sets up some globally accessed stuff that are needed by the
@@ -943,7 +943,7 @@ set_architecture(Options) ->
%% Therefore, this expands the current set of options for local use.
pre_init(Opts) ->
- Options = expand_options(Opts),
+ Options = expand_options(Opts, get(hipe_target_arch)),
%% Initialise some counters used for measurements and benchmarking. If
%% the option 'measure_regalloc' is given the compilation will return
%% a keylist with the counter values.
@@ -1105,10 +1105,10 @@ help_hiper() ->
-spec help_options() -> 'ok'.
help_options() ->
- set_architecture([]), %% needed for target-specific option expansion
- O1 = expand_options([o1]),
- O2 = expand_options([o2]),
- O3 = expand_options([o3]),
+ HostArch = erlang:system_info(hipe_architecture),
+ O1 = expand_options([o1], HostArch),
+ O2 = expand_options([o2], HostArch),
+ O3 = expand_options([o3], HostArch),
io:format("HiPE Compiler Options\n" ++
" Boolean-valued options generally have corresponding " ++
"aliases `no_...',\n" ++
@@ -1134,7 +1134,7 @@ help_options() ->
[ordsets:from_list([verbose, debug, time, load, pp_beam,
pp_icode, pp_rtl, pp_native, pp_asm,
timeout]),
- expand_options([pp_all]),
+ expand_options([pp_all], HostArch),
O1 -- [o1],
(O2 -- O1) -- [o2],
(O3 -- O2) -- [o3]]),
@@ -1232,8 +1232,8 @@ option_text(Opt) when is_atom(Opt) ->
-spec help_option(comp_option()) -> 'ok'.
help_option(Opt) ->
- set_architecture([]), %% needed for target-specific option expansion
- case expand_options([Opt]) of
+ HostArch = erlang:system_info(hipe_architecture),
+ case expand_options([Opt], HostArch) of
[Opt] ->
Name = if is_atom(Opt) -> Opt;
tuple_size(Opt) =:= 2 -> element(1, Opt)
@@ -1364,11 +1364,11 @@ opt_keys() ->
%% verbose_spills,
x87].
-%% Definitions:
+%% Definitions:
-o1_opts() ->
+o1_opts(TargetArch) ->
Common = [inline_fp, pmatch, peephole],
- case get(hipe_target_arch) of
+ case TargetArch of
ultrasparc ->
Common;
powerpc ->
@@ -1385,13 +1385,13 @@ o1_opts() ->
?EXIT({executing_on_an_unsupported_architecture,Arch})
end.
-o2_opts() ->
+o2_opts(TargetArch) ->
Common = [icode_ssa_const_prop, icode_ssa_copy_prop, % icode_ssa_struct_reuse,
icode_type, icode_inline_bifs, rtl_lcm,
rtl_ssa, rtl_ssa_const_prop,
- spillmin_color, use_indexing, remove_comments,
- concurrent_comp, binary_opt | o1_opts()],
- case get(hipe_target_arch) of
+ spillmin_color, use_indexing, remove_comments,
+ concurrent_comp, binary_opt | o1_opts(TargetArch)],
+ case TargetArch of
ultrasparc ->
Common;
powerpc ->
@@ -1409,9 +1409,9 @@ o2_opts() ->
?EXIT({executing_on_an_unsupported_architecture,Arch})
end.
-o3_opts() ->
- Common = [icode_range, {regalloc,coalescing} | o2_opts()],
- case get(hipe_target_arch) of
+o3_opts(TargetArch) ->
+ Common = [icode_range, {regalloc,coalescing} | o2_opts(TargetArch)],
+ case TargetArch of
ultrasparc ->
Common;
powerpc ->
@@ -1489,18 +1489,18 @@ opt_aliases() ->
opt_basic_expansions() ->
[{pp_all, [pp_beam, pp_icode, pp_rtl, pp_native]}].
-opt_expansions() ->
- [{o1, o1_opts()},
- {o2, o2_opts()},
- {o3, o3_opts()},
+opt_expansions(TargetArch) ->
+ [{o1, o1_opts(TargetArch)},
+ {o2, o2_opts(TargetArch)},
+ {o3, o3_opts(TargetArch)},
{to_llvm, llvm_opts(o3)},
{{to_llvm, o0}, llvm_opts(o0)},
{{to_llvm, o1}, llvm_opts(o1)},
{{to_llvm, o2}, llvm_opts(o2)},
{{to_llvm, o3}, llvm_opts(o3)},
{x87, [x87, inline_fp]},
- {inline_fp, case get(hipe_target_arch) of %% XXX: Temporary until x86
- x86 -> [x87, inline_fp]; %% has sse2
+ {inline_fp, case TargetArch of %% XXX: Temporary until x86 has sse2
+ x86 -> [x87, inline_fp];
_ -> [inline_fp] end}].
llvm_opts(O) ->
@@ -1523,18 +1523,18 @@ expand_kt2(Opts) ->
[{use_callgraph, fixpoint}, core,
{core_transform, cerl_typean}]}]}]).
-%% Note that set_architecture/1 must be called first, and that the given
+%% Note that the given
%% list should contain the total set of options, since things like 'o2'
%% are expanded here. Basic expansions are processed here also, since
%% this function is called from the help functions.
--spec expand_options(comp_options()) -> comp_options().
+-spec expand_options(comp_options(), hipe_architecture()) -> comp_options().
-expand_options(Opts) ->
+expand_options(Opts, TargetArch) ->
proplists:normalize(Opts, [{negations, opt_negations()},
{aliases, opt_aliases()},
{expand, opt_basic_expansions()},
- {expand, opt_expansions()}]).
+ {expand, opt_expansions(TargetArch)}]).
-spec check_options(comp_options()) -> 'ok'.
diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl
index 65045666ec..580c070389 100644
--- a/lib/kernel/src/code.erl
+++ b/lib/kernel/src/code.erl
@@ -339,7 +339,8 @@ do_start(Flags) ->
ok
end,
%% Quietly load native code for all modules loaded so far
- load_native_code_for_all_loaded(),
+ Architecture = erlang:system_info(hipe_architecture),
+ load_native_code_for_all_loaded(Architecture),
Ok2;
Other ->
Other
@@ -554,9 +555,9 @@ has_ext(Ext, Extlen, File) ->
%%% Silently load native code for all modules loaded so far.
%%%
--spec load_native_code_for_all_loaded() -> ok.
-load_native_code_for_all_loaded() ->
- Architecture = erlang:system_info(hipe_architecture),
+load_native_code_for_all_loaded(undefined) ->
+ ok;
+load_native_code_for_all_loaded(Architecture) ->
try hipe_unified_loader:chunk_name(Architecture) of
ChunkTag ->
Loaded = all_loaded(),
diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index 819554ce74..a4342715ef 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -324,12 +324,15 @@ handle_call({load_binary,Mod,File,Bin}, Caller, S) ->
do_load_binary(Mod, File, Bin, Caller, S);
handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) ->
- Result = (catch hipe_unified_loader:load(Mod, Bin)),
+ Architecture = erlang:system_info(hipe_architecture),
+ Result = (catch hipe_unified_loader:load(Mod, Bin, Architecture)),
Status = hipe_result_to_status(Result),
{reply,Status,S};
handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) ->
- Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule)),
+ Architecture = erlang:system_info(hipe_architecture),
+ Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule,
+ Architecture)),
Status = hipe_result_to_status(Result),
{reply,Status,S};
@@ -1259,30 +1262,40 @@ try_load_module_1(File, Mod, Bin, Caller, #state{moddb=Db}=St) ->
error_msg("Can't load module that resides in sticky dir\n",[]),
{reply,{error,sticky_directory},St};
false ->
- case catch load_native_code(Mod, Bin) of
- {module,Mod} = Module ->
- ets:insert(Db, {Mod,File}),
- {reply,Module,St};
- no_native ->
- case erlang:load_module(Mod, Bin) of
- {module,Mod} = Module ->
- ets:insert(Db, {Mod,File}),
- post_beam_load(Mod),
- {reply,Module,St};
- {error,on_load} ->
- handle_on_load(Mod, File, Caller, St);
- {error,What} = Error ->
- error_msg("Loading of ~ts failed: ~p\n", [File, What]),
- {reply,Error,St}
- end;
- Error ->
- error_msg("Native loading of ~ts failed: ~p\n",
- [File,Error]),
- {reply,ok,St}
- end
+ Architecture = erlang:system_info(hipe_architecture),
+ try_load_module_2(File, Mod, Bin, Caller, Architecture, St)
+ end.
+
+try_load_module_2(File, Mod, Bin, Caller, undefined, St) ->
+ try_load_module_3(File, Mod, Bin, Caller, undefined, St);
+try_load_module_2(File, Mod, Bin, Caller, Architecture,
+ #state{moddb=Db}=St) ->
+ case catch load_native_code(Mod, Bin, Architecture) of
+ {module,Mod} = Module ->
+ ets:insert(Db, {Mod,File}),
+ {reply,Module,St};
+ no_native ->
+ try_load_module_3(File, Mod, Bin, Caller, Architecture, St);
+ Error ->
+ error_msg("Native loading of ~ts failed: ~p\n", [File,Error]),
+ {reply,ok,St}
+ end.
+
+try_load_module_3(File, Mod, Bin, Caller, Architecture,
+ #state{moddb=Db}=St) ->
+ case erlang:load_module(Mod, Bin) of
+ {module,Mod} = Module ->
+ ets:insert(Db, {Mod,File}),
+ post_beam_load(Mod, Architecture),
+ {reply,Module,St};
+ {error,on_load} ->
+ handle_on_load(Mod, File, Caller, St);
+ {error,What} = Error ->
+ error_msg("Loading of ~ts failed: ~p\n", [File, What]),
+ {reply,Error,St}
end.
-load_native_code(Mod, Bin) ->
+load_native_code(Mod, Bin, Architecture) ->
%% During bootstrapping of Open Source Erlang, we don't have any hipe
%% loader modules, but the Erlang emulator might be hipe enabled.
%% Therefore we must test for that the loader modules are available
@@ -1291,7 +1304,8 @@ load_native_code(Mod, Bin) ->
false ->
no_native;
true ->
- Result = hipe_unified_loader:load_native_code(Mod, Bin),
+ Result = hipe_unified_loader:load_native_code(Mod, Bin,
+ Architecture),
case Result of
{module,_} ->
put(?ANY_NATIVE_CODE_LOADED, true);
@@ -1310,12 +1324,12 @@ hipe_result_to_status(Result) ->
{error,Result}
end.
-post_beam_load(Mod) ->
- %% post_beam_load/1 can potentially be very expensive because it
+post_beam_load(Mod, Architecture) ->
+ %% post_beam_load/2 can potentially be very expensive because it
%% blocks multi-scheduling; thus we want to avoid the call if we
%% know that it is not needed.
case get(?ANY_NATIVE_CODE_LOADED) of
- true -> hipe_unified_loader:post_beam_load(Mod);
+ true -> hipe_unified_loader:post_beam_load(Mod, Architecture);
false -> ok
end.
diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl
index 49d4a8fe54..ddbbc548dd 100644
--- a/lib/kernel/src/hipe_unified_loader.erl
+++ b/lib/kernel/src/hipe_unified_loader.erl
@@ -43,10 +43,10 @@
-export([chunk_name/1,
%% Only the code and code_server modules may call the entries below!
- load_native_code/2,
- post_beam_load/1,
- load_module/3,
- load/2]).
+ load_native_code/3,
+ post_beam_load/2,
+ load_module/4,
+ load/3]).
%%-define(DEBUG,true).
-define(DO_ASSERT,true).
@@ -82,58 +82,57 @@ chunk_name(Architecture) ->
%% HW32 %% HiPE, x86, Win32
end.
+word_size(Architecture) ->
+ case Architecture of
+ amd64 -> 8;
+ ppc64 -> 8;
+ _ -> 4
+ end.
+
%%========================================================================
--spec load_native_code(Mod, binary()) -> 'no_native' | {'module', Mod}
- when Mod :: atom().
+-spec load_native_code(Mod, binary(), hipe_architecture()) ->
+ 'no_native' | {'module', Mod} when Mod :: atom().
%% @doc
%% Loads the native code of a module Mod.
%% Returns {module,Mod} on success (for compatibility with
%% code:load_file/1) and the atom `no_native' on failure.
-load_native_code(Mod, Bin) when is_atom(Mod), is_binary(Bin) ->
- Architecture = erlang:system_info(hipe_architecture),
- try chunk_name(Architecture) of
- ChunkTag ->
- %% patch_to_emu(Mod),
- case code:get_chunk(Bin, ChunkTag) of
- undefined -> no_native;
- NativeCode when is_binary(NativeCode) ->
- erlang:system_flag(multi_scheduling, block),
- try
- OldReferencesToPatch = patch_to_emu_step1(Mod),
- case load_module(Mod, NativeCode, Bin, OldReferencesToPatch) of
- bad_crc -> no_native;
- Result -> Result
- end
- after
- erlang:system_flag(multi_scheduling, unblock)
- end
+load_native_code(_Mod, _Bin, undefined) ->
+ no_native;
+load_native_code(Mod, Bin, Architecture) when is_atom(Mod), is_binary(Bin) ->
+ %% patch_to_emu(Mod),
+ case code:get_chunk(Bin, chunk_name(Architecture)) of
+ undefined -> no_native;
+ NativeCode when is_binary(NativeCode) ->
+ erlang:system_flag(multi_scheduling, block),
+ try
+ OldReferencesToPatch = patch_to_emu_step1(Mod),
+ case load_module(Mod, NativeCode, Bin, OldReferencesToPatch,
+ Architecture) of
+ bad_crc -> no_native;
+ Result -> Result
+ end
+ after
+ erlang:system_flag(multi_scheduling, unblock)
end
- catch
- _:_ ->
- %% Unknown HiPE architecture. Can't happen (in principle).
- no_native
end.
%%========================================================================
--spec post_beam_load(atom()) -> 'ok'.
+-spec post_beam_load(atom(), hipe_architecture()) -> 'ok'.
-post_beam_load(Mod) when is_atom(Mod) ->
- Architecture = erlang:system_info(hipe_architecture),
- try chunk_name(Architecture) of
- _ChunkTag ->
- erlang:system_flag(multi_scheduling, block),
- try
- patch_to_emu(Mod)
- after
- erlang:system_flag(multi_scheduling, unblock)
- end
- catch
- _:_ ->
- ok
- end.
+%% does nothing on a hipe-disabled system
+post_beam_load(_Mod, undefined) ->
+ ok;
+post_beam_load(Mod, _) when is_atom(Mod) ->
+ erlang:system_flag(multi_scheduling, block),
+ try
+ patch_to_emu(Mod)
+ after
+ erlang:system_flag(multi_scheduling, unblock)
+ end,
+ ok.
%%========================================================================
@@ -148,46 +147,48 @@ version_check(Version, Mod) when is_atom(Mod) ->
%%========================================================================
--spec load_module(Mod, binary(), _) -> 'bad_crc' | {'module', Mod}
- when Mod :: atom().
-load_module(Mod, Bin, Beam) ->
+-spec load_module(Mod, binary(), _, hipe_architecture()) ->
+ 'bad_crc' | {'module', Mod} when Mod :: atom().
+
+load_module(Mod, Bin, Beam, Architecture) ->
erlang:system_flag(multi_scheduling, block),
try
- load_module_nosmp(Mod, Bin, Beam)
+ load_module_nosmp(Mod, Bin, Beam, Architecture)
after
erlang:system_flag(multi_scheduling, unblock)
end.
-load_module_nosmp(Mod, Bin, Beam) ->
- load_module(Mod, Bin, Beam, []).
+load_module_nosmp(Mod, Bin, Beam, Architecture) ->
+ load_module(Mod, Bin, Beam, [], Architecture).
-load_module(Mod, Bin, Beam, OldReferencesToPatch) ->
+load_module(Mod, Bin, Beam, OldReferencesToPatch, Architecture) ->
?debug_msg("************ Loading Module ~w ************\n",[Mod]),
%% Loading a whole module, let the BEAM loader patch closures.
put(hipe_patch_closures, false),
- load_common(Mod, Bin, Beam, OldReferencesToPatch).
+ load_common(Mod, Bin, Beam, OldReferencesToPatch, Architecture).
%%========================================================================
--spec load(Mod, binary()) -> 'bad_crc' | {'module', Mod} when Mod :: atom().
+-spec load(Mod, binary(), hipe_architecture()) ->
+ 'bad_crc' | {'module', Mod} when Mod :: atom().
-load(Mod, Bin) ->
+load(Mod, Bin, Architecture) ->
erlang:system_flag(multi_scheduling, block),
try
- load_nosmp(Mod, Bin)
+ load_nosmp(Mod, Bin, Architecture)
after
erlang:system_flag(multi_scheduling, unblock)
end.
-load_nosmp(Mod, Bin) ->
+load_nosmp(Mod, Bin, Architecture) ->
?debug_msg("********* Loading funs in module ~w *********\n",[Mod]),
%% Loading just some functions in a module; patch closures separately.
put(hipe_patch_closures, true),
- load_common(Mod, Bin, [], []).
+ load_common(Mod, Bin, [], [], Architecture).
%%------------------------------------------------------------------------
-load_common(Mod, Bin, Beam, OldReferencesToPatch) ->
+load_common(Mod, Bin, Beam, OldReferencesToPatch, Architecture) ->
%% Unpack the binary.
[{Version, CheckSum},
ConstAlign, ConstSize, ConstMap, LabelMap, ExportMap,
@@ -212,18 +213,21 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) ->
bad_crc;
true ->
put(closures_to_patch, []),
+ WordSize = word_size(Architecture),
+ WriteWord = write_word_fun(WordSize),
%% Create data segment
{ConstAddr,ConstMap2} =
- create_data_segment(ConstAlign, ConstSize, ConstMap),
+ create_data_segment(ConstAlign, ConstSize, ConstMap, WriteWord),
%% Find callees for which we may need trampolines.
- CalleeMFAs = find_callee_mfas(Refs),
+ CalleeMFAs = find_callee_mfas(Refs, Architecture),
%% Write the code to memory.
{CodeAddress,Trampolines} =
enter_code(CodeSize, CodeBinary, CalleeMFAs, Mod, Beam),
%% Construct CalleeMFA-to-trampoline mapping.
- TrampolineMap = mk_trampoline_map(CalleeMFAs, Trampolines),
+ TrampolineMap = mk_trampoline_map(CalleeMFAs, Trampolines,
+ Architecture),
%% Patch references to code labels in data seg.
- ok = patch_consts(LabelMap, ConstAddr, CodeAddress),
+ ok = patch_consts(LabelMap, ConstAddr, CodeAddress, WriteWord),
%% Find out which functions are being loaded (and where).
%% Note: Addresses are sorted descending.
{MFAs,Addresses} = exports(ExportMap, CodeAddress),
@@ -275,14 +279,26 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) ->
%% Scan the list of patches and build a set (returned as a tuple)
%% of the callees for which we may need trampolines.
%%
-find_callee_mfas(Patches) when is_list(Patches) ->
- case erlang:system_info(hipe_architecture) of
- amd64 -> [];
- arm -> find_callee_mfas(Patches, gb_sets:empty(), false);
- powerpc -> find_callee_mfas(Patches, gb_sets:empty(), true);
- ppc64 -> find_callee_mfas(Patches, gb_sets:empty(), true);
- ultrasparc -> [];
- x86 -> []
+find_callee_mfas(Patches, Architecture) when is_list(Patches) ->
+ case needs_trampolines(Architecture) of
+ true -> find_callee_mfas(Patches, gb_sets:empty(),
+ no_erts_trampolines(Architecture));
+ _ -> []
+ end.
+
+needs_trampolines(Architecture) ->
+ case Architecture of
+ arm -> true;
+ powerpc -> true;
+ ppc64 -> true;
+ _ -> false
+ end.
+
+no_erts_trampolines(Architecture) ->
+ case Architecture of
+ powerpc -> true;
+ ppc64 -> true;
+ _ -> false
end.
find_callee_mfas([{Type,Data}|Patches], MFAs, SkipErtsSyms) ->
@@ -318,14 +334,9 @@ add_callee_mfas([], MFAs, _SkipErtsSyms) -> MFAs.
%%----------------------------------------------------------------
%%
-mk_trampoline_map([], []) -> []; % archs not using trampolines
-mk_trampoline_map(CalleeMFAs, Trampolines) ->
- SizeofLong =
- case erlang:system_info(hipe_architecture) of
- amd64 -> 8;
- ppc64 -> 8;
- _ -> 4
- end,
+mk_trampoline_map([], [], _) -> []; % archs not using trampolines
+mk_trampoline_map(CalleeMFAs, Trampolines, Architecture) ->
+ SizeofLong = word_size(Architecture),
mk_trampoline_map(tuple_size(CalleeMFAs), CalleeMFAs,
Trampolines, SizeofLong, gb_trees:empty()).
@@ -621,22 +632,24 @@ patch_load_mfa(CodeAddress, DestMFA, Addresses, RemoteOrLocal) ->
%%----------------------------------------------------------------
%% Patch references to code labels in the data segment.
%%
-patch_consts(Labels, DataAddress, CodeAddress) ->
+patch_consts(Labels, DataAddress, CodeAddress, WriteWord) ->
lists:foreach(fun (L) ->
- patch_label_or_labels(L, DataAddress, CodeAddress)
+ patch_label_or_labels(L, DataAddress, CodeAddress,
+ WriteWord)
end, Labels).
-patch_label_or_labels({Pos,Offset}, DataAddress, CodeAddress) ->
+patch_label_or_labels({Pos,Offset}, DataAddress, CodeAddress, WriteWord) ->
?ASSERT(assert_local_patch(CodeAddress+Offset)),
- write_word(DataAddress+Pos, CodeAddress+Offset);
-patch_label_or_labels({sorted,Base,UnOrderdList}, DataAddress, CodeAddress) ->
- sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress).
+ WriteWord(DataAddress+Pos, CodeAddress+Offset);
+patch_label_or_labels({sorted,Base,UnOrderdList}, DataAddress, CodeAddress,
+ WriteWord) ->
+ sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress, WriteWord).
-sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress) ->
+sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress, WriteWord) ->
WriteAndInc =
fun ({_, Offset}, DataPos) ->
?ASSERT(assert_local_patch(CodeAddress+Offset)),
- write_word(DataPos, CodeAddress+Offset)
+ WriteWord(DataPos, CodeAddress+Offset)
end,
lists:foldl(WriteAndInc, DataAddress+Base, sort_on_representation(UnOrderdList)).
@@ -662,17 +675,18 @@ patch_instr(Address, Value, Type) ->
%% XXX: It appears this is used for inserting both code addresses
%% and other data. In HiPE, code addresses are still 32-bit on
%% some 64-bit machines.
-write_word(DataAddress, DataWord) ->
- case erlang:system_info(hipe_architecture) of
- amd64 ->
- hipe_bifs:write_u64(DataAddress, DataWord),
- DataAddress+8;
- ppc64 ->
- hipe_bifs:write_u64(DataAddress, DataWord),
- DataAddress+8;
- _ ->
- hipe_bifs:write_u32(DataAddress, DataWord),
- DataAddress+4
+write_word_fun(WordSize) ->
+ case WordSize of
+ 8 ->
+ fun (DataAddress, DataWord) ->
+ hipe_bifs:write_u64(DataAddress, DataWord),
+ DataAddress+8
+ end;
+ 4 ->
+ fun (DataAddress, DataWord) ->
+ hipe_bifs:write_u32(DataAddress, DataWord),
+ DataAddress+4
+ end
end.
%%--------------------------------------------------------------------
@@ -688,30 +702,31 @@ bif_address(Name) when is_atom(Name) ->
%% memory, and produces a ConstMap2 mapping each constant's ConstNo to
%% its runtime address, tagged if the constant is a term.
%%
-create_data_segment(DataAlign, DataSize, DataList) ->
+create_data_segment(DataAlign, DataSize, DataList, WriteWord) ->
%%io:format("create_data_segment: \nDataAlign: ~p\nDataSize: ~p\nDataList: ~p\n",[DataAlign,DataSize,DataList]),
DataAddress = hipe_bifs:alloc_data(DataAlign, DataSize),
- enter_data(DataList, [], DataAddress, DataSize).
+ enter_data(DataList, [], DataAddress, DataSize, WriteWord).
-enter_data(List, ConstMap2, DataAddress, DataSize) ->
+enter_data(List, ConstMap2, DataAddress, DataSize, WriteWord) ->
case List of
[ConstNo,Offset,Type,Data|Rest] when is_integer(Offset) ->
%%?msg("Const ~w\n",[[ConstNo,Offset,Type,Data]]),
?ASSERT((Offset >= 0) and (Offset =< DataSize)),
- Res = enter_datum(Type, Data, DataAddress+Offset),
- enter_data(Rest, [{ConstNo,Res}|ConstMap2], DataAddress, DataSize);
+ Res = enter_datum(Type, Data, DataAddress+Offset, WriteWord),
+ enter_data(Rest, [{ConstNo,Res}|ConstMap2], DataAddress, DataSize,
+ WriteWord);
[] ->
{DataAddress, ConstMap2}
end.
-enter_datum(Type, Data, Address) ->
+enter_datum(Type, Data, Address, WriteWord) ->
case ?EXT2CONST_TYPE(Type) of
term ->
%% Address is unused for terms
hipe_bifs:term_to_word(hipe_bifs:merge_term(Data));
sorted_block ->
L = lists:sort([hipe_bifs:term_to_word(Term) || Term <- Data]),
- write_words(L, Address),
+ write_words(L, Address, WriteWord),
Address;
block ->
case Data of
@@ -719,7 +734,7 @@ enter_datum(Type, Data, Address) ->
write_bytes(Lbls, Address);
{Lbls, SortOrder} ->
SortedLbls = [Lbl || {_,Lbl} <- lists:sort(group(Lbls, SortOrder))],
- write_words(SortedLbls, Address);
+ write_words(SortedLbls, Address, WriteWord);
Lbls ->
write_bytes(Lbls, Address)
end,
@@ -734,9 +749,9 @@ group([B1,B2,B3,B4|Ls], [O|Os]) ->
bytes_to_32(B4,B3,B2,B1) ->
(B4 bsl 24) bor (B3 bsl 16) bor (B2 bsl 8) bor B1.
-write_words([W|Rest], Addr) ->
- write_words(Rest, write_word(Addr, W));
-write_words([], Addr) when is_integer(Addr) -> true.
+write_words([W|Rest], Addr, WriteWord) ->
+ write_words(Rest, WriteWord(Addr, W), WriteWord);
+write_words([], Addr, _) when is_integer(Addr) -> true.
write_bytes([B|Rest], Addr) ->
hipe_bifs:write_u8(Addr, B),
@@ -812,7 +827,7 @@ address_to_mfa_lth(_Address, [], Prev) ->
%%----------------------------------------------------------------
%% Change callers of the given module to instead trap to BEAM.
-%% load_native_code/2 calls this just before loading native code.
+%% load_native_code/3 calls this just before loading native code.
%%
patch_to_emu(Mod) ->
patch_to_emu_step2(patch_to_emu_step1(Mod)).
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index c82aaf0582..be55e25811 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -810,14 +810,6 @@ check_funs({'$M_EXPR','$F_EXPR',_},
{unicode,characters_to_binary,3},
{filename,filename_string_to_binary,1}|_]) -> 0;
check_funs({'$M_EXPR','$F_EXPR',_},
- [{code_server,load_native_code,4},
- {code_server,load_native_code_1,2},
- {code_server,load_native_code,2},
- {code_server,try_load_module,4},
- {code_server,do_load_binary,4},
- {code_server,handle_call,3},
- {code_server,loop,1}|_]) -> 0;
-check_funs({'$M_EXPR','$F_EXPR',_},
[{code_server,do_mod_call,4},
{code_server,handle_call,3}|_]) -> 0;
check_funs({'$M_EXPR','$F_EXPR',_},
@@ -866,8 +858,14 @@ check_funs({'$M_EXPR','$F_EXPR',_},
check_funs({'$M_EXPR',module_info,1},
[{hipe_unified_loader,patch_to_emu_step1,1} | _]) -> 0;
check_funs({'$M_EXPR','$F_EXPR',2},
+ [{hipe_unified_loader,write_words,3} | _]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',2},
+ [{hipe_unified_loader,patch_label_or_labels,4} | _]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',2},
+ [{hipe_unified_loader,sort_and_write,5} | _]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',2},
[{lists,foldl,3},
- {hipe_unified_loader,sort_and_write,4} | _]) -> 0;
+ {hipe_unified_loader,sort_and_write,5} | _]) -> 0;
check_funs({'$M_EXPR','$F_EXPR',1},
[{lists,foreach,2},
{hipe_unified_loader,patch_consts,3} | _]) -> 0;
diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl
index 4f0d7a7d50..76a9708a58 100644
--- a/lib/kernel/test/gen_tcp_misc_SUITE.erl
+++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl
@@ -38,7 +38,9 @@
% Accept tests
primitive_accept/1,multi_accept_close_listen/1,accept_timeout/1,
accept_timeouts_in_order/1,accept_timeouts_in_order2/1,
- accept_timeouts_in_order3/1,accept_timeouts_mixed/1,
+ accept_timeouts_in_order3/1,accept_timeouts_in_order4/1,
+ accept_timeouts_in_order5/1,accept_timeouts_in_order6/1,
+ accept_timeouts_in_order7/1,accept_timeouts_mixed/1,
killing_acceptor/1,killing_multi_acceptors/1,killing_multi_acceptors2/1,
several_accepts_in_one_go/1, accept_system_limit/1,
active_once_closed/1, send_timeout/1, send_timeout_active/1,
@@ -99,7 +101,9 @@ all() ->
so_priority, primitive_accept,
multi_accept_close_listen, accept_timeout,
accept_timeouts_in_order, accept_timeouts_in_order2,
- accept_timeouts_in_order3, accept_timeouts_mixed,
+ accept_timeouts_in_order3, accept_timeouts_in_order4,
+ accept_timeouts_in_order5, accept_timeouts_in_order6,
+ accept_timeouts_in_order7, accept_timeouts_mixed,
killing_acceptor, killing_multi_acceptors,
killing_multi_acceptors2, several_accepts_in_one_go, accept_system_limit,
active_once_closed, send_timeout, send_timeout_active, otp_7731,
@@ -1720,8 +1724,8 @@ multi_accept_close_listen(Config) when is_list(Config) ->
spawn(F),
spawn(F),
gen_tcp:close(LS),
- ?EXPECT_ACCEPTS([{_,{error,closed}},{_,{error,closed}},
- {_,{error,closed}},{_,{error,closed}}],4,500).
+ ok = ?EXPECT_ACCEPTS([{_,{error,closed}},{_,{error,closed}},
+ {_,{error,closed}},{_,{error,closed}}],4,500).
accept_timeout(suite) ->
[];
@@ -1732,7 +1736,7 @@ accept_timeout(Config) when is_list(Config) ->
Parent = self(),
F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS,1000)} end,
P = spawn(F),
- ?EXPECT_ACCEPTS([{P,{error,timeout}}],1,2000).
+ ok = ?EXPECT_ACCEPTS([{P,{error,timeout}}],1,2000).
accept_timeouts_in_order(suite) ->
[];
@@ -1745,8 +1749,8 @@ accept_timeouts_in_order(Config) when is_list(Config) ->
P2 = spawn(mktmofun(1200,Parent,LS)),
P3 = spawn(mktmofun(1300,Parent,LS)),
P4 = spawn(mktmofun(1400,Parent,LS)),
- ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}},
- {P3,{error,timeout}},{P4,{error,timeout}}],infinity,2000).
+ ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}},
+ {P3,{error,timeout}},{P4,{error,timeout}}],infinity,2000).
accept_timeouts_in_order2(suite) ->
[];
@@ -1759,8 +1763,8 @@ accept_timeouts_in_order2(Config) when is_list(Config) ->
P2 = spawn(mktmofun(1300,Parent,LS)),
P3 = spawn(mktmofun(1200,Parent,LS)),
P4 = spawn(mktmofun(1000,Parent,LS)),
- ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P3,{error,timeout}},
- {P2,{error,timeout}},{P1,{error,timeout}}],infinity,2000).
+ ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P3,{error,timeout}},
+ {P2,{error,timeout}},{P1,{error,timeout}}],infinity,2000).
accept_timeouts_in_order3(suite) ->
[];
@@ -1773,8 +1777,74 @@ accept_timeouts_in_order3(Config) when is_list(Config) ->
P2 = spawn(mktmofun(1400,Parent,LS)),
P3 = spawn(mktmofun(1300,Parent,LS)),
P4 = spawn(mktmofun(1000,Parent,LS)),
- ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}},
- {P3,{error,timeout}},{P2,{error,timeout}}],infinity,2000).
+ ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}},
+ {P3,{error,timeout}},{P2,{error,timeout}}],infinity,2000).
+
+accept_timeouts_in_order4(suite) ->
+ [];
+accept_timeouts_in_order4(doc) ->
+ ["Check that multi-accept timeouts happen in the correct order after "
+ "mixing millsec and sec timeouts"];
+accept_timeouts_in_order4(Config) when is_list(Config) ->
+ {ok,LS}=gen_tcp:listen(0,[]),
+ Parent = self(),
+ P1 = spawn(mktmofun(200,Parent,LS)),
+ P2 = spawn(mktmofun(400,Parent,LS)),
+ P3 = spawn(mktmofun(1000,Parent,LS)),
+ P4 = spawn(mktmofun(600,Parent,LS)),
+ ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}},
+ {P4,{error,timeout}},{P3,{error,timeout}}],infinity,2000).
+
+accept_timeouts_in_order5(suite) ->
+ [];
+accept_timeouts_in_order5(doc) ->
+ ["Check that multi-accept timeouts happen in the correct order after "
+ "mixing millsec and sec timeouts (more)"];
+accept_timeouts_in_order5(Config) when is_list(Config) ->
+ {ok,LS}=gen_tcp:listen(0,[]),
+ Parent = self(),
+ P1 = spawn(mktmofun(400,Parent,LS)),
+ P2 = spawn(mktmofun(1000,Parent,LS)),
+ P3 = spawn(mktmofun(600,Parent,LS)),
+ P4 = spawn(mktmofun(200,Parent,LS)),
+ ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}},
+ {P3,{error,timeout}},{P2,{error,timeout}}],infinity,2000).
+
+accept_timeouts_in_order6(suite) ->
+ [];
+accept_timeouts_in_order6(doc) ->
+ ["Check that multi-accept timeouts happen in the correct order after "
+ "mixing millsec and sec timeouts (even more)"];
+accept_timeouts_in_order6(Config) when is_list(Config) ->
+ {ok,LS}=gen_tcp:listen(0,[]),
+ Parent = self(),
+ P1 = spawn(mktmofun(1000,Parent,LS)),
+ P2 = spawn(mktmofun(400,Parent,LS)),
+ P3 = spawn(mktmofun(600,Parent,LS)),
+ P4 = spawn(mktmofun(200,Parent,LS)),
+ ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P2,{error,timeout}},
+ {P3,{error,timeout}},{P1,{error,timeout}}],infinity,2000).
+
+accept_timeouts_in_order7(suite) ->
+ [];
+accept_timeouts_in_order7(doc) ->
+ ["Check that multi-accept timeouts happen in the correct order after "
+ "mixing millsec and sec timeouts (even more++)"];
+accept_timeouts_in_order7(Config) when is_list(Config) ->
+ {ok,LS}=gen_tcp:listen(0,[]),
+ Parent = self(),
+ P1 = spawn(mktmofun(1000,Parent,LS)),
+ P2 = spawn(mktmofun(200,Parent,LS)),
+ P3 = spawn(mktmofun(1200,Parent,LS)),
+ P4 = spawn(mktmofun(600,Parent,LS)),
+ P5 = spawn(mktmofun(400,Parent,LS)),
+ P6 = spawn(mktmofun(800,Parent,LS)),
+ P7 = spawn(mktmofun(1600,Parent,LS)),
+ P8 = spawn(mktmofun(1400,Parent,LS)),
+ ok = ?EXPECT_ACCEPTS([{P2,{error,timeout}},{P5,{error,timeout}},
+ {P4,{error,timeout}},{P6,{error,timeout}},
+ {P1,{error,timeout}},{P3,{error,timeout}},
+ {P8,{error,timeout}},{P7,{error,timeout}}],infinity,2000).
accept_timeouts_mixed(suite) ->
[];
@@ -1797,7 +1867,7 @@ accept_timeouts_mixed(Config) when is_list(Config) ->
ok = ?EXPECT_ACCEPTS([{P2,{ok,Port0}}] when is_port(Port0),infinity,100),
ok = ?EXPECT_ACCEPTS([{P3,{error,timeout}}],infinity,2000),
gen_tcp:connect("localhost",PortNo,[]),
- ?EXPECT_ACCEPTS([{P4,{ok,Port1}}] when is_port(Port1),infinity,100).
+ ok = ?EXPECT_ACCEPTS([{P4,{ok,Port1}}] when is_port(Port1),infinity,100).
killing_acceptor(suite) ->
[];
diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl
index 94154c8a96..a02c87505d 100644
--- a/lib/ssh/src/ssh.hrl
+++ b/lib/ssh/src/ssh.hrl
@@ -128,8 +128,10 @@
user,
service,
userauth_quiet_mode, % boolean()
- userauth_supported_methods , %
- userauth_methods,
+ userauth_supported_methods, % string() eg "keyboard-interactive,password"
+ userauth_methods, % list( string() ) eg ["keyboard-interactive", "password"]
+ kb_tries_left = 0, % integer(), num tries left for "keyboard-interactive"
+ kb_data,
userauth_preference,
available_host_keys,
authenticated = false
diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl
index df9a97c8f8..020fb06530 100644
--- a/lib/ssh/src/ssh_auth.erl
+++ b/lib/ssh/src/ssh_auth.erl
@@ -169,7 +169,8 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User,
service = "ssh-connection",
method = "password",
data = <<?FALSE, ?UINT32(Sz), BinPwd:Sz/binary>>}, _,
- #ssh{opts = Opts} = Ssh) ->
+ #ssh{opts = Opts,
+ userauth_supported_methods = Methods} = Ssh) ->
Password = unicode:characters_to_list(BinPwd),
case check_password(User, Password, Opts) of
true ->
@@ -178,7 +179,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User,
false ->
{not_authorized, {User, {error,"Bad user or password"}},
ssh_transport:ssh_packet(#ssh_msg_userauth_failure{
- authentications = "",
+ authentications = Methods,
partial_success = false}, Ssh)}
end;
@@ -191,7 +192,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User,
%% ?UINT32(Sz2), NewBinPwd:Sz2/binary
>>
}, _,
- Ssh) ->
+ #ssh{userauth_supported_methods = Methods} = Ssh) ->
%% Password change without us having sent SSH_MSG_USERAUTH_PASSWD_CHANGEREQ (because we never do)
%% RFC 4252 says:
%% SSH_MSG_USERAUTH_FAILURE without partial success - The password
@@ -200,7 +201,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User,
{not_authorized, {User, {error,"Password change not supported"}},
ssh_transport:ssh_packet(#ssh_msg_userauth_failure{
- authentications = "",
+ authentications = Methods,
partial_success = false}, Ssh)};
handle_userauth_request(#ssh_msg_userauth_request{user = User,
@@ -216,7 +217,9 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User,
service = "ssh-connection",
method = "publickey",
data = Data},
- SessionId, #ssh{opts = Opts} = Ssh) ->
+ SessionId,
+ #ssh{opts = Opts,
+ userauth_supported_methods = Methods} = Ssh) ->
<<?BYTE(HaveSig), ?UINT32(ALen), BAlg:ALen/binary,
?UINT32(KLen), KeyBlob:KLen/binary, SigWLen/binary>> = Data,
Alg = binary_to_list(BAlg),
@@ -231,7 +234,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User,
false ->
{not_authorized, {User, undefined},
ssh_transport:ssh_packet(#ssh_msg_userauth_failure{
- authentications="publickey,password",
+ authentications = Methods,
partial_success = false}, Ssh)}
end;
?FALSE ->
@@ -245,49 +248,60 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User,
service = "ssh-connection",
method = "keyboard-interactive",
data = _},
- _, #ssh{opts = Opts} = Ssh) ->
- %% RFC4256
- %% The data field contains:
- %% - language tag (deprecated). If =/=[] SHOULD use it however. We skip
- %% it for simplicity.
- %% - submethods. "... the user can give a hint of which actual methods
- %% he wants to use. ...". It's a "MAY use" so we skip
- %% it. It also needs an understanding between the client
- %% and the server.
- %%
- %% "The server MUST reply with an SSH_MSG_USERAUTH_SUCCESS,
- %% SSH_MSG_USERAUTH_FAILURE, or SSH_MSG_USERAUTH_INFO_REQUEST message."
- Default = {"SSH server",
- "Enter password for \""++User++"\"",
- "pwd: ",
- false},
-
- {Name, Instruction, Prompt, Echo} =
- case proplists:get_value(auth_method_kb_interactive_data, Opts) of
- undefined ->
- Default;
- {_,_,_,_}=V ->
- V;
- F when is_function(F) ->
- {_,PeerName} = Ssh#ssh.peer,
- F(PeerName, User, "ssh-connection")
- end,
- EchoEnc = case Echo of
- true -> <<?TRUE>>;
- false -> <<?FALSE>>
- end,
- Msg = #ssh_msg_userauth_info_request{name = unicode:characters_to_list(Name),
- instruction = unicode:characters_to_list(Instruction),
- language_tag = "",
- num_prompts = 1,
- data = <<?STRING(unicode:characters_to_binary(Prompt)),
- EchoEnc/binary
- >>
- },
- {not_authorized, {User, undefined},
- ssh_transport:ssh_packet(Msg, Ssh#ssh{user = User,
- opts = [{max_kb_tries,3},{kb_userauth_info_msg,Msg}|Opts]
- })};
+ _, #ssh{opts = Opts,
+ kb_tries_left = KbTriesLeft,
+ userauth_supported_methods = Methods} = Ssh) ->
+ case KbTriesLeft of
+ N when N<1 ->
+ {not_authorized, {User, {authmethod, "keyboard-interactive"}},
+ ssh_transport:ssh_packet(
+ #ssh_msg_userauth_failure{authentications = Methods,
+ partial_success = false}, Ssh)};
+
+ _ ->
+ %% RFC4256
+ %% The data field contains:
+ %% - language tag (deprecated). If =/=[] SHOULD use it however. We skip
+ %% it for simplicity.
+ %% - submethods. "... the user can give a hint of which actual methods
+ %% he wants to use. ...". It's a "MAY use" so we skip
+ %% it. It also needs an understanding between the client
+ %% and the server.
+ %%
+ %% "The server MUST reply with an SSH_MSG_USERAUTH_SUCCESS,
+ %% SSH_MSG_USERAUTH_FAILURE, or SSH_MSG_USERAUTH_INFO_REQUEST message."
+ Default = {"SSH server",
+ "Enter password for \""++User++"\"",
+ "password: ",
+ false},
+
+ {Name, Instruction, Prompt, Echo} =
+ case proplists:get_value(auth_method_kb_interactive_data, Opts) of
+ undefined ->
+ Default;
+ {_,_,_,_}=V ->
+ V;
+ F when is_function(F) ->
+ {_,PeerName} = Ssh#ssh.peer,
+ F(PeerName, User, "ssh-connection")
+ end,
+ EchoEnc = case Echo of
+ true -> <<?TRUE>>;
+ false -> <<?FALSE>>
+ end,
+ Msg = #ssh_msg_userauth_info_request{name = unicode:characters_to_list(Name),
+ instruction = unicode:characters_to_list(Instruction),
+ language_tag = "",
+ num_prompts = 1,
+ data = <<?STRING(unicode:characters_to_binary(Prompt)),
+ EchoEnc/binary
+ >>
+ },
+ {not_authorized, {User, undefined},
+ ssh_transport:ssh_packet(Msg, Ssh#ssh{user = User,
+ kb_data = Msg
+ })}
+ end;
handle_userauth_request(#ssh_msg_userauth_request{user = User,
service = "ssh-connection",
@@ -314,33 +328,37 @@ handle_userauth_info_request(
handle_userauth_info_response(#ssh_msg_userauth_info_response{num_responses = 1,
data = <<?UINT32(Sz), Password:Sz/binary>>},
- #ssh{opts = Opts0,
- user = User} = Ssh) ->
- NumTriesLeft = proplists:get_value(max_kb_tries, Opts0, 0) - 1,
- Opts = lists:keydelete(max_kb_tries,1,Opts0),
+ #ssh{opts = Opts,
+ kb_tries_left = KbTriesLeft0,
+ kb_data = InfoMsg,
+ user = User,
+ userauth_supported_methods = Methods} = Ssh) ->
+ KbTriesLeft = KbTriesLeft0 - 1,
case check_password(User, unicode:characters_to_list(Password), Opts) of
true ->
{authorized, User,
ssh_transport:ssh_packet(#ssh_msg_userauth_success{}, Ssh)};
- false when NumTriesLeft > 0 ->
+ false when KbTriesLeft > 0 ->
UserAuthInfoMsg =
- (proplists:get_value(kb_userauth_info_msg,Opts))
- #ssh_msg_userauth_info_request{name = "",
- instruction =
- lists:concat(
- ["Bad user or password, try again. ",
- integer_to_list(NumTriesLeft),
- " tries left."])},
+ InfoMsg#ssh_msg_userauth_info_request{
+ name = "",
+ instruction =
+ lists:concat(
+ ["Bad user or password, try again. ",
+ integer_to_list(KbTriesLeft),
+ " tries left."])
+ },
{not_authorized, {User, undefined},
ssh_transport:ssh_packet(UserAuthInfoMsg,
- Ssh#ssh{opts = [{max_kb_tries,NumTriesLeft}|Opts]})};
+ Ssh#ssh{kb_tries_left = KbTriesLeft})};
false ->
{not_authorized, {User, {error,"Bad user or password"}},
ssh_transport:ssh_packet(#ssh_msg_userauth_failure{
- authentications = "",
+ authentications = Methods,
partial_success = false},
- Ssh#ssh{opts = lists:keydelete(kb_userauth_info_msg,1,Opts)}
+ Ssh#ssh{kb_data = undefined,
+ kb_tries_left = 0}
)}
end;
@@ -483,22 +501,16 @@ keyboard_interact_fun(KbdInteractFun, Name, Instr, PromptInfos, NumPrompts) ->
end.
decode_public_key_v2(<<?UINT32(Len0), _:Len0/binary,
- ?UINT32(Len1), BinE:Len1/binary,
- ?UINT32(Len2), BinN:Len2/binary>>
+ ?UINT32(Len1), E:Len1/big-signed-integer-unit:8,
+ ?UINT32(Len2), N:Len2/big-signed-integer-unit:8>>
,"ssh-rsa") ->
- E = ssh_bits:erlint(Len1, BinE),
- N = ssh_bits:erlint(Len2, BinN),
{ok, #'RSAPublicKey'{publicExponent = E, modulus = N}};
decode_public_key_v2(<<?UINT32(Len0), _:Len0/binary,
- ?UINT32(Len1), BinP:Len1/binary,
- ?UINT32(Len2), BinQ:Len2/binary,
- ?UINT32(Len3), BinG:Len3/binary,
- ?UINT32(Len4), BinY:Len4/binary>>
+ ?UINT32(Len1), P:Len1/big-signed-integer-unit:8,
+ ?UINT32(Len2), Q:Len2/big-signed-integer-unit:8,
+ ?UINT32(Len3), G:Len3/big-signed-integer-unit:8,
+ ?UINT32(Len4), Y:Len4/big-signed-integer-unit:8>>
, "ssh-dss") ->
- P = ssh_bits:erlint(Len1, BinP),
- Q = ssh_bits:erlint(Len2, BinQ),
- G = ssh_bits:erlint(Len3, BinG),
- Y = ssh_bits:erlint(Len4, BinY),
{ok, {Y, #'Dss-Parms'{p = P, q = Q, g = G}}};
decode_public_key_v2(_, _) ->
diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl
index 8aaff93b9f..d5f8df6fe4 100644
--- a/lib/ssh/src/ssh_bits.erl
+++ b/lib/ssh/src/ssh_bits.erl
@@ -26,7 +26,7 @@
-include("ssh.hrl").
-export([encode/2]).
--export([mpint/1, erlint/2, string/1, name_list/1]).
+-export([mpint/1, string/1, name_list/1]).
-export([random/1]).
-define(name_list(X),
@@ -145,11 +145,7 @@ enc(Xs, ['...'| []], _Offset) ->
enc([], [],_) ->
[].
-erlint(Len, BinInt) ->
- Sz = Len*8,
- <<Int:Sz/big-signed-integer>> = BinInt,
- Int.
-
+
%%
%% Create a binary with constant bytes
%%
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index ab1fc93a1b..d8bf66d2a8 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -483,17 +483,22 @@ userauth(#ssh_msg_userauth_request{service = "ssh-connection",
service = "ssh-connection",
peer = {_, Address}} = Ssh0,
opts = Opts, starter = Pid} = State) ->
- case ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0) of
- {authorized, User, {Reply, Ssh}} ->
- send_msg(Reply, State),
- Pid ! ssh_connected,
- connected_fun(User, Address, Method, Opts),
- {next_state, connected,
- next_packet(State#state{auth_user = User, ssh_params = Ssh})};
- {not_authorized, {User, Reason}, {Reply, Ssh}} ->
- retry_fun(User, Address, Reason, Opts),
- send_msg(Reply, State),
- {next_state, userauth, next_packet(State#state{ssh_params = Ssh})}
+ case lists:member(Method, Ssh0#ssh.userauth_methods) of
+ true ->
+ case ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0) of
+ {authorized, User, {Reply, Ssh}} ->
+ send_msg(Reply, State),
+ Pid ! ssh_connected,
+ connected_fun(User, Address, Method, Opts),
+ {next_state, connected,
+ next_packet(State#state{auth_user = User, ssh_params = Ssh})};
+ {not_authorized, {User, Reason}, {Reply, Ssh}} ->
+ retry_fun(User, Address, Reason, Opts),
+ send_msg(Reply, State),
+ {next_state, userauth, next_packet(State#state{ssh_params = Ssh})}
+ end;
+ false ->
+ userauth(Msg#ssh_msg_userauth_request{method="none"}, State)
end;
userauth(#ssh_msg_userauth_info_request{} = Msg,
@@ -1148,9 +1153,9 @@ init_ssh(client = Role, Vsn, Version, Options, Socket) ->
};
init_ssh(server = Role, Vsn, Version, Options, Socket) ->
-
AuthMethods = proplists:get_value(auth_methods, Options,
?SUPPORTED_AUTH_METHODS),
+ AuthMethodsAsList = string:tokens(AuthMethods, ","),
{ok, PeerAddr} = inet:peername(Socket),
KeyCb = proplists:get_value(key_cb, Options, ssh_file),
@@ -1161,6 +1166,8 @@ init_ssh(server = Role, Vsn, Version, Options, Socket) ->
io_cb = proplists:get_value(io_cb, Options, ssh_io),
opts = Options,
userauth_supported_methods = AuthMethods,
+ userauth_methods = AuthMethodsAsList,
+ kb_tries_left = 3,
peer = {undefined, PeerAddr},
available_host_keys = supported_host_keys(Role, KeyCb, Options)
}.
diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl
index 66e7717095..483c6cb4aa 100644
--- a/lib/ssh/src/ssh_message.erl
+++ b/lib/ssh/src/ssh_message.erl
@@ -421,8 +421,8 @@ decode(<<?BYTE(?SSH_MSG_USERAUTH_INFO_RESPONSE), ?UINT32(Num), Data/binary>>) ->
decode(<<?BYTE(?SSH_MSG_KEXINIT), Cookie:128, Data/binary>>) ->
decode_kex_init(Data, [Cookie, ssh_msg_kexinit], 10);
-decode(<<?BYTE(?SSH_MSG_KEXDH_INIT), ?UINT32(Len), E:Len/binary>>) ->
- #ssh_msg_kexdh_init{e = erlint(Len, E)
+decode(<<?BYTE(?SSH_MSG_KEXDH_INIT), ?UINT32(Len), E:Len/big-signed-integer-unit:8>>) ->
+ #ssh_msg_kexdh_init{e = E
};
decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_REQUEST), ?UINT32(Min), ?UINT32(N), ?UINT32(Max)>>) ->
#ssh_msg_kex_dh_gex_request{
@@ -442,11 +442,11 @@ decode(<<?BYTE(?SSH_MSG_KEX_DH_GEX_GROUP),
g = Generator
};
decode(<<?BYTE(?SSH_MSG_KEXDH_REPLY), ?UINT32(Len0), Key:Len0/binary,
- ?UINT32(Len1), F:Len1/binary,
+ ?UINT32(Len1), F:Len1/big-signed-integer-unit:8,
?UINT32(Len2), Hashsign:Len2/binary>>) ->
#ssh_msg_kexdh_reply{
public_host_key = decode_host_key(Key),
- f = erlint(Len1, F),
+ f = F,
h_sig = decode_sign(Hashsign)
};
@@ -514,10 +514,7 @@ decode_kex_init(<<?UINT32(Len), Data:Len/binary, Rest/binary>>, Acc, N) ->
Names = string:tokens(unicode:characters_to_list(Data), ","),
decode_kex_init(Rest, [Names | Acc], N -1).
-erlint(MPIntSize, MPIntValue) ->
- Bits = MPIntSize * 8,
- <<Integer:Bits/integer>> = MPIntValue,
- Integer.
+
decode_sign(<<?UINT32(Len), _Alg:Len/binary, ?UINT32(_), Signature/binary>>) ->
Signature.
@@ -525,18 +522,19 @@ decode_sign(<<?UINT32(Len), _Alg:Len/binary, ?UINT32(_), Signature/binary>>) ->
decode_host_key(<<?UINT32(Len), Alg:Len/binary, Rest/binary>>) ->
decode_host_key(Alg, Rest).
-decode_host_key(<<"ssh-rsa">>, <<?UINT32(Len0), E:Len0/binary,
- ?UINT32(Len1), N:Len1/binary>>) ->
- #'RSAPublicKey'{publicExponent = erlint(Len0, E),
- modulus = erlint(Len1, N)};
+decode_host_key(<<"ssh-rsa">>, <<?UINT32(Len0), E:Len0/big-signed-integer-unit:8,
+ ?UINT32(Len1), N:Len1/big-signed-integer-unit:8>>) ->
+ #'RSAPublicKey'{publicExponent = E,
+ modulus = N};
decode_host_key(<<"ssh-dss">>,
- <<?UINT32(Len0), P:Len0/binary,
- ?UINT32(Len1), Q:Len1/binary,
- ?UINT32(Len2), G:Len2/binary,
- ?UINT32(Len3), Y:Len3/binary>>) ->
- {erlint(Len3, Y), #'Dss-Parms'{p = erlint(Len0, P), q = erlint(Len1, Q),
- g = erlint(Len2, G)}}.
+ <<?UINT32(Len0), P:Len0/big-signed-integer-unit:8,
+ ?UINT32(Len1), Q:Len1/big-signed-integer-unit:8,
+ ?UINT32(Len2), G:Len2/big-signed-integer-unit:8,
+ ?UINT32(Len3), Y:Len3/big-signed-integer-unit:8>>) ->
+ {Y, #'Dss-Parms'{p = P,
+ q = Q,
+ g = G}}.
encode_host_key(#'RSAPublicKey'{modulus = N, publicExponent = E}) ->
ssh_bits:encode(["ssh-rsa", E, N], [string, mpint, mpint]);
diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile
index 843b1d906d..50efc33f98 100644
--- a/lib/ssh/test/Makefile
+++ b/lib/ssh/test/Makefile
@@ -38,6 +38,7 @@ MODULES= \
ssh_sftp_SUITE \
ssh_sftpd_SUITE \
ssh_sftpd_erlclient_SUITE \
+ ssh_upgrade_SUITE \
ssh_connection_SUITE \
ssh_echo_server \
ssh_peername_sockname_server \
diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl
new file mode 100644
index 0000000000..861c7ab3dd
--- /dev/null
+++ b/lib/ssh/test/ssh_upgrade_SUITE.erl
@@ -0,0 +1,206 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014-2015. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.2
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ssh_upgrade_SUITE).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+
+-record(state, {
+ config,
+ root_dir,
+ server,
+ client,
+ connection,
+ soft
+ }).
+
+
+%%%================================================================
+%%%
+%%% CommonTest callbacks
+%%%
+all() ->
+ [
+ minor_upgrade,
+ major_upgrade
+ ].
+
+init_per_suite(Config0) ->
+ catch crypto:stop(),
+ try {crypto:start(), erlang:system_info({wordsize, internal}) ==
+ erlang:system_info({wordsize, external})} of
+ {ok, true} ->
+ case ct_release_test:init(Config0) of
+ {skip, Reason} ->
+ {skip, Reason};
+ Config ->
+ ssh:start(),
+ Config
+ end;
+ {ok, false} ->
+ {skip, "Test server will not handle halfwordemulator correctly. Skip as halfwordemulator is deprecated"}
+ catch _:_ ->
+ {skip, "Crypto did not start"}
+ end.
+
+end_per_suite(Config) ->
+ ct_release_test:cleanup(Config),
+ ssh:stop(),
+ crypto:stop(),
+ UserDir = ?config(priv_dir, Config),
+ ssh_test_lib:clean_rsa(UserDir).
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+end_per_testcase(_TestCase, Config) ->
+ Config.
+
+%%%================================================================
+%%%
+%%% Test cases
+%%%
+major_upgrade(Config) when is_list(Config) ->
+ ct_release_test:upgrade(ssh, major,{?MODULE, #state{config = Config}}, Config).
+
+minor_upgrade(Config) when is_list(Config) ->
+ ct_release_test:upgrade(ssh, minor,{?MODULE, #state{config = Config}}, Config).
+
+%%%================================================================
+%%%
+%%% ct_release_test callbacks
+%%%
+
+%%%----------------------------------------------------------------
+%%% Initialyze system before upgrade test starts.
+%%% 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]),
+ case Soft = is_soft(Up) of
+ %% It is symmetrical, if upgrade is soft so is downgrade
+ true ->
+ setup_server_client(State#state{soft = Soft});
+ false ->
+ State#state{soft = Soft}
+ end.
+
+%%%----------------------------------------------------------------
+%%% Check that upgrade was successful
+%%% Called by ct_release_test:upgrade/4
+upgrade_upgraded(_, #state{soft=false} = State) ->
+ test_hard(State, "upgrade");
+
+upgrade_upgraded(_, State) ->
+ test_soft(State, "upgrade1").
+
+%%%----------------------------------------------------------------
+%%% Check that downgrade was successful.
+%%% Called by ct_release_test:upgrade/4
+upgrade_downgraded(_, #state{soft=false} = State) ->
+ test_hard(State, "downgrade");
+
+upgrade_downgraded(_, #state{soft=true} = State) ->
+ test_soft(State, "downgrade1").
+
+%%%================================================================
+%%%
+%%% Private functions
+%%%
+
+is_soft([{restart_application, ssh}]) ->
+ false;
+is_soft(_) ->
+ true.
+
+
+test_hard(State0, FileName) ->
+ ct:pal("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]),
+ State = test_connection(FileName, random_contents(), State0),
+ setup_server_client( close(State) ).
+
+
+setup_server_client(#state{config=Config} = State) ->
+ DataDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
+
+ FtpRootDir = filename:join(PrivDir, "ftp_root"),
+ catch file:make_dir(FtpRootDir),
+
+ SFTP = ssh_sftpd:subsystem_spec([{root,FtpRootDir},{cwd,FtpRootDir}]),
+
+ {Server,Host,Port} = ssh_test_lib:daemon([{system_dir,DataDir},
+ {user_passwords,[{"hej","hopp"}]},
+ {subsystems,[SFTP]}]),
+
+ {ok, ChannelPid, Connection} =
+ ssh_sftp:start_channel(Host, Port, [{user_interaction,false},
+ {silently_accept_hosts,true},
+ {user_dir,DataDir},
+ {user,"hej"},
+ {password,"hopp"}]),
+ State#state{server = Server,
+ client = ChannelPid,
+ connection = Connection}.
+
+
+test_connection(FileName, FileContents,
+ #state{client = ChannelPid,
+ root_dir = FtpRootDir} = State) ->
+ ct:pal("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
+ {ok,FileContents} ->
+ State;
+ {ok,Unexpected} ->
+ ct:fail("Expected ~p but got ~p from sftp:read_file(~p,..) in RootDir ~p",
+ [FileContents,Unexpected,FileName,FtpRootDir]
+ );
+ Other ->
+ ct:fail("ssh_sftp:read_file(~p,~p) -> ~p~n"
+ "ssh_sftp:list_dir(~p,\".\") -> ~p",
+ [ChannelPid,FileName,Other,
+ ChannelPid, catch ssh_sftp:list_dir(ChannelPid, ".")])
+ end;
+
+ Other ->
+ ct:fail("ssh_sftp:write_file(~p,~p,~p) -> ~p",[ChannelPid,FileName,FileContents,Other])
+ end.
+
+
+close(#state{server = Server,
+ connection = Connection} = State) ->
+ ssh:close(Connection),
+ ssh:stop_daemon(Server),
+ State#state{server = undefined,
+ client = undefined,
+ connection = undefined}.
+
+
+random_contents() -> list_to_binary( random_chars(3) ).
+
+random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)].
diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/id_dsa b/lib/ssh/test/ssh_upgrade_SUITE_data/id_dsa
new file mode 100644
index 0000000000..d306f8b26e
--- /dev/null
+++ b/lib/ssh/test/ssh_upgrade_SUITE_data/id_dsa
@@ -0,0 +1,13 @@
+-----BEGIN DSA PRIVATE KEY-----
+MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ
+APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod
+/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP
+kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW
+JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD
+OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt
++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e
+uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX
+Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE
+ZU8w8Q+H7z0j+a+70x2iAw==
+-----END DSA PRIVATE KEY-----
+
diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/id_rsa b/lib/ssh/test/ssh_upgrade_SUITE_data/id_rsa
new file mode 100644
index 0000000000..9d7e0dd5fb
--- /dev/null
+++ b/lib/ssh/test/ssh_upgrade_SUITE_data/id_rsa
@@ -0,0 +1,15 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU
+DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl
+zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB
+AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V
+TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3
+CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK
+SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p
+z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd
+WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39
+sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3
+xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ
+dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x
+ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak=
+-----END RSA PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/known_hosts b/lib/ssh/test/ssh_upgrade_SUITE_data/known_hosts
new file mode 100644
index 0000000000..8b13789179
--- /dev/null
+++ b/lib/ssh/test/ssh_upgrade_SUITE_data/known_hosts
@@ -0,0 +1 @@
+
diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key
new file mode 100644
index 0000000000..51ab6fbd88
--- /dev/null
+++ b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key
@@ -0,0 +1,13 @@
+-----BEGIN DSA PRIVATE KEY-----
+MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK
+wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q
+diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA
+l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X
+skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF
+Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP
+ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah
+/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U
+ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W
+Lv62jKcdskxNyz2NQoBx
+-----END DSA PRIVATE KEY-----
+
diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key.pub
new file mode 100644
index 0000000000..4dbb1305b0
--- /dev/null
+++ b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_dsa_key.pub
@@ -0,0 +1,11 @@
+---- BEGIN SSH2 PUBLIC KEY ----
+AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j
+YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2
+KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU
+aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI
+fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT
+MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh
+DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48
+wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2
+/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg==
+---- END SSH2 PUBLIC KEY ----
diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key
new file mode 100644
index 0000000000..79968bdd7d
--- /dev/null
+++ b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key
@@ -0,0 +1,16 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337
+zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB
+6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB
+AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW
+NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++
+udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW
+WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt
+n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5
+sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY
++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt
+64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB
+m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT
+tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR
+-----END RSA PRIVATE KEY-----
+
diff --git a/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key.pub
new file mode 100644
index 0000000000..75d2025c71
--- /dev/null
+++ b/lib/ssh/test/ssh_upgrade_SUITE_data/ssh_host_rsa_key.pub
@@ -0,0 +1,5 @@
+---- BEGIN SSH2 PUBLIC KEY ----
+AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8
+semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW
+RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q==
+---- END SSH2 PUBLIC KEY ----
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index 18d98e5efb..9122066787 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -650,6 +650,27 @@ fun(srp, Username :: string(), UserState :: term()) ->
The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item>
+ <tag><c>{client_renegotiation, boolean()}</c></tag>
+ <item>In protocols that support client-initiated renegotiation, the cost
+ of resources of such an operation is higher for the server than the
+ client. This can act as a vector for denial of service attacks. The SSL
+ application already takes measures to counter-act such attempts,
+ but client-initiated renegotiation can be stricly disabled by setting
+ this option to <c>false</c>. The default value is <c>true</c>.
+ Note that disabling renegotiation can result in long-lived connections
+ becoming unusable due to limits on the number of messages the underlying
+ 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.
+ </item>
</taglist>
</section>
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
index 610e2c4e41..0c73a49a04 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -514,6 +514,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User,
user_data_buffer = <<>>,
session_cache_cb = SessionCacheCb,
renegotiation = {false, first},
+ allow_renegotiate = SSLOptions#ssl_options.client_renegotiation,
start_or_recv_from = undefined,
send_queue = queue:new(),
protocol_cb = ?MODULE
diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src
index d100e41930..1476336039 100644
--- a/lib/ssl/src/ssl.appup.src
+++ b/lib/ssl/src/ssl.appup.src
@@ -1,16 +1,14 @@
%% -*- erlang -*-
{"%VSN%",
[
- {<<"6.0">>, [{load_module, ssl_handshake, soft_purge, soft_purge, []}]},
- {<<"5\\.3\\.[1-7]($|\\..*)">>, [{restart_application, ssl}]},
- {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]},
+ {<<"6\\..*">>, [{restart_application, ssl}]},
+ {<<"5\\..*">>, [{restart_application, ssl}]},
{<<"4\\..*">>, [{restart_application, ssl}]},
{<<"3\\..*">>, [{restart_application, ssl}]}
],
[
- {<<"6.0">>, [{load_module, ssl_handshake, soft_purge, soft_purge, []}]},
- {<<"5\\.3\\.[1-7]($|\\..*)">>, [{restart_application, ssl}]},
- {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]},
+ {<<"6\\..*">>, [{restart_application, ssl}]},
+ {<<"5\\..*">>, [{restart_application, ssl}]},
{<<"4\\..*">>, [{restart_application, ssl}]},
{<<"3\\..*">>, [{restart_application, ssl}]}
]
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 225a9be66f..f8ddfba7e3 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -685,6 +685,7 @@ handle_options(Opts0) ->
reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun),
reuse_sessions = handle_option(reuse_sessions, Opts, true),
secure_renegotiate = handle_option(secure_renegotiate, Opts, false),
+ client_renegotiation = handle_option(client_renegotiation, Opts, true),
renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT),
hibernate_after = handle_option(hibernate_after, Opts, undefined),
erl_dist = handle_option(erl_dist, Opts, false),
@@ -715,7 +716,7 @@ handle_options(Opts0) ->
depth, cert, certfile, key, keyfile,
password, cacerts, cacertfile, dh, dhfile,
user_lookup_fun, psk_identity, srp_identity, ciphers,
- reuse_session, reuse_sessions, ssl_imp,
+ reuse_session, reuse_sessions, ssl_imp, client_renegotiation,
cb_info, renegotiate_at, secure_renegotiate, hibernate_after,
erl_dist, alpn_advertised_protocols, sni_hosts, sni_fun,
alpn_preferred_protocols, next_protocols_advertised,
@@ -857,6 +858,8 @@ validate_option(reuse_sessions, Value) when is_boolean(Value) ->
validate_option(secure_renegotiate, Value) when is_boolean(Value) ->
Value;
+validate_option(client_renegotiation, Value) when is_boolean(Value) ->
+ Value;
validate_option(renegotiate_at, Value) when is_integer(Value) ->
erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT);
@@ -1226,6 +1229,8 @@ new_ssl_options([{renegotiate_at, Value} | Rest], #ssl_options{} = Opts, RecordC
new_ssl_options(Rest, Opts#ssl_options{ renegotiate_at = validate_option(renegotiate_at, Value)}, RecordCB);
new_ssl_options([{secure_renegotiate, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
new_ssl_options(Rest, Opts#ssl_options{secure_renegotiate = validate_option(secure_renegotiate, Value)}, RecordCB);
+new_ssl_options([{client_renegotiation, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{client_renegotiation = validate_option(client_renegotiation, Value)}, RecordCB);
new_ssl_options([{hibernate_after, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
new_ssl_options(Rest, Opts#ssl_options{hibernate_after = validate_option(hibernate_after, Value)}, RecordCB);
new_ssl_options([{alpn_advertised_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index baeae68bc4..40eb3d0284 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -110,6 +110,7 @@
reuse_sessions :: boolean(),
renegotiate_at,
secure_renegotiate,
+ client_renegotiation,
%% undefined if not hibernating, or number of ms of
%% inactivity after which ssl_connection will go into
%% hibernation
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 3304ffcddb..ed7ccb3d70 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -392,6 +392,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us
user_data_buffer = <<>>,
session_cache_cb = SessionCacheCb,
renegotiation = {false, first},
+ allow_renegotiate = SSLOptions#ssl_options.client_renegotiation,
start_or_recv_from = undefined,
send_queue = queue:new(),
protocol_cb = ?MODULE,
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index e1a36dbbd4..e131c363d1 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -162,7 +162,8 @@ renegotiate_tests() ->
client_no_wrap_sequence_number,
server_no_wrap_sequence_number,
renegotiate_dos_mitigate_active,
- renegotiate_dos_mitigate_passive].
+ renegotiate_dos_mitigate_passive,
+ renegotiate_dos_mitigate_absolute].
cipher_tests() ->
[cipher_suites,
@@ -2998,8 +2999,36 @@ renegotiate_dos_mitigate_passive(Config) when is_list(Config) ->
ssl_test_lib:close(Client).
%%--------------------------------------------------------------------
+renegotiate_dos_mitigate_absolute() ->
+ [{doc, "Mitigate DOS computational attack by not allowing client to initiate renegotiation"}].
+renegotiate_dos_mitigate_absolute(Config) when is_list(Config) ->
+ ServerOpts = ?config(server_opts, Config),
+ ClientOpts = ?config(client_opts, Config),
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Server =
+ ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, [{client_renegotiation, false} | ServerOpts]}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ renegotiate_rejected,
+ []}},
+ {options, ClientOpts}]),
+
+ ssl_test_lib:check_result(Client, ok, Server, ok),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
+
+%%--------------------------------------------------------------------
tcp_error_propagation_in_active_mode() ->
- [{doc,"Test that process recives {ssl_error, Socket, closed} when tcp error ocurres"}].
+ [{doc,"Test that process recives {ssl_error, Socket, closed} when tcp error occurs"}].
tcp_error_propagation_in_active_mode(Config) when is_list(Config) ->
ClientOpts = ?config(client_opts, Config),
ServerOpts = ?config(server_opts, Config),
@@ -3433,12 +3462,12 @@ renegotiate_reuse_session(Socket, Data) ->
renegotiate(Socket, Data).
renegotiate_immediately(Socket) ->
- receive
+ receive
{ssl, Socket, "Hello world"} ->
ok;
%% Handle 1/n-1 splitting countermeasure Rizzo/Duong-Beast
{ssl, Socket, "H"} ->
- receive
+ receive
{ssl, Socket, "ello world"} ->
ok
end
@@ -3450,6 +3479,26 @@ renegotiate_immediately(Socket) ->
ct:log("Renegotiated again"),
ssl:send(Socket, "Hello world"),
ok.
+
+renegotiate_rejected(Socket) ->
+ receive
+ {ssl, Socket, "Hello world"} ->
+ ok;
+ %% Handle 1/n-1 splitting countermeasure Rizzo/Duong-Beast
+ {ssl, Socket, "H"} ->
+ receive
+ {ssl, Socket, "ello world"} ->
+ ok
+ end
+ end,
+ {error, renegotiation_rejected} = ssl:renegotiate(Socket),
+ {error, renegotiation_rejected} = ssl:renegotiate(Socket),
+ ct:sleep(?RENEGOTIATION_DISABLE_TIME +1),
+ {error, renegotiation_rejected} = ssl:renegotiate(Socket),
+ ct:log("Failed to renegotiate again"),
+ ssl:send(Socket, "Hello world"),
+ ok.
+
new_config(PrivDir, ServerOpts0) ->
CaCertFile = proplists:get_value(cacertfile, ServerOpts0),
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index aca34cb6e9..21ce4c4a29 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -1036,7 +1036,7 @@ erlang_client_openssl_server_alpn(Config) when is_list(Config) ->
erlang_server_alpn_openssl_client(Config) when is_list(Config) ->
Data = "From openssl to erlang",
start_erlang_server_and_openssl_client_with_opts(Config,
- [{alpn_advertised_protocols, [<<"spdy/2">>]}],
+ [{alpn_preferred_protocols, [<<"spdy/2">>]}],
"",
Data, fun(Server, OpensslPort) ->
true = port_command(OpensslPort, Data),
diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile
index a4a2ed9931..d41f91250e 100644
--- a/lib/stdlib/doc/src/Makefile
+++ b/lib/stdlib/doc/src/Makefile
@@ -102,7 +102,7 @@ XML_REF3_FILES = \
XML_REF6_FILES = stdlib_app.xml
XML_PART_FILES = part.xml part_notes.xml part_notes_history.xml
-XML_CHAPTER_FILES = io_protocol.xml unicode_usage.xml notes.xml notes_history.xml
+XML_CHAPTER_FILES = io_protocol.xml unicode_usage.xml notes.xml notes_history.xml assert_hrl.xml
BOOK_FILES = book.xml
diff --git a/lib/stdlib/doc/src/assert_hrl.xml b/lib/stdlib/doc/src/assert_hrl.xml
new file mode 100644
index 0000000000..d812ee16dc
--- /dev/null
+++ b/lib/stdlib/doc/src/assert_hrl.xml
@@ -0,0 +1,160 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE fileref SYSTEM "fileref.dtd">
+
+<fileref>
+ <header>
+ <copyright>
+ <year>2012</year><year>2015</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>assert.hrl</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <file>assert.hrl</file>
+ <filesummary>Assert Macros</filesummary>
+ <description>
+ <p>The include file <c>assert.hrl</c> provides macros for inserting
+ assertions in your program code.</p>
+ <p>These macros are defined in the Stdlib include file
+ <c>assert.hrl</c>. Include the following directive in the module
+ from which the function is called:</p>
+ <code type="none">
+-include_lib("stdlib/include/assert.hrl").</code>
+ <p>When an assertion succeeds, the assert macro yields the atom
+ <c>ok</c>. When an assertion fails, an exception of type <c>error</c> is
+ instead generated. The associated error term will have the form
+ <c>{Macro, Info}</c>, where <c>Macro</c> is the name of the macro, for
+ example <c>assertEqual</c>, and <c>Info</c> will be a list of tagged
+ values such as <c>[{module, M}, {line, L}, ...]</c> giving more
+ information about the location and cause of the exception. All entries
+ in the <c>Info</c> list are optional, and you should not rely
+ programatically on any of them being present.</p>
+
+ <p>If the macro <c>NOASSERT</c> is defined when the <c>assert.hrl</c>
+ include file is read by the compiler, the macros will be defined as
+ equivalent to the atom <c>ok</c>. The test will not be performed, and
+ there will be no cost at runtime.</p>
+
+ <p>For example, using <c>erlc</c> to compile your modules, the following
+ will disable all assertions:</p>
+ <code type="none">
+erlc -DNOASSERT=true *.erl</code>
+ <p>(The value of <c>NOASSERT</c> does not matter, only the fact that it
+ is defined.)</p>
+ <p>A few other macros also have effect on the enabling or disabling of
+ assertions:</p>
+ <list type="bulleted">
+ <item>If <c>NODEBUG</c> is defined, it implies <c>NOASSERT</c>, unless
+ <c>DEBUG</c> is also defined, which is assumed to take
+ precedence.</item>
+ <item>If <c>ASSERT</c> is defined, it overrides <c>NOASSERT</c>, that
+ is, the assertions will remain enabled.</item>
+ </list>
+ <p>If you prefer, you can thus use only <c>DEBUG</c>/<c>NODEBUG</c> as
+ the main flags to control the behaviour of the assertions (which is
+ useful if you have other compiler conditionals or debugging macros
+ controlled by those flags), or you can use <c>ASSERT</c>/<c>NOASSERT</c>
+ to control only the assert macros.</p>
+
+ </description>
+
+ <section>
+ </section>
+
+ <section>
+ <title>Macros</title>
+ <taglist>
+ <tag><c>assert(BoolExpr)</c></tag>
+ <item><p>Tests that <c>BoolExpr</c> completes normally returning
+ <c>true</c>.</p>
+ </item>
+
+ <tag><c>assertNot(BoolExpr)</c></tag>
+ <item><p>Tests that <c>BoolExpr</c> completes normally returning
+ <c>false</c>.</p>
+ </item>
+
+ <tag><c>assertMatch(GuardedPattern, Expr)</c></tag>
+ <item><p>Tests that <c>Expr</c> completes normally yielding a value
+ that matches <c>GuardedPattern</c>. For example:
+ <code type="none">
+ ?assertMatch({bork, _}, f())</code></p>
+ <p>Note that a guard <c>when ...</c> can be included:
+ <code type="none">
+ ?assertMatch({bork, X} when X > 0, f())</code></p>
+ </item>
+
+ <tag><c>assertNotMatch(GuardedPattern, Expr)</c></tag>
+ <item><p>Tests that <c>Expr</c> completes normally yielding a value
+ that does not match <c>GuardedPattern</c>.</p>
+ <p>As in <c>assertMatch</c>, <c>GuardedPattern</c> can have a
+ <c>when</c> part.</p>
+ </item>
+
+ <tag><c>assertEqual(ExpectedValue, Expr)</c></tag>
+ <item><p>Tests that <c>Expr</c> completes normally yielding a value
+ that is exactly equal to <c>ExpectedValue</c>.</p>
+ </item>
+
+ <tag><c>assertNotEqual(ExpectedValue, Expr)</c></tag>
+ <item><p>Tests that <c>Expr</c> completes normally yielding a value
+ that is not exactly equal to <c>ExpectedValue</c>.</p>
+ </item>
+
+ <tag><c>assertException(Class, Term, Expr)</c></tag>
+ <item><p>Tests that <c>Expr</c> completes abnormally with an exception
+ of type <c>Class</c> and with the associated <c>Term</c>. The
+ assertion fails if <c>Expr</c> raises a different exception or if it
+ completes normally returning any value.</p>
+ <p>Note that both <c>Class</c> and <c>Term</c> can be guarded
+ patterns, as in <c>assertMatch</c>.</p>
+ </item>
+
+ <tag><c>assertNotException(Class, Term, Expr)</c></tag>
+ <item><p>Tests that <c>Expr</c> does not evaluate abnormally with an
+ exception of type <c>Class</c> and with the associated <c>Term</c>.
+ The assertion succeeds if <c>Expr</c> raises a different exception or
+ if it completes normally returning any value.</p>
+ <p>As in <c>assertException</c>, both <c>Class</c> and <c>Term</c>
+ can be guarded patterns.</p>
+ </item>
+
+ <tag><c>assertError(Term, Expr)</c></tag>
+ <item><p>Equivalent to <c>assertException(error, Term,
+ Expr)</c></p>
+ </item>
+
+ <tag><c>assertExit(Term, Expr)</c></tag>
+ <item><p>Equivalent to <c>assertException(exit, Term, Expr)</c></p>
+ </item>
+
+ <tag><c>assertThrow(Term, Expr)</c></tag>
+ <item><p>Equivalent to <c>assertException(throw, Term, Expr)</c></p>
+ </item>
+
+ </taglist>
+ </section>
+
+ <section>
+ <title>SEE ALSO</title>
+ <p><seealso marker="compiler:compile">compile(3)</seealso></p>
+ <p><seealso marker="erts:erlc">erlc(3)</seealso></p>
+ </section>
+</fileref>
diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml
index eee4a68ca1..cae62612aa 100644
--- a/lib/stdlib/doc/src/ref_man.xml
+++ b/lib/stdlib/doc/src/ref_man.xml
@@ -35,6 +35,7 @@
</description>
<xi:include href="stdlib_app.xml"/>
<xi:include href="array.xml"/>
+ <xi:include href="assert_hrl.xml"/>
<xi:include href="base64.xml"/>
<xi:include href="beam_lib.xml"/>
<xi:include href="binary.xml"/>
diff --git a/lib/stdlib/include/assert.hrl b/lib/stdlib/include/assert.hrl
new file mode 100644
index 0000000000..239d19a6dc
--- /dev/null
+++ b/lib/stdlib/include/assert.hrl
@@ -0,0 +1,260 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright (C) 2004-2014 Richard Carlsson, Mickaël Rémond
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-ifndef(ASSERT_HRL).
+-define(ASSERT_HRL, true).
+
+%% Asserts are enabled unless NOASSERT is defined, and ASSERT can be used to
+%% override it: if both ASSERT and NOASSERT are defined, then ASSERT takes
+%% precedence, and NOASSERT will become undefined.
+%%
+%% Furthermore, if NODEBUG is defined, it implies NOASSERT, unless DEBUG or
+%% ASSERT are defined.
+%%
+%% If asserts are disabled, all assert macros are defined to be the atom
+%% 'ok'. If asserts are enabled, all assert macros are defined to yield 'ok'
+%% as the result if the test succeeds, and raise an error exception if the
+%% test fails. The error term will then have the form {Name, Info} where
+%% Name is the name of the macro and Info is a list of tagged tuples.
+
+%% allow NODEBUG to imply NOASSERT, unless DEBUG
+-ifdef(NODEBUG).
+-ifndef(DEBUG).
+-ifndef(NOASSERT).
+-define(NOASSERT, true).
+-endif.
+-endif.
+-endif.
+
+%% allow ASSERT to override NOASSERT
+-ifdef(ASSERT).
+-undef(NOASSERT).
+-endif.
+
+%% Assert macros must not depend on any non-kernel or stdlib libraries.
+%%
+%% We must use fun-call wrappers ((fun () -> ... end)()) to avoid
+%% exporting local variables, and furthermore we only use variable names
+%% prefixed with "__", that hopefully will not be bound outside the fun.
+%% It is not possible to nest assert macros.
+
+-ifdef(NOASSERT).
+-define(assert(BoolExpr),ok).
+-else.
+%% The assert macro is written the way it is so as not to cause warnings
+%% for clauses that cannot match, even if the expression is a constant.
+-define(assert(BoolExpr),
+ begin
+ ((fun () ->
+ case (BoolExpr) of
+ true -> ok;
+ __V -> erlang:error({assert,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??BoolExpr)},
+ {expected, true},
+ case __V of false -> {value, __V};
+ _ -> {not_boolean,__V}
+ end]})
+ end
+ end)())
+ end).
+-endif.
+
+%% This is the inverse case of assert, for convenience.
+-ifdef(NOASSERT).
+-define(assertNot(BoolExpr),ok).
+-else.
+-define(assertNot(BoolExpr),
+ begin
+ ((fun () ->
+ case (BoolExpr) of
+ false -> ok;
+ __V -> erlang:error({assert,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??BoolExpr)},
+ {expected, false},
+ case __V of true -> {value, __V};
+ _ -> {not_boolean,__V}
+ end]})
+ end
+ end)())
+ end).
+-endif.
+
+%% This is mostly a convenience which gives more detailed reports.
+%% Note: Guard is a guarded pattern, and can not be used for value.
+-ifdef(NOASSERT).
+-define(assertMatch(Guard, Expr), ok).
+-else.
+-define(assertMatch(Guard, Expr),
+ begin
+ ((fun () ->
+ case (Expr) of
+ Guard -> ok;
+ __V -> erlang:error({assertMatch,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {pattern, (??Guard)},
+ {value, __V}]})
+ end
+ end)())
+ end).
+-endif.
+
+%% This is the inverse case of assertMatch, for convenience.
+-ifdef(NOASSERT).
+-define(assertNotMatch(Guard, Expr), ok).
+-else.
+-define(assertNotMatch(Guard, Expr),
+ begin
+ ((fun () ->
+ __V = (Expr),
+ case __V of
+ Guard -> erlang:error({assertNotMatch,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {pattern, (??Guard)},
+ {value, __V}]});
+ _ -> ok
+ end
+ end)())
+ end).
+-endif.
+
+%% This is a convenience macro which gives more detailed reports when
+%% the expected LHS value is not a pattern, but a computed value
+-ifdef(NOASSERT).
+-define(assertEqual(Expect, Expr), ok).
+-else.
+-define(assertEqual(Expect, Expr),
+ begin
+ ((fun (__X) ->
+ case (Expr) of
+ __X -> ok;
+ __V -> erlang:error({assertEqual,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {expected, __X},
+ {value, __V}]})
+ end
+ end)(Expect))
+ end).
+-endif.
+
+%% This is the inverse case of assertEqual, for convenience.
+-ifdef(NOASSERT).
+-define(assertNotEqual(Unexpected, Expr), ok).
+-else.
+-define(assertNotEqual(Unexpected, Expr),
+ begin
+ ((fun (__X) ->
+ case (Expr) of
+ __X -> erlang:error({assertNotEqual,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {value, __X}]});
+ _ -> ok
+ end
+ end)(Unexpected))
+ end).
+-endif.
+
+%% Note: Class and Term are patterns, and can not be used for value.
+%% Term can be a guarded pattern, but Class cannot.
+-ifdef(NOASSERT).
+-define(assertException(Class, Term, Expr), ok).
+-else.
+-define(assertException(Class, Term, Expr),
+ begin
+ ((fun () ->
+ try (Expr) of
+ __V -> erlang:error({assertException,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {pattern,
+ "{ "++(??Class)++" , "++(??Term)
+ ++" , [...] }"},
+ {unexpected_success, __V}]})
+ catch
+ Class:Term -> ok;
+ __C:__T ->
+ erlang:error({assertException,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {pattern,
+ "{ "++(??Class)++" , "++(??Term)
+ ++" , [...] }"},
+ {unexpected_exception,
+ {__C, __T,
+ erlang:get_stacktrace()}}]})
+ end
+ end)())
+ end).
+-endif.
+
+-define(assertError(Term, Expr), ?assertException(error, Term, Expr)).
+-define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)).
+-define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)).
+
+%% This is the inverse case of assertException, for convenience.
+%% Note: Class and Term are patterns, and can not be used for value.
+%% Both Class and Term can be guarded patterns.
+-ifdef(NOASSERT).
+-define(assertNotException(Class, Term, Expr), ok).
+-else.
+-define(assertNotException(Class, Term, Expr),
+ begin
+ ((fun () ->
+ try (Expr) of
+ _ -> ok
+ catch
+ __C:__T ->
+ case __C of
+ Class ->
+ case __T of
+ Term ->
+ erlang:error({assertNotException,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {pattern,
+ "{ "++(??Class)++" , "
+ ++(??Term)++" , [...] }"},
+ {unexpected_exception,
+ {__C, __T,
+ erlang:get_stacktrace()
+ }}]});
+ _ -> ok
+ end;
+ _ -> ok
+ end
+ end
+ end)())
+ end).
+-endif.
+
+-endif. % ASSERT_HRL
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile
index 55bda60da5..344a5dc099 100644
--- a/lib/stdlib/src/Makefile
+++ b/lib/stdlib/src/Makefile
@@ -122,6 +122,7 @@ MODULES= \
zip
HRL_FILES= \
+ ../include/assert.hrl \
../include/erl_compile.hrl \
../include/erl_bits.hrl \
../include/ms_transform.hrl \
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index 61eb34d565..d4ab674486 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -107,7 +107,8 @@ RELSYSDIR = $(RELEASE_PATH)/stdlib_test
ERL_MAKE_FLAGS +=
ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \
- -I$(ERL_TOP)/lib/kernel/include
+ -I$(ERL_TOP)/lib/kernel/include \
+ -I$(ERL_TOP)/lib/stdlib/include
EBIN = .
diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl
index 206eb4fd74..8ab30eb62b 100644
--- a/lib/stdlib/test/stdlib_SUITE.erl
+++ b/lib/stdlib/test/stdlib_SUITE.erl
@@ -30,7 +30,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [app_test, appup_test, {group,upgrade}].
+ [app_test, appup_test, assert_test, {group,upgrade}].
groups() ->
[{upgrade,[minor_upgrade,major_upgrade]}].
@@ -185,3 +185,68 @@ upgrade_upgraded(_CtData,State) ->
State.
upgrade_downgraded(_CtData,State) ->
State.
+
+
+-include_lib("stdlib/include/assert.hrl").
+-include_lib("stdlib/include/assert.hrl"). % test repeated inclusion
+assert_test(suite) ->
+ [];
+assert_test(doc) ->
+ ["Assert macros test."];
+assert_test(_Config) ->
+ ok = ?assert(true),
+ {'EXIT',{{assert, _},_}} = (catch ?assert(false)),
+ {'EXIT',{{assert, Info1},_}} = (catch ?assert(0)),
+ {not_boolean,0} = lists:keyfind(not_boolean,1,Info1),
+
+ ok = ?assertNot(false),
+ {'EXIT',{{assert, _},_}} = (catch ?assertNot(true)),
+ {'EXIT',{{assert, Info2},_}} = (catch ?assertNot(0)),
+ {not_boolean,0} = lists:keyfind(not_boolean,1,Info2),
+
+ ok = ?assertMatch({foo,_}, {foo,bar}),
+ {'EXIT',{{assertMatch,_},_}} =
+ (catch ?assertMatch({foo,_}, {foo})),
+
+ ok = ?assertMatch({foo,N} when N > 0, {foo,1}),
+ {'EXIT',{{assertMatch,_},_}} =
+ (catch ?assertMatch({foo,N} when N > 0, {foo,0})),
+
+ ok = ?assertNotMatch({foo,_}, {foo,bar,baz}),
+ {'EXIT',{{assertNotMatch,_},_}} =
+ (catch ?assertNotMatch({foo,_}, {foo,baz})),
+
+ ok = ?assertNotMatch({foo,N} when N > 0, {foo,0}),
+ {'EXIT',{{assertNotMatch,_},_}} =
+ (catch ?assertNotMatch({foo,N} when N > 0, {foo,1})),
+
+ ok = ?assertEqual(1.0, 1.0),
+ {'EXIT',{{assertEqual,_},_}} = (catch ?assertEqual(1, 1.0)),
+
+ ok = ?assertNotEqual(1, 1.0),
+ {'EXIT',{{assertNotEqual,_},_}} = (catch ?assertNotEqual(1.0, 1.0)),
+
+ ok = ?assertException(error, badarith, 1/0),
+ ok = ?assertException(exit, foo, exit(foo)),
+ ok = ?assertException(throw, foo, throw(foo)),
+ ok = ?assertException(throw, {foo,_}, throw({foo,bar})),
+ ok = ?assertException(throw, {foo,N} when N > 0, throw({foo,1})),
+ {'EXIT',{{assertException,Why1},_}} =
+ (catch ?assertException(error, badarith, 0/1)),
+ true = lists:keymember(unexpected_success,1,Why1),
+ {'EXIT',{{assertException,Why2},_}} =
+ (catch ?assertException(error, badarith, 1/length(0))),
+ true = lists:keymember(unexpected_exception,1,Why2),
+ {'EXIT',{{assertException,Why3},_}} =
+ (catch ?assertException(throw, {foo,N} when N > 0, throw({foo,0}))),
+ true = lists:keymember(unexpected_exception,1,Why3),
+
+ ok = ?assertNotException(throw, {foo,baz}, throw({foo,bar})),
+ {'EXIT',{{assertNotException,Why4},_}} =
+ (catch ?assertNotException(throw, {foo,bar}, throw({foo,bar}))),
+ true = lists:keymember(unexpected_exception,1,Why4),
+
+ ok = ?assertError(badarith, 1/0),
+ ok = ?assertExit(foo, exit(foo)),
+ ok = ?assertThrow(foo, throw(foo)),
+ ok.