diff options
Diffstat (limited to 'lib')
73 files changed, 1995 insertions, 764 deletions
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 38a2aa53ac..3d4f674160 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -24,7 +24,7 @@ -module(ct_framework). --export([init_tc/3, end_tc/4, get_suite/2, report/2, warn/1]). +-export([init_tc/3, end_tc/3, end_tc/4, get_suite/2, report/2, warn/1]). -export([error_notification/4]). -export([overview_html_header/1]). @@ -434,6 +434,9 @@ try_set_default(Name,Key,Info,Where) -> %%% %%% @doc Test server framework callback, called by the test_server %%% when a test case is finished. +end_tc(Mod, Fun, Args) -> + %% Have to keep end_tc/3 for backwards compatabilty issues + end_tc(Mod, Fun, Args, '$end_tc_dummy'). end_tc(?MODULE,error_in_suite,_, _) -> % bad start! ok; end_tc(Mod,Func,{TCPid,Result,[Args]}, Return) when is_pid(TCPid) -> diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 2a36fda1ea..5cc8252b99 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -651,10 +651,8 @@ add_warning(Term, Anno, Ws) -> warning_translate_label(Term, D) when is_tuple(Term) -> case element(1, Term) of {label,F} -> - case gb_trees:lookup(F, D) of - none -> Term; - {value,FA} -> setelement(1, Term, FA) - end; + FA = gb_trees:get(F, D), + setelement(1, Term, FA); _ -> Term end; warning_translate_label(Term, _) -> Term. diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index bb93110176..8e96569414 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -162,14 +162,11 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> %% We must split the basic block when we encounter instructions with labels, %% such as catches and BIFs. All labels must be visible outside the blocks. -%% Also remove empty blocks. split_blocks({function,Name,Arity,CLabel,Is0}) -> Is = split_blocks(Is0, []), {function,Name,Arity,CLabel,Is}. -split_blocks([{block,[]}|Is], Acc) -> - split_blocks(Is, Acc); split_blocks([{block,Bl}|Is], Acc0) -> Acc = split_block(Bl, [], Acc0), split_blocks(Is, Acc); @@ -246,30 +243,24 @@ forward([{select_val,Reg,_,{list,List}}=I|Is], D0, Lc, Acc) -> D = update_value_dict(List, Reg, D0), forward(Is, D, Lc, [I|Acc]); forward([{label,Lbl}=LblI,{block,[{set,[Dst],[Lit],move}|BlkIs]}=Blk|Is], D, Lc, Acc) -> + %% Assumption: The target labels in a select_val/3 instruction + %% cannot be reached in any other way than through the select_val/3 + %% instruction (i.e. there can be no fallthrough to such label and + %% it cannot be referenced by, for example, a jump/1 instruction). Block = case gb_trees:lookup({Lbl,Dst}, D) of - {value,Lit} -> - %% The move instruction seems to be redundant, but also make - %% sure that the instruction preceeding the label - %% cannot fall through to the move instruction. - case is_unreachable_after(Acc) of - false -> Blk; %Must keep move instruction. - true -> {block,BlkIs} %Safe to remove move instruction. - end; - _ -> Blk %Keep move instruction. + {value,Lit} -> {block,BlkIs}; %Safe to remove move instruction. + _ -> Blk %Must keep move instruction. end, forward([Block|Is], D, Lc, [LblI|Acc]); forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) -> + %% Assumption: The target labels in a select_val/3 instruction + %% cannot be reached in any other way than through the select_val/3 + %% instruction (i.e. there can be no fallthrough to such label and + %% it cannot be referenced by, for example, a jump/1 instruction). Is = case gb_trees:lookup({Lbl,Dst}, D) of - {value,Lit} -> - %% The move instruction seems to be redundant, but also make - %% sure that the instruction preceeding the label - %% cannot fall through to the move instruction. - case is_unreachable_after(Acc) of - false -> Is0; %Must keep move instruction. - true -> Is1 %Safe to remove move instruction. - end; - _ -> Is0 %Keep move instruction. - end, + {value,Lit} -> Is1; %Safe to remove move instruction. + _ -> Is0 %Keep move instruction. + end, forward(Is, D, Lc, [LblI|Acc]); forward([{test,is_eq_exact,_,[Dst,Src]}=I, {block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) -> @@ -299,16 +290,12 @@ update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> Key = {Lbl,Reg}, D = case gb_trees:lookup(Key, D0) of none -> gb_trees:insert(Key, Lit, D0); %New. - {value,Lit} -> D0; %Already correct. {value,inconsistent} -> D0; %Inconsistent. {value,_} -> gb_trees:update(Key, inconsistent, D0) end, update_value_dict(T, Reg, D); update_value_dict([], _, D) -> D. -is_unreachable_after([I|_]) -> - beam_jump:is_unreachable_after(I). - %%% %%% Scan instructions in reverse execution order and remove dead code. %%% @@ -602,16 +589,11 @@ count_bits_matched([{test,_,_,_}|Is], SavePoint, Bits) -> count_bits_matched([{bs_save2,Reg,SavePoint}|_], {Reg,SavePoint}, Bits) -> %% The save point we are looking for - we are done. Bits; -count_bits_matched([{bs_save2,_,_}|Is], SavePoint, Bits) -> - %% Another save point - keep counting. - count_bits_matched(Is, SavePoint, Bits); count_bits_matched([_|_], _, Bits) -> Bits. shortcut_bs_pos_used(To, Reg, D) -> shortcut_bs_pos_used_1(beam_utils:code_at(To, D), Reg, D). -shortcut_bs_pos_used_1([{bs_restore2,Reg,_}|_], Reg, _) -> - false; shortcut_bs_pos_used_1([{bs_context_to_binary,Reg}|_], Reg, _) -> false; shortcut_bs_pos_used_1(Is, Reg, D) -> diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index cab22e03d0..f7388f1614 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -28,7 +28,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(andor_SUITE), + test_lib:recompile(?MODULE), [t_case, t_and_or, t_andalso, t_orelse, inside, overlap, combined, in_case, before_and_inside_if]. diff --git a/lib/compiler/test/apply_SUITE.erl b/lib/compiler/test/apply_SUITE.erl index c517c4465e..25f8a8dfb5 100644 --- a/lib/compiler/test/apply_SUITE.erl +++ b/lib/compiler/test/apply_SUITE.erl @@ -28,7 +28,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(apply_SUITE), + test_lib:recompile(?MODULE), [mfa, fun_apply]. groups() -> diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index fc88ebeb41..556dc54a8f 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -46,7 +46,7 @@ end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(beam_validator_SUITE), + test_lib:recompile(?MODULE), [beam_files, compiler_bug, stupid_but_valid, xrange, yrange, stack, call_last, merge_undefined, uninit, unsafe_catch, dead_code, mult_labels, diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl index 30c04f80cf..d39e340429 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_SUITE.erl @@ -32,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_bincomp_SUITE), + test_lib:recompile(?MODULE), [byte_aligned, bit_aligned, extended_byte_aligned, extended_bit_aligned, mixed, filters, trim_coverage, nomatch, sizes, tail]. diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl index 8be0c4196a..30276f1259 100644 --- a/lib/compiler/test/bs_bit_binaries_SUITE.erl +++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl @@ -33,7 +33,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_bit_binaries_SUITE), + test_lib:recompile(?MODULE), [misc, horrid_match, test_bitstr, test_bit_size, asymmetric_tests, big_asymmetric_tests, binary_to_and_from_list, big_binary_to_and_from_list, diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index c430b12b70..31c7890f26 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -35,7 +35,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_construct_SUITE), + test_lib:recompile(?MODULE), [two, test1, fail, float_bin, in_guard, in_catch, nasty_literals, side_effect, opt, otp_7556, float_arith, otp_8054]. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 9184e14cb2..6a795f6634 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -35,7 +35,7 @@ match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1]). --export([coverage_id/1]). +-export([coverage_id/1,coverage_external_ignore/2]). -include_lib("test_server/include/test_server.hrl"). @@ -43,7 +43,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_match_SUITE), + test_lib:recompile(?MODULE), [fun_shadow, int_float, otp_5269, null_fields, wiger, bin_tail, save_restore, shadowed_size_var, partitioned_bs_match, function_clause, unit, @@ -585,13 +585,17 @@ coverage(Config) when is_list(Config) -> A+B end, 0, [a,b,c])), + ?line {<<42.0:64/float>>,float} = coverage_build(<<>>, <<42>>, float), ?line {<<>>,not_a_tuple} = coverage_build(<<>>, <<>>, not_a_tuple), ?line {<<16#76,"abc",16#A9,"abc">>,{x,42,43}} = coverage_build(<<>>, <<16#7,16#A>>, {x,y,z}), + ?line [<<2>>,<<1>>] = coverage_bc(<<1,2>>, []), + ?line {x,<<"abc">>,z} = coverage_setelement(<<2,"abc">>, {x,y,z}), ?line [42] = coverage_apply(<<42>>, [coverage_id]), + ?line 42 = coverage_external(<<42>>), ?line do_coverage_bin_to_term_list([]), ?line do_coverage_bin_to_term_list([lists:seq(0, 10),{a,b,c},<<23:42>>]), @@ -608,6 +612,10 @@ coverage_fold(Fun, Acc, <<H,T/binary>>) -> coverage_fold(Fun, Fun(IdFun(H), IdFun(Acc)), T); coverage_fold(Fun, Acc, <<>>) when is_function(Fun, 2) -> Acc. +coverage_build(Acc0, <<H,T/binary>>, float) -> + Float = id(<<H:64/float>>), + Acc = <<Acc0/binary,Float/binary>>, + coverage_build(Acc, T, float); coverage_build(Acc0, <<H,T/binary>>, Tuple0) -> Str = id(<<H:(id(4)),(H-1):4,"abc">>), Acc = id(<<Acc0/bitstring,Str/bitstring>>), @@ -618,6 +626,11 @@ coverage_build(Acc0, <<H,T/binary>>, Tuple0) -> end; coverage_build(Acc, <<>>, Tuple) -> {Acc,Tuple}. +coverage_bc(<<H,T/binary>>, Acc) -> + B = << <<C:8>> || C <- [H] >>, + coverage_bc(T, [B|Acc]); +coverage_bc(<<>>, Acc) -> Acc. + coverage_setelement(<<H,T1/binary>>, Tuple) when element(1, Tuple) =:= x -> setelement(H, Tuple, T1). @@ -625,6 +638,13 @@ coverage_apply(<<H,T/binary>>, [F|Fs]) -> [?MODULE:F(H)|coverage_apply(T, Fs)]; coverage_apply(<<>>, []) -> []. +coverage_external(<<H,T/binary>>) -> + ?MODULE:coverage_external_ignore(T, T), + H. + +coverage_external_ignore(_, _) -> + ok. + coverage_id(I) -> id(I). do_coverage_bin_to_term_list(L) -> diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl index d37943ce3a..f30a4d3fef 100644 --- a/lib/compiler/test/bs_utf_SUITE.erl +++ b/lib/compiler/test/bs_utf_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_utf_SUITE), + test_lib:recompile(?MODULE), [utf8_roundtrip, unused_utf_char, utf16_roundtrip, utf32_roundtrip, guard, extreme_tripping, literals, coverage]. diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index ba225b66d0..1343fbd1c9 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -27,7 +27,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(compilation_SUITE), + test_lib:recompile(?MODULE), [self_compile_old_inliner, self_compile, compiler_1, compiler_3, compiler_5, beam_compiler_1, beam_compiler_2, beam_compiler_3, beam_compiler_4, diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 037c078fd0..b3e5376ffd 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -40,7 +40,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. -spec all() -> all_return_type(). all() -> - test_lib:recompile(compile_SUITE), + test_lib:recompile(?MODULE), [app_test, file_1, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, other_output, package_forms, encrypted_abstr, diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index 21a5f65dee..26173c62b8 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -40,7 +40,7 @@ end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(core_SUITE), + test_lib:recompile(?MODULE), [dehydrated_itracer, nested_tries]. groups() -> diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 710751b09d..ac14d36e82 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(core_fold_SUITE), + test_lib:recompile(?MODULE), [t_element, setelement, t_length, append, t_apply, bifs, eq, nested_call_in_case, coverage]. diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index c9823665b4..6e0aadf007 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -27,7 +27,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(error_SUITE), + test_lib:recompile(?MODULE), [head_mismatch_line, warnings_as_errors, bif_clashes]. groups() -> diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl index 6738265776..afc04fd440 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -26,7 +26,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(float_SUITE), + test_lib:recompile(?MODULE), [pending, bif_calls, math_functions, mixed_float_and_int]. diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index aa9be83c82..368a5815bf 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -27,7 +27,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(fun_SUITE), + test_lib:recompile(?MODULE), [test1, overwritten_fun, otp_7202, bif_fun]. groups() -> diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 482564a32b..0e69efba6b 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -37,7 +37,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(guard_SUITE), + test_lib:recompile(?MODULE), [misc, const_cond, basic_not, complex_not, nested_nots, semicolon, complex_semicolon, comma, or_guard, more_or_guards, complex_or_guards, and_guard, xor_guard, diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index 7b9600c2f6..af2b8ec92a 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -31,7 +31,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(inline_SUITE), + test_lib:recompile(?MODULE), [attribute, bsdecode, bsdes, barnes2, decode1, smith, itracer, pseudoknot, lists, really_inlined, otp_7223, coverage]. diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index bcdcf2fd9f..c8908858ba 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(lc_SUITE), + test_lib:recompile(?MODULE), [basic, deeply_nested, no_generator, empty_generator]. groups() -> diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 04879300d1..9406d7de8f 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -22,16 +22,16 @@ init_per_group/2,end_per_group/2, pmatch/1,mixed/1,aliases/1,match_in_call/1, untuplify/1,shortcut_boolean/1,letify_guard/1, - selectify/1,underscore/1]). + selectify/1,underscore/1,coverage/1]). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(match_SUITE), + test_lib:recompile(?MODULE), [pmatch, mixed, aliases, match_in_call, untuplify, - shortcut_boolean, letify_guard, selectify, underscore]. + shortcut_boolean, letify_guard, selectify, underscore, coverage]. groups() -> []. @@ -398,4 +398,18 @@ underscore(Config) when is_list(Config) -> _ = is_list(Config), ok. +coverage(Config) when is_list(Config) -> + %% Cover beam_dead. + ok = coverage_1(x, a), + ok = coverage_1(x, b). + +coverage_1(B, Tag) -> + case Tag of + a -> coverage_2(1, a, B); + b -> coverage_2(2, b, B) + end. + +coverage_2(1, a, x) -> ok; +coverage_2(2, b, x) -> ok. + id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index f1f9b17084..c941a80e61 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -56,7 +56,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. -spec all() -> misc_SUITE_test_cases(). all() -> - test_lib:recompile(misc_SUITE), + test_lib:recompile(?MODULE), [tobias, empty_string, md5, silly_coverage, confused_literals, integer_encoding, override_bif]. diff --git a/lib/compiler/test/num_bif_SUITE.erl b/lib/compiler/test/num_bif_SUITE.erl index 0a4750dc08..3479cf5425 100644 --- a/lib/compiler/test/num_bif_SUITE.erl +++ b/lib/compiler/test/num_bif_SUITE.erl @@ -40,7 +40,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(num_bif_SUITE), + test_lib:recompile(?MODULE), [t_abs, t_float, t_float_to_list, t_integer_to_list, {group, t_list_to_float}, t_list_to_integer, t_round, t_trunc]. diff --git a/lib/compiler/test/pmod_SUITE.erl b/lib/compiler/test/pmod_SUITE.erl index 4c68d777ca..9a317b5762 100644 --- a/lib/compiler/test/pmod_SUITE.erl +++ b/lib/compiler/test/pmod_SUITE.erl @@ -28,7 +28,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(pmod_SUITE), + test_lib:recompile(?MODULE), [basic, otp_8447]. groups() -> diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 75e8045693..2a67615e5e 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -39,7 +39,7 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(receive_SUITE), + test_lib:recompile(?MODULE), [recv, coverage, otp_7980, ref_opt, export]. groups() -> diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index 65b96590ed..363422ec7e 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -26,7 +26,8 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, errors/1,record_test_2/1,record_test_3/1,record_access_in_guards/1, - guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1, nested_access/1]). + guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1, + nested_access/1,coverage/1]). init_per_testcase(_Case, Config) -> ?line Dog = test_server:timetrap(test_server:minutes(2)), @@ -40,10 +41,10 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(record_SUITE), + test_lib:recompile(?MODULE), [errors, record_test_2, record_test_3, record_access_in_guards, guard_opt, eval_once, foobar, - missing_test_heap, nested_access]. + missing_test_heap, nested_access, coverage]. groups() -> []. @@ -568,4 +569,18 @@ nested_access(Config) when is_list(Config) -> ?line N2a = N2b, ok. +-record(rr, {a,b,c}). + +coverage(Config) when is_list(Config) -> + %% There should only remain one record test in the code below. + R0 = id(#rr{a=1,b=2,c=3}), + B = R0#rr.b, %Test the record here. + R = R0#rr{c=42}, %No need to test here. + if + B > R#rr.a -> %No need to test here. + ok + end, + #rr{a=1,b=2,c=42} = id(R), %Test for correctness. + ok. + id(I) -> I. diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 92a79d3cba..c6e0f8d85d 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -31,7 +31,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(trycatch_SUITE), + test_lib:recompile(?MODULE), [basic, lean_throw, try_of, try_after, catch_oops, after_oops, eclectic, rethrow, nested_of, nested_catch, nested_after, nested_horrid, last_call_optimization, diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index dd18a6e1a3..f6a572abfa 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -54,7 +54,7 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(warnings_SUITE), + test_lib:recompile(?MODULE), [pattern, pattern2, pattern3, pattern4, guard, bad_arith, bool_cases, bad_apply, files, effect, bin_opt_info, bin_construction]. diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index b8786f6f94..3ebf62d87c 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -134,7 +134,9 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -204,7 +206,9 @@ static ErlNifFunc nif_funcs[] = { {"aes_ctr_encrypt", 3, aes_ctr_encrypt}, {"aes_ctr_decrypt", 3, aes_ctr_encrypt}, {"rand_bytes", 1, rand_bytes_1}, + {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif}, {"rand_bytes", 3, rand_bytes_3}, + {"strong_rand_mpint_nif", 3, strong_rand_mpint_nif}, {"rand_uniform_nif", 2, rand_uniform_nif}, {"mod_exp_nif", 3, mod_exp_nif}, {"dss_verify", 4, dss_verify}, @@ -704,6 +708,22 @@ static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes); return ret; } +static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Bytes) */ + unsigned bytes; + unsigned char* data; + ERL_NIF_TERM ret; + if (!enif_get_uint(env, argv[0], &bytes)) { + return enif_make_badarg(env); + } + data = enif_make_new_binary(env, bytes, &ret); + if ( RAND_bytes(data, bytes) != 1) { + return atom_false; + } + ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes); + return ret; +} + static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Bytes, TopMask, BottomMask) */ unsigned bytes; @@ -724,6 +744,47 @@ static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar } return ret; } +static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Bytes, TopMask, BottomMask) */ + unsigned bits; + BIGNUM *bn_rand; + int top, bottom; + unsigned char* data; + unsigned dlen; + ERL_NIF_TERM ret; + if (!enif_get_uint(env, argv[0], &bits) + || !enif_get_int(env, argv[1], &top) + || !enif_get_int(env, argv[2], &bottom)) { + return enif_make_badarg(env); + } + if (! (top == -1 || top == 0 || top == 1) ) { + return enif_make_badarg(env); + } + if (! (bottom == 0 || bottom == 1) ) { + return enif_make_badarg(env); + } + + bn_rand = BN_new(); + if (! bn_rand ) { + return enif_make_badarg(env); + } + + /* Get a (bits) bit random number */ + if (!BN_rand(bn_rand, bits, top, bottom)) { + ret = atom_false; + } + else { + /* Copy the bignum into an erlang mpint binary. */ + dlen = BN_num_bytes(bn_rand); + data = enif_make_new_binary(env, dlen+4, &ret); + put_int32(data, dlen); + BN_bn2bin(bn_rand, data+4); + ERL_VALGRIND_MAKE_MEM_DEFINED(data+4, dlen); + } + BN_free(bn_rand); + + return ret; +} static int get_bn_from_mpint(ErlNifEnv* env, ERL_NIF_TERM term, BIGNUM** bnp) { diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index dfafe67348..1ccea6df79 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2010</year> + <year>1999</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -619,6 +619,21 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </desc> </func> <func> + <name>strong_rand_bytes(N) -> binary()</name> + <fsummary>Generate a binary of random bytes</fsummary> + <type> + <v>N = integer()</v> + </type> + <desc> + <p>Generates N bytes randomly uniform 0..255, and returns the + result in a binary. Uses a cryptographically secure prng seeded and + periodically mixed with operating system provided entropy. By default + this is the <c>RAND_bytes</c> method from OpenSSL.</p> + <p>May throw exception <c>low_entropy</c> in case the random generator + failed due to lack of secure "randomness".</p> + </desc> + </func> + <func> <name>rand_uniform(Lo, Hi) -> N</name> <fsummary>Generate a random number</fsummary> <type> @@ -633,6 +648,31 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </desc> </func> <func> + <name>strong_rand_mpint(N, Top, Bottom) -> Mpint</name> + <fsummary>Generate an N bit random number</fsummary> + <type> + <v>N = non_neg_integer()</v> + <v>Top = -1 | 0 | 1</v> + <v>Bottom = 0 | 1</v> + <v>Mpint = binary()</v> + </type> + <desc> + <p>Generate an N bit random number using OpenSSL's + cryptographically strong pseudo random number generator + <c>BN_rand</c>.</p> + <p>The parameter <c>Top</c> places constraints on the most + significant bits of the generated number. If <c>Top</c> is 1, then the + two most significant bits will be set to 1, if <c>Top</c> is 0, the + most significant bit will be 1, and if <c>Top</c> is -1 then no + constraints are applied and thus the generated number may be less than + N bits long.</p> + <p>If <c>Bottom</c> is 1, then the generated number is + constrained to be odd.</p> + <p>May throw exception <c>low_entropy</c> in case the random generator + failed due to lack of secure "randomness".</p> + </desc> + </func> + <func> <name>mod_exp(N, P, M) -> Result</name> <fsummary>Perform N ^ P mod M</fsummary> <type> diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index 5e9bda3920..ab1ffa9e5c 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1999</year><year>2010</year> + <year>1999</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -30,6 +30,21 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 2.0.2.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Strengthened random number generation. (Thanks to Geoff Cant)</p> + <p> + Own Id: OTP-9225</p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 2.0.2.1</title> <section><title>Improvements and New Features</title> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index d6e2e033c0..cc7b3acc9c 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -46,6 +46,7 @@ -export([rsa_private_encrypt/3, rsa_public_decrypt/3]). -export([dh_generate_key/1, dh_generate_key/2, dh_compute_key/3]). -export([rand_bytes/1, rand_bytes/3, rand_uniform/2]). +-export([strong_rand_bytes/1, strong_rand_mpint/3]). -export([mod_exp/3, mpint/1, erlint/1]). %% -export([idea_cbc_encrypt/3, idea_cbc_decrypt/3]). -export([aes_cbc_128_encrypt/3, aes_cbc_128_decrypt/3]). @@ -68,6 +69,8 @@ des_ede3_cbc_encrypt, des_ede3_cbc_decrypt, aes_cfb_128_encrypt, aes_cfb_128_decrypt, rand_bytes, + strong_rand_bytes, + strong_rand_mpint, rand_uniform, mod_exp, dss_verify,dss_sign, @@ -361,12 +364,32 @@ aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% RAND - pseudo random numbers using RN_ functions in crypto lib %% -spec rand_bytes(non_neg_integer()) -> binary(). +-spec strong_rand_bytes(non_neg_integer()) -> binary(). -spec rand_uniform(crypto_integer(), crypto_integer()) -> crypto_integer(). +-spec strong_rand_mpint(Bits::non_neg_integer(), + Top::-1..1, + Bottom::0..1) -> binary(). rand_bytes(_Bytes) -> ?nif_stub. + +strong_rand_bytes(Bytes) -> + case strong_rand_bytes_nif(Bytes) of + false -> erlang:error(low_entropy); + Bin -> Bin + end. +strong_rand_bytes_nif(_Bytes) -> ?nif_stub. + rand_bytes(_Bytes, _Topmask, _Bottommask) -> ?nif_stub. +strong_rand_mpint(Bits, Top, Bottom) -> + case strong_rand_mpint_nif(Bits,Top,Bottom) of + false -> erlang:error(low_entropy); + Bin -> Bin + end. +strong_rand_mpint_nif(_Bits, _Top, _Bottom) -> ?nif_stub. + + rand_uniform(From,To) when is_binary(From), is_binary(To) -> case rand_uniform_nif(From,To) of <<Len:32/integer, MSB, Rest/binary>> when MSB > 127 -> diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index fe8f8e69a0..854a8b4485 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -46,6 +46,7 @@ aes_ctr/1, mod_exp_test/1, rand_uniform_test/1, + strong_rand_test/1, rsa_verify_test/1, dsa_verify_test/1, rsa_sign_test/1, @@ -68,7 +69,8 @@ all() -> md5_mac_io, sha, sha_update, %% sha256, sha256_update, sha512,sha512_update, des_cbc, aes_cfb, aes_cbc, - aes_cbc_iter, aes_ctr, des_cbc_iter, des_ecb, rand_uniform_test, + aes_cbc_iter, aes_ctr, des_cbc_iter, des_ecb, + rand_uniform_test, strong_rand_test, rsa_verify_test, dsa_verify_test, rsa_sign_test, dsa_sign_test, rsa_encrypt_decrypt, dh, exor_test, rc4_test, rc4_stream_test, mod_exp_test, blowfish_cfb64, @@ -710,6 +712,33 @@ rand_uniform_aux_test(N) -> %% %% +strong_rand_test(doc) -> + "strong_rand_mpint and strong_random_bytes testing"; +strong_rand_test(suite) -> + []; +strong_rand_test(Config) when is_list(Config) -> + strong_rand_aux_test(180), + ?line 10 = byte_size(crypto:strong_rand_bytes(10)). + +strong_rand_aux_test(0) -> + ?line t(crypto:strong_rand_mpint(0,0,0) =:= <<0,0,0,0>>), + ok; +strong_rand_aux_test(1) -> + ?line t(crypto:erlint(crypto:strong_rand_mpint(1,0,1)) =:= 1), + ?line strong_rand_aux_test(0); +strong_rand_aux_test(N) -> + ?line t(sru_length(crypto:strong_rand_mpint(N,-1,0)) =< N), + ?line t(sru_length(crypto:strong_rand_mpint(N,0,0)) =:= N), + ?line t(crypto:erlint(crypto:strong_rand_mpint(N,0,1)) band 1 =:= 1), + ?line t(crypto:erlint(crypto:strong_rand_mpint(N,1,0)) bsr (N - 2) =:= 2#11), + ?line strong_rand_aux_test(N-1). + +sru_length(Mpint) -> + I = crypto:erlint(Mpint), + length(erlang:integer_to_list(I, 2)). + +%% +%% %% %% rsa_verify_test(doc) -> @@ -1097,7 +1126,7 @@ worker_loop(0, _) -> ok; worker_loop(N, Config) -> Funcs = { md5, md5_update, md5_mac, md5_mac_io, sha, sha_update, des_cbc, - aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test, + aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test, strong_rand_test, rsa_verify_test, exor_test, rc4_test, rc4_stream_test, mod_exp_test }, F = element(random:uniform(size(Funcs)),Funcs), diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index e2d6fd0b37..740c68d8fa 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 2.0.2.1 +CRYPTO_VSN = 2.0.2.2 diff --git a/lib/dialyzer/doc/manual.txt b/lib/dialyzer/doc/manual.txt index 1d7a1a6222..d519ac960b 100644 --- a/lib/dialyzer/doc/manual.txt +++ b/lib/dialyzer/doc/manual.txt @@ -37,7 +37,7 @@ The parameters are: The analysis starts from .beam bytecode files. The files must be compiled with +debug_info. - Source code: - The analysis starts from .erl files. + The analysis starts from .erl files. Controlling the discrepancies reported by the Dialyzer ====================================================== @@ -131,7 +131,7 @@ Usage: dialyzer [--help] [--version] [--shell] [--quiet] [--verbose] [--check_plt] [--no_check_plt] [--plt_info] [--get_warnings] [--no_native] [--fullpath] -Options: +Options: files_or_dirs (for backwards compatibility also as: -c files_or_dirs) Use Dialyzer from the command line to detect defects in the specified files or directories containing .erl or .beam files, @@ -169,7 +169,7 @@ Options: --output_plt file Store the plt at the specified file after building it. --plt plt - Use the specified plt as the initial plt (if the plt was built + Use the specified plt as the initial plt (if the plt was built during setup the files will be checked for consistency). --plts plt* Merge the specified plts to create the initial plt -- requires @@ -204,8 +204,8 @@ Options: --add_to_plt The plt is extended to also include the files specified with -c and -r. Use --plt to specify which plt to start from, and --output_plt to - specify where to put the plt. Note that the analysis might include - files from the plt if they depend on the new files. + specify where to put the plt. Note that the analysis might include + files from the plt if they depend on the new files. This option only works with beam files. --remove_from_plt The information from the files specified with -c and -r is removed @@ -269,13 +269,13 @@ Warning options: Include warnings about behaviour callbacks which drift from the published recommended interfaces. -Wunderspecs *** - Warn about underspecified functions + Warn about underspecified functions (those whose -spec is strictly more allowing than the success typing). The following options are also available but their use is not recommended: (they are mostly for Dialyzer developers and internal debugging) -Woverspecs *** - Warn about overspecified functions + Warn about overspecified functions (those whose -spec is strictly less allowing than the success typing). -Wspecdiffs *** Warn when the -spec is different than the success typing. @@ -306,8 +306,8 @@ dialyzer:run(OptList) -> Warnings Warnings :: [{tag(), id(), msg()}] tag() :: 'warn_return_no_exit' | 'warn_return_only_exit' | 'warn_not_called' | 'warn_non_proper_list' | 'warn_fun_app' | 'warn_matching' - | 'warn_failing_call' | 'warn_contract_types' - | 'warn_contract_syntax' | 'warn_contract_not_equal' + | 'warn_failing_call' | 'warn_contract_types' + | 'warn_contract_syntax' | 'warn_contract_not_equal' | 'warn_contract_subtype' | 'warn_contract_supertype' id() :: {File :: string(), Line :: integer()} msg() :: Undefined @@ -319,24 +319,31 @@ Option :: {files, [Filename :: string()]} | {from, src_code | byte_code} %% Defaults to byte_code | {init_plt, FileName :: string()} %% If changed from default | {plts, [FileName :: string()]} %% If changed from default - | {include_dirs, [DirName :: string()]} + | {include_dirs, [DirName :: string()]} | {output_file, FileName :: string()} | {output_plt, FileName :: string()} | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'} | {warnings, [WarnOpts]} + | {get_warnings, bool()} WarnOpts :: no_return | no_unused | no_improper_lists | no_fun_app | no_match + | no_opaque | no_fail_call - | unmatched_returns | error_handling + | race_conditions + | behaviours + | unmatched_returns + | overspecs + | underspecs + | specdiffs dialyzer:format_warning({tag(), id(), msg()}) -> string() - + Returns a string representation of the warnings as returned by dialyzer:run/1. dialyzer:plt_info(string()) -> {'ok', [{atom(), any()}]} | {'error', atom()} @@ -392,7 +399,7 @@ files that depend on these files. Note that this consistency check will be performed automatically the next time you run Dialyzer with this plt. The --check_plt option is merely for doing so without doing any other analysis. - + ----------------------------------------------- -- -- Feedback & bug reports diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index b6547b11e1..4080dfdf77 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -241,7 +241,7 @@ <item>Include warnings about behaviour callbacks which drift from the published recommended interfaces.</item> <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> - <item>Warn about underspecified functions + <item>Warn about underspecified functions (the -spec is strictly more allowing than the success typing).</item> </taglist> <p>The following options are also available but their use is not @@ -249,7 +249,7 @@ debugging)</p> <taglist> <tag><c><![CDATA[-Woverspecs]]></c>***</tag> - <item>Warn about overspecified functions + <item>Warn about overspecified functions (the -spec is strictly less allowing than the success typing).</item> <tag><c><![CDATA[-Wspecdiffs]]></c>***</tag> <item>Warn when the -spec is different than the success typing.</item> @@ -278,34 +278,34 @@ <desc> <p>Dialyzer GUI version.</p> <code type="none"><![CDATA[ -OptList : [Option] -Option : {files, [Filename : string()]} - | {files_rec, [DirName : string()]} - | {defines, [{Macro: atom(), Value : term()}]} - | {from, src_code | byte_code} %% Defaults to byte_code - | {init_plt, FileName : string()} %% If changed from default - | {plts, [FileName :: string()]} %% If changed from default - | {include_dirs, [DirName : string()]} - | {output_file, FileName : string()} - | {output_plt, FileName :: string()} - | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'} - | {warnings, [WarnOpts]} - | {get_warnings, bool()} +OptList :: [Option] +Option :: {files, [Filename :: string()]} + | {files_rec, [DirName :: string()]} + | {defines, [{Macro: atom(), Value : term()}]} + | {from, src_code | byte_code} %% Defaults to byte_code + | {init_plt, FileName :: string()} %% If changed from default + | {plts, [FileName :: string()]} %% If changed from default + | {include_dirs, [DirName :: string()]} + | {output_file, FileName :: string()} + | {output_plt, FileName :: string()} + | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'} + | {warnings, [WarnOpts]} + | {get_warnings, bool()} -WarnOpts : no_return - | no_unused - | no_improper_lists - | no_fun_app - | no_match - | no_opaque - | no_fail_call - | error_handling - | race_conditions - | behaviours - | unmatched_returns - | overspecs - | underspecs - | specdiffs +WarnOpts :: no_return + | no_unused + | no_improper_lists + | no_fun_app + | no_match + | no_opaque + | no_fail_call + | error_handling + | race_conditions + | behaviours + | unmatched_returns + | overspecs + | underspecs + | specdiffs ]]></code> </desc> </func> @@ -320,12 +320,12 @@ WarnOpts : no_return <p>Dialyzer command line version.</p> <code type="none"><![CDATA[ Warnings :: [{Tag, Id, Msg}] -Tag : 'warn_return_no_exit' | 'warn_return_only_exit' - | 'warn_not_called' | 'warn_non_proper_list' - | 'warn_fun_app' | 'warn_matching' - | 'warn_failing_call' | 'warn_contract_types' - | 'warn_contract_syntax' | 'warn_contract_not_equal' - | 'warn_contract_subtype' | 'warn_contract_supertype' +Tag :: 'warn_return_no_exit' | 'warn_return_only_exit' + | 'warn_not_called' | 'warn_non_proper_list' + | 'warn_fun_app' | 'warn_matching' + | 'warn_failing_call' | 'warn_contract_types' + | 'warn_contract_syntax' | 'warn_contract_not_equal' + | 'warn_contract_subtype' | 'warn_contract_supertype' Id = {File :: string(), Line :: integer()} Msg = msg() -- Undefined ]]></code> diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index 24d6013692..b8da57d3f9 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -155,19 +155,24 @@ postprocess_dataflow_warns(RawWarnings, State, WarnAcc) -> postprocess_dataflow_warns([], _State, WAcc, Acc) -> {WAcc, lists:reverse(Acc)}; -postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {File, CallL}, Msg}|Rest], +postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {CallF, CallL}, Msg}|Rest], #st{codeserver = Codeserver} = State, WAcc, Acc) -> {contract_range, [Contract, M, F, A, ArgStrings, CRet]} = Msg, - {ok, {{File, _ContrL} = FileLine, _C}} = + {ok, {{ContrF, _ContrL} = FileLine, _C}} = dialyzer_codeserver:lookup_mfa_contract({M,F,A}, Codeserver), - NewMsg = - {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]}, - W = {?WARN_CONTRACT_RANGE, FileLine, NewMsg}, - Filter = - fun({?WARN_CONTRACT_TYPES, FL, _}) when FL =:= FileLine -> false; - (_) -> true - end, - postprocess_dataflow_warns(Rest, State, lists:filter(Filter, WAcc), [W|Acc]); + case CallF =:= ContrF of + true -> + NewMsg = {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]}, + W = {?WARN_CONTRACT_RANGE, FileLine, NewMsg}, + Filter = + fun({?WARN_CONTRACT_TYPES, FL, _}) when FL =:= FileLine -> false; + (_) -> true + end, + FilterWAcc = lists:filter(Filter, WAcc), + postprocess_dataflow_warns(Rest, State, FilterWAcc, [W|Acc]); + false -> + postprocess_dataflow_warns(Rest, State, WAcc, Acc) + end; postprocess_dataflow_warns([W|Rest], State, Wacc, Acc) -> postprocess_dataflow_warns(Rest, State, Wacc, [W|Acc]). diff --git a/lib/dialyzer/test/small_tests_SUITE.erl b/lib/dialyzer/test/small_tests_SUITE.erl index 21a2c76160..dbcc044eea 100644 --- a/lib/dialyzer/test/small_tests_SUITE.erl +++ b/lib/dialyzer/test/small_tests_SUITE.erl @@ -18,18 +18,18 @@ contract5/1, disj_norm_form/1, eqeq/1, ets_select/1, exhaust_case/1, failing_guard1/1, flatten/1, fun_app/1, fun_ref_match/1, fun_ref_record/1, gencall/1, gs_make/1, - inf_loop2/1, letrec1/1, list_match/1, lzip/1, make_tuple/1, - minus_minus/1, mod_info/1, my_filter/1, my_sofs/1, no_match/1, - no_unused_fun/1, no_unused_fun2/1, non_existing/1, - not_guard_crash/1, or_bug/1, orelsebug/1, orelsebug2/1, - overloaded1/1, port_info_test/1, process_info_test/1, pubsub/1, - receive1/1, record_construct/1, record_pat/1, - record_send_test/1, record_test/1, recursive_types1/1, - recursive_types2/1, recursive_types3/1, recursive_types4/1, - recursive_types5/1, recursive_types6/1, recursive_types7/1, - refine_bug1/1, toth/1, trec/1, try1/1, tuple1/1, - unsafe_beamcode_bug/1, unused_cases/1, unused_clauses/1, - zero_tuple/1]). + inf_loop2/1, invalid_specs/1, letrec1/1, list_match/1, lzip/1, + make_tuple/1, minus_minus/1, mod_info/1, my_filter/1, + my_sofs/1, no_match/1, no_unused_fun/1, no_unused_fun2/1, + non_existing/1, not_guard_crash/1, or_bug/1, orelsebug/1, + orelsebug2/1, overloaded1/1, port_info_test/1, + process_info_test/1, pubsub/1, receive1/1, record_construct/1, + record_pat/1, record_send_test/1, record_test/1, + recursive_types1/1, recursive_types2/1, recursive_types3/1, + recursive_types4/1, recursive_types5/1, recursive_types6/1, + recursive_types7/1, refine_bug1/1, toth/1, trec/1, try1/1, + tuple1/1, unsafe_beamcode_bug/1, unused_cases/1, + unused_clauses/1, zero_tuple/1]). suite() -> [{timetrap, {minutes, 1}}]. @@ -51,10 +51,10 @@ all() -> atom_guard,atom_widen,bs_fail_constr,bs_utf8,cerl_hipeify,comm_layer, compare1,confusing_warning,contract2,contract3,contract5,disj_norm_form, eqeq,ets_select,exhaust_case,failing_guard1,flatten,fun_app,fun_ref_match, - fun_ref_record,gencall,gs_make,inf_loop2,letrec1,list_match,lzip, - make_tuple,minus_minus,mod_info,my_filter,my_sofs,no_match,no_unused_fun, - no_unused_fun2,non_existing,not_guard_crash,or_bug,orelsebug,orelsebug2, - overloaded1,port_info_test,process_info_test,pubsub,receive1, + fun_ref_record,gencall,gs_make,inf_loop2,invalid_specs,letrec1,list_match, + lzip,make_tuple,minus_minus,mod_info,my_filter,my_sofs,no_match, + no_unused_fun,no_unused_fun2,non_existing,not_guard_crash,or_bug,orelsebug, + orelsebug2,overloaded1,port_info_test,process_info_test,pubsub,receive1, record_construct,record_pat,record_send_test,record_test,recursive_types1, recursive_types2,recursive_types3,recursive_types4,recursive_types5, recursive_types6,recursive_types7,refine_bug1,toth,trec,try1,tuple1, @@ -235,6 +235,12 @@ inf_loop2(Config) -> Error -> ct:fail(Error) end. +invalid_specs(Config) -> + case dialyze(Config, invalid_specs) of + 'same' -> 'same'; + Error -> ct:fail(Error) + end. + letrec1(Config) -> case dialyze(Config, letrec1) of 'same' -> 'same'; diff --git a/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs b/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs new file mode 100644 index 0000000000..c95c0ff1f8 --- /dev/null +++ b/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs @@ -0,0 +1,3 @@ + +invalid_spec1.erl:5: Invalid type specification for function invalid_spec1:get_plan_dirty/1. The success typing is ([string()]) -> {maybe_improper_list(),[atom()]} +invalid_spec2.erl:5: Function foo/0 has no local return diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl new file mode 100644 index 0000000000..06ab2f9a22 --- /dev/null +++ b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl @@ -0,0 +1,28 @@ +-module(invalid_spec1). + +-export([get_plan_dirty/1]). + +-spec get_plan_dirty([string()]) -> {{atom(), any()}, [atom()]}. + +get_plan_dirty(ClassL) -> + get_plan_dirty(ClassL, [], []). + +get_plan_dirty([], Res, FoundClassList) -> + {Res,FoundClassList}; +get_plan_dirty([Class|ClassL], Res, FoundClassList) -> + ClassPlan = list_to_atom(Class ++ "_plan"), + case catch mnesia:dirty_all_keys(ClassPlan) of + {'EXIT',_} -> + get_plan_dirty(ClassL, Res, FoundClassList); + [] -> + get_plan_dirty(ClassL, Res, FoundClassList); + KeyL -> + ClassAtom = list_to_atom(Class), + Res2 = + lists:foldl(fun(Key, Acc) -> + [{ClassAtom,Key}|Acc] + end, + Res, + KeyL), + get_plan_dirty(ClassL, Res2, [ClassAtom|FoundClassList]) + end. diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl new file mode 100644 index 0000000000..e49f73d014 --- /dev/null +++ b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl @@ -0,0 +1,11 @@ +-module(invalid_spec2). + +-export([foo/0]). + +foo() -> + case + invalid_spec1:get_plan_dirty(mnesia:dirty_all_keys(cmClassInfo)) + of + {[],[]} -> foo; + { _, _} -> bar + end. diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index 4751f1094a..45d2387e7b 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -33,7 +33,7 @@ -export([dlist_next/1, uniq/1, fun_parent/1, is_string/1, command/1, command/2, command/3, trie_new/0, trie_store/2, trie_match/2, split_node/1, consult_file/1, list_dir/1, format_exit_term/1, - format_exception/1, format_error/1]). + format_exception/1, format_exception/2, format_error/1]). %% Type definitions for describing exceptions @@ -55,21 +55,23 @@ %% --------------------------------------------------------------------- %% Formatting of error descriptors +format_exception(Exception) -> + format_exception(Exception, 20). -format_exception({Class,Term,Trace}) +format_exception({Class,Term,Trace}, Depth) when is_atom(Class), is_list(Trace) -> case is_stacktrace(Trace) of true -> io_lib:format("~w:~P\n~s", - [Class, Term, 20, format_stacktrace(Trace)]); + [Class, Term, Depth, format_stacktrace(Trace)]); false -> - format_term(Term) + format_term(Term, Depth) end; -format_exception(Term) -> - format_term(Term). +format_exception(Term, Depth) -> + format_term(Term, Depth). -format_term(Term) -> - io_lib:format("~P\n", [Term, 15]). +format_term(Term, Depth) -> + io_lib:format("~P\n", [Term, Depth]). format_exit_term(Term) -> {Reason, Trace} = analyze_exit_term(Term), diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl index eb994a990a..f289cd724a 100644 --- a/lib/eunit/src/eunit_surefire.erl +++ b/lib/eunit/src/eunit_surefire.erl @@ -323,7 +323,7 @@ write_testcase( format_testcase_result(ok) -> [<<>>]; format_testcase_result({failed, {error, {Type, _}, _} = Exception}) when is_atom(Type) -> [?INDENT, ?INDENT, <<"<failure type=\"">>, escape_attr(atom_to_list(Type)), <<"\">">>, ?NEWLINE, - <<"::">>, escape_text(eunit_lib:format_exception(Exception)), + <<"::">>, escape_text(eunit_lib:format_exception(Exception, 100)), ?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE]; format_testcase_result({failed, Term}) -> [?INDENT, ?INDENT, <<"<failure type=\"unknown\">">>, ?NEWLINE, @@ -331,7 +331,7 @@ format_testcase_result({failed, Term}) -> ?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE]; format_testcase_result({aborted, {Class, _Term, _Trace} = Exception}) when is_atom(Class) -> [?INDENT, ?INDENT, <<"<error type=\"">>, escape_attr(atom_to_list(Class)), <<"\">">>, ?NEWLINE, - <<"::">>, escape_text(eunit_lib:format_exception(Exception)), + <<"::">>, escape_text(eunit_lib:format_exception(Exception, 100)), ?INDENT, ?INDENT, <<"</error>">>, ?NEWLINE]; format_testcase_result({aborted, Term}) -> [?INDENT, ?INDENT, <<"<error type=\"unknown\">">>, ?NEWLINE, diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl index de0f23bf24..93563c6011 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -539,27 +539,41 @@ udp_send(#sock{inet=I}, {A,B,C,D}=IP, Port, Buffer) when ?ip(A,B,C,D), ?port(Port) -> gen_udp:send(I, IP, Port, Buffer). -udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout) +udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout, Decode) when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> - do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout); -udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout) + do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout); +udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout, Decode) when ?ip(A,B,C,D), ?port(Port) -> - do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout). - -do_udp_recv(Recv, IP, Port, Timeout) -> - do_udp_recv(Recv, IP, Port, Timeout, - if Timeout =/= 0 -> erlang:now(); true -> undefined end). - -do_udp_recv(Recv, IP, Port, Timeout, Then) -> - case Recv(Timeout) of - {ok,{IP,Port,Answer}} -> - {ok,Answer,erlang:max(0, Timeout - now_ms(erlang:now(), Then))}; - {ok,_} when Timeout =:= 0 -> - {error,timeout}; - {ok,_} -> - Now = erlang:now(), - T = erlang:max(0, Timeout - now_ms(Now, Then)), - do_udp_recv(Recv, IP, Port, T, Now); + do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout). + +do_udp_recv(_I, _IP, _Port, 0, _Decode, _Start, _T) -> + timeout; +do_udp_recv(I, IP, Port, Timeout, Decode, Start, T) -> + case gen_udp:recv(I, 0, T) of + {ok,Reply} -> + case Decode(Reply) of + false when T =:= 0 -> + %% This is a compromize between the hard way i.e + %% in the clause below if NewT becomes 0 bailout + %% immediately and risk that the right reply lies + %% ahead after some bad id replies, and the + %% forgiving way i.e go on with Timeout 0 until + %% the right reply comes or no reply (timeout) + %% which opens for a DOS attack by a malicious + %% DNS server flooding with bad id replies causing + %% an infinite loop here. + %% + %% Timeout is used as a sanity limit counter + %% just to put an end to the loop. + NewTimeout = erlang:max(0, Timeout - 50), + do_udp_recv(I, IP, Port, NewTimeout, Decode, Start, T); + false -> + Now = erlang:now(), + NewT = erlang:max(0, Timeout - now_ms(Now, Start)), + do_udp_recv(I, IP, Port, Timeout, Decode, Start, NewT); + Result -> + Result + end; Error -> Error end. @@ -580,6 +594,17 @@ udp_close(#sock{inet=I,inet6=I6}) -> %% end %% end %% +%% But that man page also says dig always use num_servers = 1. +%% +%% Our man page says: timeout/retry, then double for next retry, i.e +%% for i = 0 to retry - 1 +%% foreach nameserver +%% send query +%% wait((time * (2**i)) / retry) +%% end +%% end +%% +%% And that is what the code seems to do, now fixed, hopefully... do_query(_Q, [], _Timer) -> {error,nxdomain}; @@ -589,19 +614,16 @@ do_query(#q{options=#options{retry=Retry}}=Q, NSs, Timer) -> query_retries(_Q, _NSs, _Timer, Retry, Retry, S) -> udp_close(S), {error,timeout}; +query_retries(_Q, [], _Timer, _Retry, _I, S) -> + udp_close(S), + {error,timeout}; query_retries(Q, NSs, Timer, Retry, I, S0) -> - Num = length(NSs), - if Num =:= 0 -> - udp_close(S0), - {error,timeout}; - true -> - case query_nss(Q, NSs, Timer, Retry, I, S0, []) of - {S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers - query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S); - {S,Result} -> - udp_close(S), - Result - end + case query_nss(Q, NSs, Timer, Retry, I, S0, []) of + {S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers + query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S); + {S,Result} -> + udp_close(S), + Result end. query_nss(_Q, [], _Timer, _Retry, _I, S, ErrNSs) -> @@ -611,13 +633,13 @@ query_nss(#q{edns=undefined}=Q, NSs, Timer, Retry, I, S, ErrNSs) -> query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs) -> query_nss_edns(Q, NSs, Timer, Retry, I, S, ErrNSs). -query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options, - edns={Id,Buffer}}=Q, - [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) -> - {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer, - Retry, I, Options, PSz), +query_nss_edns( + #q{options=#options{udp_payload_size=PSz}=Options,edns={Id,Buffer}}=Q, + [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) -> + {S,Res}=Reply = + query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I, Options, PSz), case Res of - timeout -> {S,{error,timeout}}; + timeout -> {S,{error,timeout}}; % Bailout timeout {ok,_} -> Reply; {error,{nxdomain,_}} -> Reply; {error,{E,_}} when E =:= qfmterror; E =:= notimp; E =:= servfail; @@ -629,17 +651,19 @@ query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options, query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs) end. -query_nss_dns(#q{dns=Qdns}=Q0, [{IP,Port}=NS|NSs], - Timer, Retry, I, S0, ErrNSs) -> +query_nss_dns( + #q{dns=Qdns}=Q0, + [{IP,Port}=NS|NSs], Timer, Retry, I, S0, ErrNSs) -> #q{options=Options,dns={Id,Buffer}}=Q = if is_function(Qdns, 0) -> Q0#q{dns=Qdns()}; true -> Q0 end, - {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer, - Retry, I, Options, ?PACKETSZ), + {S,Res}=Reply = + query_ns( + S0, Id, Buffer, IP, Port, Timer, Retry, I, Options, ?PACKETSZ), case Res of - timeout -> {S,{error,timeout}}; + timeout -> {S,{error,timeout}}; % Bailout timeout {ok,_} -> Reply; {error,{E,_}} when E =:= nxdomain; E =:= qfmterror -> Reply; {error,E} when E =:= fmt; E =:= enetunreach; E =:= econnrefused -> @@ -653,48 +677,66 @@ query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I, PSz) -> case UseVC orelse iolist_size(Buffer) > PSz of true -> - {S0,query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose)}; + TcpTimeout = inet:timeout(Tm*5, Timer), + {S0,query_tcp(TcpTimeout, Id, Buffer, IP, Port, Verbose)}; false -> case udp_open(S0, IP) of {ok,S} -> - {S,case query_udp(S, Id, Buffer, IP, Port, Timer, - Retry, I, Tm, Verbose) of - {ok,#dns_rec{header=H}} when H#dns_header.tc -> - query_tcp(Tm, Id, Buffer, - IP, Port, Timer, Verbose); - Reply -> Reply - end}; + Timeout = + inet:timeout( (Tm * (1 bsl I)) div Retry, Timer), + {S, + case query_udp( + S, Id, Buffer, IP, Port, Timeout, Verbose) of + {ok,#dns_rec{header=H}} when H#dns_header.tc -> + TcpTimeout = inet:timeout(Tm*5, Timer), + query_tcp( + TcpTimeout, Id, Buffer, IP, Port, Verbose); + Reply -> Reply + end}; Error -> {S0,Error} end end. -query_udp(S, Id, Buffer, IP, Port, Timer, Retry, I, Tm, Verbose) -> - Timeout = inet:timeout( (Tm * (1 bsl I)) div Retry, Timer), +query_udp(_S, _Id, _Buffer, _IP, _Port, 0, Verbose) -> + timeout; +query_udp(S, Id, Buffer, IP, Port, Timeout, Verbose) -> ?verbose(Verbose, "Try UDP server : ~p:~p (timeout=~w)\n", - [IP, Port, Timeout]), - udp_connect(S, IP, Port), - udp_send(S, IP, Port, Buffer), - query_udp_recv(S, IP, Port, Id, Timeout, Verbose). - -query_udp_recv(S, IP, Port, Id, Timeout, Verbose) -> - case udp_recv(S, IP, Port, Timeout) of - {ok,Answer,T} -> - case decode_answer(Answer, Id, Verbose) of - {error, badid} -> - query_udp_recv(S, IP, Port, Id, T, Verbose); - Reply -> Reply + [IP,Port,Timeout]), + case + case udp_connect(S, IP, Port) of + ok -> + udp_send(S, IP, Port, Buffer); + E1 -> + E1 end of + ok -> + Decode = + fun ({RecIP,RecPort,Answer}) + when RecIP =:= IP, RecPort =:= Port -> + case decode_answer(Answer, Id, Verbose) of + {error,badid} -> + false; + Reply -> + Reply + end; + ({_,_,_}) -> + false + end, + case udp_recv(S, IP, Port, Timeout, Decode) of + {ok,_}=Result -> + Result; + E2 -> + ?verbose(Verbose, "UDP server error: ~p\n", [E2]), + E2 end; - {error, timeout} when Timeout =:= 0 -> - ?verbose(Verbose, "UDP server timeout\n", []), - timeout; - Error -> - ?verbose(Verbose, "UDP server error: ~p\n", [Error]), - Error + E3 -> + ?verbose(Verbose, "UDP send failed: ~p\n", [E3]), + {error,econnrefused} end. -query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) -> - Timeout = inet:timeout(Tm*5, Timer), +query_tcp(0, _Id, _Buffer, _IP, _Port, Verbose) -> + timeout; +query_tcp(Timeout, Id, Buffer, IP, Port, Verbose) -> ?verbose(Verbose, "Try TCP server : ~p:~p (timeout=~w)\n", [IP, Port, Timeout]), Family = case IP of @@ -716,19 +758,10 @@ query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) -> end; Error -> gen_tcp:close(S), - case Error of - {error, timeout} when Timeout =:= 0 -> - ?verbose(Verbose, "TCP server recv timeout\n", []), - timeout; - _ -> - ?verbose(Verbose, "TCP server recv error: ~p\n", - [Error]), - Error - end + ?verbose(Verbose, "TCP server recv error: ~p\n", + [Error]), + Error end; - {error, timeout} when Timeout =:= 0 -> - ?verbose(Verbose, "TCP server connect timeout\n", []), - timeout; Error -> ?verbose(Verbose, "TCP server error: ~p\n", [Error]), Error diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index 49a02359b0..5228d4fe01 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -1249,7 +1249,7 @@ protocol_childspecs([H|T]) -> epmd_module() -> case init:get_argument(epmd_module) of {ok,[[Module]]} -> - Module; + list_to_atom(Module); _ -> erl_epmd end. diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 043c753cf8..233e438dc9 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -22,7 +22,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, start/1, restart/1, - reboot/1, set_cmd/1, clear_cmd/1, + reboot/1, set_cmd/1, clear_cmd/1, get_cmd/1, dont_drop/1, kill_pid/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -58,7 +58,7 @@ end_per_testcase(_Func, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [start, restart, reboot, set_cmd, clear_cmd, kill_pid]. + [start, restart, reboot, set_cmd, clear_cmd, get_cmd, kill_pid]. groups() -> []. @@ -246,6 +246,15 @@ clear_cmd(Config) when is_list(Config) -> end, ok. +get_cmd(suite) -> []; +get_cmd(Config) when is_list(Config) -> + ?line {ok, Node} = start_check(slave, heart_test), + Cmd = "test", + ?line ok = rpc:call(Node, heart, set_cmd, [Cmd]), + ?line {ok, Cmd} = rpc:call(Node, heart, get_cmd, []), + stop_node(Node), + ok. + dont_drop(suite) -> %%% Removed as it may crash epmd/distribution in colourful %%% ways. While we ARE finding out WHY, it would diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index 5fc8df475d..6064a9b2d9 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -27,7 +27,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2, end_per_testcase/2]). --export([basic/1, resolve/1, edns0/1, txt_record/1, files_monitor/1]). +-export([basic/1, resolve/1, edns0/1, txt_record/1, files_monitor/1, + last_ms_answer/1]). -export([ gethostbyaddr/0, gethostbyaddr/1, gethostbyaddr_v6/0, gethostbyaddr_v6/1, @@ -45,6 +46,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [basic, resolve, edns0, txt_record, files_monitor, + last_ms_answer, gethostbyaddr, gethostbyaddr_v6, gethostbyname, gethostbyname_v6, getaddr, getaddr_v6, ipv4_to_ipv6, host_and_addr]. @@ -64,16 +66,15 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. -zone_dir(basic) -> - otptest; -zone_dir(resolve) -> - otptest; -zone_dir(edns0) -> - otptest; -zone_dir(files_monitor) -> - otptest; -zone_dir(_) -> - undefined. +zone_dir(TC) -> + case TC of + basic -> otptest; + resolve -> otptest; + edns0 -> otptest; + files_monitor -> otptest; + last_ms_answer -> otptest; + _ -> undefined + end. init_per_testcase(Func, Config) -> PrivDir = ?config(priv_dir, Config), @@ -184,6 +185,88 @@ ns_printlog(Fname) -> ok end. +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Behaviour modifying nameserver proxy + +proxy_start(TC, {NS,P}) -> + Tag = make_ref(), + Parent = self(), + Pid = + spawn_link( + fun () -> + try proxy_start(TC, NS, P, Parent, Tag) + catch C:X -> + io:format( + "~w: ~w:~p ~p~n", + [self(),C,X,erlang:get_stacktrace()]) + end + end), + receive {started,Tag,Port} -> + ProxyNS = {{127,0,0,1},Port}, + {proxy,Pid,Tag,ProxyNS} + end. + +proxy_start(TC, NS, P, Parent, Tag) -> + {ok,Outbound} = gen_udp:open(0, [binary]), + ok = gen_udp:connect(Outbound, NS, P), + {ok,Inbound} = gen_udp:open(0, [binary]), + {ok,Port} = inet:port(Inbound), + Parent ! {started,Tag,Port}, + proxy(TC, Outbound, NS, P, Inbound). + + +%% To provoke the last_ms_answer bug (OTP-9221) the proxy +%% * Relays the query to the right nameserver +%% * Intercepts the reply but holds it until the timer that +%% was started when receiving the query fires. +%% * Repeats the reply with incorrect query ID a number of +%% times with a short interval. +%% * Sends the correct reply, to give a correct test result +%% after bug correction. +%% +%% The repetition of an incorrect answer with tight interval will keep +%% inet_res in an inner loop in the code that decrements the remaining +%% time until it hits 0 which triggers a crash, if the outer timeout +%% parameter to inet_res:resolve is so short that it runs out during +%% these repetitions. +proxy(last_ms_answer, Outbound, NS, P, Inbound) -> + receive + {udp,Inbound,SrcIP,SrcPort,Data} -> + Time = + inet_db:res_option(timeout) div inet_db:res_option(retry), + Tag = erlang:make_ref(), + erlang:send_after(Time - 10, self(), {time,Tag}), + ok = gen_udp:send(Outbound, NS, P, Data), + receive + {udp,Outbound,NS,P,Reply} -> + {ok,Msg} = inet_dns:decode(Reply), + Hdr = inet_dns:msg(Msg, header), + Id = inet_dns:header(Hdr, id), + BadHdr = + inet_dns:make_header(Hdr, id, (Id+1) band 16#ffff), + BadMsg = inet_dns:make_msg(Msg, header, BadHdr), + BadReply = inet_dns:encode(BadMsg), + receive + {time,Tag} -> + proxy__last_ms_answer( + Inbound, SrcIP, SrcPort, BadReply, Reply, 30) + end + end + end. + +proxy__last_ms_answer(Socket, IP, Port, _, Reply, 0) -> + ok = gen_udp:send(Socket, IP, Port, Reply); +proxy__last_ms_answer(Socket, IP, Port, BadReply, Reply, N) -> + ok = gen_udp:send(Socket, IP, Port, BadReply), + receive after 1 -> ok end, + proxy__last_ms_answer(Socket, IP, Port, BadReply, Reply, N-1). + +proxy_wait({proxy,Pid,_,_}) -> + Mref = erlang:monitor(process, Pid), + receive {'DOWN',Mref,_,_,_} -> ok end. + +proxy_ns({proxy,_,_,ProxyNS}) -> ProxyNS. + %% %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -204,7 +287,7 @@ basic(Config) when is_list(Config) -> {ok,Msg1} = inet_dns:decode(Bin1), %% %% resolve - {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]}]), + {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]},verbose]), io:format("~p~n", [Msg2]), [RR2] = inet_dns:msg(Msg2, anlist), IP = inet_dns:rr(RR2, data), @@ -474,6 +557,26 @@ do_files_monitor(Config) -> ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +last_ms_answer(doc) -> + ["Answer just when timeout is triggered (OTP-9221)"]; +last_ms_answer(Config) when is_list(Config) -> + NS = ns(Config), + Name = "ns.otptest", + %%IP = {127,0,0,254}, + Time = inet_db:res_option(timeout) div inet_db:res_option(retry), + PSpec = proxy_start(last_ms_answer, NS), + ProxyNS = proxy_ns(PSpec), + %% + %% resolve; whith short timeout to trigger Timeout =:= 0 in inet_res + {error,timeout} = + inet_res:resolve( + Name, in, a, [{nameservers,[ProxyNS]},verbose], Time + 10), + %% + proxy_wait(PSpec), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Compatibility tests. Call the inet_SUITE tests, but with %% lookup = [file,dns] instead of [native] diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl index 3340f7ee72..3ee1df759f 100644 --- a/lib/os_mon/src/disksup.erl +++ b/lib/os_mon/src/disksup.erl @@ -103,6 +103,7 @@ init([]) -> Flavor==darwin; Flavor==linux; Flavor==openbsd; + Flavor==netbsd; Flavor==irix64; Flavor==irix -> start_portprogram(); @@ -267,6 +268,9 @@ check_disk_space({unix, freebsd}, Port, Threshold) -> check_disk_space({unix, openbsd}, Port, Threshold) -> Result = my_cmd("/bin/df -k -t ffs", Port), check_disks_solaris(skip_to_eol(Result), Threshold); +check_disk_space({unix, netbsd}, Port, Threshold) -> + Result = my_cmd("/bin/df -k -t ffs", Port), + check_disks_solaris(skip_to_eol(Result), Threshold); check_disk_space({unix, sunos4}, Port, Threshold) -> Result = my_cmd("df", Port), check_disks_solaris(skip_to_eol(Result), Threshold); diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl index 822e1f939c..cc4941ee7d 100644 --- a/lib/os_mon/src/memsup.erl +++ b/lib/os_mon/src/memsup.erl @@ -176,9 +176,11 @@ init([]) -> PortMode = case OS of {unix, darwin} -> false; {unix, freebsd} -> false; + {unix, dragonfly} -> false; % Linux supports this. {unix, linux} -> true; {unix, openbsd} -> true; + {unix, netbsd} -> true; {unix, irix64} -> true; {unix, irix} -> true; {unix, sunos} -> true; @@ -610,8 +612,10 @@ code_change(Vsn, PrevState, "1.8") -> PortMode = case OS of {unix, darwin} -> false; {unix, freebsd} -> false; + {unix, dragonfly} -> false; {unix, linux} -> false; {unix, openbsd} -> true; + {unix, netbsd} -> true; {unix, sunos} -> true; {win32, _OSname} -> false; vxworks -> true @@ -687,6 +691,7 @@ get_os_wordsize({unix, linux}) -> get_os_wordsize_with_uname(); get_os_wordsize({unix, darwin}) -> get_os_wordsize_with_uname(); get_os_wordsize({unix, netbsd}) -> get_os_wordsize_with_uname(); get_os_wordsize({unix, freebsd}) -> get_os_wordsize_with_uname(); +get_os_wordsize({unix, dragonfly}) -> get_os_wordsize_with_uname(); get_os_wordsize({unix, openbsd}) -> get_os_wordsize_with_uname(); get_os_wordsize(_) -> unsupported_os. @@ -736,7 +741,7 @@ get_memory_usage({unix,darwin}) -> %% FreeBSD: Look in /usr/include/sys/vmmeter.h for the format of struct %% vmmeter -get_memory_usage({unix,freebsd}) -> +get_memory_usage({unix,OSname}) when OSname == freebsd; OSname == dragonfly -> PageSize = freebsd_sysctl("vm.stats.vm.v_page_size"), PageCount = freebsd_sysctl("vm.stats.vm.v_page_count"), FreeCount = freebsd_sysctl("vm.stats.vm.v_free_count"), @@ -779,6 +784,9 @@ get_ext_memory_usage(OS, {Alloc, Total}) -> {unix, freebsd} -> [{total_memory, Total}, {free_memory, Total-Alloc}, {system_total_memory, Total}]; + {unix, dragonfly} -> + [{total_memory, Total}, {free_memory, Total-Alloc}, + {system_total_memory, Total}]; {unix, darwin} -> [{total_memory, Total}, {free_memory, Total-Alloc}, {system_total_memory, Total}]; diff --git a/lib/public_key/src/public_key.appup.src b/lib/public_key/src/public_key.appup.src index c65ac7bc99..4986801dad 100644 --- a/lib/public_key/src/public_key.appup.src +++ b/lib/public_key/src/public_key.appup.src @@ -1,6 +1,16 @@ %% -*- erlang -*- {"%VSN%", [ + {"0.11", + [ + {update, public_key, soft, soft_purge, soft_purge, []}, + {update, pubkey_pem, soft, soft_purge, soft_purge, []}, + {add_module, pubkey_ssh, soft, soft_purge, soft_purge}, + {update, pubkey_cert, soft, soft_purge, soft_purge, []}, + {update, pubkey_cert_records, soft, soft_purge, soft_purge, []} + ] + }, + {"0.10", [ {update, public_key, soft, soft_purge, soft_purge, []}, @@ -25,6 +35,16 @@ } ], [ + {"0.11", + [ + {update, public_key, soft, soft_purge, soft_purge, []}, + {update, pubkey_pem, soft, soft_purge, soft_purge, []}, + {delete_module, pubkey_ssh, soft, soft_purge, soft_purge}, + {update, pubkey_cert, soft, soft_purge, soft_purge, []}, + {update, pubkey_cert_records, soft, soft_purge, soft_purge, []} + ] + }, + {"0.10", [ {update, public_key, soft, soft_purge, soft_purge, []}, diff --git a/lib/public_key/test/pkits_SUITE.erl b/lib/public_key/test/pkits_SUITE.erl index 660af4e8ab..a325a975e9 100644 --- a/lib/public_key/test/pkits_SUITE.erl +++ b/lib/public_key/test/pkits_SUITE.erl @@ -26,7 +26,6 @@ -compile(export_all). -include_lib("public_key/include/public_key.hrl"). -%%-include("public_key.hrl"). -define(error(Format,Args), error(Format,Args,?FILE,?LINE)). -define(warning(Format,Args), warning(Format,Args,?FILE,?LINE)). @@ -42,18 +41,65 @@ -define(NIST5, "2.16.840.1.101.3.2.1.48.5"). -define(NIST6, "2.16.840.1.101.3.2.1.48.6"). +-record(verify_state, { + certs_db, + crl_info, + revoke_state}). %% -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}]. all() -> - [signature_verification, validity_periods, - verifying_name_chaining, - verifying_paths_with_self_issued_certificates, - verifying_basic_constraints, key_usage, - name_constraints, private_certificate_extensions]. + [{group, signature_verification}, + {group, validity_periods}, + {group, verifying_name_chaining}, + {group, verifying_paths_with_self_issued_certificates}, + %%{group, basic_certificate_revocation_tests}, + %%{group, delta_crls}, + %%{group, distribution_points}, + {group, verifying_basic_constraints}, + {group, key_usage}, + {group, name_constraints}, + {group, private_certificate_extensions}]. groups() -> - []. + [{signature_verification, [], [valid_rsa_signature, + invalid_rsa_signature, valid_dsa_signature, + invalid_dsa_signature]}, + {validity_periods, [], + [not_before_invalid, not_before_valid, not_after_invalid, not_after_valid]}, + {verifying_name_chaining, [], + [invalid_name_chain, whitespace_name_chain, capitalization_name_chain, + uid_name_chain, attrib_name_chain, string_name_chain]}, + {verifying_paths_with_self_issued_certificates, [], + [basic_valid, basic_invalid, crl_signing_valid, crl_signing_invalid]}, + %% {basic_certificate_revocation_tests, [], + %% [missing_CRL, revoked_CA, revoked_peer, invalid_CRL_signature, + %% invalid_CRL_issuer, invalid_CRL, valid_CRL, + %% unknown_CRL_extension, old_CRL, fresh_CRL, valid_serial, + %% invalid_serial, valid_seperate_keys, invalid_separate_keys]}, + %% {delta_crls, [], [delta_without_crl, valid_delta_crls, invalid_delta_crls]}, + %% {distribution_points, [], [valid_distribution_points, + %% valid_distribution_points_no_issuing_distribution_point, + %% invalid_distribution_points, valid_only_contains, + %% invalid_only_contains, valid_only_some_reasons, + %% invalid_only_some_reasons, valid_indirect_crl, + %% invalid_indirect_crl, valid_crl_issuer, invalid_crl_issuer]}, + {verifying_basic_constraints,[], + [missing_basic_constraints, valid_basic_constraint, invalid_path_constraints, + valid_path_constraints]}, + {key_usage, [], + [invalid_key_usage, valid_key_usage]}, + {name_constraints, [], + [valid_DN_name_constraints, invalid_DN_name_constraints, + valid_rfc822_name_constraints, + invalid_rfc822_name_constraints, valid_DN_and_rfc822_name_constraints, + invalid_DN_and_rfc822_name_constraints, valid_dns_name_constraints, + invalid_dns_name_constraints, valid_uri_name_constraints, + invalid_uri_name_constraints]}, + {private_certificate_extensions, [], + [unknown_critical_extension, unknown_not_critical_extension]} + ]. init_per_group(_GroupName, Config) -> Config. @@ -61,112 +107,706 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(_Func, Config) -> + Datadir = proplists:get_value(data_dir, Config), + put(datadir, Datadir), + Config. + +end_per_testcase(_Func, Config) -> + Config. + +init_per_suite(Config) -> + {skip, "PKIX Conformance test certificates expired 14 of April 2011," + " new conformance test suite uses new format so skip until PKCS-12 support is implemented"}. + %% try crypto:start() of + %% ok -> + %% Config + %% catch _:_ -> + %% {skip, "Crypto did not start"} + %% end. + +end_per_suite(_Config) -> + application:stop(crypto). + +%%----------------------------------------------------------------------------- +valid_rsa_signature(doc) -> + ["Test rsa signatur verification"]; +valid_rsa_signature(suite) -> + []; +valid_rsa_signature(Config) when is_list(Config) -> + run([{ "4.1.1", "Valid Signatures Test1", ok}]). + +invalid_rsa_signature(doc) -> + ["Test rsa signatur verification"]; +invalid_rsa_signature(suite) -> + []; +invalid_rsa_signature(Config) when is_list(Config) -> + run([{ "4.1.2", "Invalid CA Signature Test2", {bad_cert,invalid_signature}}, + { "4.1.3", "Invalid EE Signature Test3", {bad_cert,invalid_signature}}]). + +valid_dsa_signature(doc) -> + ["Test dsa signatur verification"]; +valid_dsa_signature(suite) -> + []; +valid_dsa_signature(Config) when is_list(Config) -> + run([{ "4.1.4", "Valid DSA Signatures Test4", ok}, + { "4.1.5", "Valid DSA Parameter Inheritance Test5", ok}]). + +invalid_dsa_signature(doc) -> + ["Test dsa signatur verification"]; +invalid_dsa_signature(suite) -> + []; +invalid_dsa_signature(Config) when is_list(Config) -> + run([{ "4.1.6", "Invalid DSA Signature Test6",{bad_cert,invalid_signature}}]). +%%----------------------------------------------------------------------------- +not_before_invalid(doc) -> + [""]; +not_before_invalid(suite) -> + []; +not_before_invalid(Config) when is_list(Config) -> + run([{ "4.2.1", "Invalid CA notBefore Date Test1",{bad_cert, cert_expired}}, + { "4.2.2", "Invalid EE notBefore Date Test2",{bad_cert, cert_expired}}]). + +not_before_valid(doc) -> + [""]; +not_before_valid(suite) -> + []; +not_before_valid(Config) when is_list(Config) -> + run([{ "4.2.3", "Valid pre2000 UTC notBefore Date Test3", ok}, + { "4.2.4", "Valid GeneralizedTime notBefore Date Test4", ok}]). + +not_after_invalid(doc) -> + [""]; +not_after_invalid(suite) -> + []; +not_after_invalid(Config) when is_list(Config) -> + run([{ "4.2.5", "Invalid CA notAfter Date Test5", {bad_cert, cert_expired}}, + { "4.2.6", "Invalid EE notAfter Date Test6", {bad_cert, cert_expired}}, + { "4.2.7", "Invalid pre2000 UTC EE notAfter Date Test7",{bad_cert, cert_expired}}]). + +not_after_valid(doc) -> + [""]; +not_after_valid(suite) -> + []; +not_after_valid(Config) when is_list(Config) -> + run([{ "4.2.8", "Valid GeneralizedTime notAfter Date Test8", ok}]). +%%----------------------------------------------------------------------------- +invalid_name_chain(doc) -> + [""]; +invalid_name_chain(suite) -> + []; +invalid_name_chain(Config) when is_list(Config) -> + run([{ "4.3.1", "Invalid Name Chaining EE Test1", {bad_cert, invalid_issuer}}, + { "4.3.2", "Invalid Name Chaining Order Test2", {bad_cert, invalid_issuer}}]). + +whitespace_name_chain(doc) -> + [""]; +whitespace_name_chain(suite) -> + []; +whitespace_name_chain(Config) when is_list(Config) -> + run([{ "4.3.3", "Valid Name Chaining Whitespace Test3", ok}, + { "4.3.4", "Valid Name Chaining Whitespace Test4", ok}]). + +capitalization_name_chain(doc) -> + [""]; +capitalization_name_chain(suite) -> + []; +capitalization_name_chain(Config) when is_list(Config) -> + run([{ "4.3.5", "Valid Name Chaining Capitalization Test5",ok}]). + +uid_name_chain(doc) -> + [""]; +uid_name_chain(suite) -> + []; +uid_name_chain(Config) when is_list(Config) -> + run([{ "4.3.6", "Valid Name Chaining UIDs Test6",ok}]). + +attrib_name_chain(doc) -> + [""]; +attrib_name_chain(suite) -> + []; +attrib_name_chain(Config) when is_list(Config) -> + run([{ "4.3.7", "Valid RFC3280 Mandatory Attribute Types Test7", ok}, + { "4.3.8", "Valid RFC3280 Optional Attribute Types Test8", ok}]). + +string_name_chain(doc) -> + [""]; +string_name_chain(suite) -> + []; +string_name_chain(Config) when is_list(Config) -> + run([{ "4.3.9", "Valid UTF8String Encoded Names Test9", ok}, + { "4.3.10", "Valid Rollover from PrintableString to UTF8String Test10", ok}, + { "4.3.11", "Valid UTF8String Case Insensitive Match Test11", ok}]). + +%%----------------------------------------------------------------------------- + +basic_valid(doc) -> + [""]; +basic_valid(suite) -> + []; +basic_valid(Config) when is_list(Config) -> + run([{ "4.5.1", "Valid Basic Self-Issued Old With New Test1", ok}, + { "4.5.3", "Valid Basic Self-Issued New With Old Test3", ok}, + { "4.5.4", "Valid Basic Self-Issued New With Old Test4", ok} + ]). + +basic_invalid(doc) -> + [""]; +basic_invalid(suite) -> + []; +basic_invalid(Config) when is_list(Config) -> + run([{"4.5.2", "Invalid Basic Self-Issued Old With New Test2", + {bad_cert, {revoked, keyCompromise}}}, + {"4.5.5", "Invalid Basic Self-Issued New With Old Test5", + {bad_cert, {revoked, keyCompromise}}} + ]). + +crl_signing_valid(doc) -> + [""]; +crl_signing_valid(suite) -> + []; +crl_signing_valid(Config) when is_list(Config) -> + run([{ "4.5.6", "Valid Basic Self-Issued CRL Signing Key Test6", ok}]). + +crl_signing_invalid(doc) -> + [""]; +crl_signing_invalid(suite) -> + []; +crl_signing_invalid(Config) when is_list(Config) -> + run([{ "4.5.7", "Invalid Basic Self-Issued CRL Signing Key Test7", + {bad_cert, {revoked, keyCompromise}}}, + { "4.5.8", "Invalid Basic Self-Issued CRL Signing Key Test8", + {bad_cert, invalid_key_usage}} + ]). + +%%----------------------------------------------------------------------------- +missing_CRL(doc) -> + [""]; +missing_CRL(suite) -> + []; +missing_CRL(Config) when is_list(Config) -> + run([{ "4.4.1", "Missing CRL Test1",{bad_cert, + revocation_status_undetermined}}]). + +revoked_CA(doc) -> + [""]; +revoked_CA(suite) -> + []; +revoked_CA(Config) when is_list(Config) -> + run([{ "4.4.2", "Invalid Revoked CA Test2", {bad_cert, + {revoked, keyCompromise}}}]). + +revoked_peer(doc) -> + [""]; +revoked_peer(suite) -> + []; +revoked_peer(Config) when is_list(Config) -> + run([{ "4.4.3", "Invalid Revoked EE Test3", {bad_cert, + {revoked, keyCompromise}}}]). + +invalid_CRL_signature(doc) -> + [""]; +invalid_CRL_signature(suite) -> + []; +invalid_CRL_signature(Config) when is_list(Config) -> + run([{ "4.4.4", "Invalid Bad CRL Signature Test4", + {bad_cert, revocation_status_undetermined}}]). + +invalid_CRL_issuer(doc) -> + [""]; +invalid_CRL_issuer(suite) -> + []; +invalid_CRL_issuer(Config) when is_list(Config) -> + run({ "4.4.5", "Invalid Bad CRL Issuer Name Test5", + {bad_cert, revocation_status_undetermined}}). + +invalid_CRL(doc) -> + [""]; +invalid_CRL(suite) -> + []; +invalid_CRL(Config) when is_list(Config) -> + run([{ "4.4.6", "Invalid Wrong CRL Test6", + {bad_cert, revocation_status_undetermined}}]). + +valid_CRL(doc) -> + [""]; +valid_CRL(suite) -> + []; +valid_CRL(Config) when is_list(Config) -> + run([{ "4.4.7", "Valid Two CRLs Test7", ok}]). + +unknown_CRL_extension(doc) -> + [""]; +unknown_CRL_extension(suite) -> + []; +unknown_CRL_extension(Config) when is_list(Config) -> + run([{ "4.4.8", "Invalid Unknown CRL Entry Extension Test8", + {bad_cert, {revoked, keyCompromise}}}, + { "4.4.9", "Invalid Unknown CRL Extension Test9", + {bad_cert, {revoked, keyCompromise}}}, + { "4.4.10", "Invalid Unknown CRL Extension Test10", + {bad_cert, revocation_status_undetermined}}]). + +old_CRL(doc) -> + [""]; +old_CRL(suite) -> + []; +old_CRL(Config) when is_list(Config) -> + run([{ "4.4.11", "Invalid Old CRL nextUpdate Test11", + {bad_cert, revocation_status_undetermined}}, + { "4.4.12", "Invalid pre2000 CRL nextUpdate Test12", + {bad_cert, revocation_status_undetermined}}]). + +fresh_CRL(doc) -> + [""]; +fresh_CRL(suite) -> + []; +fresh_CRL(Config) when is_list(Config) -> + run([{ "4.4.13", "Valid GeneralizedTime CRL nextUpdate Test13", ok}]). + +valid_serial(doc) -> + [""]; +valid_serial(suite) -> + []; +valid_serial(Config) when is_list(Config) -> + run([ + { "4.4.14", "Valid Negative Serial Number Test14",ok}, + { "4.4.16", "Valid Long Serial Number Test16", ok}, + { "4.4.17", "Valid Long Serial Number Test17", ok} + ]). + +invalid_serial(doc) -> + [""]; +invalid_serial(suite) -> + []; +invalid_serial(Config) when is_list(Config) -> + run([{ "4.4.15", "Invalid Negative Serial Number Test15", + {bad_cert, {revoked, keyCompromise}}}, + { "4.4.18", "Invalid Long Serial Number Test18", + {bad_cert, {revoked, keyCompromise}}}]). + +valid_seperate_keys(doc) -> + [""]; +valid_seperate_keys(suite) -> + []; +valid_seperate_keys(Config) when is_list(Config) -> + run([{ "4.4.19", "Valid Separate Certificate and CRL Keys Test19", ok}]). + +invalid_separate_keys(doc) -> + [""]; +invalid_separate_keys(suite) -> + []; +invalid_separate_keys(Config) when is_list(Config) -> + run([{ "4.4.20", "Invalid Separate Certificate and CRL Keys Test20", + {bad_cert, {revoked, keyCompromise}}}, + { "4.4.21", "Invalid Separate Certificate and CRL Keys Test21", + {bad_cert, revocation_status_undetermined}} + ]). +%%----------------------------------------------------------------------------- +missing_basic_constraints(doc) -> + [""]; +missing_basic_constraints(suite) -> + []; +missing_basic_constraints(Config) when is_list(Config) -> + run([{ "4.6.1", "Invalid Missing basicConstraints Test1", + {bad_cert, missing_basic_constraint}}, + { "4.6.2", "Invalid cA False Test2", + {bad_cert, missing_basic_constraint}}, + { "4.6.3", "Invalid cA False Test3", + {bad_cert, missing_basic_constraint}}]). + +valid_basic_constraint(doc) -> + [""]; +valid_basic_constraint(suite) -> + []; +valid_basic_constraint(Config) when is_list(Config) -> + run([{"4.6.4", "Valid basicConstraints Not Critical Test4", ok}]). + +invalid_path_constraints(doc) -> + [""]; +invalid_path_constraints(suite) -> + []; +invalid_path_constraints(Config) when is_list(Config) -> + run([{ "4.6.5", "Invalid pathLenConstraint Test5", {bad_cert, max_path_length_reached}}, + { "4.6.6", "Invalid pathLenConstraint Test6", {bad_cert, max_path_length_reached}}, + { "4.6.9", "Invalid pathLenConstraint Test9", {bad_cert, max_path_length_reached}}, + { "4.6.10", "Invalid pathLenConstraint Test10", {bad_cert, max_path_length_reached}}, + { "4.6.11", "Invalid pathLenConstraint Test11", {bad_cert, max_path_length_reached}}, + { "4.6.12", "Invalid pathLenConstraint Test12", {bad_cert, max_path_length_reached}}, + { "4.6.16", "Invalid Self-Issued pathLenConstraint Test16", + {bad_cert, max_path_length_reached}}]). -signature_verification(doc) -> [""]; -signature_verification(suite) -> []; -signature_verification(Config) when is_list(Config) -> - run(signature_verification()). -validity_periods(doc) -> [""]; -validity_periods(suite) -> []; -validity_periods(Config) when is_list(Config) -> - run(validity_periods()). -verifying_name_chaining(doc) -> [""]; -verifying_name_chaining(suite) -> []; -verifying_name_chaining(Config) when is_list(Config) -> - run(verifying_name_chaining()). -basic_certificate_revocation_tests(doc) -> [""]; -basic_certificate_revocation_tests(suite) -> []; -basic_certificate_revocation_tests(Config) when is_list(Config) -> - run(basic_certificate_revocation_tests()). -verifying_paths_with_self_issued_certificates(doc) -> [""]; -verifying_paths_with_self_issued_certificates(suite) -> []; -verifying_paths_with_self_issued_certificates(Config) when is_list(Config) -> - run(verifying_paths_with_self_issued_certificates()). -verifying_basic_constraints(doc) -> [""]; -verifying_basic_constraints(suite) -> []; -verifying_basic_constraints(Config) when is_list(Config) -> - run(verifying_basic_constraints()). -key_usage(doc) -> [""]; -key_usage(suite) -> []; -key_usage(Config) when is_list(Config) -> - run(key_usage()). +valid_path_constraints(doc) -> + [""]; +valid_path_constraints(suite) -> + []; +valid_path_constraints(Config) when is_list(Config) -> + run([{ "4.6.7", "Valid pathLenConstraint Test7", ok}, + { "4.6.8", "Valid pathLenConstraint Test8", ok}, + { "4.6.13", "Valid pathLenConstraint Test13", ok}, + { "4.6.14", "Valid pathLenConstraint Test14", ok}, + { "4.6.15", "Valid Self-Issued pathLenConstraint Test15", ok}, + { "4.6.17", "Valid Self-Issued pathLenConstraint Test17", ok}]). + +%%----------------------------------------------------------------------------- +invalid_key_usage(doc) -> + [""]; +invalid_key_usage(suite) -> + []; +invalid_key_usage(Config) when is_list(Config) -> + run([{ "4.7.1", "Invalid keyUsage Critical keyCertSign False Test1", + {bad_cert,invalid_key_usage} }, + { "4.7.2", "Invalid keyUsage Not Critical keyCertSign False Test2", + {bad_cert,invalid_key_usage}}, + { "4.7.4", "Invalid keyUsage Critical cRLSign False Test4", + {bad_cert, revocation_status_undetermined}}, + { "4.7.5", "Invalid keyUsage Not Critical cRLSign False Test5", + {bad_cert, revocation_status_undetermined}} + ]). + +valid_key_usage(doc) -> + [""]; +valid_key_usage(suite) -> + []; +valid_key_usage(Config) when is_list(Config) -> + run([{ "4.7.3", "Valid keyUsage Not Critical Test3", ok}]). + +%%----------------------------------------------------------------------------- certificate_policies(doc) -> [""]; certificate_policies(suite) -> []; certificate_policies(Config) when is_list(Config) -> run(certificate_policies()). +%%----------------------------------------------------------------------------- require_explicit_policy(doc) -> [""]; require_explicit_policy(suite) -> []; require_explicit_policy(Config) when is_list(Config) -> run(require_explicit_policy()). +%%----------------------------------------------------------------------------- policy_mappings(doc) -> [""]; policy_mappings(suite) -> []; policy_mappings(Config) when is_list(Config) -> run(policy_mappings()). +%%----------------------------------------------------------------------------- inhibit_policy_mapping(doc) -> [""]; inhibit_policy_mapping(suite) -> []; inhibit_policy_mapping(Config) when is_list(Config) -> run(inhibit_policy_mapping()). +%%----------------------------------------------------------------------------- inhibit_any_policy(doc) -> [""]; inhibit_any_policy(suite) -> []; inhibit_any_policy(Config) when is_list(Config) -> run(inhibit_any_policy()). -name_constraints(doc) -> [""]; -name_constraints(suite) -> []; -name_constraints(Config) when is_list(Config) -> - run(name_constraints()). -distribution_points(doc) -> [""]; -distribution_points(suite) -> []; -distribution_points(Config) when is_list(Config) -> - run(distribution_points()). -delta_crls(doc) -> [""]; -delta_crls(suite) -> []; -delta_crls(Config) when is_list(Config) -> - run(delta_crls()). -private_certificate_extensions(doc) -> [""]; -private_certificate_extensions(suite) -> []; -private_certificate_extensions(Config) when is_list(Config) -> - run(private_certificate_extensions()). - -run() -> - Tests = - [signature_verification(), - validity_periods(), - verifying_name_chaining(), - %%basic_certificate_revocation_tests(), - verifying_paths_with_self_issued_certificates(), - verifying_basic_constraints(), - key_usage(), - %%certificate_policies(), - %%require_explicit_policy(), - %%policy_mappings(), - %%inhibit_policy_mapping(), - %%inhibit_any_policy(), - name_constraints(), - %distribution_points(), - %delta_crls(), - private_certificate_extensions() - ], - run(lists:append(Tests)). +%%----------------------------------------------------------------------------- + +valid_DN_name_constraints(doc) -> + [""]; +valid_DN_name_constraints(suite) -> + []; +valid_DN_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.1", "Valid DN nameConstraints Test1", ok}, + { "4.13.4", "Valid DN nameConstraints Test4", ok}, + { "4.13.5", "Valid DN nameConstraints Test5", ok}, + { "4.13.6", "Valid DN nameConstraints Test6", ok}, + { "4.13.11", "Valid DN nameConstraints Test11", ok}, + { "4.13.14", "Valid DN nameConstraints Test14", ok}, + { "4.13.18", "Valid DN nameConstraints Test18", ok}, + { "4.13.19", "Valid Self-Issued DN nameConstraints Test19", ok}]). + +invalid_DN_name_constraints(doc) -> + [""]; +invalid_DN_name_constraints(suite) -> + []; +invalid_DN_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.2", "Invalid DN nameConstraints Test2", {bad_cert, name_not_permitted}}, + { "4.13.3", "Invalid DN nameConstraints Test3", {bad_cert, name_not_permitted}}, + { "4.13.7", "Invalid DN nameConstraints Test7", {bad_cert, name_not_permitted}}, + { "4.13.8", "Invalid DN nameConstraints Test8", {bad_cert, name_not_permitted}}, + { "4.13.9", "Invalid DN nameConstraints Test9", {bad_cert, name_not_permitted}}, + { "4.13.10", "Invalid DN nameConstraints Test10",{bad_cert, name_not_permitted}}, + { "4.13.12", "Invalid DN nameConstraints Test12",{bad_cert, name_not_permitted}}, + { "4.13.13", "Invalid DN nameConstraints Test13",{bad_cert, name_not_permitted}}, + { "4.13.15", "Invalid DN nameConstraints Test15",{bad_cert, name_not_permitted}}, + { "4.13.16", "Invalid DN nameConstraints Test16",{bad_cert, name_not_permitted}}, + { "4.13.17", "Invalid DN nameConstraints Test17",{bad_cert, name_not_permitted}}, + { "4.13.20", "Invalid Self-Issued DN nameConstraints Test20", + {bad_cert, name_not_permitted}}]). + +valid_rfc822_name_constraints(doc) -> + [""]; +valid_rfc822_name_constraints(suite) -> + []; +valid_rfc822_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.21", "Valid RFC822 nameConstraints Test21", ok}, + { "4.13.23", "Valid RFC822 nameConstraints Test23", ok}, + { "4.13.25", "Valid RFC822 nameConstraints Test25", ok}]). + + +invalid_rfc822_name_constraints(doc) -> + [""]; +invalid_rfc822_name_constraints(suite) -> + []; +invalid_rfc822_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.22", "Invalid RFC822 nameConstraints Test22", + {bad_cert, name_not_permitted}}, + { "4.13.24", "Invalid RFC822 nameConstraints Test24", + {bad_cert, name_not_permitted}}, + { "4.13.26", "Invalid RFC822 nameConstraints Test26", + {bad_cert, name_not_permitted}}]). + +valid_DN_and_rfc822_name_constraints(doc) -> + [""]; +valid_DN_and_rfc822_name_constraints(suite) -> + []; +valid_DN_and_rfc822_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.27", "Valid DN and RFC822 nameConstraints Test27", ok}]). + +invalid_DN_and_rfc822_name_constraints(doc) -> + [""]; +invalid_DN_and_rfc822_name_constraints(suite) -> + []; +invalid_DN_and_rfc822_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.28", "Invalid DN and RFC822 nameConstraints Test28", + {bad_cert, name_not_permitted}}, + { "4.13.29", "Invalid DN and RFC822 nameConstraints Test29", + {bad_cert, name_not_permitted}}]). + +valid_dns_name_constraints(doc) -> + [""]; +valid_dns_name_constraints(suite) -> + []; +valid_dns_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.30", "Valid DNS nameConstraints Test30", ok}, + { "4.13.32", "Valid DNS nameConstraints Test32", ok}]). + +invalid_dns_name_constraints(doc) -> + [""]; +invalid_dns_name_constraints(suite) -> + []; +invalid_dns_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.31", "Invalid DNS nameConstraints Test31", {bad_cert, name_not_permitted}}, + { "4.13.33", "Invalid DNS nameConstraints Test33", {bad_cert, name_not_permitted}}, + { "4.13.38", "Invalid DNS nameConstraints Test38", {bad_cert, name_not_permitted}}]). + +valid_uri_name_constraints(doc) -> + [""]; +valid_uri_name_constraints(suite) -> + []; +valid_uri_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.34", "Valid URI nameConstraints Test34", ok}, + { "4.13.36", "Valid URI nameConstraints Test36", ok}]). + +invalid_uri_name_constraints(doc) -> + [""]; +invalid_uri_name_constraints(suite) -> + []; +invalid_uri_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.35", "Invalid URI nameConstraints Test35",{bad_cert, name_not_permitted}}, + { "4.13.37", "Invalid URI nameConstraints Test37",{bad_cert, name_not_permitted}}]). + +%%----------------------------------------------------------------------------- +delta_without_crl(doc) -> + [""]; +delta_without_crl(suite) -> + []; +delta_without_crl(Config) when is_list(Config) -> + run([{ "4.15.1", "Invalid deltaCRLIndicator No Base Test1",{bad_cert, + revocation_status_undetermined}}, + {"4.15.10", "Invalid delta-CRL Test10", {bad_cert, + revocation_status_undetermined}}]). + +valid_delta_crls(doc) -> + [""]; +valid_delta_crls(suite) -> + []; +valid_delta_crls(Config) when is_list(Config) -> + run([{ "4.15.2", "Valid delta-CRL Test2", ok}, + { "4.15.5", "Valid delta-CRL Test5", ok}, + { "4.15.7", "Valid delta-CRL Test7", ok}, + { "4.15.8", "Valid delta-CRL Test8", ok} + ]). + +invalid_delta_crls(doc) -> + [""]; +invalid_delta_crls(suite) -> + []; +invalid_delta_crls(Config) when is_list(Config) -> + run([{ "4.15.3", "Invalid delta-CRL Test3", {bad_cert,{revoked, keyCompromise}}}, + { "4.15.4", "Invalid delta-CRL Test4", {bad_cert,{revoked, keyCompromise}}}, + { "4.15.6", "Invalid delta-CRL Test6", {bad_cert,{revoked, keyCompromise}}}, + { "4.15.9", "Invalid delta-CRL Test9", {bad_cert,{revoked, keyCompromise}}}]). + +%%----------------------------------------------------------------------------- + +valid_distribution_points(doc) -> + [""]; +valid_distribution_points(suite) -> + []; +valid_distribution_points(Config) when is_list(Config) -> + run([{ "4.14.1", "Valid distributionPoint Test1", ok}, + { "4.14.4", "Valid distributionPoint Test4", ok}, + { "4.14.5", "Valid distributionPoint Test5", ok}, + { "4.14.7", "Valid distributionPoint Test7", ok} + ]). + +valid_distribution_points_no_issuing_distribution_point(doc) -> + [""]; +valid_distribution_points_no_issuing_distribution_point(suite) -> + []; +valid_distribution_points_no_issuing_distribution_point(Config) when is_list(Config) -> + run([{ "4.14.10", "Valid No issuingDistributionPoint Test10", ok} + ]). + +invalid_distribution_points(doc) -> + [""]; +invalid_distribution_points(suite) -> + []; +invalid_distribution_points(Config) when is_list(Config) -> + run([{ "4.14.2", "Invalid distributionPoint Test2", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.3", "Invalid distributionPoint Test3", {bad_cert, + revocation_status_undetermined}}, + { "4.14.6", "Invalid distributionPoint Test6", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.8", "Invalid distributionPoint Test8", {bad_cert, + revocation_status_undetermined}}, + { "4.14.9", "Invalid distributionPoint Test9", {bad_cert, + revocation_status_undetermined}} + ]). + +valid_only_contains(doc) -> + [""]; +valid_only_contains(suite) -> + []; +valid_only_contains(Config) when is_list(Config) -> + run([{ "4.14.13", "Valid onlyContainsCACerts CRL Test13", ok}]). + +invalid_only_contains(doc) -> + [""]; +invalid_only_contains(suite) -> + []; +invalid_only_contains(Config) when is_list(Config) -> + run([{ "4.14.11", "Invalid onlyContainsUserCerts CRL Test11", + {bad_cert, revocation_status_undetermined}}, + { "4.14.12", "Invalid onlyContainsCACerts CRL Test12", + {bad_cert, revocation_status_undetermined}}, + { "4.14.14", "Invalid onlyContainsAttributeCerts Test14", + {bad_cert, revocation_status_undetermined}} + ]). + +valid_only_some_reasons(doc) -> + [""]; +valid_only_some_reasons(suite) -> + []; +valid_only_some_reasons(Config) when is_list(Config) -> + run([{ "4.14.18", "Valid onlySomeReasons Test18", ok}, + { "4.14.19", "Valid onlySomeReasons Test19", ok} + ]). + +invalid_only_some_reasons(doc) -> + [""]; +invalid_only_some_reasons(suite) -> + []; +invalid_only_some_reasons(Config) when is_list(Config) -> + run([{ "4.14.15", "Invalid onlySomeReasons Test15", + {bad_cert,{revoked, keyCompromise}}}, + { "4.14.16", "Invalid onlySomeReasons Test16", + {bad_cert,{revoked, certificateHold}}}, + { "4.14.17", "Invalid onlySomeReasons Test17", + {bad_cert, revocation_status_undetermined}}, + { "4.14.20", "Invalid onlySomeReasons Test20", + {bad_cert,{revoked, keyCompromise}}}, + { "4.14.21", "Invalid onlySomeReasons Test21", + {bad_cert,{revoked, affiliationChanged}}} + ]). + +valid_indirect_crl(doc) -> + [""]; +valid_indirect_crl(suite) -> + []; +valid_indirect_crl(Config) when is_list(Config) -> + run([{ "4.14.22", "Valid IDP with indirectCRL Test22", ok}, + { "4.14.24", "Valid IDP with indirectCRL Test24", ok}, + { "4.14.25", "Valid IDP with indirectCRL Test25", ok} + ]). + +invalid_indirect_crl(doc) -> + [""]; +invalid_indirect_crl(suite) -> + []; +invalid_indirect_crl(Config) when is_list(Config) -> + run([{ "4.14.23", "Invalid IDP with indirectCRL Test23", + {bad_cert,{revoked, keyCompromise}}}, + { "4.14.26", "Invalid IDP with indirectCRL Test26", + {bad_cert, revocation_status_undetermined}} + ]). + +valid_crl_issuer(doc) -> + [""]; +valid_crl_issuer(suite) -> + []; +valid_crl_issuer(Config) when is_list(Config) -> + run([{ "4.14.28", "Valid cRLIssuer Test28", ok}%%, + %%{ "4.14.29", "Valid cRLIssuer Test29", ok}, + %%{ "4.14.33", "Valid cRLIssuer Test33", ok} + ]). + +invalid_crl_issuer(doc) -> + [""]; +invalid_crl_issuer(suite) -> + []; +invalid_crl_issuer(Config) when is_list(Config) -> + run([ + { "4.14.27", "Invalid cRLIssuer Test27", {bad_cert, revocation_status_undetermined}}, + { "4.14.31", "Invalid cRLIssuer Test31", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.32", "Invalid cRLIssuer Test32", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.34", "Invalid cRLIssuer Test34", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.35", "Invalid cRLIssuer Test35", {bad_cert, revocation_status_undetermined}} + ]). + + +%%distribution_points() -> + %%{ "4.14", "Distribution Points" }, +%% [ + %% Although this test is valid it has a circular dependency. As a result + %% an attempt is made to reursively checks a CRL path and rejected due to + %% a CRL path validation error. PKITS notes suggest this test does not + %% need to be run due to this issue. +%% { "4.14.30", "Valid cRLIssuer Test30", 54 }]. + + +%%----------------------------------------------------------------------------- + +unknown_critical_extension(doc) -> + [""]; +unknown_critical_extension(suite) -> + []; +unknown_critical_extension(Config) when is_list(Config) -> + run([{ "4.16.2", "Invalid Unknown Critical Certificate Extension Test2", + {bad_cert,unknown_critical_extension}}]). + +unknown_not_critical_extension(doc) -> + [""]; +unknown_not_critical_extension(suite) -> + []; +unknown_not_critical_extension(Config) when is_list(Config) -> + run([{ "4.16.1", "Valid Unknown Not Critical Certificate Extension Test1", ok}]). + +%%----------------------------------------------------------------------------- run(Tests) -> File = file(?CERTS,"TrustAnchorRootCertificate.crt"), {ok, TA} = file:read_file(File), run(Tests, TA). run({Chap, Test, Result}, TA) -> - CertChain = sort_chain(read_certs(Test),TA, [], false), - try public_key:pkix_path_validation(TA, CertChain, []) of - {Result, _} -> ok; + CertChain = sort_chain(read_certs(Test),TA, [], false, Chap), + Options = path_validation_options(TA, Chap,Test), + try public_key:pkix_path_validation(TA, CertChain, Options) of + {Result, _} -> ok; {error,Result} when Result =/= ok -> ok; - {error,Error} when is_integer(Result) -> - ?warning(" ~p~n Got ~p expected ~p~n",[Test, Error, Result]); - {error,Error} when Result =/= ok -> - ?error(" minor ~p~n Got ~p expected ~p~n",[Test, Error, Result]); {error, Error} -> ?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, Error]), fail; - {ok, _} when Result =/= ok -> + {ok, _OK} when Result =/= ok -> ?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, ok]), fail catch Type:Reason -> @@ -181,14 +821,318 @@ run([Test|Rest],TA) -> run(Rest,TA); run([],_) -> ok. +path_validation_options(TA, Chap, Test) -> + case needs_crl_options(Chap) of + true -> + crl_options(TA, Test); + false -> + Fun = + fun(_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, _}, UserState) -> + {unknown, UserState}; + (_, Valid, UserState) when Valid == valid; + Valid == valid_peer -> + {valid, UserState} + end, + [{verify_fun, {Fun, []}}] + end. + +needs_crl_options("4.4" ++ _) -> + true; +needs_crl_options("4.5" ++ _) -> + true; +needs_crl_options("4.7.4" ++ _) -> + true; +needs_crl_options("4.7.5" ++ _) -> + true; +needs_crl_options("4.14" ++ _) -> + true; +needs_crl_options("4.15" ++ _) -> + true; +needs_crl_options(_) -> + false. + +crl_options(TA, Test) -> + case read_crls(Test) of + [] -> + []; + CRLs -> + Fun = + fun(_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, + #'Extension'{extnID = ?'id-ce-cRLDistributionPoints', + extnValue = Value}}, UserState0) -> + UserState = update_crls(Value, UserState0), + {valid, UserState}; + (_,{extension, _}, UserState) -> + {unknown, UserState}; + (OtpCert, Valid, UserState) when Valid == valid; + Valid == valid_peer -> + {ErlCerts, CRLs} = UserState#verify_state.crl_info, + CRLInfo0 = + crl_info(OtpCert, + ErlCerts,[{DerCRL, public_key:der_decode('CertificateList', + DerCRL)} || DerCRL <- CRLs], + []), + CRLInfo = lists:reverse(CRLInfo0), + Certs = UserState#verify_state.certs_db, + Fun = fun(DP, CRLtoValidate, Id, CertsDb) -> + trusted_cert_and_path(DP, CRLtoValidate, Id, CertsDb) + end, + Ignore = ignore_sign_test_when_building_path(Test), + case public_key:pkix_crls_validate(OtpCert, CRLInfo, + [{issuer_fun,{Fun, {Ignore, Certs}}}]) of + valid -> + {valid, UserState}; + Reason -> + {fail, Reason} + end + end, + + Certs = read_certs(Test), + ErlCerts = [public_key:pkix_decode_cert(Cert, otp) || Cert <- Certs], + + [{verify_fun, {Fun, #verify_state{certs_db = [TA| Certs], + crl_info = {ErlCerts, CRLs}}}}] + end. + +crl_info(_, _, [], Acc) -> + Acc; +crl_info(OtpCert, Certs, [{_, #'CertificateList'{tbsCertList = + #'TBSCertList'{issuer = Issuer, + crlExtensions = CRLExtensions}}} + = CRL | Rest], Acc) -> + OtpTBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + Extensions = OtpTBSCert#'OTPTBSCertificate'.extensions, + ExtList = pubkey_cert:extensions_list(CRLExtensions), + DPs = case pubkey_cert:select_extension(?'id-ce-cRLDistributionPoints', Extensions) of + #'Extension'{extnValue = Value} -> + lists:map(fun(Point) -> pubkey_cert_records:transform(Point, decode) end, Value); + _ -> + case same_issuer(OtpCert, Issuer) of + true -> + [make_dp(ExtList, asn1_NOVALUE, Issuer)]; + false -> + [make_dp(ExtList, Issuer, ignore)] + end + end, + DPsCRLs = lists:map(fun(DP) -> {DP, CRL} end, DPs), + crl_info(OtpCert, Certs, Rest, DPsCRLs ++ Acc). + +ignore_sign_test_when_building_path("Invalid Bad CRL Signature Test4") -> + true; +ignore_sign_test_when_building_path(_) -> + false. + +same_issuer(OTPCert, Issuer) -> + DecIssuer = pubkey_cert_records:transform(Issuer, decode), + OTPTBSCert = OTPCert#'OTPCertificate'.tbsCertificate, + CertIssuer = OTPTBSCert#'OTPTBSCertificate'.issuer, + pubkey_cert:is_issuer(DecIssuer, CertIssuer). + +make_dp(Extensions, Issuer0, DpInfo) -> + {Issuer, Point} = mk_issuer_dp(Issuer0, DpInfo), + case pubkey_cert:select_extension('id-ce-cRLReason', Extensions) of + #'Extension'{extnValue = Reasons} -> + #'DistributionPoint'{cRLIssuer = Issuer, + reasons = Reasons, + distributionPoint = Point}; + _ -> + #'DistributionPoint'{cRLIssuer = Issuer, + reasons = [unspecified, keyCompromise, + cACompromise, affiliationChanged, superseded, + cessationOfOperation, certificateHold, + removeFromCRL, privilegeWithdrawn, aACompromise], + distributionPoint = Point} + end. + +mk_issuer_dp(asn1_NOVALUE, Issuer) -> + {asn1_NOVALUE, {fullName, [{directoryName, Issuer}]}}; +mk_issuer_dp(Issuer, _) -> + {[{directoryName, Issuer}], asn1_NOVALUE}. + +update_crls(_, State) -> + State. + +trusted_cert_and_path(DP, CRL, Id, {Ignore, CertsList}) -> + case crl_issuer(crl_issuer_name(DP), CRL, Id, CertsList, CertsList, Ignore) of + {ok, IssuerCert, DerIssuerCert} -> + Certs = [{public_key:pkix_decode_cert(Cert, otp), Cert} || Cert <- CertsList], + CertChain = build_chain(Certs, Certs, IssuerCert, Ignore, [DerIssuerCert]), + {ok, public_key:pkix_decode_cert(hd(CertChain), otp), CertChain}; + Other -> + Other + end. + +crl_issuer_name(#'DistributionPoint'{cRLIssuer = asn1_NOVALUE}) -> + undefined; +crl_issuer_name(#'DistributionPoint'{cRLIssuer = [{directoryName, Issuer}]}) -> + pubkey_cert_records:transform(Issuer, decode). + +build_chain([],_, _, _,Acc) -> + Acc; + +build_chain([{First, DerFirst}|Certs], All, Cert, Ignore, Acc) -> + case public_key:pkix_is_self_signed(Cert) andalso is_test_root(Cert) of + true -> + Acc; + false -> + case public_key:pkix_is_issuer(Cert, First) + %%andalso check_extension_cert_signer(First) + andalso is_signer(First, Cert, Ignore) + of + true -> + build_chain(All, All, First, Ignore, [DerFirst | Acc]); + false -> + build_chain(Certs, All, Cert, Ignore, Acc) + end + end. + +is_signer(_,_, true) -> + true; +is_signer(Signer, #'OTPCertificate'{} = Cert,_) -> + TBSCert = Signer#'OTPCertificate'.tbsCertificate, + PublicKeyInfo = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, + PublicKey = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.subjectPublicKey, + AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm, + PublicKeyParams = AlgInfo#'PublicKeyAlgorithm'.parameters, + try pubkey_cert:validate_signature(Cert, public_key:pkix_encode('OTPCertificate', + Cert, otp), + PublicKey, PublicKeyParams, true, ?DEFAULT_VERIFYFUN) of + true -> + true + catch + _:_ -> + false + end; +is_signer(Signer, #'CertificateList'{} = CRL, _) -> + TBSCert = Signer#'OTPCertificate'.tbsCertificate, + PublicKeyInfo = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, + PublicKey = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.subjectPublicKey, + AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm, + PublicKeyParams = AlgInfo#'PublicKeyAlgorithm'.parameters, + pubkey_crl:verify_crl_signature(CRL, public_key:pkix_encode('CertificateList', + CRL, plain), + PublicKey, PublicKeyParams). + +is_test_root(OtpCert) -> + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + {rdnSequence, AtterList} = TBSCert#'OTPTBSCertificate'.issuer, + lists:member([{'AttributeTypeAndValue',{2,5,4,3},{printableString,"Trust Anchor"}}], + AtterList). + +check_extension_cert_signer(OtpCert) -> + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + Extensions = TBSCert#'OTPTBSCertificate'.extensions, + case pubkey_cert:select_extension(?'id-ce-keyUsage', Extensions) of + #'Extension'{extnValue = KeyUse} -> + lists:member(keyCertSign, KeyUse); + _ -> + true + end. + +check_extension_crl_signer(OtpCert) -> + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + Extensions = TBSCert#'OTPTBSCertificate'.extensions, + case pubkey_cert:select_extension(?'id-ce-keyUsage', Extensions) of + #'Extension'{extnValue = KeyUse} -> + lists:member(cRLSign, KeyUse); + _ -> + true + end. + +crl_issuer(undefined, CRL, issuer_not_found, _, CertsList, Ignore) -> + crl_issuer(CRL, CertsList, Ignore); + +crl_issuer(IssuerName, CRL, issuer_not_found, CertsList, CertsList, Ignore) -> + crl_issuer(IssuerName, CRL, IssuerName, CertsList, CertsList, Ignore); + +crl_issuer(undefined, CRL, Id, [Cert | Rest], All, false) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, + SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber, + Issuer = public_key:pkix_normalize_name( + TBSCertificate#'OTPTBSCertificate'.subject), + Bool = is_signer(ErlCert, CRL, false), + case {SerialNumber, Issuer} of + Id when Bool == true -> + {ok, ErlCert, Cert}; + _ -> + crl_issuer(undefined, CRL, Id, Rest, All, false) + end; + +crl_issuer(IssuerName, CRL, Id, [Cert | Rest], All, false) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, + SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber, + %%Issuer = public_key:pkix_normalize_name( + %% TBSCertificate#'OTPTBSCertificate'.subject), + Bool = is_signer(ErlCert, CRL, false), + case {SerialNumber, IssuerName} of + Id when Bool == true -> + {ok, ErlCert, Cert}; + {_, IssuerName} when Bool == true -> + {ok, ErlCert, Cert}; + _ -> + crl_issuer(IssuerName, CRL, Id, Rest, All, false) + end; + +crl_issuer(undefined, CRL, _, [], CertsList, Ignore) -> + crl_issuer(CRL, CertsList, Ignore); +crl_issuer(CRLName, CRL, _, [], CertsList, Ignore) -> + crl_issuer(CRLName, CRL, CertsList, Ignore). + + +crl_issuer(_, [],_) -> + {error, issuer_not_found}; +crl_issuer(CRL, [Cert | Rest], Ignore) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + case public_key:pkix_is_issuer(CRL, ErlCert) andalso + check_extension_crl_signer(ErlCert) andalso + is_signer(ErlCert, CRL, Ignore) + of + true -> + {ok, ErlCert,Cert}; + false -> + crl_issuer(CRL, Rest, Ignore) + end. + +crl_issuer(_,_, [],_) -> + {error, issuer_not_found}; +crl_issuer(IssuerName, CRL, [Cert | Rest], Ignore) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, + Issuer = public_key:pkix_normalize_name( + TBSCertificate#'OTPTBSCertificate'.subject), + + case + public_key:pkix_is_issuer(CRL, ErlCert) andalso + check_extension_crl_signer(ErlCert) andalso + is_signer(ErlCert, CRL, Ignore) + of + true -> + case pubkey_cert:is_issuer(Issuer, IssuerName) of + true -> + {ok, ErlCert,Cert}; + false -> + crl_issuer(IssuerName, CRL, Rest, Ignore) + end; + false -> + crl_issuer(IssuerName, CRL, Rest, Ignore) + end. read_certs(Test) -> File = test_file(Test), - %% io:format("Read ~p ",[File]), Ders = erl_make_certs:pem_to_der(File), - %% io:format("Ders ~p ~n",[length(Ders)]), [Cert || {'Certificate', Cert, not_encrypted} <- Ders]. +read_crls(Test) -> + File = test_file(Test), + Ders = erl_make_certs:pem_to_der(File), + [CRL || {'CertificateList', CRL, not_encrypted} <- Ders]. + test_file(Test) -> file(?CONV, lists:append(string:tokens(Test, " -")) ++ ".pem"). @@ -206,118 +1150,89 @@ file(Sub,File) -> end, AbsFile. -sort_chain([First|Certs], TA, Try, Found) -> +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.5.3"-> + [CA, Entity, Self] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Self, Entity]; +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.5.4"; + Chap == "4.5.5" -> + [CA, Entity, _Self] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Entity]; + +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.24"; + Chap == "4.14.25"; + Chap == "4.14.26"; + Chap == "4.14.27"; + Chap == "4.14.31"; + Chap == "4.14.32"; + Chap == "4.14.33" -> + [_OtherCA, Entity, CA] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Entity]; + +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.28"; + Chap == "4.14.29" -> + [CA, _OtherCA, Entity] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Entity]; + + +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.33" -> + [Entity, CA, _OtherCA] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Entity]; + + +sort_chain(Certs, TA, Acc, Bool, Chap) -> + do_sort_chain(Certs, TA, Acc, Bool, Chap). + +do_sort_chain([First], TA, Try, Found, Chap) when Chap == "4.5.6"; + Chap == "4.5.7"; + Chap == "4.4.19"; + Chap == "4.4.20"; + Chap == "4.4.21"-> case public_key:pkix_is_issuer(First,TA) of true -> - [First|sort_chain(Certs,First,Try,true)]; + [First|do_sort_chain([],First,Try,true, Chap)]; false -> - sort_chain(Certs,TA,[First|Try],Found) + do_sort_chain([],TA,[First|Try],Found, Chap) end; -sort_chain([], _, [],_) -> []; -sort_chain([], Valid, Check, true) -> - sort_chain(lists:reverse(Check), Valid, [], false); -sort_chain([], _Valid, Check, false) -> +do_sort_chain([First|Certs], TA, Try, Found, Chap) when Chap == "4.5.6"; + Chap == "4.5.7"; + Chap == "4.4.19"; + Chap == "4.4.20"; + Chap == "4.4.21"-> +%% case check_extension_cert_signer(public_key:pkix_decode_cert(First, otp)) of +%% true -> + case public_key:pkix_is_issuer(First,TA) of + true -> + [First|do_sort_chain(Certs,First,Try,true, Chap)]; + false -> + do_sort_chain(Certs,TA,[First|Try],Found, Chap) + end; +%% false -> +%% do_sort_chain(Certs, TA, Try, Found, Chap) +%% end; + +do_sort_chain([First|Certs], TA, Try, Found, Chap) -> + case public_key:pkix_is_issuer(First,TA) of + true -> + [First|do_sort_chain(Certs,First,Try,true, Chap)]; + false -> + do_sort_chain(Certs,TA,[First|Try],Found, Chap) + end; + +do_sort_chain([], _, [],_, _) -> []; +do_sort_chain([], Valid, Check, true, Chap) -> + do_sort_chain(lists:reverse(Check), Valid, [], false, Chap); +do_sort_chain([], _Valid, Check, false, _) -> Check. -signature_verification() -> - %% "4.1", "Signature Verification" , - [{ "4.1.1", "Valid Signatures Test1", ok}, - { "4.1.2", "Invalid CA Signature Test2", {bad_cert,invalid_signature}}, - { "4.1.3", "Invalid EE Signature Test3", {bad_cert,invalid_signature}}, - { "4.1.4", "Valid DSA Signatures Test4", ok}, - { "4.1.5", "Valid DSA Parameter Inheritance Test5", ok}, - { "4.1.6", "Invalid DSA Signature Test6", {bad_cert,invalid_signature}}]. -validity_periods() -> - %% { "4.2", "Validity Periods" }, - [{ "4.2.1", "Invalid CA notBefore Date Test1", {bad_cert, cert_expired}}, - { "4.2.2", "Invalid EE notBefore Date Test2", {bad_cert, cert_expired}}, - { "4.2.3", "Valid pre2000 UTC notBefore Date Test3", ok}, - { "4.2.4", "Valid GeneralizedTime notBefore Date Test4", ok}, - { "4.2.5", "Invalid CA notAfter Date Test5", {bad_cert, cert_expired}}, - { "4.2.6", "Invalid EE notAfter Date Test6", {bad_cert, cert_expired}}, - { "4.2.7", "Invalid pre2000 UTC EE notAfter Date Test7", {bad_cert, cert_expired}}, - { "4.2.8", "Valid GeneralizedTime notAfter Date Test8", ok}]. -verifying_name_chaining() -> - %%{ "4.3", "Verifying Name Chaining" }, - [{ "4.3.1", "Invalid Name Chaining EE Test1", {bad_cert, invalid_issuer}}, - { "4.3.2", "Invalid Name Chaining Order Test2", {bad_cert, invalid_issuer}}, - { "4.3.3", "Valid Name Chaining Whitespace Test3", ok}, - { "4.3.4", "Valid Name Chaining Whitespace Test4", ok}, - { "4.3.5", "Valid Name Chaining Capitalization Test5", ok}, - { "4.3.6", "Valid Name Chaining UIDs Test6", ok}, - { "4.3.7", "Valid RFC3280 Mandatory Attribute Types Test7", ok}, - { "4.3.8", "Valid RFC3280 Optional Attribute Types Test8", ok}, - { "4.3.9", "Valid UTF8String Encoded Names Test9", ok}, - { "4.3.10", "Valid Rollover from PrintableString to UTF8String Test10", ok}, - { "4.3.11", "Valid UTF8String Case Insensitive Match Test11", ok}]. -basic_certificate_revocation_tests() -> - %%{ "4.4", "Basic Certificate Revocation Tests" }, - [{ "4.4.1", "Missing CRL Test1", 3 }, - { "4.4.2", "Invalid Revoked CA Test2", 23 }, - { "4.4.3", "Invalid Revoked EE Test3", 23 }, - { "4.4.4", "Invalid Bad CRL Signature Test4", 8 }, - { "4.4.5", "Invalid Bad CRL Issuer Name Test5", 3 }, - { "4.4.6", "Invalid Wrong CRL Test6", 3 }, - { "4.4.7", "Valid Two CRLs Test7", ok}, - - %% The test document suggests these should return certificate revoked... - %% Subsquent discussion has concluded they should not due to unhandle - %% critical CRL extensions. - { "4.4.8", "Invalid Unknown CRL Entry Extension Test8", 36 }, - { "4.4.9", "Invalid Unknown CRL Extension Test9", 36 }, - - { "4.4.10", "Invalid Unknown CRL Extension Test10", 36 }, - { "4.4.11", "Invalid Old CRL nextUpdate Test11", 12 }, - { "4.4.12", "Invalid pre2000 CRL nextUpdate Test12", 12 }, - { "4.4.13", "Valid GeneralizedTime CRL nextUpdate Test13", ok}, - { "4.4.14", "Valid Negative Serial Number Test14", ok}, - { "4.4.15", "Invalid Negative Serial Number Test15", 23 }, - { "4.4.16", "Valid Long Serial Number Test16", ok}, - { "4.4.17", "Valid Long Serial Number Test17", ok}, - { "4.4.18", "Invalid Long Serial Number Test18", 23 }, - { "4.4.19", "Valid Separate Certificate and CRL Keys Test19", ok}, - { "4.4.20", "Invalid Separate Certificate and CRL Keys Test20", 23 }, - - %% CRL path is revoked so get a CRL path validation error - { "4.4.21", "Invalid Separate Certificate and CRL Keys Test21", 54 }]. -verifying_paths_with_self_issued_certificates() -> - %%{ "4.5", "Verifying Paths with Self-Issued Certificates" }, - [{ "4.5.1", "Valid Basic Self-Issued Old With New Test1", ok}, - %%{ "4.5.2", "Invalid Basic Self-Issued Old With New Test2", 23 }, - %%{ "4.5.3", "Valid Basic Self-Issued New With Old Test3", ok}, - %%{ "4.5.4", "Valid Basic Self-Issued New With Old Test4", ok}, - { "4.5.5", "Invalid Basic Self-Issued New With Old Test5", 23 }, - %%{ "4.5.6", "Valid Basic Self-Issued CRL Signing Key Test6", ok}, - { "4.5.7", "Invalid Basic Self-Issued CRL Signing Key Test7", 23 }, - { "4.5.8", "Invalid Basic Self-Issued CRL Signing Key Test8", {bad_cert,invalid_key_usage} }]. -verifying_basic_constraints() -> - [%%{ "4.6", "Verifying Basic Constraints" }, - { "4.6.1", "Invalid Missing basicConstraints Test1", - {bad_cert, missing_basic_constraint} }, - { "4.6.2", "Invalid cA False Test2", {bad_cert, missing_basic_constraint}}, - { "4.6.3", "Invalid cA False Test3", {bad_cert, missing_basic_constraint}}, - { "4.6.4", "Valid basicConstraints Not Critical Test4", ok}, - { "4.6.5", "Invalid pathLenConstraint Test5", {bad_cert, max_path_length_reached}}, - { "4.6.6", "Invalid pathLenConstraint Test6", {bad_cert, max_path_length_reached}}, - { "4.6.7", "Valid pathLenConstraint Test7", ok}, - { "4.6.8", "Valid pathLenConstraint Test8", ok}, - { "4.6.9", "Invalid pathLenConstraint Test9", {bad_cert, max_path_length_reached}}, - { "4.6.10", "Invalid pathLenConstraint Test10", {bad_cert, max_path_length_reached}}, - { "4.6.11", "Invalid pathLenConstraint Test11", {bad_cert, max_path_length_reached}}, - { "4.6.12", "Invalid pathLenConstraint Test12", {bad_cert, max_path_length_reached}}, - { "4.6.13", "Valid pathLenConstraint Test13", ok}, - { "4.6.14", "Valid pathLenConstraint Test14", ok}, - { "4.6.15", "Valid Self-Issued pathLenConstraint Test15", ok}, - { "4.6.16", "Invalid Self-Issued pathLenConstraint Test16", {bad_cert, max_path_length_reached}}, - { "4.6.17", "Valid Self-Issued pathLenConstraint Test17", ok}]. -key_usage() -> - %%{ "4.7", "Key Usage" }, - [{ "4.7.1", "Invalid keyUsage Critical keyCertSign False Test1", {bad_cert,invalid_key_usage} }, - { "4.7.2", "Invalid keyUsage Not Critical keyCertSign False Test2", {bad_cert,invalid_key_usage} }, - { "4.7.3", "Valid keyUsage Not Critical Test3", ok} - %%,{ "4.7.4", "Invalid keyUsage Critical cRLSign False Test4", 35 } - %%,{ "4.7.5", "Invalid keyUsage Not Critical cRLSign False Test5", 35 } - ]. +error(Format, Args, File0, Line) -> + File = filename:basename(File0), + Pid = group_leader(), + Pid ! {failed, File, Line}, + io:format(Pid, "~s(~p): ERROR"++Format, [File,Line|Args]). + +warning(Format, Args, File0, Line) -> + File = filename:basename(File0), + io:format("~s(~p): Warning "++Format, [File,Line|Args]). %% Certificate policy tests need special handling. They can have several %% sub tests and we need to check the outputs are correct. @@ -425,182 +1340,3 @@ inhibit_any_policy() -> {"4.12.8", "Invalid Self-Issued inhibitAnyPolicy Test8", 43 }, {"4.12.9", "Valid Self-Issued inhibitAnyPolicy Test9", ok}, {"4.12.10", "Invalid Self-Issued inhibitAnyPolicy Test10", 43 }]. - -name_constraints() -> - %%{ "4.13", "Name Constraints" }, - [{ "4.13.1", "Valid DN nameConstraints Test1", ok}, - { "4.13.2", "Invalid DN nameConstraints Test2", {bad_cert, name_not_permitted}}, - { "4.13.3", "Invalid DN nameConstraints Test3", {bad_cert, name_not_permitted}}, - { "4.13.4", "Valid DN nameConstraints Test4", ok}, - { "4.13.5", "Valid DN nameConstraints Test5", ok}, - { "4.13.6", "Valid DN nameConstraints Test6", ok}, - { "4.13.7", "Invalid DN nameConstraints Test7", {bad_cert, name_not_permitted}}, - { "4.13.8", "Invalid DN nameConstraints Test8", {bad_cert, name_not_permitted}}, - { "4.13.9", "Invalid DN nameConstraints Test9", {bad_cert, name_not_permitted}}, - { "4.13.10", "Invalid DN nameConstraints Test10", {bad_cert, name_not_permitted}}, - { "4.13.11", "Valid DN nameConstraints Test11", ok}, - { "4.13.12", "Invalid DN nameConstraints Test12", {bad_cert, name_not_permitted}}, - { "4.13.13", "Invalid DN nameConstraints Test13", {bad_cert, name_not_permitted}}, - { "4.13.14", "Valid DN nameConstraints Test14", ok}, - { "4.13.15", "Invalid DN nameConstraints Test15", {bad_cert, name_not_permitted}}, - { "4.13.16", "Invalid DN nameConstraints Test16", {bad_cert, name_not_permitted}}, - { "4.13.17", "Invalid DN nameConstraints Test17", {bad_cert, name_not_permitted}}, - { "4.13.18", "Valid DN nameConstraints Test18", ok}, - { "4.13.19", "Valid Self-Issued DN nameConstraints Test19", ok}, - { "4.13.20", "Invalid Self-Issued DN nameConstraints Test20", {bad_cert, name_not_permitted} }, - { "4.13.21", "Valid RFC822 nameConstraints Test21", ok}, - { "4.13.22", "Invalid RFC822 nameConstraints Test22", {bad_cert, name_not_permitted} }, - { "4.13.23", "Valid RFC822 nameConstraints Test23", ok}, - { "4.13.24", "Invalid RFC822 nameConstraints Test24", {bad_cert, name_not_permitted} }, - { "4.13.25", "Valid RFC822 nameConstraints Test25", ok}, - { "4.13.26", "Invalid RFC822 nameConstraints Test26", {bad_cert, name_not_permitted}}, - { "4.13.27", "Valid DN and RFC822 nameConstraints Test27", ok}, - { "4.13.28", "Invalid DN and RFC822 nameConstraints Test28", {bad_cert, name_not_permitted} }, - { "4.13.29", "Invalid DN and RFC822 nameConstraints Test29", {bad_cert, name_not_permitted} }, - { "4.13.30", "Valid DNS nameConstraints Test30", ok}, - { "4.13.31", "Invalid DNS nameConstraints Test31", {bad_cert, name_not_permitted} }, - { "4.13.32", "Valid DNS nameConstraints Test32", ok}, - { "4.13.33", "Invalid DNS nameConstraints Test33", {bad_cert, name_not_permitted}}, - { "4.13.34", "Valid URI nameConstraints Test34", ok}, - { "4.13.35", "Invalid URI nameConstraints Test35", {bad_cert, name_not_permitted} }, - { "4.13.36", "Valid URI nameConstraints Test36", ok}, - { "4.13.37", "Invalid URI nameConstraints Test37", {bad_cert, name_not_permitted}}, - { "4.13.38", "Invalid DNS nameConstraints Test38", {bad_cert, name_not_permitted} }]. -distribution_points() -> - %%{ "4.14", "Distribution Points" }, - [{ "4.14.1", "Valid distributionPoint Test1", ok}, - { "4.14.2", "Invalid distributionPoint Test2", 23 }, - { "4.14.3", "Invalid distributionPoint Test3", 44 }, - { "4.14.4", "Valid distributionPoint Test4", ok}, - { "4.14.5", "Valid distributionPoint Test5", ok}, - { "4.14.6", "Invalid distributionPoint Test6", 23 }, - { "4.14.7", "Valid distributionPoint Test7", ok}, - { "4.14.8", "Invalid distributionPoint Test8", 44 }, - { "4.14.9", "Invalid distributionPoint Test9", 44 }, - { "4.14.10", "Valid No issuingDistributionPoint Test10", ok}, - { "4.14.11", "Invalid onlyContainsUserCerts CRL Test11", 44 }, - { "4.14.12", "Invalid onlyContainsCACerts CRL Test12", 44 }, - { "4.14.13", "Valid onlyContainsCACerts CRL Test13", ok}, - { "4.14.14", "Invalid onlyContainsAttributeCerts Test14", 44 }, - { "4.14.15", "Invalid onlySomeReasons Test15", 23 }, - { "4.14.16", "Invalid onlySomeReasons Test16", 23 }, - { "4.14.17", "Invalid onlySomeReasons Test17", 3 }, - { "4.14.18", "Valid onlySomeReasons Test18", ok}, - { "4.14.19", "Valid onlySomeReasons Test19", ok}, - { "4.14.20", "Invalid onlySomeReasons Test20", 23 }, - { "4.14.21", "Invalid onlySomeReasons Test21", 23 }, - { "4.14.22", "Valid IDP with indirectCRL Test22", ok}, - { "4.14.23", "Invalid IDP with indirectCRL Test23", 23 }, - { "4.14.24", "Valid IDP with indirectCRL Test24", ok}, - { "4.14.25", "Valid IDP with indirectCRL Test25", ok}, - { "4.14.26", "Invalid IDP with indirectCRL Test26", 44 }, - { "4.14.27", "Invalid cRLIssuer Test27", 3 }, - { "4.14.28", "Valid cRLIssuer Test28", ok}, - { "4.14.29", "Valid cRLIssuer Test29", ok}, - - %% Although this test is valid it has a circular dependency. As a result - %% an attempt is made to reursively checks a CRL path and rejected due to - %% a CRL path validation error. PKITS notes suggest this test does not - %% need to be run due to this issue. - { "4.14.30", "Valid cRLIssuer Test30", 54 }, - { "4.14.31", "Invalid cRLIssuer Test31", 23 }, - { "4.14.32", "Invalid cRLIssuer Test32", 23 }, - { "4.14.33", "Valid cRLIssuer Test33", ok}, - { "4.14.34", "Invalid cRLIssuer Test34", 23 }, - { "4.14.35", "Invalid cRLIssuer Test35", 44 }]. -delta_crls() -> - %%{ "4.15", "Delta-CRLs" }, - [{ "4.15.1", "Invalid deltaCRLIndicator No Base Test1", 3 }, - { "4.15.2", "Valid delta-CRL Test2", ok}, - { "4.15.3", "Invalid delta-CRL Test3", 23 }, - { "4.15.4", "Invalid delta-CRL Test4", 23 }, - { "4.15.5", "Valid delta-CRL Test5", ok}, - { "4.15.6", "Invalid delta-CRL Test6", 23 }, - { "4.15.7", "Valid delta-CRL Test7", ok}, - { "4.15.8", "Valid delta-CRL Test8", ok}, - { "4.15.9", "Invalid delta-CRL Test9", 23 }, - { "4.15.10", "Invalid delta-CRL Test10", 12 }]. -private_certificate_extensions() -> - %%{ "4.16", "Private Certificate Extensions" }, - [{ "4.16.1", "Valid Unknown Not Critical Certificate Extension Test1", ok}, - { "4.16.2", "Invalid Unknown Critical Certificate Extension Test2", - {bad_cert,unknown_critical_extension}}]. - - -convert() -> - Tests = [signature_verification(), - validity_periods(), - verifying_name_chaining(), - basic_certificate_revocation_tests(), - verifying_paths_with_self_issued_certificates(), - verifying_basic_constraints(), - key_usage(), - certificate_policies(), - require_explicit_policy(), - policy_mappings(), - inhibit_policy_mapping(), - inhibit_any_policy(), - name_constraints(), - distribution_points(), - delta_crls(), - private_certificate_extensions()], - [convert(Test) || Test <- lists:flatten(Tests)]. - -convert({_,Test,_}) -> - convert1(Test); -convert({_,Test,_,_,_,_,_}) -> - convert1(Test). - -convert1(Test) -> - FName = lists:append(string:tokens(Test, " -")), - File = filename:join(?MIME, "Signed" ++ FName ++ ".eml"), - io:format("Convert ~p~n",[File]), - {ok, Mail} = file:read_file(File), - Base64 = skip_lines(Mail), - %%io:format("~s",[Base64]), - Tmp = base64:mime_decode(Base64), - file:write_file("pkits/smime-pem/tmp-pkcs7.der", Tmp), - Cmd = "openssl pkcs7 -inform der -in pkits/smime-pem/tmp-pkcs7.der" - " -print_certs -out pkits/smime-pem/" ++ FName ++ ".pem", - case os:cmd(Cmd) of - "" -> ok; - Err -> - io:format("~s",[Err]), - erlang:error(bad_cmd) - end. - -skip_lines(<<"\r\n\r\n", Rest/binary>>) -> Rest; -skip_lines(<<"\n\n", Rest/binary>>) -> Rest; -skip_lines(<<_:8, Rest/binary>>) -> - skip_lines(Rest). - -init_per_testcase(_Func, Config) -> - Datadir = proplists:get_value(data_dir, Config), - put(datadir, Datadir), - Config. - -end_per_testcase(_Func, Config) -> - %% Nodes = select_nodes(all, Config, ?FILE, ?LINE), - %% rpc:multicall(Nodes, mnesia, lkill, []), - Config. - -init_per_suite(Config) -> - try crypto:start() of - ok -> - Config - catch _:_ -> - {skip, "Crypto did not start"} - end. - -end_per_suite(_Config) -> - application:stop(crypto). - -error(Format, Args, File0, Line) -> - File = filename:basename(File0), - Pid = group_leader(), - Pid ! {failed, File, Line}, - io:format(Pid, "~s(~p): ERROR"++Format, [File,Line|Args]). - -warning(Format, Args, File0, Line) -> - File = filename:basename(File0), - io:format("~s(~p): Warning "++Format, [File,Line|Args]). diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index c99fd6fee1..3c6b012152 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 0.11 +PUBLIC_KEY_VSN = 0.12 diff --git a/lib/sasl/src/rb.erl b/lib/sasl/src/rb.erl index 38e486b7a7..13753565d8 100644 --- a/lib/sasl/src/rb.erl +++ b/lib/sasl/src/rb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -169,7 +169,7 @@ print_filters() -> print_dates() -> io:format(" - {StartDate, EndDate}~n"), - io:format(" StartDate = EndDate = {{Y-M-D},{H,M,S}} ~n"), + io:format(" StartDate = EndDate = {{Y,M,D},{H,M,S}} ~n"), io:format(" prints the reports with date between StartDate and EndDate~n"), io:format(" - {StartDate, from}~n"), io:format(" prints the reports with date greater than StartDate~n"), diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index af667b1a71..224b9d4af7 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -29,6 +29,19 @@ <file>notes.xml</file> </header> +<section><title>Ssh 2.0.5</title> + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Strengthened random number generation. (Thanks to Geoff Cant)</p> + <p> + Own Id: OTP-9225</p> + </item> + </list> + </section> +</section> + <section><title>Ssh 2.0.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 501da8ceb9..9be8c3c7d5 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,34 +19,44 @@ {"%VSN%", [ - {"2.0.3", [{load_module, ssh_file, soft_purge, soft_purge, []}, + {"2.0.4", [{load_module, ssh_bits, soft_purge, soft_purge, []}, + {load_module, ssh_connection_handler, soft_purge, soft_purge, []}]}, + {"2.0.3", [{load_module, ssh_bits, soft_purge, soft_purge, []}, + {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, + {load_module, ssh_file, soft_purge, soft_purge, []}, {load_module, ssh, soft_purge, soft_purge, []}, {load_module, ssh_rsa, soft_purge, soft_purge, []}, {load_module, ssh_acceptor, soft_purge, soft_purge, []}, {load_module, ssh_transport, soft_purge, soft_purge, []}, {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, - {"2.0.2", [{load_module, ssh_file, soft_purge, soft_purge, []}, + {"2.0.2", [{load_module, ssh_bits, soft_purge, soft_purge, []}, + {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, + {load_module, ssh_file, soft_purge, soft_purge, []}, {load_module, ssh, soft_purge, soft_purge, []}, {load_module, ssh_rsa, soft_purge, soft_purge, []}, {load_module, ssh_acceptor, soft_purge, soft_purge, []}, {load_module, ssh_transport, soft_purge, soft_purge, []}, - {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, - {"2.0.1", [{restart_application, ssh}]} + {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]} ], [ - {"2.0.3", [{load_module, ssh_file, soft_purge, soft_purge, []}, + {"2.0.4", [{load_module, ssh_bits, soft_purge, soft_purge, []}, + {load_module, ssh_connection_handler, soft_purge, soft_purge, []}]}, + {"2.0.3", [{load_module, ssh_bits, soft_purge, soft_purge, []}, + {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, + {load_module, ssh_file, soft_purge, soft_purge, []}, {load_module, ssh, soft_purge, soft_purge, []}, {load_module, ssh_rsa, soft_purge, soft_purge, []}, {load_module, ssh_acceptor, soft_purge, soft_purge, []}, {load_module, ssh_transport, soft_purge, soft_purge, []}, {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, - {"2.0.2", [{load_module, ssh_file, soft_purge, soft_purge, []}, + {"2.0.2", [{load_module, ssh_bits, soft_purge, soft_purge, []}, + {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, + {load_module, ssh_file, soft_purge, soft_purge, []}, {load_module, ssh, soft_purge, soft_purge, []}, {load_module, ssh_rsa, soft_purge, soft_purge, []}, {load_module, ssh_acceptor, soft_purge, soft_purge, []}, {load_module, ssh_transport, soft_purge, soft_purge, []}, - {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, - {"2.0.1", [{restart_application, ssh}]} + {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]} ] }. diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 399581a0fd..3f0a06575c 100755 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -34,7 +34,7 @@ %% integer utils -export([isize/1]). -export([irandom/1, irandom/3]). --export([random/1, random/3]). +-export([random/1]). -export([xor_bits/2, fill_bits/2]). -export([i2bin/2, bin2i/1]). @@ -401,9 +401,6 @@ xor_bits(XBits, YBits) -> irandom(Bits) -> irandom(Bits, 1, 0). -%% irandom_odd(Bits) -> -%% irandom(Bits, 1, 1). - %% %% irandom(N, Top, Bottom) %% @@ -414,57 +411,16 @@ irandom(Bits) -> %% Bot = 0 - do not set the least signifcant bit %% Bot = 1 - set the least signifcant bit (i.e always odd) %% -irandom(0, _Top, _Bottom) -> - 0; -irandom(Bits, Top, Bottom) -> - Bytes = (Bits+7) div 8, - Skip = (8-(Bits rem 8)) rem 8, - TMask = case Top of - 0 -> 0; - 1 -> 16#80; - 2 -> 16#c0 - end, - BMask = case Bottom of - 0 -> 0; - 1 -> (1 bsl Skip) - end, - <<X:Bits/big-unsigned-integer, _:Skip>> = random(Bytes, TMask, BMask), - X. +irandom(Bits, Top, Bottom) when is_integer(Top), + 0 =< Top, Top =< 2 -> + crypto:erlint(crypto:strong_rand_mpint(Bits, Top - 1, Bottom)). %% %% random/1 %% Generate N random bytes %% random(N) -> - random(N, 0, 0). - -random(N, TMask, BMask) -> - list_to_binary(rnd(N, TMask, BMask)). - -%% random/3 -%% random(Bytes, TopMask, BotMask) -%% where -%% Bytes is the number of bytes to generate -%% TopMask is bitwised or'ed to the first byte -%% BotMask is bitwised or'ed to the last byte -%% -rnd(0, _TMask, _BMask) -> - []; -rnd(1, TMask, BMask) -> - [(rand8() bor TMask) bor BMask]; -rnd(N, TMask, BMask) -> - [(rand8() bor TMask) | rnd_n(N-1, BMask)]. - -rnd_n(1, BMask) -> - [rand8() bor BMask]; -rnd_n(I, BMask) -> - [rand8() | rnd_n(I-1, BMask)]. - -rand8() -> - (rand32() bsr 8) band 16#ff. - -rand32() -> - random:uniform(16#100000000) -1. + crypto:strong_rand_bytes(N). %% %% Base 64 encode/decode diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 0ba11b0a26..2d82e6d77d 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -106,8 +106,6 @@ peer_address(ConnectionHandler) -> %% initialize. %%-------------------------------------------------------------------- init([Role, Manager, Socket, SshOpts]) -> - {A,B,C} = erlang:now(), - random:seed(A, B, C), {NumVsn, StrVsn} = ssh_transport:versions(Role, SshOpts), ssh_bits:install_messages(ssh_transport:transport_messages(NumVsn)), {Protocol, Callback, CloseTag} = diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 51f9f47446..8c9f671fd5 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 2.0.4 +SSH_VSN = 2.0.5 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index cd5c9281cd..60ea4d547f 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -266,7 +266,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <p>Possible path validation errors: </p> -<p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p> +<p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca},{bad_cert, selfsigned_peer}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p> </item> <tag>{hibernate_after, integer()|undefined}</tag> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index d3e426f254..a0ecb4ac6f 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,7 @@ %% -*- erlang -*- {"%VSN%", [ + {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, {"4.1.2", [{restart_application, ssl}]}, {"4.1.1", [{restart_application, ssl}]}, @@ -8,6 +9,7 @@ {"4.0.1", [{restart_application, ssl}]} ], [ + {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, {"4.1.2", [{restart_application, ssl}]}, {"4.1.1", [{restart_application, ssl}]}, diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 2f1edfa186..0e80e42637 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 4.1.4 +SSL_VSN = 4.1.5 diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 45fa0847a8..d6203bdaa0 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2010</year> + <year>1996</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -83,11 +83,17 @@ supervisor, where all child processes are dynamically added instances of the same process type, i.e. running the same code.</p> - <p>The functions <c>terminate_child/2</c>, <c>delete_child/2</c> + <p>The functions <c>delete_child/2</c> and <c>restart_child/2</c> are invalid for <c>simple_one_for_one</c> supervisors and will return <c>{error,simple_one_for_one}</c> if the specified supervisor uses this restart strategy.</p> + <p>The function <c>terminate_child/2</c> can be used for + children under <c>simple_one_for_one</c> supervisors by + giving the child's <c>pid()</c> as the second argument. If + instead the child specification identifier is used, + <c>terminate_child/2</c> will return + <c>{error,simple_one_for_one}</c>.</p> </item> </list> <p>To prevent a supervisor from getting into an infinite loop of @@ -311,24 +317,33 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <type> <v>SupRef = Name | {Name,Node} | {global,Name} | pid()</v> <v> Name = Node = atom()</v> - <v>Id = term()</v> + <v>Id = pid() | term()</v> <v>Result = ok | {error,Error}</v> <v> Error = not_found | simple_one_for_one</v> </type> <desc> - <p>Tells the supervisor <c>SupRef</c> to terminate the child - process corresponding to the child specification identified - by <c>Id</c>. The process, if there is one, is terminated but - the child specification is kept by the supervisor. This means - that the child process may be later be restarted by - the supervisor. The child process can also be restarted - explicitly by calling <c>restart_child/2</c>. Use - <c>delete_child/2</c> to remove the child specification.</p> + <p>Tells the supervisor <c>SupRef</c> to terminate the given + child.</p> + <p>If the supervisor is not <c>simple_one_for_one</c>, + <c>Id</c> must be the child specification identifier. The + process, if there is one, is terminated but the child + specification is kept by the supervisor. The child process + may later be restarted by the supervisor. The child process + can also be restarted explicitly by calling + <c>restart_child/2</c>. Use <c>delete_child/2</c> to remove + the child specification.</p> + <p>If the supervisor is <c>simple_one_for_one</c>, <c>Id</c> + must be the child process' <c>pid()</c>. I the specified + process is alive, but is not a child of the given + supervisor, the function will return + <c>{error,not_found}</c>. If the child specification + identifier is given instead instead of a <c>pid()</c>, the + function will return <c>{error,simple_one_for_one}</c>.</p> + <p>If successful, the function returns <c>ok</c>. If there is + no child specification with the specified <c>Id</c>, the + function returns <c>{error,not_found}</c>.</p> <p>See <c>start_child/2</c> for a description of <c>SupRef</c>.</p> - <p>If successful, the function returns <c>ok</c>. If there is - no child specification with the specified <c>Id</c>, - the function returns <c>{error,not_found}</c>.</p> </desc> </func> <func> diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 43df6f621d..574146b1cd 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -29,6 +29,8 @@ -export([init_it/6, init_it/7]). +-export([format_status_header/2]). + -define(default_timeout, 5000). %%----------------------------------------------------------------- @@ -315,3 +317,10 @@ debug_options(Opts) -> {ok, Options} -> sys:debug_options(Options); _ -> [] end. + +format_status_header(TagLine, Pid) when is_pid(Pid) -> + lists:concat([TagLine, " ", pid_to_list(Pid)]); +format_status_header(TagLine, RegName) when is_atom(RegName) -> + lists:concat([TagLine, " ", RegName]); +format_status_header(TagLine, Name) -> + {TagLine, Name}. diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index b1e9e3a02f..b00910771f 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -724,7 +724,8 @@ get_modules(MSL) -> %%----------------------------------------------------------------- format_status(Opt, StatusData) -> [PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData, - Header = lists:concat(["Status for event handler ", ServerName]), + Header = gen:format_status_header("Status for event handler", + ServerName), FmtMSL = [case erlang:function_exported(Mod, format_status, 2) of true -> Args = [PDict, State], diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 7d9960b912..f2f1365d3d 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -614,15 +614,8 @@ get_msg(Msg) -> Msg. format_status(Opt, StatusData) -> [PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time]] = StatusData, - StatusHdr = "Status for state machine", - Header = if - is_pid(Name) -> - lists:concat([StatusHdr, " ", pid_to_list(Name)]); - is_atom(Name); is_list(Name) -> - lists:concat([StatusHdr, " ", Name]); - true -> - {StatusHdr, Name} - end, + Header = gen:format_status_header("Status for state machine", + Name), Log = sys:get_debug(log, Debug, []), DefaultStatus = [{data, [{"StateData", StateData}]}], Specfic = diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index ac81df9cab..09d94a9c40 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -840,15 +840,8 @@ name_to_pid(Name) -> %%----------------------------------------------------------------- format_status(Opt, StatusData) -> [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData, - StatusHdr = "Status for generic server", - Header = if - is_pid(Name) -> - lists:concat([StatusHdr, " ", pid_to_list(Name)]); - is_atom(Name); is_list(Name) -> - lists:concat([StatusHdr, " ", Name]); - true -> - {StatusHdr, Name} - end, + Header = gen:format_status_header("Status for generic server", + Name), Log = sys:get_debug(log, Debug, []), DefaultStatus = [{data, [{"State", State}]}], Specfic = diff --git a/lib/stdlib/src/pool.erl b/lib/stdlib/src/pool.erl index 7f5f23e26d..a3c9927ee9 100644 --- a/lib/stdlib/src/pool.erl +++ b/lib/stdlib/src/pool.erl @@ -95,6 +95,9 @@ pspawn_link(M, F, A) -> start_nodes([], _, _) -> []; start_nodes([Host|Tail], Name, Args) -> case slave:start(Host, Name, Args) of + {error, {already_running, Node}} -> + io:format("Can't start node on host ~w due to ~w~n",[Host, {already_running, Node}]), + [Node | start_nodes(Tail, Name, Args)]; {error, R} -> io:format("Can't start node on host ~w due to ~w~n",[Host, R]), start_nodes(Tail, Name, Args); diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 368dc2e3e5..4fd7f1d47c 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -138,7 +138,7 @@ delete_child(Supervisor, Name) -> %%----------------------------------------------------------------- -type term_err() :: 'not_found' | 'simple_one_for_one'. --spec terminate_child(sup_ref(), term()) -> 'ok' | {'error', term_err()}. +-spec terminate_child(sup_ref(), pid() | term()) -> 'ok' | {'error', term_err()}. terminate_child(Supervisor, Name) -> call(Supervisor, {terminate_child, Name}). @@ -297,8 +297,26 @@ handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) -> {reply, What, State} end; -%%% The requests terminate_child, delete_child and restart_child are -%%% invalid for simple_one_for_one supervisors. +%% terminate_child for simple_one_for_one can only be done with pid +handle_call({terminate_child, Name}, _From, State) when not is_pid(Name), + ?is_simple(State) -> + {reply, {error, simple_one_for_one}, State}; + +handle_call({terminate_child, Name}, _From, State) -> + case get_child(Name, State, ?is_simple(State)) of + {value, Child} -> + case do_terminate(Child, State#state.name) of + #child{restart_type=RT} when RT=:=temporary; ?is_simple(State) -> + {reply, ok, state_del_child(Child, State)}; + NChild -> + {reply, ok, replace_child(NChild, State)} + end; + false -> + {reply, {error, not_found}, State} + end; + +%%% The requests delete_child and restart_child are invalid for +%%% simple_one_for_one supervisors. handle_call({_Req, _Data}, _From, State) when ?is_simple(State) -> {reply, {error, simple_one_for_one}, State}; @@ -341,19 +359,6 @@ handle_call({delete_child, Name}, _From, State) -> {reply, {error, not_found}, State} end; -handle_call({terminate_child, Name}, _From, State) -> - case get_child(Name, State) of - {value, Child} -> - case do_terminate(Child, State#state.name) of - #child{restart_type = temporary} = NChild -> - {reply, ok, state_del_child(NChild, State)}; - NChild -> - {reply, ok, replace_child(NChild, State)} - end; - _ -> - {reply, {error, not_found}, State} - end; - handle_call(which_children, _From, #state{children = [#child{restart_type = temporary, child_type = CT, modules = Mods}]} = @@ -849,7 +854,28 @@ split_child(_, [], After) -> {lists:reverse(After), []}. get_child(Name, State) -> + get_child(Name, State, false). +get_child(Pid, State, AllowPid) when AllowPid, is_pid(Pid) -> + get_dynamic_child(Pid, State); +get_child(Name, State, _) -> lists:keysearch(Name, #child.name, State#state.children). + +get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> + case is_dynamic_pid(Pid, dynamics_db(Child#child.restart_type, Dynamics)) of + true -> + {value, Child#child{pid=Pid}}; + false -> + case erlang:is_process_alive(Pid) of + true -> false; + false -> {value, Child} + end + end. + +is_dynamic_pid(Pid, Dynamics) when is_list(Dynamics) -> + lists:member(Pid, Dynamics); +is_dynamic_pid(Pid, Dynamics) -> + dict:is_key(Pid, Dynamics). + replace_child(Child, State) -> Chs = do_replace_child(Child, State#state.children), State#state{children = Chs}. diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 9e3e717e7d..b3a7edc140 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -25,13 +25,14 @@ -export([start/1, add_handler/1, add_sup_handler/1, delete_handler/1, swap_handler/1, swap_sup_handler/1, notify/1, sync_notify/1, call/1, info/1, hibernate/1, - call_format_status/1, error_format_status/1]). + call_format_status/1, call_format_status_anon/1, + error_format_status/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [start, {group, test_all}, hibernate, - call_format_status, error_format_status]. + call_format_status, call_format_status_anon, error_format_status]. groups() -> [{test_all, [], @@ -888,6 +889,22 @@ call_format_status(Config) when is_list(Config) -> ?line {"Installed handlers", [{_,dummy1_h,_,FmtState,_}]} = HandlerInfo2, ok. +call_format_status_anon(suite) -> + []; +call_format_status_anon(doc) -> + ["Test that sys:get_status/1,2 calls format_status/2 for anonymous gen_event processes"]; +call_format_status_anon(Config) when is_list(Config) -> + ?line {ok, Pid} = gen_event:start(), + %% The 'Name' of the gen_event process will be a pid() here, so + %% the next line will crash if format_status can't string-ify pids. + ?line Status1 = sys:get_status(Pid), + ?line ok = gen_event:stop(Pid), + Header = "Status for event handler " ++ pid_to_list(Pid), + ?line {status, Pid, _, [_, _, Pid, [], Data1]} = Status1, + ?line Header = proplists:get_value(header, Data1), + ok. + + error_format_status(suite) -> []; error_format_status(doc) -> diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index f9ceed8f84..cc271bd047 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -20,7 +20,7 @@ -module(supervisor_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(TIMEOUT, 1000). %% Testserver specific export @@ -349,8 +349,7 @@ child_adm(Config) when is_list(Config) -> ok = supervisor:terminate_child(sup_test, child1), %% Start of already existing but not running process - {error,already_present} = - supervisor:start_child(sup_test, Child), + {error,already_present} = supervisor:start_child(sup_test, Child), %% Restart {ok, CPid2} = supervisor:restart_child(sup_test, child1), @@ -377,6 +376,11 @@ child_adm(Config) when is_list(Config) -> [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test), [1,1,0,1] = get_child_counts(sup_test), + %% Terminate with Pid not allowed when not simple_one_for_one + {error,not_found} = supervisor:terminate_child(sup_test, CPid3), + [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + {'EXIT',{noproc,{gen_server,call,[foo,which_children,infinity]}}} = (catch supervisor:which_children(foo)), {'EXIT',{noproc,{gen_server,call,[foo,count_children,infinity]}}} @@ -412,16 +416,26 @@ child_adm_simple(Config) when is_list(Config) -> [1,2,0,2] = get_child_counts(sup_test), %% Termination - {error, simple_one_for_one} = - supervisor:terminate_child(sup_test, child1), + {error, simple_one_for_one} = supervisor:terminate_child(sup_test, child1), + [1,2,0,2] = get_child_counts(sup_test), + ok = supervisor:terminate_child(sup_test,CPid1), + [_] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + false = erlang:is_process_alive(CPid1), + %% Terminate non-existing proccess is ok + ok = supervisor:terminate_child(sup_test,CPid1), + [_] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + %% Terminate pid which is not a child of this supervisor is not ok + NoChildPid = spawn_link(fun() -> receive after infinity -> ok end end), + {error, not_found} = supervisor:terminate_child(sup_test, NoChildPid), + true = erlang:is_process_alive(NoChildPid), %% Restart - {error, simple_one_for_one} = - supervisor:restart_child(sup_test, child1), + {error, simple_one_for_one} = supervisor:restart_child(sup_test, child1), %% Deletion - {error, simple_one_for_one} = - supervisor:delete_child(sup_test, child1), + {error, simple_one_for_one} = supervisor:delete_child(sup_test, child1), ok. %%------------------------------------------------------------------------- diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 7f0011bd68..8fe7d72270 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -1193,11 +1193,10 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> do_end_tc_call(M,F,Res,Return) -> Ref = make_ref(), - case test_server_sup:framework_call( - end_tc, [?pl2a(M),F,Res], Ref) of - {fail,FWReason} -> - {failed,FWReason}; - Ref -> + case os:getenv("TEST_SERVER_FRAMEWORK") of + FW when FW == "ct_framework"; + FW == "undefined"; + FW == false -> case test_server_sup:framework_call( end_tc, [?pl2a(M),F,Res, Return], ok) of {fail,FWReason} -> @@ -1212,8 +1211,14 @@ do_end_tc_call(M,F,Res,Return) -> NewReturn -> NewReturn end; - _ -> - Return + Other -> + case test_server_sup:framework_call( + end_tc, [Other,F,Res], Ref) of + {fail,FWReason} -> + {failed,FWReason}; + _Else -> + Return + end end. %% the return value is a list and we have to check if it contains diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 230f0e9428..73a736f0e8 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -253,6 +253,7 @@ compile_modules(Files,Options) -> {i, Dir} when is_list(Dir) -> true; {d, _Macro} -> true; {d, _Macro, _Value} -> true; + export_all -> true; _ -> false end end, @@ -625,7 +626,7 @@ main_process_loop(State) -> case get_beam_file(Module,BeamFile0,Compiled0) of {ok,BeamFile} -> {Reply,Compiled} = - case do_compile_beam(Module,BeamFile) of + case do_compile_beam(Module,BeamFile,[]) of {ok, Module} -> remote_load_compiled(State#main_state.nodes, [{Module,BeamFile}]), @@ -1258,13 +1259,13 @@ do_compile(File, UserOptions) -> Options = [debug_info,binary,report_errors,report_warnings] ++ UserOptions, case compile:file(File, Options) of {ok, Module, Binary} -> - do_compile_beam(Module,Binary); + do_compile_beam(Module,Binary,UserOptions); error -> error end. %% Beam is a binary or a .beam file name -do_compile_beam(Module,Beam) -> +do_compile_beam(Module,Beam,UserOptions) -> %% Clear database do_clear(Module), @@ -1284,7 +1285,7 @@ do_compile_beam(Module,Beam) -> %% Compile and load the result %% It's necessary to check the result of loading since it may %% fail, for example if Module resides in a sticky directory - {ok, Module, Binary} = compile:forms(Forms, []), + {ok, Module, Binary} = compile:forms(Forms, UserOptions), case code:load_binary(Module, ?TAG, Binary) of {module, Module} -> |