diff options
Diffstat (limited to 'lib')
84 files changed, 2701 insertions, 1270 deletions
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 5a4621dc37..a452d30b61 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -126,44 +126,53 @@ bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> %% There was a reference to a boolean expression %% from inside a protected block (try/catch), to %% a boolean expression outside. - throw:protected_barrier -> + throw:protected_barrier -> failed; - %% The 'xor' operator was used. We currently don't - %% find it worthwile to translate 'xor' operators - %% (the code would be clumsy). - throw:'xor' -> + %% The 'xor' operator was used. We currently don't + %% find it worthwile to translate 'xor' operators + %% (the code would be clumsy). + throw:'xor' -> failed; - %% The block does not contain a boolean expression, - %% but only a call to a guard BIF. - %% For instance: ... when element(1, T) -> - throw:not_boolean_expr -> + %% The block does not contain a boolean expression, + %% but only a call to a guard BIF. + %% For instance: ... when element(1, T) -> + throw:not_boolean_expr -> failed; - %% The block contains a 'move' instruction that could - %% not be handled. - throw:move -> + %% The block contains a 'move' instruction that could + %% not be handled. + throw:move -> failed; - %% The optimization is not safe. (A register - %% used by the instructions following the - %% optimized code is either not assigned a - %% value at all or assigned a different value.) - throw:all_registers_not_killed -> + %% The optimization is not safe. (A register + %% used by the instructions following the + %% optimized code is either not assigned a + %% value at all or assigned a different value.) + throw:all_registers_not_killed -> failed; - throw:registers_used -> + throw:registers_used -> failed; - %% A protected block refered to the value - %% returned by another protected block, - %% probably because the Core Erlang code - %% used nested try/catches in the guard. - %% (v3_core never produces nested try/catches - %% in guards, so it must have been another - %% Core Erlang translator.) - throw:protected_violation -> + %% A protected block refered to the value + %% returned by another protected block, + %% probably because the Core Erlang code + %% used nested try/catches in the guard. + %% (v3_core never produces nested try/catches + %% in guards, so it must have been another + %% Core Erlang translator.) + throw:protected_violation -> + failed; + + %% Failed to work out the live registers for a GC + %% BIF. For example, if the number of live registers + %% needed to be 4 because {x,3} was a source register, + %% but {x,2} was not known to be initialized, this + %% exception would be thrown. + throw:gc_bif_alloc_failure -> failed + end end. @@ -665,10 +674,16 @@ put_reg_1(V, [], I) -> [{I,V}]. fetch_reg(V, [{I,V}|_]) -> {x,I}; fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). -live_regs(Regs) -> - foldl(fun ({I,_}, _) -> - I - end, -1, Regs)+1. +live_regs([{_,reserved}|_]) -> + %% We are not sure that this register is initialized, so we must + %% abort the optimization. + throw(gc_bif_alloc_failure); +live_regs([{I,_}]) -> + I+1; +live_regs([{_,_}|Regs]) -> + live_regs(Regs); +live_regs([]) -> + 0. %%% diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index 2792fd8fa5..0d95971f91 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -212,6 +212,8 @@ vu_pattern(V, #c_tuple{es=Es}, St) -> vu_pattern_list(V, Es, St); vu_pattern(V, #c_binary{segments=Ss}, St) -> vu_pat_seg_list(V, Ss, St); +vu_pattern(V, #c_map{es=Es}, St) -> + vu_map_pairs(V, Es, St); vu_pattern(V, #c_alias{var=Var,pat=P}, St0) -> case vu_pattern(V, Var, St0) of {true,_}=St1 -> St1; @@ -234,6 +236,13 @@ vu_pat_seg_list(V, Ss, St) -> end end, St, Ss). +vu_map_pairs(V, [#c_map_pair{val=Pat}|T], St0) -> + case vu_pattern(V, Pat, St0) of + {true,_}=St -> St; + St -> vu_map_pairs(V, T, St) + end; +vu_map_pairs(_, [], St) -> St. + -spec vu_var_list(cerl:var_name(), [cerl:c_var()]) -> boolean(). vu_var_list(V, Vs) -> diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 82817a987a..ed8f609082 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1229,6 +1229,11 @@ is_non_numeric([H|T]) -> is_non_numeric(H) andalso is_non_numeric(T); is_non_numeric(Tuple) when is_tuple(Tuple) -> is_non_numeric_tuple(Tuple, tuple_size(Tuple)); +is_non_numeric(Map) when is_map(Map) -> + %% Note that 17.x and 18.x compare keys in different ways. + %% Be very conservative -- require that both keys and values + %% are non-numeric. + is_non_numeric(maps:to_list(Map)); is_non_numeric(Num) when is_number(Num) -> false; is_non_numeric(_) -> true. @@ -1338,9 +1343,12 @@ eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types) {ok,#c_tuple{es=Elements}} -> if 1 =< Pos, Pos =< length(Elements) -> - case lists:nth(Pos, Elements) of - #c_alias{var=Alias} -> Alias; - Res -> Res + El = lists:nth(Pos, Elements), + try + pat_to_expr(El) + catch + throw:impossible -> + Call end; true -> eval_failure(Call, badarg) @@ -2040,17 +2048,18 @@ case_opt_args([], Cs, _Sub, _LitExpr, Acc) -> %% Try to expand one argument to several arguments (if tuple/list) %% or to remove a literal argument. %% -case_opt_arg(E0, Sub, Cs, LitExpr) -> +case_opt_arg(E0, Sub, Cs0, LitExpr) -> E = maybe_replace_var(E0, Sub), case cerl:is_data(E) of false -> - {error,Cs}; + {error,Cs0}; true -> + Cs = case_opt_nomatch(E, Cs0, LitExpr), case cerl:data_type(E) of {atomic,_} -> - case_opt_lit(E, Cs, LitExpr); + case_opt_lit(E, Cs); _ -> - case_opt_data(E, Cs, LitExpr) + case_opt_data(E, Cs) end end. @@ -2072,19 +2081,67 @@ maybe_replace_var_1(E, #sub{t=Tdb}) -> false -> E; true -> - cerl_trees:map(fun(C) -> - case cerl:is_c_alias(C) of - false -> C; - true -> cerl:alias_pat(C) - end - end, T0) + %% The pattern was a tuple. Now we must make sure + %% that the elements of the tuple are suitable. In + %% particular, we don't want binary or map + %% construction here, since that means that the + %% binary or map will be constructed in the 'case' + %% argument. That is wasteful for binaries. Even + %% worse is that any map pattern that use the ':=' + %% operator will fail when used in map + %% construction (only the '=>' operator is allowed + %% when constructing a map from scratch). + ToData = fun coerce_to_data/1, + try + cerl_trees:map(ToData, T0) + catch + throw:impossible -> + %% Something unsuitable was found (map or + %% or binary). Keep the variable. + E + end end; error -> E end. -%% case_opt_lit(Literal, Clauses0, LitExpr) -> -%% {ok,[],Clauses} | error +%% coerce_to_data(Core) -> Core' +%% Coerce an element originally from a pattern to an data item or or +%% variable. Throw an 'impossible' exception if non-data Core Erlang +%% terms such as binary construction or map construction are +%% encountered. + +coerce_to_data(C) -> + case cerl:is_c_alias(C) of + false -> + case cerl:is_data(C) orelse cerl:is_c_var(C) of + true -> C; + false -> throw(impossible) + end; + true -> + coerce_to_data(cerl:alias_pat(C)) + end. + +%% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses' +%% Remove all clauses that cannot possibly match. + +case_opt_nomatch(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) -> + case cerl_clauses:match(P, E) of + none -> + %% The pattern will not match the case expression. Remove + %% the clause. Unless the entire case expression is a + %% literal, also emit a warning. + case LitExpr of + false -> add_warning(C, nomatch_clause_type); + true -> ok + end, + case_opt_nomatch(E, Cs, LitExpr); + _ -> + [Current|case_opt_nomatch(E, Cs, LitExpr)] + end; +case_opt_nomatch(_, [], _) -> []. + +%% case_opt_lit(Literal, Clauses0) -> {ok,[],Clauses} | error %% The current part of the case expression is a literal. That %% means that we will know at compile-time whether a clause %% will match, and we can remove the corresponding pattern from @@ -2093,68 +2150,48 @@ maybe_replace_var_1(E, #sub{t=Tdb}) -> %% The only complication is if the literal is a binary. Binary %% pattern matching is tricky, so we will give up in that case. -case_opt_lit(Lit, Cs0, LitExpr) -> - Cs1 = case_opt_lit_1(Lit, Cs0, LitExpr), - try case_opt_lit_2(Lit, Cs1) of +case_opt_lit(Lit, Cs0) -> + try case_opt_lit_1(Lit, Cs0) of Cs -> {ok,[],Cs} catch throw:impossible -> - {error,Cs1} + {error,Cs0} end. -case_opt_lit_1(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) -> - case cerl_clauses:match(P, E) of - none -> - %% The pattern will not match the literal. Remove the clause. - %% Unless the entire case expression is a literal, also - %% emit a warning. - case LitExpr of - false -> add_warning(C, nomatch_clause_type); - true -> ok - end, - case_opt_lit_1(E, Cs, LitExpr); - _ -> - [Current|case_opt_lit_1(E, Cs, LitExpr)] - end; -case_opt_lit_1(_, [], _) -> []. - -case_opt_lit_2(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) -> - %% Non-matching clauses have already been removed in case_opt_lit_1/3. +case_opt_lit_1(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) -> + %% Non-matching clauses have already been removed + %% in case_opt_nomatch/3. case cerl_clauses:match(P, E) of {true,Bs} -> %% The pattern matches the literal. Remove the pattern %% and update the bindings. - [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_2(E, Cs)]; + [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(E, Cs)]; {false,_} -> %% Binary literal and pattern. We are not sure whether %% the pattern will match. throw(impossible) end; -case_opt_lit_2(_, []) -> []. +case_opt_lit_1(_, []) -> []. %% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses} -case_opt_data(E, Cs0, LitExpr) -> +case_opt_data(E, Cs0) -> Es = cerl:data_es(E), - Cs = case_opt_data_1(Cs0, Es, - {cerl:data_type(E),cerl:data_arity(E)}, - LitExpr), - {ok,Es,Cs}. - -case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig, LitExpr) -> - case case_data_pat(P, TypeSig) of - {ok,Ps1,Bs1} -> - [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}| - case_opt_data_1(Cs, Es, TypeSig,LitExpr)]; - error -> - case LitExpr of - false -> add_warning(C, nomatch_clause_type); - true -> ok - end, - case_opt_data_1(Cs, Es, TypeSig, LitExpr) - end; -case_opt_data_1([], _, _, _) -> []. + TypeSig = {cerl:data_type(E),cerl:data_arity(E)}, + try case_opt_data_1(Cs0, Es, TypeSig) of + Cs -> + {ok,Es,Cs} + catch + throw:impossible -> + {error,Cs0} + end. + +case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) -> + {ok,Ps1,Bs1} = case_data_pat(P, TypeSig), + [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}| + case_opt_data_1(Cs, Es, TypeSig)]; +case_opt_data_1([], _, _) -> []. %% case_data_pat(Pattern, Type, Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error. @@ -2163,12 +2200,7 @@ case_data_pat(P, TypeSig) -> false -> case_data_pat_var(P, TypeSig); true -> - case {cerl:data_type(P),cerl:data_arity(P)} of - TypeSig -> - {ok,cerl:data_es(P),[]}; - {_,_} -> - error - end + {ok,cerl:data_es(P),[]} end. %% case_data_pat_var(Pattern, {DataType,ArityType}) -> @@ -2188,35 +2220,38 @@ case_data_pat_var(P, {Type,Arity}=TypeSig) -> alias -> V = cerl:alias_var(P), Apat = cerl:alias_pat(P), - case case_data_pat(Apat, TypeSig) of - {ok,Ps,Bs} -> - {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, unalias_pat_list(Ps))}|Bs]}; - error -> - error - end; - _ -> - error + {ok,Ps,Bs} = case_data_pat(Apat, TypeSig), + {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, + pat_to_expr_list(Ps))}|Bs]} end. -%% unalias_pat(Pattern) -> Pattern. -%% Remove all the aliases in a pattern but using the alias variables -%% instead of the values. We KNOW they will be bound. +%% pat_to_expr(Pattern) -> Expression. +%% Convert a pattern to an expression if possible. We KNOW that +%% all variables in the pattern will be bound. +%% +%% Throw an 'impossible' exception if a map or (non-literal) +%% binary is encountered. Trying to use a map pattern as an +%% expression is incorrect, while rebuilding a potentially +%% huge binary in an expression would be wasteful. -unalias_pat(P) -> - case cerl:is_c_alias(P) of - true -> +pat_to_expr(P) -> + case cerl:type(P) of + alias -> cerl:alias_var(P); - false -> + var -> + P; + _ -> case cerl:is_data(P) of false -> - P; + %% Map or binary. + throw(impossible); true -> - Es = unalias_pat_list(cerl:data_es(P)), + Es = pat_to_expr_list(cerl:data_es(P)), cerl:update_data(P, cerl:data_type(P), Es) end end. -unalias_pat_list(Ps) -> [unalias_pat(P) || P <- Ps]. +pat_to_expr_list(Ps) -> [pat_to_expr(P) || P <- Ps]. make_vars(A, Max) -> make_vars(A, 1, Max). diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 149b9bbb8f..10e3451e8f 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -34,7 +34,7 @@ otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1, match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1, - no_partition/1,calling_a_binary/1]). + no_partition/1,calling_a_binary/1,binary_in_map/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -59,7 +59,7 @@ groups() -> matching_and_andalso,otp_7188,otp_7233,otp_7240, otp_7498,match_string,zero_width,bad_size,haystack, cover_beam_bool,matched_out_size,follow_fail_branch, - no_partition,calling_a_binary]}]. + no_partition,calling_a_binary,binary_in_map]}]. init_per_suite(Config) -> @@ -1189,6 +1189,26 @@ call_binary(<<>>, Acc) -> call_binary(<<H,T/bits>>, Acc) -> T(<<Acc/binary,H>>). +binary_in_map(Config) when is_list(Config) -> + ok = match_binary_in_map(#{key => <<42:8>>}), + {'EXIT',{{badmatch,#{key := 1}},_}} = + (catch match_binary_in_map(#{key => 1})), + {'EXIT',{{badmatch,#{key := <<1023:16>>}},_}} = + (catch match_binary_in_map(#{key => <<1023:16>>})), + {'EXIT',{{badmatch,#{key := <<1:8>>}},_}} = + (catch match_binary_in_map(#{key => <<1:8>>})), + {'EXIT',{{badmatch,not_a_map},_}} = + (catch match_binary_in_map(not_a_map)), + ok. + +match_binary_in_map(Map) -> + case 8 of + N -> + #{key := <<42:N>>} = Map, + ok + end. + + check(F, R) -> R = F(). diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 6a7036d728..2de17e7653 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -60,6 +60,12 @@ t_element(Config) when is_list(Config) -> X = make_ref(), ?line X = id(element(1, {X,y,z})), ?line b = id(element(2, {a,b,c,d})), + (fun() -> + case {a,#{k=>X}} of + {a,#{k:=X}}=Tuple -> + #{k:=X} = id(element(2, Tuple)) + end + end)(), %% No optimization, but should work. Tuple = id({x,y,z}), @@ -204,6 +210,16 @@ eq(Config) when is_list(Config) -> ?line ?CMP_DIFF(a, [a]), ?line ?CMP_DIFF(a, {1,2,3}), + ?CMP_SAME(#{a=>1.0,b=>2}, #{b=>2.0,a=>1}), + ?CMP_SAME(#{a=>[1.0],b=>[2]}, #{b=>[2.0],a=>[1]}), + + %% The rule for comparing keys are different in 17.x and 18.x. + %% Just test that the results are consistent. + Bool = id(#{1=>a}) == id(#{1.0=>a}), %Unoptimizable. + Bool = id(#{1=>a}) == #{1.0=>a}, %Optimizable. + Bool = #{1=>a} == #{1.0=>a}, %Optimizable. + io:format("Bool = ~p\n", [Bool]), + ok. %% OTP-7117. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index eb205d09a7..34bfdeb1e5 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -1556,6 +1556,24 @@ bad_constants(Config) when is_list(Config) -> bad_guards(Config) when is_list(Config) -> if erlang:float(self()); true -> ok end, + + fc(catch bad_guards_1(1, [])), + fc(catch bad_guards_1(1, [2])), + fc(catch bad_guards_1(atom, [2])), + + fc(catch bad_guards_2(#{a=>0,b=>0}, [])), + fc(catch bad_guards_2(#{a=>0,b=>0}, [x])), + fc(catch bad_guards_2(not_a_map, [x])), + fc(catch bad_guards_2(42, [x])), + ok. + +%% beam_bool used to produce GC BIF instructions whose +%% Live operands included uninitialized registers. + +bad_guards_1(X, [_]) when {{X}}, -X -> + ok. + +bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) -> ok. %% Call this function to turn off constant propagation. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index ae7d764535..1e778dca24 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -22,7 +22,7 @@ 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,coverage/1]). + selectify/1,underscore/1,match_map/1,coverage/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,8 @@ all() -> groups() -> [{p,test_lib:parallel(), [pmatch,mixed,aliases,match_in_call,untuplify, - shortcut_boolean,letify_guard,selectify,underscore,coverage]}]. + shortcut_boolean,letify_guard,selectify, + underscore,match_map,coverage]}]. init_per_suite(Config) -> @@ -400,6 +401,24 @@ underscore(Config) when is_list(Config) -> _ = is_list(Config), ok. +-record(s, {map,t}). + +match_map(Config) when is_list(Config) -> + Map = #{key=>{x,y},ignore=>anything}, + #s{map=Map,t={x,y}} = do_match_map(#s{map=Map}), + {a,#{k:={a,b,c}}} = do_match_map_2(#{k=>{a,b,c}}), + ok. + +do_match_map(#s{map=#{key:=Val}}=S) -> + %% Would crash with a 'badarg' exception. + S#s{t=Val}. + +do_match_map_2(Map) -> + case {a,Map} of + {a,#{k:=_}}=Tuple -> + Tuple + end. + coverage(Config) when is_list(Config) -> %% Cover beam_dead. ok = coverage_1(x, a), diff --git a/lib/debugger/src/dbg_wx_settings.erl b/lib/debugger/src/dbg_wx_settings.erl index 20aac74c3d..2c332c0a54 100644 --- a/lib/debugger/src/dbg_wx_settings.erl +++ b/lib/debugger/src/dbg_wx_settings.erl @@ -65,14 +65,8 @@ open_win(Win, Pos, SFile, Str, What) -> {style,What}]), case wxFileDialog:showModal(FD) of ?wxID_OK -> - case wxFileDialog:getPaths(FD) of - [NewFile] -> - wxFileDialog:destroy(FD), - {ok, NewFile}; - _ -> - wxFileDialog:destroy(FD), - cancel - end; + NewFile = wxFileDialog:getPath(FD), + {ok, NewFile}; _ -> wxFileDialog:destroy(FD), cancel diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps_redef2.erl b/lib/dialyzer/test/small_SUITE_data/src/maps_redef2.erl new file mode 100644 index 0000000000..945b2a9144 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/maps_redef2.erl @@ -0,0 +1,23 @@ +%% In 17, the linter says that map(A) redefines 'type map', which is +%% allowed until next release. However, Dialyzer used to replace +%% map(A) with #{}, which resulted in warnings. + +-module(maps_redef2). + +-export([t/0]). + +-type map(_A) :: integer(). + +t() -> + M = new(), + t1(M). + +-spec t1(map(_)) -> map(_). + +t1(A) -> + A + A. + +-spec new() -> map(_). + +new() -> + 3. diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index 4417551aa8..c4b1ac36ca 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -107,19 +107,23 @@ filter() See present/1, substrings/2, </type> <desc> <p>Upgrade the connection associated with <c>Handle</c> to a tls connection if possible.</p> - <p>The upgrade is done in two phases: first the server is asked for permission to upgrade. Second, if the request is acknowledged, the upgrade is performed.</p> - <p>Error responese from phase one will not affect the current encryption state of the connection. Those responses are:</p> + <p>The upgrade is done in two phases: first the server is asked for permission to upgrade. Second, if the request is acknowledged, the upgrade to tls is performed.</p> + <p>Error responses from phase one will not affect the current encryption state of the connection. Those responses are:</p> <taglist> <tag><c>tls_already_started</c></tag> <item>The connection is already encrypted. The connection is not affected.</item> <tag><c>{response,ResponseFromServer}</c></tag> <item>The upgrade was refused by the LDAP server. The <c>ResponseFromServer</c> is an atom delivered byt the LDAP server explained in section 2.3 of rfc 2830. The connection is not affected, so it is still un-encrypted.</item> </taglist> - <p>Errors in the seconde phase will however end the connection:</p> + <p>Errors in the second phase will however end the connection:</p> <taglist> <tag><c>Error</c></tag> <item>Any error responded from ssl:connect/3</item> </taglist> + <p>The <c>Timeout</c> parameter is for the actual tls upgrade (phase 2) while the timeout in + <seealso marker="#open/2">erl_tar:open/2</seealso> is used for the initial negotiation about + upgrade (phase 1). + </p> </desc> </func> <func> @@ -224,9 +228,9 @@ filter() See present/1, substrings/2, </type> <desc> <p> Modify the DN of an entry. <c>DeleteOldRDN</c> indicates - whether the current RDN should be removed after operation. - <c>NewSupDN</c> should be "" if the RDN should not be moved or the new parent which - the RDN will be moved to.</p> + whether the current RDN should be removed from the attribute list after the after operation. + <c>NewSupDN</c> is the new parent that the RDN shall be moved to. If the old parent should + remain as parent, <c>NewSupDN</c> shall be "".</p> <pre> modify_dn(Handle, "cn=Bill Valentine, ou=people, o=Example Org, dc=example, dc=com ", "cn=Bill Jr Valentine", true, "") @@ -253,6 +257,10 @@ filter() See present/1, substrings/2, Filter = eldap:substrings("cn", [{any,"V"}]), search(Handle, [{base, "dc=example, dc=com"}, {filter, Filter}, {attributes, ["cn"]}]), </pre> + <p>The <c>timeout</c> option in the <c>SearchOptions</c> is for the ldap server, while + the timeout in <seealso marker="#open/2">erl_tar:open/2</seealso> is used for each + individual request in the search operation. + </p> </desc> </func> diff --git a/lib/eldap/doc/src/notes.xml b/lib/eldap/doc/src/notes.xml index f92d100757..e5cbcb26ff 100644 --- a/lib/eldap/doc/src/notes.xml +++ b/lib/eldap/doc/src/notes.xml @@ -30,6 +30,35 @@ </header> <p>This document describes the changes made to the Eldap application.</p> +<section><title>Eldap 1.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed that eldap:open did not use the Timeout parameter + when calling ssl:connect. (Thanks Wiesław Bieniek for + reporting)</p> + <p> + Own Id: OTP-12311</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Added the LDAP filter <c>extensibleMatch</c>.</p> + <p> + Own Id: OTP-12174</p> + </item> + </list> + </section> + +</section> + <section><title>Eldap 1.0.4</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 9f7aca287b..689600258f 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -107,7 +107,8 @@ getopts(Handle, OptNames) when is_pid(Handle), is_list(OptNames) -> %%% -------------------------------------------------------------------- close(Handle) when is_pid(Handle) -> - send(Handle, close). + send(Handle, close), + ok. %%% -------------------------------------------------------------------- %%% Set who we should link ourselves to diff --git a/lib/eldap/test/Makefile b/lib/eldap/test/Makefile index 24e71cebaa..28a7a107e1 100644 --- a/lib/eldap/test/Makefile +++ b/lib/eldap/test/Makefile @@ -28,8 +28,9 @@ INCLUDES= -I. -I ../include # ---------------------------------------------------- MODULES= \ - eldap_connections_SUITE \ - eldap_basic_SUITE + eldap_basic_SUITE \ + make_certs + ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/eldap/test/eldap_basic_SUITE.erl b/lib/eldap/test/eldap_basic_SUITE.erl index d87f3ac4ac..137c61b2d9 100644 --- a/lib/eldap/test/eldap_basic_SUITE.erl +++ b/lib/eldap/test/eldap_basic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2014. 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 @@ -24,305 +24,919 @@ %%-include_lib("common_test/include/ct.hrl"). -include_lib("test_server/include/test_server.hrl"). -include_lib("eldap/include/eldap.hrl"). +-include_lib("eldap/ebin/ELDAPv3.hrl"). + -define(TIMEOUT, 120000). % 2 min +all() -> + [app, + appup, + {group, encode_decode}, + {group, return_values}, + {group, v4_connections}, + {group, v6_connections}, + {group, plain_api}, + {group, ssl_api}, + {group, start_tls_api} + ]. + +groups() -> + [{encode_decode, [], [encode, + decode + ]}, + {plain_api, [], [{group,api}]}, + {ssl_api, [], [{group,api}, start_tls_on_ssl_should_fail]}, + {start_tls_api, [], [{group,api}, start_tls_twice_should_fail]}, + + {api, [], [{group,api_not_bound}, + {group,api_bound}]}, + + {api_not_bound, [], [elementary_search, search_non_existant, + add_when_not_bound, + bind]}, + {api_bound, [], [add_when_bound, + add_already_exists, + more_add, + search_filter_equalityMatch, + search_filter_substring_any, + search_filter_initial, + search_filter_final, + search_filter_and, + search_filter_or, + search_filter_and_not, + search_two_hits, + modify, + delete, + modify_dn_delete_old, + modify_dn_keep_old]}, + {v4_connections, [], connection_tests()}, + {v6_connections, [], connection_tests()}, + {return_values, [], [open_ret_val_success, + open_ret_val_error, + close_ret_val]} + ]. + +connection_tests() -> + [tcp_connection, + tcp_connection_option, + ssl_connection, + client_side_start_tls_timeout, + client_side_bind_timeout, + client_side_add_timeout, + client_side_search_timeout + ]. + + + init_per_suite(Config) -> - StartSsl = try ssl:start() - catch - Error:Reason -> - {skip, lists:flatten(io_lib:format("eldap init_per_suite failed to start ssl Error=~p Reason=~p", [Error, Reason]))} - end, - case StartSsl of - ok -> - chk_config(ldap_server, {"localhost",9876}, - chk_config(ldaps_server, {"localhost",9877}, - Config)); - _ -> - StartSsl - end. + SSL_available = init_ssl_certs_et_al(Config), + LDAP_server = find_first_server(false, [{config,eldap_server}, {config,ldap_server}, {"localhost",9876}]), + LDAPS_server = + case SSL_available of + true -> + find_first_server(true, [{config,ldaps_server}, {"localhost",9877}]); + false -> + undefined + end, + [{ssl_available, SSL_available}, + {ldap_server, LDAP_server}, + {ldaps_server, LDAPS_server} | Config]. end_per_suite(_Config) -> - ok. - -init_per_testcase(_TestCase, Config0) -> - {EldapHost,Port} = proplists:get_value(ldap_server,Config0), - try - {ok, Handle} = eldap:open([EldapHost], [{port,Port}]), - ok = eldap:simple_bind(Handle, "cn=Manager,dc=ericsson,dc=se", "hejsan"), - {ok, MyHost} = inet:gethostname(), - Path = "dc="++MyHost++",dc=ericsson,dc=se", - eldap:add(Handle,"dc=ericsson,dc=se", - [{"objectclass", ["dcObject", "organization"]}, - {"dc", ["ericsson"]}, {"o", ["Testing"]}]), - eldap:add(Handle,Path, - [{"objectclass", ["dcObject", "organization"]}, - {"dc", [MyHost]}, {"o", ["Test machine"]}]), - [{eldap_path,Path}|Config0] - catch error:{badmatch,Error} -> - io:format("Eldap init error ~p~n ~p~n",[Error, erlang:get_stacktrace()]), - {skip, lists:flatten(io_lib:format("Ldap init failed with host ~p:~p. Error=~p", [EldapHost,Port,Error]))} + ssl:stop(). + + +init_per_group(return_values, Config) -> + case ?config(ldap_server,Config) of + undefined -> + {skip, "LDAP server not availble"}; + {Host,Port} -> + ct:comment("ldap://~s:~p",[Host,Port]), + Config + end; +init_per_group(plain_api, Config0) -> + case ?config(ldap_server,Config0) of + undefined -> + {skip, "LDAP server not availble"}; + Server = {Host,Port} -> + ct:comment("ldap://~s:~p",[Host,Port]), + initialize_db([{server,Server}, {ssl_flag,false}, {start_tls,false} | Config0]) + end; +init_per_group(ssl_api, Config0) -> + case ?config(ldaps_server,Config0) of + undefined -> + {skip, "LDAPS server not availble"}; + Server = {Host,Port} -> + ct:comment("ldaps://~s:~p",[Host,Port]), + initialize_db([{server,Server}, {ssl_flag,true}, {start_tls,false} | Config0]) + end; +init_per_group(start_tls_api, Config0) -> + case {?config(ldap_server,Config0), ?config(ssl_available,Config0)} of + {undefined,true} -> + {skip, "LDAP server not availble"}; + {_,false} -> + {skip, "TLS not availble"}; + {Server={Host,Port}, true} -> + ct:comment("ldap://~s:~p + start_tls",[Host,Port]), + Config = [{server,Server}, {ssl_flag,false} | Config0], + case supported_extension("1.3.6.1.4.1.1466.20037", Config) of + true -> initialize_db([{start_tls,true} | Config]); + false -> {skip, "start_tls not supported according to the server"} + end + end; +init_per_group(v4_connections, Config) -> + [{tcp_listen_opts, [{reuseaddr, true}]}, + {listen_host, "localhost"}, + {tcp_connect_opts, []} + | Config]; +init_per_group(v6_connections, Config) -> + {ok, Hostname} = inet:gethostname(), + case lists:member(list_to_atom(Hostname), ct:get_config(ipv6_hosts,[])) of + true -> + [{tcp_listen_opts, [inet6,{reuseaddr, true}]}, + {listen_host, "::"}, + {tcp_connect_opts, [{tcpopts,[inet6]}]} + | Config]; + false -> + {skip, io_lib:format("~p is not an ipv6_host",[Hostname])} + end; +init_per_group(_, Config) -> + Config. + +end_per_group(plain_api, Config) -> clear_db(Config); +end_per_group(ssl_api, Config) -> clear_db(Config); +end_per_group(start_tls_api, Config) -> clear_db(Config); +end_per_group(_Group, Config) -> Config. + + +init_per_testcase(ssl_connection, Config) -> + case ?config(ssl_available,Config) of + true -> + SSL_Port = 9999, + CertFile = filename:join(?config(data_dir,Config), "certs/server/cert.pem"), + KeyFile = filename:join(?config(data_dir,Config), "certs/server/key.pem"), + + Parent = self(), + Listener = spawn_link( + fun() -> + case ssl:listen(SSL_Port, [{certfile, CertFile}, + {keyfile, KeyFile} + | ?config(tcp_listen_opts,Config) + ]) of + {ok,SSL_LSock} -> + Parent ! {ok,self()}, + (fun L() -> + ct:log("ssl server waiting for connections...",[]), + {ok, S} = ssl:transport_accept(SSL_LSock), + ct:log("ssl:transport_accept/1 ok",[]), + ok = ssl:ssl_accept(S), + ct:log("ssl:ssl_accept/1 ok",[]), + L() + end)(); + Other -> + Parent ! {not_ok,Other,self()} + end + end), + receive + {ok,Listener} -> + ct:log("SSL listening to port ~p (process ~p)",[SSL_Port, Listener]), + [{ssl_listener,Listener}, + {ssl_listen_port,SSL_Port}, + {ssl_connect_opts,[]} + | Config]; + {no_ok,SSL_Other,Listener} -> + ct:log("ssl:listen on port ~p failed: ~p",[SSL_Port,SSL_Other]), + {fail, "ssl:listen/2 failed"} + after 5000 -> + {fail, "Waiting for ssl:listen timeout"} + end; + false -> + {skip, "ssl not available"} + end; + +init_per_testcase(TC, Config) -> + case lists:member(TC,connection_tests()) of + true -> + case gen_tcp:listen(0, proplists:get_value(tcp_listen_opts,Config)) of + {ok,LSock} -> + {ok,{_,Port}} = inet:sockname(LSock), + [{listen_socket,LSock}, + {listen_port,Port} + | Config]; + Other -> + {fail, Other} + end; + + false -> + case proplists:get_value(name,?config(tc_group_properties, Config)) of + api_not_bound -> + {ok,H} = open(Config), + [{handle,H} | Config]; + api_bound -> + {ok,H} = open(Config), + ok = eldap:simple_bind(H, + "cn=Manager,dc=ericsson,dc=se", + "hejsan"), + [{handle,H} | Config]; + _Name -> + Config + end end. -end_per_testcase(_TestCase, Config) -> - {EHost, Port} = proplists:get_value(ldap_server, Config), - Path = proplists:get_value(eldap_path, Config), - {ok, H} = eldap:open([EHost], [{port, Port}]), - ok = eldap:simple_bind(H, "cn=Manager,dc=ericsson,dc=se", "hejsan"), - case eldap:search(H, [{base, Path}, - {filter, eldap:present("objectclass")}, - {scope, eldap:wholeSubtree()}]) - of - {ok, {eldap_search_result, Entries, _}} -> - [ok = eldap:delete(H, Entry) || {eldap_entry, Entry, _} <- Entries]; - _ -> ignore - end, +end_per_testcase(_, Config) -> + catch gen_tcp:close( proplists:get_value(listen_socket, Config) ), + catch eldap:close( proplists:get_value(handle,Config) ). - ok. -%% suite() -> +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% Test cases +%%% -all() -> - [app, - appup, - api, - ssl_api, - start_tls, - tls_operations, - start_tls_twice, - start_tls_on_ssl - ]. - -app(doc) -> "Test that the eldap app file is ok"; -app(suite) -> []; +%%%---------------------------------------------------------------- +%%% Test that the eldap app file is ok app(Config) when is_list(Config) -> ok = test_server:app_test(eldap). -%% Test that the eldap appup file is ok +%%%---------------------------------------------------------------- +%%% Test that the eldap appup file is ok appup(Config) when is_list(Config) -> ok = test_server:appup_test(eldap). -api(doc) -> "Basic test that all api functions works as expected"; -api(suite) -> []; -api(Config) -> - {Host,Port} = proplists:get_value(ldap_server, Config), - {ok, H} = eldap:open([Host], [{port,Port} - ,{log,fun(Lvl,Fmt,Args)-> io:format("~p: ~s",[Lvl,io_lib:format(Fmt,Args)]) end} - ]), - %% {ok, H} = eldap:open([Host], [{port,Port+1}, {ssl, true}]), - do_api_checks(H, Config), - eldap:close(H), - ok. +%%%---------------------------------------------------------------- +open_ret_val_success(Config) -> + {Host,Port} = ?config(ldap_server,Config), + {ok,H} = eldap:open([Host], [{port,Port}]), + catch eldap:close(H). + +%%%---------------------------------------------------------------- +open_ret_val_error(_Config) -> + {error,_} = eldap:open(["nohost.example.com"], [{port,65535}]). + +%%%---------------------------------------------------------------- +close_ret_val(Config) -> + {Host,Port} = ?config(ldap_server,Config), + {ok,H} = eldap:open([Host], [{port,Port}]), + ok = eldap:close(H). + +%%%---------------------------------------------------------------- +tcp_connection(Config) -> + Host = proplists:get_value(listen_host, Config), + Port = proplists:get_value(listen_port, Config), + Opts = proplists:get_value(tcp_connect_opts, Config), + case eldap:open([Host], [{port,Port}|Opts]) of + {ok,_H} -> + Sl = proplists:get_value(listen_socket, Config), + case gen_tcp:accept(Sl,1000) of + {ok,_S} -> ok; + {error,timeout} -> ct:fail("server side accept timeout",[]); + Other -> ct:fail("gen_tdp:accept failed: ~p",[Other]) + end; + Other -> ct:fail("eldap:open failed: ~p",[Other]) + end. +%%%---------------------------------------------------------------- +ssl_connection(Config) -> + Host = proplists:get_value(listen_host, Config), + Port = proplists:get_value(ssl_listen_port, Config), + Opts = proplists:get_value(tcp_connect_opts, Config), + SSLOpts = proplists:get_value(ssl_connect_opts, Config), + case eldap:open([Host], [{port,Port}, + {ssl,true}, + {timeout,5000}, + {sslopts,SSLOpts}|Opts]) of + {ok,_H} -> ok; + Other -> ct:fail("eldap:open failed: ~p",[Other]) + end. -ssl_api(doc) -> "Basic test that all api functions works as expected"; -ssl_api(suite) -> []; -ssl_api(Config) -> - {Host,Port} = proplists:get_value(ldaps_server, Config), - {ok, H} = eldap:open([Host], [{port,Port}, {ssl,true}]), - do_api_checks(H, Config), - eldap:close(H), - ok. +%%%---------------------------------------------------------------- +client_side_add_timeout(Config) -> + client_timeout( + fun(H) -> + eldap:add(H, "cn=Foo Bar,dc=host,dc=ericsson,dc=se", + [{"objectclass", ["person"]}, + {"cn", ["Foo Bar"]}, + {"sn", ["Bar"]}, + {"telephoneNumber", ["555-1232", "555-5432"]}]) + end, Config). + +%%%---------------------------------------------------------------- +client_side_bind_timeout(Config) -> + client_timeout( + fun(H) -> + eldap:simple_bind(H, anon, anon) + end, Config). + +%%%---------------------------------------------------------------- +client_side_search_timeout(Config) -> + client_timeout( + fun(H) -> + eldap:search(H, [{base,"dc=host,dc=ericsson,dc=se"}, + {filter, eldap:present("objectclass")}, + {scope, eldap:wholeSubtree()}]) + end, Config). + +%%%---------------------------------------------------------------- +client_side_start_tls_timeout(Config) -> + client_timeout( + fun(H) -> + eldap:start_tls(H, []) + end, Config). + +%%%---------------------------------------------------------------- +tcp_connection_option(Config) -> + Host = proplists:get_value(listen_host, Config), + Port = proplists:get_value(listen_port, Config), + Opts = proplists:get_value(tcp_connect_opts, Config), + Sl = proplists:get_value(listen_socket, Config), + + %% Make an option value to test. The option must be implemented on all + %% platforms that we test on. Must check what the default value is + %% so we don't happen to choose that particular value. + {ok,[{linger,DefaultLinger}]} = inet:getopts(Sl, [linger]), + TestLinger = case DefaultLinger of + {false,_} -> {true,5}; + {true,_} -> {false,0} + end, + + case catch eldap:open([Host], + [{port,Port},{tcpopts,[{linger,TestLinger}]}|Opts]) of + {ok,H} -> + case gen_tcp:accept(Sl,1000) of + {ok,_} -> + case eldap:getopts(H, [{tcpopts,[linger]}]) of + {ok,[{tcpopts,[{linger,ActualLinger}]}]} -> + case ActualLinger of + TestLinger -> + ok; + DefaultLinger -> + ct:fail("eldap:getopts: 'linger' didn't change," + " got ~p (=default) expected ~p", + [ActualLinger,TestLinger]); + _ -> + ct:fail("eldap:getopts: bad 'linger', got ~p expected ~p", + [ActualLinger,TestLinger]) + end; + Other -> + ct:fail("eldap:getopts: bad result ~p",[Other]) + end; + {error,timeout} -> + ct:fail("server side accept timeout",[]) + end; + + Other -> + ct:fail("eldap:open failed: ~p",[Other]) + end. -start_tls(doc) -> "Test that an existing (tcp) connection can be upgraded to tls"; -start_tls(suite) -> []; -start_tls(Config) -> - {Host,Port} = proplists:get_value(ldap_server, Config), - {ok, H} = eldap:open([Host], [{port,Port}]), - ok = eldap:start_tls(H, [ - {keyfile, filename:join([proplists:get_value(data_dir,Config), - "certs/client/key.pem"])} - ]), - eldap:close(H). +%%%---------------------------------------------------------------- +%%% Basic test that all api functions works as expected + +%%%---------------------------------------------------------------- +elementary_search(Config) -> + {ok, #eldap_search_result{entries=[_]}} = + eldap:search(?config(handle,Config), + #eldap_search{base = ?config(eldap_path, Config), + filter= eldap:present("objectclass"), + scope = eldap:wholeSubtree()}). + +%%%---------------------------------------------------------------- +search_non_existant(Config) -> + {error, noSuchObject} = + eldap:search(?config(handle,Config), + #eldap_search{base = "cn=Bar," ++ ?config(eldap_path, Config), + filter= eldap:present("objectclass"), + scope = eldap:wholeSubtree()}). + +%%%---------------------------------------------------------------- +add_when_not_bound(Config) -> + {error, _} = eldap:add(?config(handle,Config), + "cn=Jonas Jonsson," ++ ?config(eldap_path, Config), + [{"objectclass", ["person"]}, + {"cn", ["Jonas Jonsson"]}, + {"sn", ["Jonsson"]}]). + +%%%---------------------------------------------------------------- +bind(Config) -> + ok = eldap:simple_bind(?config(handle,Config), + "cn=Manager,dc=ericsson,dc=se", + "hejsan"). + +%%%---------------------------------------------------------------- +add_when_bound(Config) -> + ok = eldap:add(?config(handle, Config), + "cn=Jonas Jonsson," ++ ?config(eldap_path, Config), + [{"objectclass", ["person"]}, + {"cn", ["Jonas Jonsson"]}, + {"sn", ["Jonsson"]}]). + +%%%---------------------------------------------------------------- +add_already_exists(Config) -> + {error, entryAlreadyExists} = + eldap:add(?config(handle, Config), + "cn=Jonas Jonsson," ++ ?config(eldap_path, Config), + [{"objectclass", ["person"]}, + {"cn", ["Jonas Jonsson"]}, + {"sn", ["Jonsson"]}]). + +%%%---------------------------------------------------------------- +more_add(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + ok = eldap:add(H, "cn=Foo Bar," ++ BasePath, + [{"objectclass", ["person"]}, + {"cn", ["Foo Bar"]}, + {"sn", ["Bar"]}, + {"telephoneNumber", ["555-1232", "555-5432"]}]), + ok = eldap:add(H, "ou=Team," ++ BasePath, + [{"objectclass", ["organizationalUnit"]}, + {"ou", ["Team"]}]). -tls_operations(doc) -> "Test that an upgraded connection is usable for ldap stuff"; -tls_operations(suite) -> []; -tls_operations(Config) -> - {Host,Port} = proplists:get_value(ldap_server, Config), - {ok, H} = eldap:open([Host], [{port,Port}]), - ok = eldap:start_tls(H, [ - {keyfile, filename:join([proplists:get_value(data_dir,Config), - "certs/client/key.pem"])} - ]), - do_api_checks(H, Config), +%%%---------------------------------------------------------------- +search_filter_equalityMatch(Config) -> + BasePath = ?config(eldap_path, Config), + ExpectedDN = "cn=Jonas Jonsson," ++ BasePath, + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=ExpectedDN}]}} = + eldap:search(?config(handle, Config), + #eldap_search{base = BasePath, + filter = eldap:equalityMatch("sn", "Jonsson"), + scope=eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +search_filter_substring_any(Config) -> + BasePath = ?config(eldap_path, Config), + ExpectedDN = "cn=Jonas Jonsson," ++ BasePath, + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=ExpectedDN}]}} = + eldap:search(?config(handle, Config), + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{any, "ss"}]), + scope=eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +search_filter_initial(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + ExpectedDN = "cn=Foo Bar," ++ BasePath, + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=ExpectedDN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{initial, "B"}]), + scope=eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +search_filter_final(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + ExpectedDN = "cn=Foo Bar," ++ BasePath, + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=ExpectedDN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{final, "r"}]), + scope=eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +search_filter_and(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + ExpectedDN = "cn=Foo Bar," ++ BasePath, + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=ExpectedDN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:'and'([eldap:substrings("sn", [{any, "a"}]), + eldap:equalityMatch("cn","Foo Bar")]), + scope=eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +search_filter_or(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + ExpectedDNs = lists:sort(["cn=Foo Bar," ++ BasePath, + "ou=Team," ++ BasePath]), + {ok, #eldap_search_result{entries=Es}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:'or'([eldap:substrings("sn", [{any, "a"}]), + eldap:equalityMatch("ou","Team")]), + scope=eldap:singleLevel()}), + ExpectedDNs = lists:sort([DN || #eldap_entry{object_name=DN} <- Es]). + +%%%---------------------------------------------------------------- +search_filter_and_not(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + {ok, #eldap_search_result{entries=[]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:'and'([eldap:substrings("sn", [{any, "a"}]), + eldap:'not'( + eldap:equalityMatch("cn","Foo Bar") + )]), + scope=eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +search_two_hits(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + DN1 = "cn=Santa Claus," ++ BasePath, + DN2 = "cn=Jultomten," ++ BasePath, + %% Add two objects: + ok = eldap:add(H, DN1, + [{"objectclass", ["person"]}, + {"cn", ["Santa Claus"]}, + {"sn", ["Santa"]}, + {"description", ["USA"]}]), + ok = eldap:add(H, DN2, + [{"objectclass", ["person"]}, + {"cn", ["Jultomten"]}, + {"sn", ["Tomten"]}, + {"description", ["Sweden"]}]), + + %% Search for them: + {ok, #eldap_search_result{entries=Es}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:present("description"), + scope=eldap:singleLevel()}), + + %% And check that they are the expected ones: + ExpectedDNs = lists:sort([DN1, DN2]), + ExpectedDNs = lists:sort([D || #eldap_entry{object_name=D} <- Es]), + + %% Restore the database: + [ok=eldap:delete(H,DN) || DN <- ExpectedDNs]. + +%%%---------------------------------------------------------------- +modify(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + %% The object to modify + DN = "cn=Foo Bar," ++ BasePath, + + %% Save a copy to restore later: + {ok,OriginalAttrs} = attributes(H, DN), + + %% Do a change + Mod = [eldap:mod_replace("telephoneNumber", ["555-12345"]), + eldap:mod_add("description", ["Nice guy"])], + ok = eldap:modify(H, DN, Mod), + + %% Check that the object was changed + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=DN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:equalityMatch("telephoneNumber", "555-12345"), + scope=eldap:singleLevel()}), + + %% Do another type of change + ok = eldap:modify(H, DN, [eldap:mod_delete("telephoneNumber", [])]), + %% and check that it worked by repeating the test above + {ok, #eldap_search_result{entries=[]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:equalityMatch("telephoneNumber", "555-12345"), + scope=eldap:singleLevel()}), + %% restore the orignal version: + restore_original_object(H, DN, OriginalAttrs). + +%%%---------------------------------------------------------------- +delete(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + %% The element to play with: + DN = "cn=Jonas Jonsson," ++ BasePath, + + %% Prove that the element is present before deletion + {ok,OriginalAttrs} = attributes(H, DN), + + %% Do what the test has to do: + ok = eldap:delete(H, DN), + %% check that it really was deleted: + {error, noSuchObject} = eldap:delete(H, DN), + + %% And restore the object for subsequent tests + restore_original_object(H, DN, OriginalAttrs). + +%%%---------------------------------------------------------------- +modify_dn_delete_old(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + OrigCN = "Foo Bar", + OriginalRDN = "cn="++OrigCN, + DN = OriginalRDN ++ "," ++ BasePath, + NewCN = "Niclas Andre", + NewRDN = "cn="++NewCN, + NewDN = NewRDN ++ "," ++BasePath, + + %% Check that the object to modify_dn of exists: + {ok,OriginalAttrs} = attributes(H, DN), + CN_orig = lists:sort(proplists:get_value("cn",OriginalAttrs)), + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=DN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{any, "a"}]), + scope = eldap:singleLevel()}), + + %% Modify and delete the old one: + ok = eldap:modify_dn(H, DN, NewRDN, true, ""), + + %% Check that DN was modified and the old one was deleted: + {ok,NewAttrs} = attributes(H, NewDN), + CN_new = lists:sort(proplists:get_value("cn",NewAttrs)), + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=NewDN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{any, "a"}]), + scope = eldap:singleLevel()}), + %% What we expect: + CN_new = lists:sort([NewCN | CN_orig -- [OrigCN]]), + + %% Change back: + ok = eldap:modify_dn(H, NewDN, OriginalRDN, true, ""), + + %% Check that DN was modified and the new one was deleted: + {ok,SameAsOriginalAttrs} = attributes(H, DN), + CN_orig = lists:sort(proplists:get_value("cn",SameAsOriginalAttrs)), + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=DN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{any, "a"}]), + scope = eldap:singleLevel()}). + +%%%---------------------------------------------------------------- +modify_dn_keep_old(Config) -> + H = ?config(handle, Config), + BasePath = ?config(eldap_path, Config), + OriginalRDN = "cn=Foo Bar", + DN = OriginalRDN ++ "," ++ BasePath, + NewCN = "Niclas Andre", + NewRDN = "cn="++NewCN, + NewDN = NewRDN ++ "," ++BasePath, + + %% Check that the object to modify_dn of exists but the new one does not: + {ok,OriginalAttrs} = attributes(H, DN), + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=DN}]}} = + eldap:search(H, + #eldap_search{base = BasePath, + filter = eldap:substrings("sn", [{any, "a"}]), + scope = eldap:singleLevel()}), + + %% Modify but keep the old "cn" attr: + ok = eldap:modify_dn(H, DN, NewRDN, false, ""), + + %% Check that DN was modified and the old CN entry is not deleted: + {ok,NewAttrs} = attributes(H, NewDN), + CN_orig = proplists:get_value("cn",OriginalAttrs), + CN_new = proplists:get_value("cn",NewAttrs), + Expected = lists:sort([NewCN|CN_orig]), + Expected = lists:sort(CN_new), + + %% Restore db: + ok = eldap:delete(H, NewDN), + restore_original_object(H, DN, OriginalAttrs). + +%%%---------------------------------------------------------------- +%%% Test that start_tls on an already upgraded connection makes no noise +start_tls_twice_should_fail(Config) -> + {ok,H} = open_bind(Config), + {error,tls_already_started} = eldap:start_tls(H, []), eldap:close(H). -start_tls_twice(doc) -> "Test that start_tls on an already upgraded connection fails"; -start_tls_twice(suite) -> []; -start_tls_twice(Config) -> - {Host,Port} = proplists:get_value(ldap_server, Config), - {ok, H} = eldap:open([Host], [{port,Port}]), - ok = eldap:start_tls(H, []), +%%%---------------------------------------------------------------- +%%% Test that start_tls on an ldaps connection fails +start_tls_on_ssl_should_fail(Config) -> + {ok,H} = open_bind(Config), {error,tls_already_started} = eldap:start_tls(H, []), - do_api_checks(H, Config), eldap:close(H). +%%%---------------------------------------------------------------- +encode(_Config) -> + {ok,Bin} = 'ELDAPv3':encode('AddRequest', #'AddRequest'{entry="hejHopp" ,attributes=[]} ), + Expected = <<104,11,4,7,104,101,106,72,111,112,112,48,0>>, + case Bin of + Expected -> ok; + _ -> ct:log("Encoded erroneously to:~n~p~nExpected:~n~p",[Bin,Expected]), + {fail, "Bad encode"} + end. + +%%%---------------------------------------------------------------- +decode(_Config) -> + {ok,Res} = 'ELDAPv3':decode('AddRequest', <<104,11,4,7,104,101,106,72,111,112,112,48,0>>), + ct:log("Res = ~p", [Res]), + Expected = #'AddRequest'{entry = "hejHopp",attributes = []}, + case Res of + Expected -> ok; + #'AddRequest'{entry= <<"hejHopp">>, attributes=[]} -> + {fail, "decoded to (correct) binary!!"}; + _ -> + {fail, "Bad decode"} + end. -start_tls_on_ssl(doc) -> "Test that start_tls on an ldaps connection fails"; -start_tls_on_ssl(suite) -> []; -start_tls_on_ssl(Config) -> - {Host,Port} = proplists:get_value(ldaps_server, Config), - {ok, H} = eldap:open([Host], [{port,Port}, {ssl,true}]), - {error,tls_already_started} = eldap:start_tls(H, []), - do_api_checks(H, Config), - eldap:close(H). -%%%-------------------------------------------------------------------------------- -chk_config(Key, Default, Config) -> - case catch ct:get_config(ldap_server, undefined) of - undefined -> [{Key,Default} | Config ]; - {'EXIT',_} -> [{Key,Default} | Config ]; - Value -> [{Key,Value} | Config] +%%%**************************************************************** +%%% Private + +attributes(H, DN) -> + case eldap:search(H, + #eldap_search{base = DN, + filter= eldap:present("objectclass"), + scope = eldap:wholeSubtree()}) of + {ok, #eldap_search_result{entries=[#eldap_entry{object_name=DN, + attributes=OriginalAttrs}]}} -> + {ok, OriginalAttrs}; + Other -> + Other end. +restore_original_object(H, DN, Attrs) -> + eldap:delete(H, DN), + ok = eldap:add(H, DN, Attrs). + + +find_first_server(UseSSL, [{config,Key}|Ss]) -> + case ct:get_config(Key) of + {Host,Port} -> + ct:log("find_first_server config ~p -> ~p",[Key,{Host,Port}]), + find_first_server(UseSSL, [{Host,Port}|Ss]); + undefined -> + ct:log("find_first_server config ~p is undefined",[Key]), + find_first_server(UseSSL, Ss) + end; +find_first_server(UseSSL, [{Host,Port}|Ss]) -> + case eldap:open([Host],[{port,Port},{ssl,UseSSL}]) of + {ok,H} when UseSSL==false, Ss=/=[] -> + case eldap:start_tls(H,[]) of + ok -> + ct:log("find_first_server ~p UseSSL=~p -> ok",[{Host,Port},UseSSL]), + eldap:close(H), + {Host,Port}; + Res -> + ct:log("find_first_server ~p UseSSL=~p failed with~n~p~nSave as spare host.",[{Host,Port},UseSSL,Res]), + eldap:close(H), + find_first_server(UseSSL, Ss++[{spare_host,Host,Port}]) + end; + {ok,H} -> + ct:log("find_first_server ~p UseSSL=~p -> ok",[{Host,Port},UseSSL]), + eldap:close(H), + {Host,Port}; + Res -> + ct:log("find_first_server ~p UseSSL=~p failed with~n~p",[{Host,Port},UseSSL,Res]), + find_first_server(UseSSL, Ss) + end; +find_first_server(false, [{spare_host,Host,Port}|_]) -> + ct:log("find_first_server can't find start_tls host, use the spare non-start_tls host for plain ldap: ~p",[{Host,Port}]), + {Host,Port}; +find_first_server(_, []) -> + ct:log("find_first_server, nothing left to try",[]), + undefined. + +initialize_db(Config) -> + case {open_bind(Config), inet:gethostname()} of + {{ok,H}, {ok,MyHost}} -> + Path = "dc="++MyHost++",dc=ericsson,dc=se", + delete_old_contents(H, Path), + add_new_contents(H, Path, MyHost), + eldap:close(H), + [{eldap_path,Path}|Config]; + Other -> + ct:fail("initialize_db failed: ~p",[Other]) + end. +clear_db(Config) -> + {ok,H} = open_bind(Config), + Path = ?config(eldap_path, Config), + delete_old_contents(H, Path), + eldap:close(H), + Config. -do_api_checks(H, Config) -> - BasePath = proplists:get_value(eldap_path, Config), +delete_old_contents(H, Path) -> + case eldap:search(H, [{base, Path}, + {filter, eldap:present("objectclass")}, + {scope, eldap:wholeSubtree()}]) + of + {ok, #eldap_search_result{entries=Entries}} -> + [ok = eldap:delete(H,DN) || #eldap_entry{object_name=DN} <- Entries]; + _Res -> + ignore + end. - All = fun(Where) -> - eldap:search(H, #eldap_search{base=Where, - filter=eldap:present("objectclass"), - scope= eldap:wholeSubtree()}) - end, - {ok, #eldap_search_result{entries=[_XYZ]}} = All(BasePath), -%% ct:log("XYZ=~p",[_XYZ]), - {error, noSuchObject} = All("cn=Bar,"++BasePath), +add_new_contents(H, Path, MyHost) -> + ok(eldap:add(H,"dc=ericsson,dc=se", + [{"objectclass", ["dcObject", "organization"]}, + {"dc", ["ericsson"]}, + {"o", ["Testing"]}])), + ok(eldap:add(H,Path, + [{"objectclass", ["dcObject", "organization"]}, + {"dc", [MyHost]}, + {"o", ["Test machine"]}])). - {error, _} = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, - [{"objectclass", ["person"]}, - {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), - eldap:simple_bind(H, "cn=Manager,dc=ericsson,dc=se", "hejsan"), - chk_add(H, BasePath), - {ok,FB} = chk_search(H, BasePath), - chk_modify(H, FB), - chk_delete(H, BasePath), - chk_modify_dn(H, FB). +ok({error,entryAlreadyExists}) -> ok; +ok(X) -> ok=X. -chk_add(H, BasePath) -> - ok = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, - [{"objectclass", ["person"]}, - {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), - {error, entryAlreadyExists} = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, - [{"objectclass", ["person"]}, - {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), - ok = eldap:add(H, "cn=Foo Bar," ++ BasePath, - [{"objectclass", ["person"]}, - {"cn", ["Foo Bar"]}, {"sn", ["Bar"]}, {"telephoneNumber", ["555-1232", "555-5432"]}]), - ok = eldap:add(H, "ou=Team," ++ BasePath, - [{"objectclass", ["organizationalUnit"]}, - {"ou", ["Team"]}]). -chk_search(H, BasePath) -> - Search = fun(Filter) -> - eldap:search(H, #eldap_search{base=BasePath, - filter=Filter, - scope=eldap:singleLevel()}) - end, - JJSR = {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(eldap:equalityMatch("sn", "Jonsson")), - JJSR = Search(eldap:substrings("sn", [{any, "ss"}])), - FBSR = {ok, #eldap_search_result{entries=[#eldap_entry{object_name=FB}]}} = - Search(eldap:substrings("sn", [{any, "a"}])), - FBSR = Search(eldap:substrings("sn", [{initial, "B"}])), - FBSR = Search(eldap:substrings("sn", [{final, "r"}])), - F_AND = eldap:'and'([eldap:present("objectclass"), eldap:present("ou")]), - {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(F_AND), - F_NOT = eldap:'and'([eldap:present("objectclass"), eldap:'not'(eldap:present("ou"))]), - {ok, #eldap_search_result{entries=[#eldap_entry{}, #eldap_entry{}]}} = Search(F_NOT), - {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(eldap:extensibleMatch("Bar",[{type,"sn"},{matchingRule,"caseExactMatch"}])), - {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(eldap:extensibleMatch("Bar",[{type,"sn"},{matchingRule,"2.5.13.5"}])), - {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(eldap:extensibleMatch("Bar",[{type,"sn"},{matchingRule,"caseIgnoreMatch"}])), - {ok, #eldap_search_result{entries=[#eldap_entry{}]}} = Search(eldap:extensibleMatch("bar",[{type,"sn"},{matchingRule,"caseIgnoreMatch"}])), - {ok, #eldap_search_result{entries=[]}} = Search(eldap:extensibleMatch("bar",[{type,"sn"},{matchingRule,"gluffgluff"}])), - {ok, #eldap_search_result{entries=[]}} = Search(eldap:extensibleMatch("bar",[{type,"sn"},{matchingRule,"caseExactMatch"}])), - {ok,FB}. %% FIXME - -chk_modify(H, FB) -> - Mod = [eldap:mod_replace("telephoneNumber", ["555-12345"]), - eldap:mod_add("description", ["Nice guy"])], - %% io:format("MOD ~p ~p ~n",[FB, Mod]), - ok = eldap:modify(H, FB, Mod), - %% DELETE ATTR - ok = eldap:modify(H, FB, [eldap:mod_delete("telephoneNumber", [])]). - - -chk_delete(H, BasePath) -> - {error, entryAlreadyExists} = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, - [{"objectclass", ["person"]}, - {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), - ok = eldap:delete(H, "cn=Jonas Jonsson," ++ BasePath), - {error, noSuchObject} = eldap:delete(H, "cn=Jonas Jonsson," ++ BasePath). - -chk_modify_dn(H, FB) -> - ok = eldap:modify_dn(H, FB, "cn=Niclas Andre", true, ""). - %%io:format("Res ~p~n ~p~n",[R, All(BasePath)]). - - -%%%---------------- -add(H, Attr, Value, Path0, Attrs, Class) -> - Path = case Path0 of - [] -> Attr ++ "=" ++ Value; - _ -> Attr ++ "=" ++ Value ++ "," ++ Path0 - end, - case eldap:add(H, Path, [{"objectclass", Class}, {Attr, [Value]}] ++ Attrs) - of - ok -> {ok, Path}; - {error, E = entryAlreadyExists} -> {E, Path}; - R = {error, Reason} -> - io:format("~p:~p: ~s,~s =>~n ~p~n", - [?MODULE,?LINE, Attr, Value, R]), - exit({ldap, add, Reason}) +cond_start_tls(H, Config) -> + case ?config(start_tls,Config) of + true -> start_tls(H,Config); + _ -> Config end. +start_tls(H, Config) -> + KeyFile = filename:join([?config(data_dir,Config), + "certs/client/key.pem" + ]), + case eldap:start_tls(H, [{keyfile, KeyFile}]) of + ok -> + [{start_tls_success,true} | Config]; + Error -> + ct:log("Start_tls on ~p failed: ~p",[?config(url,Config) ,Error]), + ct:fail("start_tls failed") + end. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Develop -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -test() -> - run(). - -run() -> - Cases = all(), - run(Cases). - -run(Case) when is_atom(Case) -> - run([Case]); -run(Cases) when is_list(Cases) -> - Run = fun(Test, Config0) -> - Config = init_per_testcase(Test, Config0), - try - io:format("~nTest ~p ... ",[Test]), - ?MODULE:Test(Config), - end_per_testcase(Test, Config), - io:format("ok~n",[]) - catch _:Reason -> - io:format("~n FAIL (~p): ~p~n ~p~n", - [Test, Reason, erlang:get_stacktrace()]) - end - end, - process_flag(trap_exit, true), - Pid = spawn_link(fun() -> - case init_per_suite([]) of - {skip, Reason} -> io:format("Skip ~s~n",[Reason]); - Config -> - try - [Run(Test, Config) || Test <- Cases] - catch _:Err -> - io:format("Error ~p in ~p~n",[Err, erlang:get_stacktrace()]) - end, - end_per_suite(Config) - end - end), - receive - {'EXIT', Pid, normal} -> ok; - Msg -> io:format("Received ~p (~p)~n",[Msg, Pid]) - after 100 -> ok end, - process_flag(trap_exit, false), - ok. +%%%---------------------------------------------------------------- +open_bind(Config) -> + {ok,H} = open(Config), + ok = eldap:simple_bind(H, "cn=Manager,dc=ericsson,dc=se", "hejsan"), + {ok,H}. + +open(Config) -> + {Host,Port} = ?config(server,Config), + SSLflag = ?config(ssl_flag,Config), + {ok,H} = eldap:open([Host], [{port,Port},{ssl,SSLflag}]), + cond_start_tls(H, Config), + {ok,H}. + +%%%---------------------------------------------------------------- +supported_extension(OID, Config) -> + {ok,H} = open_bind(Config), + case eldap:search(H, [{scope, eldap:baseObject()}, + {filter, eldap:present("objectclass")}, + {deref, eldap:neverDerefAliases()}, + {attributes, ["+"]}]) of + {ok,R=#eldap_search_result{}} -> + eldap:close(H), + lists:member(OID, + [SE || EE <- R#eldap_search_result.entries, + {"supportedExtension",SEs} <- EE#eldap_entry.attributes, + SE<-SEs]); + _ -> + eldap:close(H), + false + end. + +%%%---------------------------------------------------------------- +client_timeout(Fun, Config) -> + Host = proplists:get_value(listen_host, Config), + Port = proplists:get_value(listen_port, Config), + Opts = proplists:get_value(tcp_connect_opts, Config), + T = 1000, + case eldap:open([Host], [{timeout,T},{port,Port}|Opts]) of + {ok,H} -> + T0 = now(), + {error,{gen_tcp_error,timeout}} = Fun(H), + T_op = diff(T0,now()), + ct:log("Time = ~p, Timeout spec = ~p",[T_op,T]), + if + T_op < T -> + {fail, "Timeout too early"}; + true -> + ok + end; + + Other -> ct:fail("eldap:open failed: ~p",[Other]) + end. + +diff({M1,S1,U1},{M2,S2,U2}) -> + ( ((M2-M1)*1000 + (S2-S1))*1000 + (U2-U1) ). + +%%%---------------------------------------------------------------- +init_ssl_certs_et_al(Config) -> + try ssl:start() + of + R when R==ok ; R=={error,{already_started,ssl}} -> + try make_certs:all("/dev/null", + filename:join(?config(data_dir,Config), "certs")) + of + {ok,_} -> true; + Other -> + ct:comment("make_certs failed"), + ct:log("make_certs failed ~p", [Other]), + false + catch + C:E -> + ct:comment("make_certs crashed"), + ct:log("make_certs failed ~p:~p", [C,E]), + false + end; + _ -> + false + catch + Error:Reason -> + ct:comment("ssl failed to start"), + ct:log("init_per_suite failed to start ssl Error=~p Reason=~p", [Error, Reason]), + false + end. diff --git a/lib/eldap/test/eldap_basic_SUITE_data/RAND b/lib/eldap/test/eldap_basic_SUITE_data/RAND Binary files differnew file mode 100644 index 0000000000..70997bd01f --- /dev/null +++ b/lib/eldap/test/eldap_basic_SUITE_data/RAND diff --git a/lib/eldap/test/eldap_connections_SUITE.erl b/lib/eldap/test/eldap_connections_SUITE.erl deleted file mode 100644 index c5460fef09..0000000000 --- a/lib/eldap/test/eldap_connections_SUITE.erl +++ /dev/null @@ -1,147 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2012-2014. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(eldap_connections_SUITE). - --compile(export_all). - --include_lib("common_test/include/ct.hrl"). -%-include_lib("eldap/include/eldap.hrl"). - - -all() -> - [ - {group, v4}, - {group, v6} - ]. - - -init_per_group(v4, Config) -> - [{listen_opts, []}, - {listen_host, "localhost"}, - {connect_opts, []} - | Config]; -init_per_group(v6, Config) -> - {ok, Hostname} = inet:gethostname(), - case lists:member(list_to_atom(Hostname), ct:get_config(ipv6_hosts,[])) of - true -> - [{listen_opts, [inet6]}, - {listen_host, "::"}, - {connect_opts, [{tcpopts,[inet6]}]} - | Config]; - false -> - {skip, io_lib:format("~p is not an ipv6_host",[Hostname])} - end. - - -end_per_group(_GroupName, Config) -> - Config. - - -groups() -> - [{v4, [], [tcp_connection, tcp_connection_option]}, - {v6, [], [tcp_connection, tcp_connection_option]} - ]. - - -init_per_suite(Config) -> Config. - - -end_per_suite(_Config) -> ok. - - -init_per_testcase(_TestCase, Config) -> - case gen_tcp:listen(0, proplists:get_value(listen_opts,Config)) of - {ok,LSock} -> - {ok,{_,Port}} = inet:sockname(LSock), - [{listen_socket,LSock}, - {listen_port,Port} - | Config]; - Other -> - {fail, Other} - end. - - -end_per_testcase(_TestCase, Config) -> - catch gen_tcp:close( proplists:get_value(listen_socket, Config) ). - -%%%================================================================ -%%% -%%% Test cases -%%% -%%%---------------------------------------------------------------- -tcp_connection(Config) -> - Host = proplists:get_value(listen_host, Config), - Port = proplists:get_value(listen_port, Config), - Opts = proplists:get_value(connect_opts, Config), - case eldap:open([Host], [{port,Port}|Opts]) of - {ok,_H} -> - Sl = proplists:get_value(listen_socket, Config), - case gen_tcp:accept(Sl,1000) of - {ok,_S} -> ok; - {error,timeout} -> ct:fail("server side accept timeout",[]) - end; - Other -> ct:fail("eldap:open failed: ~p",[Other]) - end. - - -%%%---------------------------------------------------------------- -tcp_connection_option(Config) -> - Host = proplists:get_value(listen_host, Config), - Port = proplists:get_value(listen_port, Config), - Opts = proplists:get_value(connect_opts, Config), - Sl = proplists:get_value(listen_socket, Config), - - %% Make an option value to test. The option must be implemented on all - %% platforms that we test on. Must check what the default value is - %% so we don't happen to choose that particular value. - {ok,[{linger,DefaultLinger}]} = inet:getopts(Sl, [linger]), - TestLinger = case DefaultLinger of - {false,_} -> {true,5}; - {true,_} -> {false,0} - end, - - case catch eldap:open([Host], - [{port,Port},{tcpopts,[{linger,TestLinger}]}|Opts]) of - {ok,H} -> - case gen_tcp:accept(Sl,1000) of - {ok,_} -> - case eldap:getopts(H, [{tcpopts,[linger]}]) of - {ok,[{tcpopts,[{linger,ActualLinger}]}]} -> - case ActualLinger of - TestLinger -> - ok; - DefaultLinger -> - ct:fail("eldap:getopts: 'linger' didn't change," - " got ~p (=default) expected ~p", - [ActualLinger,TestLinger]); - _ -> - ct:fail("eldap:getopts: bad 'linger', got ~p expected ~p", - [ActualLinger,TestLinger]) - end; - Other -> - ct:fail("eldap:getopts: bad result ~p",[Other]) - end; - {error,timeout} -> - ct:fail("server side accept timeout",[]) - end; - - Other -> - ct:fail("eldap:open failed: ~p",[Other]) - end. diff --git a/lib/eldap/test/eldap_misc_SUITE.erl b/lib/eldap/test/eldap_misc_SUITE.erl deleted file mode 100644 index ca810ee33c..0000000000 --- a/lib/eldap/test/eldap_misc_SUITE.erl +++ /dev/null @@ -1,51 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2012-2014. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(eldap_misc_SUITE). - --compile(export_all). %% Use this only in test suites... - --include_lib("common_test/include/ct.hrl"). --include_lib("eldap/include/eldap.hrl"). --include_lib("eldap/ebin/ELDAPv3.hrl"). - -all() -> - [ - encode, - decode - ]. - - -encode(_Config) -> - {ok,Bin} = 'ELDAPv3':encode('AddRequest', #'AddRequest'{entry="hejHopp" ,attributes=[]} ), - Expected = <<104,11,4,7,104,101,106,72,111,112,112,48,0>>, - Expected = Bin. - -decode(_Config) -> - {ok,Res} = 'ELDAPv3':decode('AddRequest', <<104,11,4,7,104,101,106,72,111,112,112,48,0>>), - ct:log("Res = ~p", [Res]), - Expected = #'AddRequest'{entry = "hejHopp",attributes = []}, - case Res of - Expected -> ok; - #'AddRequest'{entry= <<"hejHopp">>, attributes=[]} -> - {fail, "decoded to (correct) binary!!"}; - _ -> - {fail, "Bad decode"} - end. - diff --git a/lib/eldap/test/make_certs.erl b/lib/eldap/test/make_certs.erl index f963af180d..15a7e118ff 100644 --- a/lib/eldap/test/make_certs.erl +++ b/lib/eldap/test/make_certs.erl @@ -1,41 +1,89 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-2012. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(make_certs). +-compile([export_all]). --export([all/2]). +%-export([all/1, all/2, rootCA/2, intermediateCA/3, endusers/3, enduser/3, revoke/3, gencrl/2, verify/3]). --record(dn, {commonName, +-record(config, {commonName, organizationalUnitName = "Erlang OTP", organizationName = "Ericsson AB", localityName = "Stockholm", countryName = "SE", - emailAddress = "[email protected]"}). + emailAddress = "[email protected]", + default_bits = 2048, + v2_crls = true, + ecc_certs = false, + issuing_distribution_point = false, + crl_port = 8000, + openssl_cmd = "openssl"}). + + +default_config() -> + #config{}. + +make_config(Args) -> + make_config(Args, #config{}). + +make_config([], C) -> + C; +make_config([{organizationalUnitName, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{organizationalUnitName = Name}); +make_config([{organizationName, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{organizationName = Name}); +make_config([{localityName, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{localityName = Name}); +make_config([{countryName, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{countryName = Name}); +make_config([{emailAddress, Name}|T], C) when is_list(Name) -> + make_config(T, C#config{emailAddress = Name}); +make_config([{default_bits, Bits}|T], C) when is_integer(Bits) -> + make_config(T, C#config{default_bits = Bits}); +make_config([{v2_crls, Bool}|T], C) when is_boolean(Bool) -> + make_config(T, C#config{v2_crls = Bool}); +make_config([{crl_port, Port}|T], C) when is_integer(Port) -> + make_config(T, C#config{crl_port = Port}); +make_config([{ecc_certs, Bool}|T], C) when is_boolean(Bool) -> + make_config(T, C#config{ecc_certs = Bool}); +make_config([{issuing_distribution_point, Bool}|T], C) when is_boolean(Bool) -> + make_config(T, C#config{issuing_distribution_point = Bool}); +make_config([{openssl_cmd, Cmd}|T], C) when is_list(Cmd) -> + make_config(T, C#config{openssl_cmd = Cmd}). + + +all([DataDir, PrivDir]) -> + all(DataDir, PrivDir). all(DataDir, PrivDir) -> - OpenSSLCmd = "openssl", + all(DataDir, PrivDir, #config{}). + +all(DataDir, PrivDir, C) when is_list(C) -> + all(DataDir, PrivDir, make_config(C)); +all(DataDir, PrivDir, C = #config{}) -> + ok = filelib:ensure_dir(filename:join(PrivDir, "erlangCA")), create_rnd(DataDir, PrivDir), % For all requests - rootCA(PrivDir, OpenSSLCmd, "erlangCA"), - intermediateCA(PrivDir, OpenSSLCmd, "otpCA", "erlangCA"), - endusers(PrivDir, OpenSSLCmd, "otpCA", ["client", "server"]), - collect_certs(PrivDir, ["erlangCA", "otpCA"], ["client", "server"]), - %% Create keycert files + rootCA(PrivDir, "erlangCA", C), + intermediateCA(PrivDir, "otpCA", "erlangCA", C), + endusers(PrivDir, "otpCA", ["client", "server", "revoked"], C), + endusers(PrivDir, "erlangCA", ["localhost"], C), + %% Create keycert files SDir = filename:join([PrivDir, "server"]), SC = filename:join([SDir, "cert.pem"]), SK = filename:join([SDir, "key.pem"]), @@ -46,7 +94,14 @@ all(DataDir, PrivDir) -> CK = filename:join([CDir, "key.pem"]), CKC = filename:join([CDir, "keycert.pem"]), append_files([CK, CC], CKC), - remove_rnd(PrivDir). + RDir = filename:join([PrivDir, "revoked"]), + RC = filename:join([RDir, "cert.pem"]), + RK = filename:join([RDir, "key.pem"]), + RKC = filename:join([RDir, "keycert.pem"]), + revoke(PrivDir, "otpCA", "revoked", C), + append_files([RK, RC], RKC), + remove_rnd(PrivDir), + {ok, C}. append_files(FileNames, ResultFileName) -> {ok, ResultFile} = file:open(ResultFileName, [write]), @@ -59,117 +114,182 @@ do_append_files([F|Fs], RF) -> ok = file:write(RF, Data), do_append_files(Fs, RF). -rootCA(Root, OpenSSLCmd, Name) -> - create_ca_dir(Root, Name, ca_cnf(Name)), - DN = #dn{commonName = Name}, - create_self_signed_cert(Root, OpenSSLCmd, Name, req_cnf(DN)), - ok. +rootCA(Root, Name, C) -> + create_ca_dir(Root, Name, ca_cnf(C#config{commonName = Name})), + create_self_signed_cert(Root, Name, req_cnf(C#config{commonName = Name}), C), + file:copy(filename:join([Root, Name, "cert.pem"]), filename:join([Root, Name, "cacerts.pem"])), + gencrl(Root, Name, C). -intermediateCA(Root, OpenSSLCmd, CA, ParentCA) -> - CA = "otpCA", - create_ca_dir(Root, CA, ca_cnf(CA)), +intermediateCA(Root, CA, ParentCA, C) -> + create_ca_dir(Root, CA, ca_cnf(C#config{commonName = CA})), CARoot = filename:join([Root, CA]), - DN = #dn{commonName = CA}, CnfFile = filename:join([CARoot, "req.cnf"]), - file:write_file(CnfFile, req_cnf(DN)), - KeyFile = filename:join([CARoot, "private", "key.pem"]), - ReqFile = filename:join([CARoot, "req.pem"]), - create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile), + file:write_file(CnfFile, req_cnf(C#config{commonName = CA})), + KeyFile = filename:join([CARoot, "private", "key.pem"]), + ReqFile = filename:join([CARoot, "req.pem"]), + create_req(Root, CnfFile, KeyFile, ReqFile, C), CertFile = filename:join([CARoot, "cert.pem"]), - sign_req(Root, OpenSSLCmd, ParentCA, "ca_cert", ReqFile, CertFile). - -endusers(Root, OpenSSLCmd, CA, Users) -> - lists:foreach(fun(User) -> enduser(Root, OpenSSLCmd, CA, User) end, Users). - -enduser(Root, OpenSSLCmd, CA, User) -> + sign_req(Root, ParentCA, "ca_cert", ReqFile, CertFile, C), + CACertsFile = filename:join(CARoot, "cacerts.pem"), + file:copy(filename:join([Root, ParentCA, "cacerts.pem"]), CACertsFile), + %% append this CA's cert to the cacerts file + {ok, Bin} = file:read_file(CertFile), + {ok, FD} = file:open(CACertsFile, [append]), + file:write(FD, ["\n", Bin]), + file:close(FD), + gencrl(Root, CA, C). + +endusers(Root, CA, Users, C) -> + [enduser(Root, CA, User, C) || User <- Users]. + +enduser(Root, CA, User, C) -> UsrRoot = filename:join([Root, User]), file:make_dir(UsrRoot), CnfFile = filename:join([UsrRoot, "req.cnf"]), - DN = #dn{commonName = User}, - file:write_file(CnfFile, req_cnf(DN)), - KeyFile = filename:join([UsrRoot, "key.pem"]), - ReqFile = filename:join([UsrRoot, "req.pem"]), - create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile), + file:write_file(CnfFile, req_cnf(C#config{commonName = User})), + KeyFile = filename:join([UsrRoot, "key.pem"]), + ReqFile = filename:join([UsrRoot, "req.pem"]), + create_req(Root, CnfFile, KeyFile, ReqFile, C), + %create_req(Root, CnfFile, KeyFile, ReqFile), CertFileAllUsage = filename:join([UsrRoot, "cert.pem"]), - sign_req(Root, OpenSSLCmd, CA, "user_cert", ReqFile, CertFileAllUsage), + sign_req(Root, CA, "user_cert", ReqFile, CertFileAllUsage, C), CertFileDigitalSigOnly = filename:join([UsrRoot, "digital_signature_only_cert.pem"]), - sign_req(Root, OpenSSLCmd, CA, "user_cert_digital_signature_only", ReqFile, CertFileDigitalSigOnly). - -collect_certs(Root, CAs, Users) -> - Bins = lists:foldr( - fun(CA, Acc) -> - File = filename:join([Root, CA, "cert.pem"]), - {ok, Bin} = file:read_file(File), - [Bin, "\n" | Acc] - end, [], CAs), - lists:foreach( - fun(User) -> - File = filename:join([Root, User, "cacerts.pem"]), - file:write_file(File, Bins) - end, Users). + sign_req(Root, CA, "user_cert_digital_signature_only", ReqFile, CertFileDigitalSigOnly, C), + CACertsFile = filename:join(UsrRoot, "cacerts.pem"), + file:copy(filename:join([Root, CA, "cacerts.pem"]), CACertsFile), + ok. -create_self_signed_cert(Root, OpenSSLCmd, CAName, Cnf) -> +revoke(Root, CA, User, C) -> + UsrCert = filename:join([Root, User, "cert.pem"]), + CACnfFile = filename:join([Root, CA, "ca.cnf"]), + Cmd = [C#config.openssl_cmd, " ca" + " -revoke ", UsrCert, + [" -crl_reason keyCompromise" || C#config.v2_crls ], + " -config ", CACnfFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env), + gencrl(Root, CA, C). + +gencrl(Root, CA, C) -> + CACnfFile = filename:join([Root, CA, "ca.cnf"]), + CACRLFile = filename:join([Root, CA, "crl.pem"]), + Cmd = [C#config.openssl_cmd, " ca" + " -gencrl ", + " -crlhours 24", + " -out ", CACRLFile, + " -config ", CACnfFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env). + +verify(Root, CA, User, C) -> + CAFile = filename:join([Root, User, "cacerts.pem"]), + CACRLFile = filename:join([Root, CA, "crl.pem"]), + CertFile = filename:join([Root, User, "cert.pem"]), + Cmd = [C#config.openssl_cmd, " verify" + " -CAfile ", CAFile, + " -CRLfile ", CACRLFile, %% this is undocumented, but seems to work + " -crl_check ", + CertFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + try cmd(Cmd, Env) catch + exit:{eval_cmd, _, _} -> + invalid + end. + +create_self_signed_cert(Root, CAName, Cnf, C = #config{ecc_certs = true}) -> CARoot = filename:join([Root, CAName]), CnfFile = filename:join([CARoot, "req.cnf"]), file:write_file(CnfFile, Cnf), - KeyFile = filename:join([CARoot, "private", "key.pem"]), - CertFile = filename:join([CARoot, "cert.pem"]), - Cmd = [OpenSSLCmd, " req" + KeyFile = filename:join([CARoot, "private", "key.pem"]), + CertFile = filename:join([CARoot, "cert.pem"]), + Cmd = [C#config.openssl_cmd, " ecparam" + " -out ", KeyFile, + " -name secp521r1 ", + %" -name sect283k1 ", + " -genkey "], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env), + + Cmd2 = [C#config.openssl_cmd, " req" + " -new" + " -x509" + " -config ", CnfFile, + " -key ", KeyFile, + " -outform PEM ", + " -out ", CertFile], + cmd(Cmd2, Env); +create_self_signed_cert(Root, CAName, Cnf, C) -> + CARoot = filename:join([Root, CAName]), + CnfFile = filename:join([CARoot, "req.cnf"]), + file:write_file(CnfFile, Cnf), + KeyFile = filename:join([CARoot, "private", "key.pem"]), + CertFile = filename:join([CARoot, "cert.pem"]), + Cmd = [C#config.openssl_cmd, " req" " -new" " -x509" " -config ", CnfFile, " -keyout ", KeyFile, - " -out ", CertFile], - Env = [{"ROOTDIR", Root}], - cmd(Cmd, Env), - fix_key_file(OpenSSLCmd, KeyFile). - -% openssl 1.0 generates key files in pkcs8 format by default and we don't handle this format -fix_key_file(OpenSSLCmd, KeyFile) -> - KeyFileTmp = KeyFile ++ ".tmp", - Cmd = [OpenSSLCmd, " rsa", - " -in ", - KeyFile, - " -out ", - KeyFileTmp], - cmd(Cmd, []), - ok = file:rename(KeyFileTmp, KeyFile). + " -outform PEM", + " -out ", CertFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env). + create_ca_dir(Root, CAName, Cnf) -> CARoot = filename:join([Root, CAName]), + ok = filelib:ensure_dir(CARoot), file:make_dir(CARoot), create_dirs(CARoot, ["certs", "crl", "newcerts", "private"]), create_rnd(Root, filename:join([CAName, "private"])), create_files(CARoot, [{"serial", "01\n"}, + {"crlnumber", "01"}, {"index.txt", ""}, {"ca.cnf", Cnf}]). -create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile) -> - Cmd = [OpenSSLCmd, " req" +create_req(Root, CnfFile, KeyFile, ReqFile, C = #config{ecc_certs = true}) -> + Cmd = [C#config.openssl_cmd, " ecparam" + " -out ", KeyFile, + " -name secp521r1 ", + %" -name sect283k1 ", + " -genkey "], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env), + Cmd2 = [C#config.openssl_cmd, " req" + " -new ", + " -key ", KeyFile, + " -outform PEM ", + " -out ", ReqFile, + " -config ", CnfFile], + cmd(Cmd2, Env); + %fix_key_file(KeyFile). +create_req(Root, CnfFile, KeyFile, ReqFile, C) -> + Cmd = [C#config.openssl_cmd, " req" " -new" " -config ", CnfFile, - " -keyout ", KeyFile, - " -out ", ReqFile], - Env = [{"ROOTDIR", Root}], - cmd(Cmd, Env), - fix_key_file(OpenSSLCmd, KeyFile). + " -outform PEM ", + " -keyout ", KeyFile, + " -out ", ReqFile], + Env = [{"ROOTDIR", filename:absname(Root)}], + cmd(Cmd, Env). + %fix_key_file(KeyFile). + -sign_req(Root, OpenSSLCmd, CA, CertType, ReqFile, CertFile) -> +sign_req(Root, CA, CertType, ReqFile, CertFile, C) -> CACnfFile = filename:join([Root, CA, "ca.cnf"]), - Cmd = [OpenSSLCmd, " ca" + Cmd = [C#config.openssl_cmd, " ca" " -batch" " -notext" - " -config ", CACnfFile, + " -config ", CACnfFile, " -extensions ", CertType, - " -in ", ReqFile, + " -in ", ReqFile, " -out ", CertFile], - Env = [{"ROOTDIR", Root}], + Env = [{"ROOTDIR", filename:absname(Root)}], cmd(Cmd, Env). - + %% %% Misc %% - + create_dirs(Root, Dirs) -> lists:foreach(fun(Dir) -> file:make_dir(filename:join([Root, Dir])) end, @@ -192,30 +312,30 @@ remove_rnd(Dir) -> cmd(Cmd, Env) -> FCmd = lists:flatten(Cmd), - Port = open_port({spawn, FCmd}, [stream, eof, exit_status, stderr_to_stdout, + Port = open_port({spawn, FCmd}, [stream, eof, exit_status, stderr_to_stdout, {env, Env}]), - eval_cmd(Port). + eval_cmd(Port, FCmd). -eval_cmd(Port) -> - receive +eval_cmd(Port, Cmd) -> + receive {Port, {data, _}} -> - eval_cmd(Port); + eval_cmd(Port, Cmd); {Port, eof} -> ok end, receive {Port, {exit_status, Status}} when Status /= 0 -> %% io:fwrite("exit status: ~w~n", [Status]), - exit({eval_cmd, Status}) + exit({eval_cmd, Cmd, Status}) after 0 -> ok end. %% -%% Contents of configuration files +%% Contents of configuration files %% -req_cnf(DN) -> +req_cnf(C) -> ["# Purpose: Configuration for requests (end users and CAs)." "\n" "ROOTDIR = $ENV::ROOTDIR\n" @@ -224,10 +344,10 @@ req_cnf(DN) -> "[req]\n" "input_password = secret\n" "output_password = secret\n" - "default_bits = 1024\n" + "default_bits = ", integer_to_list(C#config.default_bits), "\n" "RANDFILE = $ROOTDIR/RAND\n" "encrypt_key = no\n" - "default_md = sha1\n" + "default_md = md5\n" "#string_mask = pkix\n" "x509_extensions = ca_ext\n" "prompt = no\n" @@ -235,12 +355,12 @@ req_cnf(DN) -> "\n" "[name]\n" - "commonName = ", DN#dn.commonName, "\n" - "organizationalUnitName = ", DN#dn.organizationalUnitName, "\n" - "organizationName = ", DN#dn.organizationName, "\n" - "localityName = ", DN#dn.localityName, "\n" - "countryName = ", DN#dn.countryName, "\n" - "emailAddress = ", DN#dn.emailAddress, "\n" + "commonName = ", C#config.commonName, "\n" + "organizationalUnitName = ", C#config.organizationalUnitName, "\n" + "organizationName = ", C#config.organizationName, "\n" + "localityName = ", C#config.localityName, "\n" + "countryName = ", C#config.countryName, "\n" + "emailAddress = ", C#config.emailAddress, "\n" "\n" "[ca_ext]\n" @@ -249,8 +369,7 @@ req_cnf(DN) -> "subjectKeyIdentifier = hash\n" "subjectAltName = email:copy\n"]. - -ca_cnf(CA) -> +ca_cnf(C) -> ["# Purpose: Configuration for CAs.\n" "\n" "ROOTDIR = $ENV::ROOTDIR\n" @@ -258,21 +377,23 @@ ca_cnf(CA) -> "\n" "[ca]\n" - "dir = $ROOTDIR/", CA, "\n" + "dir = $ROOTDIR/", C#config.commonName, "\n" "certs = $dir/certs\n" "crl_dir = $dir/crl\n" "database = $dir/index.txt\n" "new_certs_dir = $dir/newcerts\n" "certificate = $dir/cert.pem\n" "serial = $dir/serial\n" - "crl = $dir/crl.pem\n" + "crl = $dir/crl.pem\n", + ["crlnumber = $dir/crlnumber\n" || C#config.v2_crls], "private_key = $dir/private/key.pem\n" "RANDFILE = $dir/private/RAND\n" "\n" - "x509_extensions = user_cert\n" + "x509_extensions = user_cert\n", + ["crl_extensions = crl_ext\n" || C#config.v2_crls], "unique_subject = no\n" "default_days = 3600\n" - "default_md = sha1\n" + "default_md = md5\n" "preserve = no\n" "policy = policy_match\n" "\n" @@ -286,6 +407,13 @@ ca_cnf(CA) -> "emailAddress = supplied\n" "\n" + "[crl_ext]\n" + "authorityKeyIdentifier=keyid:always,issuer:always\n", + ["issuingDistributionPoint=critical, @idpsec\n" || C#config.issuing_distribution_point], + + "[idpsec]\n" + "fullname=URI:http://localhost:8000/",C#config.commonName,"/crl.pem\n" + "[user_cert]\n" "basicConstraints = CA:false\n" "keyUsage = nonRepudiation, digitalSignature, keyEncipherment\n" @@ -293,6 +421,12 @@ ca_cnf(CA) -> "authorityKeyIdentifier = keyid,issuer:always\n" "subjectAltName = email:copy\n" "issuerAltName = issuer:copy\n" + "crlDistributionPoints=@crl_section\n" + + "[crl_section]\n" + %% intentionally invalid + "URI.1=http://localhost/",C#config.commonName,"/crl.pem\n" + "URI.2=http://localhost:",integer_to_list(C#config.crl_port),"/",C#config.commonName,"/crl.pem\n" "\n" "[user_cert_digital_signature_only]\n" @@ -310,4 +444,7 @@ ca_cnf(CA) -> "subjectKeyIdentifier = hash\n" "authorityKeyIdentifier = keyid:always,issuer:always\n" "subjectAltName = email:copy\n" - "issuerAltName = issuer:copy\n"]. + "issuerAltName = issuer:copy\n" + "crlDistributionPoints=@crl_section\n" + ]. + diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 4b2bec5fa8..4215448c61 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2014. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -4230,7 +4230,7 @@ t_from_form({type, _L, any, []}, _TypeNames, _RecDict, _VarDict) -> t_from_form({type, _L, arity, []}, _TypeNames, _RecDict, _VarDict) -> {t_arity(), []}; t_from_form({type, _L, array, []}, TypeNames, RecDict, VarDict) -> - builtin_type(array, t_array(), TypeNames, RecDict, VarDict); + builtin_type(array, t_array(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, atom, []}, _TypeNames, _RecDict, _VarDict) -> {t_atom(), []}; t_from_form({type, _L, binary, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4253,9 +4253,9 @@ t_from_form({type, _L, byte, []}, _TypeNames, _RecDict, _VarDict) -> t_from_form({type, _L, char, []}, _TypeNames, _RecDict, _VarDict) -> {t_char(), []}; t_from_form({type, _L, dict, []}, TypeNames, RecDict, VarDict) -> - builtin_type(dict, t_dict(), TypeNames, RecDict, VarDict); + builtin_type(dict, t_dict(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, digraph, []}, TypeNames, RecDict, VarDict) -> - builtin_type(digraph, t_digraph(), TypeNames, RecDict, VarDict); + builtin_type(digraph, t_digraph(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, float, []}, _TypeNames, _RecDict, _VarDict) -> {t_float(), []}; t_from_form({type, _L, function, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4272,9 +4272,9 @@ t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, {T, R2} = t_from_form(Range, TypeNames, RecDict, VarDict), {t_fun(L, T), R1 ++ R2}; t_from_form({type, _L, gb_set, []}, TypeNames, RecDict, VarDict) -> - builtin_type(gb_set, t_gb_set(), TypeNames, RecDict, VarDict); + builtin_type(gb_set, t_gb_set(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, gb_tree, []}, TypeNames, RecDict, VarDict) -> - builtin_type(gb_tree, t_gb_tree(), TypeNames, RecDict, VarDict); + builtin_type(gb_tree, t_gb_tree(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, identifier, []}, _TypeNames, _RecDict, _VarDict) -> {t_identifier(), []}; t_from_form({type, _L, integer, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4288,8 +4288,12 @@ t_from_form({type, _L, list, []}, _TypeNames, _RecDict, _VarDict) -> t_from_form({type, _L, list, [Type]}, TypeNames, RecDict, VarDict) -> {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), {t_list(T), R}; -t_from_form({type, _L, map, _}, TypeNames, RecDict, VarDict) -> - builtin_type(map, t_map([]), TypeNames, RecDict, VarDict); +t_from_form({type, _L, map, As0}, TypeNames, RecDict, VarDict) -> + As = case is_list(As0) of + true -> As0; + false -> [] + end, + builtin_type(map, t_map([]), As, TypeNames, RecDict, VarDict); t_from_form({type, _L, mfa, []}, _TypeNames, _RecDict, _VarDict) -> {t_mfa(), []}; t_from_form({type, _L, module, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4348,7 +4352,7 @@ t_from_form({type, _L, product, Elements}, TypeNames, RecDict, VarDict) -> {L, R} = list_from_form(Elements, TypeNames, RecDict, VarDict), {t_product(L), R}; t_from_form({type, _L, queue, []}, TypeNames, RecDict, VarDict) -> - builtin_type(queue, t_queue(), TypeNames, RecDict, VarDict); + builtin_type(queue, t_queue(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, range, [From, To]} = Type, _TypeNames, _RecDict, _VarDict) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of @@ -4361,13 +4365,13 @@ t_from_form({type, _L, record, [Name|Fields]}, TypeNames, RecDict, VarDict) -> t_from_form({type, _L, reference, []}, _TypeNames, _RecDict, _VarDict) -> {t_reference(), []}; t_from_form({type, _L, set, []}, TypeNames, RecDict, VarDict) -> - builtin_type(set, t_set(), TypeNames, RecDict, VarDict); + builtin_type(set, t_set(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, string, []}, _TypeNames, _RecDict, _VarDict) -> {t_string(), []}; t_from_form({type, _L, term, []}, _TypeNames, _RecDict, _VarDict) -> {t_any(), []}; t_from_form({type, _L, tid, []}, TypeNames, RecDict, VarDict) -> - builtin_type(tid, t_tid(), TypeNames, RecDict, VarDict); + builtin_type(tid, t_tid(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, timeout, []}, _TypeNames, _RecDict, _VarDict) -> {t_timeout(), []}; t_from_form({type, _L, tuple, any}, _TypeNames, _RecDict, _VarDict) -> @@ -4384,10 +4388,10 @@ t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _RecDict, _VarDict) -> {t_opaque(Mod, Name, Args, Rep), []}. -builtin_type(Name, Type, TypeNames, RecDict, VarDict) -> - case lookup_type(Name, 0, RecDict) of +builtin_type(Name, Type, Args, TypeNames, RecDict, VarDict) -> + case lookup_type(Name, length(Args), RecDict) of {_, {_M, _T, _A}} -> - type_from_form(Name, [], TypeNames, RecDict, VarDict); + type_from_form(Name, Args, TypeNames, RecDict, VarDict); error -> {Type, []} end. @@ -4588,7 +4592,7 @@ t_form_to_string({type, _L, iodata, []}) -> "iodata()"; t_form_to_string({type, _L, iolist, []}) -> "iolist()"; t_form_to_string({type, _L, list, [Type]}) -> "[" ++ t_form_to_string(Type) ++ "]"; -t_form_to_string({type, _L, map, _}) -> +t_form_to_string({type, _L, map, Args}) when not is_list(Args) -> "#{}"; t_form_to_string({type, _L, mfa, []}) -> "mfa()"; t_form_to_string({type, _L, module, []}) -> "module()"; diff --git a/lib/hipe/ppc/hipe_rtl_to_ppc.erl b/lib/hipe/ppc/hipe_rtl_to_ppc.erl index 7dfa56df29..a55fc137c3 100644 --- a/lib/hipe/ppc/hipe_rtl_to_ppc.erl +++ b/lib/hipe/ppc/hipe_rtl_to_ppc.erl @@ -102,10 +102,18 @@ conv_insn(I, Map, Data) -> end. conv_fconv(I, Map, Data) -> - %% Dst := (double)Src, where Dst is FP reg and Src is int reg + %% Dst := (double)Src, where Dst is FP reg and Src is GP reg or imm {Dst, Map0} = conv_fpreg(hipe_rtl:fconv_dst(I), Map), - {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), % exclude imm src - I2 = mk_fconv(Dst, Src), + {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), + I2 = + case hipe_ppc:is_temp(Src) of + true -> + mk_fconv(Dst, Src); + false -> + Tmp = new_untagged_temp(), + mk_li(Tmp, Src, + mk_fconv(Dst, Tmp)) + end, {I2, Map1, Data}. mk_fconv(Dst, Src) -> diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl index bc61bec0bd..2f62dd79ad 100644 --- a/lib/hipe/rtl/hipe_rtl.erl +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -413,11 +413,11 @@ rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}. %% move %% -mk_move(Dst, Src) -> #move{dst=Dst, src=Src}. +mk_move(Dst, Src) -> false = is_fpreg(Dst), false = is_fpreg(Src), #move{dst=Dst, src=Src}. move_dst(#move{dst=Dst}) -> Dst. -move_dst_update(M, NewDst) -> M#move{dst=NewDst}. +move_dst_update(M, NewDst) -> false = is_fpreg(NewDst), M#move{dst=NewDst}. move_src(#move{src=Src}) -> Src. -move_src_update(M, NewSrc) -> M#move{src=NewSrc}. +move_src_update(M, NewSrc) -> false = is_fpreg(NewSrc), M#move{src=NewSrc}. %% is_move(#move{}) -> true; %% is_move(_) -> false. @@ -469,7 +469,11 @@ phi_remove_pred(Phi, Pred) -> case NewArgList of [Arg] -> %% the phi should be turned into a move instruction {_Label,Var} = Arg, - mk_move(phi_dst(Phi), Var); + Dst = phi_dst(Phi), + case {is_fpreg(Dst), is_fpreg(Var)} of + {true, true} -> mk_fmove(Dst, Var); + {false, false} -> mk_move(Dst, Var) + end; %% io:format("~nPhi (~w) turned into move (~w) when removing pred ~w~n",[Phi,Move,Pred]), [_|_] -> Phi#phi{arglist=NewArgList} @@ -836,11 +840,11 @@ fp_unop_op(#fp_unop{op=Op}) -> Op. %% fmove %% -mk_fmove(X, Y) -> #fmove{dst=X, src=Y}. +mk_fmove(X, Y) -> true = is_fpreg(X), true = is_fpreg(Y), #fmove{dst=X, src=Y}. fmove_dst(#fmove{dst=Dst}) -> Dst. -fmove_dst_update(M, NewDst) -> M#fmove{dst=NewDst}. +fmove_dst_update(M, NewDst) -> true = is_fpreg(NewDst), M#fmove{dst=NewDst}. fmove_src(#fmove{src=Src}) -> Src. -fmove_src_update(M, NewSrc) -> M#fmove{src=NewSrc}. +fmove_src_update(M, NewSrc) -> true = is_fpreg(NewSrc), M#fmove{src=NewSrc}. %% %% fconv diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index 8831199244..af8903904b 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -990,19 +990,19 @@ unsigned_bignum(Dst1, Src, TrueLblName) -> hipe_tagscheme:unsafe_mk_big(Dst1, Src, unsigned), hipe_rtl:mk_goto(TrueLblName)]. -load_bytes(Dst, Base, Offset, {Signedness, _Endianess},1) -> +load_bytes(Dst, Base, Offset, {Signedness, _Endianness},1) -> [hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness), hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))]; -load_bytes(Dst, Base, Offset, {Signedness, Endianess},2) -> - case Endianess of +load_bytes(Dst, Base, Offset, {Signedness, Endianness},2) -> + case Endianness of big -> hipe_rtl_arch:load_big_2(Dst, Base, Offset, Signedness); little -> hipe_rtl_arch:load_little_2(Dst, Base, Offset, Signedness) end; -load_bytes(Dst, Base, Offset, {Signedness, Endianess},3) -> +load_bytes(Dst, Base, Offset, {Signedness, Endianness},3) -> Tmp1 = hipe_rtl:mk_new_reg(), - case Endianess of + case Endianness of big -> [hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness), hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)), @@ -1026,18 +1026,18 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianess},3) -> hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))] end; -load_bytes(Dst, Base, Offset, {Signedness, Endianess}, 4) -> - case Endianess of +load_bytes(Dst, Base, Offset, {Signedness, Endianness}, 4) -> + case Endianness of big -> hipe_rtl_arch:load_big_4(Dst, Base, Offset, Signedness); little -> hipe_rtl_arch:load_little_4(Dst, Base, Offset, Signedness) end; -load_bytes(Dst, Base, Offset, {Signedness, Endianess}, X) when X > 1 -> +load_bytes(Dst, Base, Offset, {Signedness, Endianness}, X) when X > 1 -> [LoopLbl, EndLbl] = create_lbls(2), [Tmp1, Limit, TmpOffset] = create_regs(3), - case Endianess of + case Endianness of big -> [hipe_rtl:mk_alu(Limit, Offset, add, hipe_rtl:mk_imm(X)), hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness), diff --git a/lib/hipe/sparc/hipe_rtl_to_sparc.erl b/lib/hipe/sparc/hipe_rtl_to_sparc.erl index dc001f865e..fd21be3ae7 100644 --- a/lib/hipe/sparc/hipe_rtl_to_sparc.erl +++ b/lib/hipe/sparc/hipe_rtl_to_sparc.erl @@ -85,17 +85,17 @@ conv_insn(I, Map, Data) -> end. conv_fconv(I, Map, Data) -> - %% Dst := (double)Src, where Dst is FP reg and Src is int reg - {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map), % exclude imm src + %% Dst := (double)Src, where Dst is FP reg and Src is GP reg or imm + {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map), {Dst, Map2} = conv_fpreg(hipe_rtl:fconv_dst(I), Map1), I2 = mk_fconv(Src, Dst), {I2, Map2, Data}. mk_fconv(Src, Dst) -> CSP = hipe_sparc:mk_temp(14, 'untagged'), % o6 - Disp = hipe_sparc:mk_simm13(100), - [hipe_sparc:mk_store('stw', Src, CSP, Disp), - hipe_sparc:mk_pseudo_fload(CSP, Disp, Dst, true), + Offset = 100, + mk_store('stw', Src, CSP, Offset) ++ + [hipe_sparc:mk_pseudo_fload(CSP, hipe_sparc:mk_simm13(Offset), Dst, true), hipe_sparc:mk_fp_unary('fitod', Dst, Dst)]. conv_fmove(I, Map, Data) -> diff --git a/lib/hipe/x86/hipe_rtl_to_x86.erl b/lib/hipe/x86/hipe_rtl_to_x86.erl index d77e4fed3b..36da2f4d44 100644 --- a/lib/hipe/x86/hipe_rtl_to_x86.erl +++ b/lib/hipe/x86/hipe_rtl_to_x86.erl @@ -236,7 +236,7 @@ conv_insn(I, Map, Data) -> #fconv{} -> {Dst, Map0} = conv_dst(hipe_rtl:fconv_dst(I), Map), {[], Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), - I2 = [hipe_x86:mk_fmove(Src, Dst)], + I2 = conv_fconv(Dst, Src), {I2, Map1, Data}; X -> %% gctest?? @@ -712,6 +712,19 @@ vmap_lookup(Map, Key) -> vmap_bind(Map, Key, Val) -> gb_trees:insert(Key, Val, Map). +%%% Finalise the conversion of an Integer-to-Float operation. + +conv_fconv(Dst, Src) -> + case hipe_x86:is_imm(Src) of + false -> + [hipe_x86:mk_fmove(Src, Dst)]; + true -> + %% cvtsi2sd does not allow src to be an immediate + Tmp = new_untagged_temp(), + [hipe_x86:mk_move(Src, Tmp), + hipe_x86:mk_fmove(Tmp, Dst)] + end. + %%% Finalise the conversion of a 2-address FP operation. conv_fp_unary(Dst, Src, FpUnOp) -> diff --git a/lib/inets/doc/src/http_uri.xml b/lib/inets/doc/src/http_uri.xml index e64c375bba..acbd79b201 100644 --- a/lib/inets/doc/src/http_uri.xml +++ b/lib/inets/doc/src/http_uri.xml @@ -63,6 +63,7 @@ host() = string() port() = pos_integer() path() = string() - Representing a file path or directory path query() = string() +fragment() = string() ]]></code> <marker id="scheme_defaults"></marker> @@ -92,13 +93,16 @@ query() = string() <v>URI = uri() </v> <v>Options = [Option] </v> <v>Option = {ipv6_host_with_brackets, boolean()} | - {scheme_defaults, scheme_defaults()}]</v> - <v>Result = {Scheme, UserInfo, Host, Port, Path, Query}</v> + {scheme_defaults, scheme_defaults()} | + {fragment, boolean()}]</v> + <v>Result = {Scheme, UserInfo, Host, Port, Path, Query} | + {Scheme, UserInfo, Host, Port, Path, Query, Fragment}</v> <v>UserInfo = user_info()</v> <v>Host = host()</v> <v>Port = pos_integer()</v> <v>Path = path()</v> <v>Query = query()</v> + <v>Fragment = fragment()</v> <v>Reason = term() </v> </type> <desc> @@ -111,6 +115,9 @@ query() = string() a scheme not found in the scheme defaults) a port number must be provided or else the parsing will fail. </p> + <p>If the fragment option is true, the URI fragment will be returned as + part of the parsing result, otherwise it is completely ignored.</p> + <marker id="encode"></marker> </desc> </func> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 4ca038cc99..20c8a6b1b1 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2013</year> + <year>1997</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -249,7 +249,16 @@ <p>Limits the size of the message header of HTTP request. Defaults to 10240. </p> </item> - + + <marker id="prop_max_content_length"></marker> + <tag>{max_content_length, integer()}</tag> + <item> + <p>Maximum Content-Length in an incoming request, in bytes. Requests + with content larger than this are answered with Status 413. + Defaults to 100000000 (100 MB). + </p> + </item> + <marker id="prop_max_uri"></marker> <tag>{max_uri_size, integer()}</tag> <item> diff --git a/lib/inets/doc/src/httpd_conf.xml b/lib/inets/doc/src/httpd_conf.xml index 3ef03966a7..60fc2f135e 100644 --- a/lib/inets/doc/src/httpd_conf.xml +++ b/lib/inets/doc/src/httpd_conf.xml @@ -97,7 +97,7 @@ <v>FilePath = string()</v> <v>Result = {ok,Directory} | {error,Reason}</v> <v>Directory = string()</v> - <v>Reason = string() | enoent | eaccess | enotdir | FileInfo</v> + <v>Reason = string() | enoent | eacces | enotdir | FileInfo</v> <v>FileInfo = File info record</v> </type> <desc> @@ -105,7 +105,7 @@ <p><c>is_directory/1</c> checks if <c>FilePath</c> is a directory in which case it is returned. Please read <c>file(3)</c> for a description of <c>enoent</c>, - <c>eaccess</c> and <c>enotdir</c>. The definition of + <c>eacces</c> and <c>enotdir</c>. The definition of the file info record can be found by including <c>file.hrl</c> from the kernel application, see file(3).</p> @@ -120,14 +120,14 @@ <v>FilePath = string()</v> <v>Result = {ok,File} | {error,Reason}</v> <v>File = string()</v> - <v>Reason = string() | enoent | eaccess | enotdir | FileInfo</v> + <v>Reason = string() | enoent | eacces | enotdir | FileInfo</v> <v>FileInfo = File info record</v> </type> <desc> <marker id="is_file"></marker> <p><c>is_file/1</c> checks if <c>FilePath</c> is a regular file in which case it is returned. Read <c>file(3)</c> for a - description of <c>enoent</c>, <c>eaccess</c> and + description of <c>enoent</c>, <c>eacces</c> and <c>enotdir</c>. The definition of the file info record can be found by including <c>file.hrl</c> from the kernel application, see file(3).</p> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index fb7034498c..7f73aa5e7b 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,7 +32,40 @@ <file>notes.xml</file> </header> - <section><title>Inets 5.10.4</title> + <section><title>Inets 5.10.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + mod_alias now handles https-URIs properly</p> + <p> + Consistent view of configuration parameter + keep_alive_timeout, should be presented in the + httpd:info/[1,2] function in the same unit as it is + inputted.</p> + <p> + Own Id: OTP-12436 Aux Id: seq12786 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Gracefully handle invalid content-lenght headers instead + of crashing in list_to_integer.</p> + <p> + Own Id: OTP-12429</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 5.10.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/examples/httpd_load_test/hdlt_slave.erl b/lib/inets/examples/httpd_load_test/hdlt_slave.erl index 52af9b5b90..41361418bc 100644 --- a/lib/inets/examples/httpd_load_test/hdlt_slave.erl +++ b/lib/inets/examples/httpd_load_test/hdlt_slave.erl @@ -180,7 +180,7 @@ ssh_slave_start(Host, ErlCmd) -> ?DEBUG("ssh_exec_erl -> done", []), {ok, Connection, Channel}; Error3 -> - ?LOG("failed exec comand: ~p", [Error3]), + ?LOG("failed exec command: ~p", [Error3]), throw({error, {ssh_exec_failed, Error3}}) end. diff --git a/lib/inets/src/http_client/httpc_cookie.erl b/lib/inets/src/http_client/httpc_cookie.erl index 134115bdfa..ed306a84f5 100644 --- a/lib/inets/src/http_client/httpc_cookie.erl +++ b/lib/inets/src/http_client/httpc_cookie.erl @@ -334,9 +334,23 @@ add_domain(Str, #http_cookie{domain_default = true}) -> add_domain(Str, #http_cookie{domain = Domain}) -> Str ++ "; $Domain=" ++ Domain. +is_set_cookie_valid("") -> + %% an empty Set-Cookie header is not valid + false; +is_set_cookie_valid([$=|_]) -> + %% a Set-Cookie header without name is not valid + false; +is_set_cookie_valid(SetCookieHeader) -> + %% a Set-Cookie header without name/value is not valid + case string:chr(SetCookieHeader, $=) of + 0 -> false; + _ -> true + end. + parse_set_cookies(CookieHeaders, DefaultPathDomain) -> - %% empty Set-Cookie header is invalid according to RFC but some sites violate it - SetCookieHeaders = [Value || {"set-cookie", Value} <- CookieHeaders, Value /= ""], + %% filter invalid Set-Cookie headers + SetCookieHeaders = [Value || {"set-cookie", Value} <- CookieHeaders, + is_set_cookie_valid(Value)], Cookies = [parse_set_cookie(SetCookieHeader, DefaultPathDomain) || SetCookieHeader <- SetCookieHeaders], %% print_cookies("Parsed Cookies", Cookies), @@ -348,6 +362,8 @@ parse_set_cookie(CookieHeader, {DefaultPath, DefaultDomain}) -> Name = string:substr(CookieHeader, 1, Pos - 1), {Value, Attrs} = case string:substr(CookieHeader, Pos + 1) of + [] -> + {"", ""}; [$;|ValueAndAttrs] -> {"", string:tokens(ValueAndAttrs, ";")}; ValueAndAttrs -> diff --git a/lib/inets/src/http_lib/http_internal.hrl b/lib/inets/src/http_lib/http_internal.hrl index 53b776c4e7..54425740b5 100644 --- a/lib/inets/src/http_lib/http_internal.hrl +++ b/lib/inets/src/http_lib/http_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2014. All Rights Reserved. +%% Copyright Ericsson AB 2002-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -28,6 +28,7 @@ -define(HTTP_MAX_URI_SIZE, nolimit). -define(HTTP_MAX_VERSION_STRING, 8). -define(HTTP_MAX_METHOD_STRING, 20). +-define(HTTP_MAX_CONTENT_LENGTH, 100000000). -ifndef(HTTP_DEFAULT_SSL_KIND). -define(HTTP_DEFAULT_SSL_KIND, essl). diff --git a/lib/inets/src/http_lib/http_request.erl b/lib/inets/src/http_lib/http_request.erl index f295453bdd..a0833ddf01 100644 --- a/lib/inets/src/http_lib/http_request.erl +++ b/lib/inets/src/http_lib/http_request.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2014. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -21,8 +21,16 @@ -include("http_internal.hrl"). --export([headers/2, http_headers/1, is_absolut_uri/1]). +-export([headers/2, http_headers/1, is_absolut_uri/1, key_value/1]). + +key_value(KeyValueStr) -> + case lists:splitwith(fun($:) -> false; (_) -> true end, KeyValueStr) of + {Key, [$: | Value]} -> + {http_util:to_lower(string:strip(Key)), string:strip(Value)}; + {_, []} -> + undefined + end. %%------------------------------------------------------------------------- %% headers(HeaderList, #http_request_h{}) -> #http_request_h{} %% HeaderList - ["HeaderField:Value"] @@ -34,14 +42,12 @@ %%------------------------------------------------------------------------- headers([], Headers) -> Headers; -headers([Header | Tail], Headers) -> - case lists:splitwith(fun($:) -> false; (_) -> true end, Header) of - {Key, [$: | Value]} -> - headers(Tail, headers(http_util:to_lower(string:strip(Key)), - string:strip(Value), Headers)); - {_, []} -> - headers(Tail, Headers) - end. +headers([{Key, Value} | Tail], Headers) -> + headers(Tail, headers(Key, Value, Headers)); +headers([undefined], Headers) -> + Headers; +headers(KeyValues, Headers) -> + headers([key_value(KeyValue) || KeyValue <- KeyValues], Headers). %%------------------------------------------------------------------------- %% headers(#http_request_h{}) -> HeaderList diff --git a/lib/inets/src/http_lib/http_uri.erl b/lib/inets/src/http_lib/http_uri.erl index 5962001c3a..350a4bc169 100644 --- a/lib/inets/src/http_lib/http_uri.erl +++ b/lib/inets/src/http_lib/http_uri.erl @@ -90,8 +90,8 @@ parse(AbsURI, Opts) -> {error, Reason}; {Scheme, DefaultPort, Rest} -> case (catch parse_uri_rest(Scheme, DefaultPort, Rest, Opts)) of - {ok, {UserInfo, Host, Port, Path, Query}} -> - {ok, {Scheme, UserInfo, Host, Port, Path, Query}}; + {ok, Result} -> + {ok, Result}; {error, Reason} -> {error, {Reason, Scheme, AbsURI}}; _ -> @@ -148,27 +148,22 @@ parse_scheme(AbsURI, Opts) -> end. parse_uri_rest(Scheme, DefaultPort, "//" ++ URIPart, Opts) -> - {Authority, PathQuery} = - case split_uri(URIPart, "/", URIPart, 1, 0) of - Split = {_, _} -> - Split; - URIPart -> - case split_uri(URIPart, "\\?", URIPart, 1, 0) of - Split = {_, _} -> - Split; - URIPart -> - {URIPart,""} - end - end, + {Authority, PathQueryFragment} = + split_uri(URIPart, "[/?#]", {URIPart, ""}, 1, 0), + {RawPath, QueryFragment} = + split_uri(PathQueryFragment, "[?#]", {PathQueryFragment, ""}, 1, 0), + {Query, Fragment} = + split_uri(QueryFragment, "#", {QueryFragment, ""}, 1, 0), {UserInfo, HostPort} = split_uri(Authority, "@", {"", Authority}, 1, 1), {Host, Port} = parse_host_port(Scheme, DefaultPort, HostPort, Opts), - {Path, Query} = parse_path_query(PathQuery), - {ok, {UserInfo, Host, Port, Path, Query}}. - + Path = path(RawPath), + case lists:keyfind(fragment, 1, Opts) of + {fragment, true} -> + {ok, {Scheme, UserInfo, Host, Port, Path, Query, Fragment}}; + _ -> + {ok, {Scheme, UserInfo, Host, Port, Path, Query}} + end. -parse_path_query(PathQuery) -> - {Path, Query} = split_uri(PathQuery, "\\?", {PathQuery, ""}, 1, 0), - {path(Path), Query}. %% In this version of the function, we no longer need %% the Scheme argument, but just in case... diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index 27446ca7fe..78dda794db 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -44,7 +44,7 @@ %% FilePath = string() %% Result = {ok,Directory} | {error,Reason} %% Directory = string() -%% Reason = string() | enoent | eaccess | enotdir | FileInfo +%% Reason = string() | enoent | eacces | enotdir | FileInfo %% FileInfo = File info record %% %% Description: Checks if FilePath is a directory in which case it is @@ -71,7 +71,7 @@ is_directory(_Type,_Access,FileInfo,_Directory) -> %% FilePath = string() %% Result = {ok,File} | {error,Reason} %% File = string() -%% Reason = string() | enoent | eaccess | enotdir | FileInfo +%% Reason = string() | enoent | eacces | enotdir | FileInfo %% FileInfo = File info record %% %% Description: Checks if FilePath is a regular file in which case it @@ -205,13 +205,13 @@ load("MaxURISize " ++ MaxHeaderSize, []) -> " is an invalid number of MaxHeaderSize")} end; -load("MaxBodySize " ++ MaxBodySize, []) -> - case make_integer(MaxBodySize) of +load("MaxContentLength " ++ Max, []) -> + case make_integer(Max) of {ok, Integer} -> - {ok, [], {max_body_size,Integer}}; + {ok, [], {max_content_length, Integer}}; {error, _} -> - {error, ?NICE(clean(MaxBodySize) ++ - " is an invalid number of MaxBodySize")} + {error, ?NICE(clean(Max) ++ + " is an invalid number of MaxContentLength")} end; load("ServerName " ++ ServerName, []) -> @@ -337,7 +337,7 @@ load("MaxKeepAliveRequest " ++ MaxRequests, []) -> load("KeepAliveTimeout " ++ Timeout, []) -> case make_integer(Timeout) of {ok, Integer} -> - {ok, [], {keep_alive_timeout, Integer*1000}}; + {ok, [], {keep_alive_timeout, Integer}}; {error, _} -> {error, ?NICE(clean(Timeout)++" is an invalid KeepAliveTimeout")} end; @@ -569,6 +569,12 @@ validate_config_params([{max_body_size, Value} | Rest]) validate_config_params([{max_body_size, Value} | _]) -> throw({max_body_size, Value}); +validate_config_params([{max_content_length, Value} | Rest]) + when is_integer(Value) andalso (Value > 0) -> + validate_config_params(Rest); +validate_config_params([{max_content_length, Value} | _]) -> + throw({max_content_length, Value}); + validate_config_params([{server_name, Value} | Rest]) when is_list(Value) -> validate_config_params(Rest); @@ -635,7 +641,7 @@ validate_config_params([{max_keep_alive_request, Value} | Rest]) when is_integer(Value) andalso (Value > 0) -> validate_config_params(Rest); validate_config_params([{max_keep_alive_request, Value} | _]) -> - throw({max_header_size, Value}); + throw({max_keep_alive_request, Value}); validate_config_params([{keep_alive_timeout, Value} | Rest]) when is_integer(Value) andalso (Value >= 0) -> @@ -799,7 +805,7 @@ store({server_tokens, ServerTokens} = Entry, _ConfigList) -> Server = server(ServerTokens), {ok, [Entry, {server, Server}]}; store({keep_alive_timeout, KeepAliveTimeout}, _ConfigList) -> - {ok, {keep_alive_timeout, KeepAliveTimeout * 1000}}; + {ok, {keep_alive_timeout, KeepAliveTimeout}}; store(ConfigListEntry, _ConfigList) -> {ok, ConfigListEntry}. diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index 712c73599f..6985065c3e 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2014. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -118,18 +118,17 @@ validate(Method, Uri, Version) -> %% create it. %% ---------------------------------------------------------------------- update_mod_data(ModData, Method, RequestURI, HTTPVersion, Headers)-> - ParsedHeaders = tagup_header(Headers), - PersistentConn = get_persistens(HTTPVersion, ParsedHeaders, + PersistentConn = get_persistens(HTTPVersion, Headers, ModData#mod.config_db), {ok, ModData#mod{data = [], method = Method, absolute_uri = format_absolute_uri(RequestURI, - ParsedHeaders), + Headers), request_uri = format_request_uri(RequestURI), http_version = HTTPVersion, request_line = Method ++ " " ++ RequestURI ++ " " ++ HTTPVersion, - parsed_header = ParsedHeaders, + parsed_header = Headers, connection = PersistentConn}}. %%%======================================================================== @@ -146,14 +145,14 @@ parse_method(_, _, _, Max, _, _) -> %% We do not know the version of the client as it comes after the %% method send the lowest version in the response so that the client %% will be able to handle it. - {error, {too_long, Max, 413, "Method unreasonably long"}, lowest_version()}. + {error, {size_error, Max, 413, "Method unreasonably long"}, lowest_version()}. parse_uri(_, _, Current, MaxURI, _, _) when (Current > MaxURI) andalso (MaxURI =/= nolimit) -> %% We do not know the version of the client as it comes after the %% uri send the lowest version in the response so that the client %% will be able to handle it. - {error, {too_long, MaxURI, 414, "URI unreasonably long"},lowest_version()}; + {error, {size_error, MaxURI, 414, "URI unreasonably long"},lowest_version()}; parse_uri(<<>>, URI, Current, Max, MaxSizes, Result) -> {?MODULE, parse_uri, [URI, Current, Max, MaxSizes, Result]}; parse_uri(<<?SP, Rest/binary>>, URI, _, _, MaxSizes, Result) -> @@ -179,12 +178,12 @@ parse_version(<<?CR>> = Data, Version, Current, Max, MaxSizes, Result) -> parse_version(<<Octet, Rest/binary>>, Version, Current, Max, MaxSizes, Result) when Current =< Max -> parse_version(Rest, [Octet | Version], Current + 1, Max, MaxSizes, Result); parse_version(_, _, _, Max,_,_) -> - {error, {too_long, Max, 413, "Version string unreasonably long"}, lowest_version()}. + {error, {size_error, Max, 413, "Version string unreasonably long"}, lowest_version()}. parse_headers(_, _, _, Current, Max, _, Result) when Max =/= nolimit andalso Current > Max -> HttpVersion = lists:nth(3, lists:reverse(Result)), - {error, {too_long, Max, 413, "Headers unreasonably long"}, HttpVersion}; + {error, {size_error, Max, 413, "Headers unreasonably long"}, HttpVersion}; parse_headers(<<>>, Header, Headers, Current, Max, MaxSizes, Result) -> {?MODULE, parse_headers, [<<>>, Header, Headers, Current, Max, @@ -204,14 +203,22 @@ parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], _, _, _, Result) -> Result])), {ok, NewResult}; parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _, _, - _, Result) -> - HTTPHeaders = [lists:reverse(Header) | Headers], - RequestHeaderRcord = - http_request:headers(HTTPHeaders, #http_request_h{}), - NewResult = - list_to_tuple(lists:reverse([Body, {RequestHeaderRcord, - HTTPHeaders} | Result])), - {ok, NewResult}; + MaxSizes, Result) -> + case http_request:key_value(lists:reverse(Header)) of + undefined -> %% Skip headers with missing : + {ok, list_to_tuple(lists:reverse([Body, {http_request:headers(Headers, #http_request_h{}), Headers} | Result]))}; + NewHeader -> + case check_header(NewHeader, MaxSizes) of + ok -> + {ok, list_to_tuple(lists:reverse([Body, {http_request:headers([NewHeader | Headers], + #http_request_h{}), + [NewHeader | Headers]} | Result]))}; + + {error, Reason} -> + HttpVersion = lists:nth(3, lists:reverse(Result)), + {error, Reason, HttpVersion} + end + end; parse_headers(<<?CR,?LF,?CR>> = Data, Header, Headers, Current, Max, MaxSizes, Result) -> @@ -243,8 +250,21 @@ parse_headers(<<?LF, Octet, Rest/binary>>, Header, Headers, Current, Max, MaxSizes, Result); parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, _, Max, MaxSizes, Result) -> - parse_headers(Rest, [Octet], [lists:reverse(Header) | Headers], - 0, Max, MaxSizes, Result); + case http_request:key_value(lists:reverse(Header)) of + undefined -> %% Skip headers with missing : + parse_headers(Rest, [Octet], Headers, + 0, Max, MaxSizes, Result); + NewHeader -> + case check_header(NewHeader, MaxSizes) of + ok -> + parse_headers(Rest, [Octet], [NewHeader | Headers], + 0, Max, MaxSizes, Result); + {error, Reason} -> + HttpVersion = lists:nth(3, lists:reverse(Result)), + {error, Reason, HttpVersion} + end + end; + parse_headers(<<?CR>> = Data, Header, Headers, Current, Max, MaxSizes, Result) -> {?MODULE, parse_headers, [Data, Header, Headers, Current, Max, @@ -388,29 +408,25 @@ get_persistens(HTTPVersion,ParsedHeader,ConfigDB)-> false end. - -%%---------------------------------------------------------------------- -%% tagup_header -%% -%% Parses the header of a HTTP request and returns a key,value tuple -%% list containing Name and Value of each header directive as of: -%% -%% Content-Type: multipart/mixed -> {"Content-Type", "multipart/mixed"} -%% -%% But in http/1.1 the field-names are case insencitive so now it must be -%% Content-Type: multipart/mixed -> {"content-type", "multipart/mixed"} -%% The standard furthermore says that leading and traling white space -%% is not a part of the fieldvalue and shall therefore be removed. -%%---------------------------------------------------------------------- -tagup_header([]) -> []; -tagup_header([Line|Rest]) -> [tag(Line, [])|tagup_header(Rest)]. - -tag([], Tag) -> - {http_util:to_lower(lists:reverse(Tag)), ""}; -tag([$:|Rest], Tag) -> - {http_util:to_lower(lists:reverse(Tag)), string:strip(Rest)}; -tag([Chr|Rest], Tag) -> - tag(Rest, [Chr|Tag]). - lowest_version()-> "HTTP/0.9". + +check_header({"content-length", Value}, Maxsizes) -> + Max = proplists:get_value(max_content_length, Maxsizes), + MaxLen = length(integer_to_list(Max)), + case length(Value) =< MaxLen of + true -> + try + _ = list_to_integer(Value), + ok + catch _:_ -> + {error, {size_error, Max, 411, "content-length not an integer"}} + end; + false -> + {error, {size_error, Max, 413, "content-length unreasonably long"}} + end; +check_header(_, _) -> + ok. + + + diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index 9bea58cc9e..f7a9fe5d49 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -96,8 +96,9 @@ init([Manager, ConfigDB, AcceptTimeout]) -> proc_lib:init_ack({ok, self()}), {SocketType, Socket} = await_socket_ownership_transfer(AcceptTimeout), - - KeepAliveTimeOut = httpd_util:lookup(ConfigDB, keep_alive_timeout, 150000), + + %%Timeout value is in seconds we want it in milliseconds + KeepAliveTimeOut = 1000 * httpd_util:lookup(ConfigDB, keep_alive_timeout, 150), case http_transport:negotiate(SocketType, Socket, ?HANDSHAKE_TIMEOUT) of {error, _Error} -> @@ -119,11 +120,15 @@ continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> MaxHeaderSize = max_header_size(ConfigDB), MaxURISize = max_uri_size(ConfigDB), NrOfRequest = max_keep_alive_request(ConfigDB), - + MaxContentLen = max_content_length(ConfigDB), + {_, Status} = httpd_manager:new_connection(Manager), MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize}, - {max_version, ?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}]]}, + {max_version, ?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, MaxContentLen} + ]]}, State = #state{mod = Mod, manager = Manager, @@ -207,7 +212,7 @@ handle_info({Proto, Socket, Data}, set_new_data_size(cancel_request_timeout(State), NewDataSize) end, handle_http_msg(Result, NewState); - {error, {too_long, MaxSize, ErrCode, ErrStr}, Version} -> + {error, {size_error, MaxSize, ErrCode, ErrStr}, Version} -> NewModData = ModData#mod{http_version = Version}, httpd_response:send_status(NewModData, ErrCode, ErrStr), Reason = io_lib:format("~p: ~p max size is ~p~n", @@ -444,8 +449,7 @@ handle_body(#state{headers = Headers, body = Body, mod = ModData} = State, error_log(Reason, ModData), {stop, normal, State#state{response_sent = true}}; _ -> - Length = - list_to_integer(Headers#http_request_h.'content-length'), + Length = list_to_integer(Headers#http_request_h.'content-length'), case ((Length =< MaxBodySize) or (MaxBodySize == nolimit)) of true -> case httpd_request:whole_body(Body, Length) of @@ -454,7 +458,7 @@ handle_body(#state{headers = Headers, body = Body, mod = ModData} = State, ModData#mod.socket, [{active, once}]), {noreply, State#state{mfa = - {Module, Function, Args}}}; + {Module, Function, Args}}}; {ok, NewBody} -> handle_response( @@ -471,7 +475,7 @@ handle_body(#state{headers = Headers, body = Body, mod = ModData} = State, handle_expect(#state{headers = Headers, mod = #mod{config_db = ConfigDB} = ModData} = State, MaxBodySize) -> - Length = Headers#http_request_h.'content-length', + Length = list_to_integer(Headers#http_request_h.'content-length'), case expect(Headers, ModData#mod.http_version, ConfigDB) of continue when (MaxBodySize > Length) orelse (MaxBodySize =:= nolimit) -> httpd_response:send_status(ModData, 100, ""), @@ -545,9 +549,13 @@ handle_next_request(#state{mod = #mod{connection = true} = ModData, init_data = ModData#mod.init_data}, MaxHeaderSize = max_header_size(ModData#mod.config_db), MaxURISize = max_uri_size(ModData#mod.config_db), + MaxContentLen = max_content_length(ModData#mod.config_db), MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize}, - {max_version, ?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}]]}, + {max_version, ?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, MaxContentLen} + ]]}, TmpState = State#state{mod = NewModData, mfa = MFA, max_keep_alive_request = decrease(Max), @@ -630,3 +638,5 @@ max_body_size(ConfigDB) -> max_keep_alive_request(ConfigDB) -> httpd_util:lookup(ConfigDB, max_keep_alive_request, infinity). +max_content_length(ConfigDB) -> + httpd_util:lookup(ConfigDB, max_content_length, ?HTTP_MAX_CONTENT_LENGTH). diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl index 0b9fe4cfe0..5039cd56b5 100644 --- a/lib/inets/src/http_server/mod_alias.erl +++ b/lib/inets/src/http_server/mod_alias.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -55,6 +55,7 @@ do(#mod{data = Data} = Info) -> do_alias(#mod{config_db = ConfigDB, request_uri = ReqURI, + socket_type = SocketType, data = Data}) -> {ShortPath, Path, AfterPath} = real_name(ConfigDB, ReqURI, which_alias(ConfigDB)), @@ -70,8 +71,9 @@ do_alias(#mod{config_db = ConfigDB, (LastChar =/= $/)) -> ?hdrt("directory and last-char is a /", []), ServerName = which_server_name(ConfigDB), - Port = port_string( which_port(ConfigDB) ), - URL = "http://" ++ ServerName ++ Port ++ ReqURI ++ "/", + Port = port_string(which_port(ConfigDB)), + Protocol = get_protocol(SocketType), + URL = Protocol ++ ServerName ++ Port ++ ReqURI ++ "/", ReasonPhrase = httpd_util:reason_phrase(301), Message = httpd_util:message(301, URL, ConfigDB), {proceed, @@ -94,6 +96,12 @@ port_string(80) -> port_string(Port) -> ":" ++ integer_to_list(Port). +get_protocol(ip_comm) -> + "http://"; +get_protocol(_) -> + %% Should clean up to have only one ssl type essl vs ssl is not relevant any more + "https://". + %% real_name real_name(ConfigDB, RequestURI, []) -> diff --git a/lib/inets/test/http_format_SUITE.erl b/lib/inets/test/http_format_SUITE.erl index d4a3f28f38..5952e9fd6e 100644 --- a/lib/inets/test/http_format_SUITE.erl +++ b/lib/inets/test/http_format_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -355,10 +355,12 @@ http_request(Config) when is_list(Config) -> "http://www.erlang.org", "HTTP/1.1", {#http_request_h{host = "www.erlang.org", te = []}, - ["te: ","host:www.erlang.org"]}, <<>>} = + [{"te", []}, {"host", "www.erlang.org"}]}, <<>>} = parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE}, {max_version, ?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]], + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + ]], HttpHead), HttpHead1 = ["GET http://www.erlang.org HTTP/1.1" ++ @@ -369,7 +371,9 @@ http_request(Config) when is_list(Config) -> {#http_request_h{}, []}, <<>>} = parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE}, {max_version, ?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]], HttpHead1), + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + ]], HttpHead1), HttpHead2 = ["GET http://www.erlang.org HTTP/1.1" ++ @@ -380,7 +384,9 @@ http_request(Config) when is_list(Config) -> {#http_request_h{}, []}, <<>>} = parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE}, {max_version, ?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]], HttpHead2), + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + ]], HttpHead2), %% Note the following body is not related to the headers above HttpBody = ["<HTML>\n<HEAD>\n<TITLE> dummy </TITLE>\n</HEAD>\n<BODY>\n", diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index c535d59b9f..21be7862cb 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -91,6 +91,7 @@ only_simulated() -> cookie, cookie_profile, empty_set_cookie, + invalid_set_cookie, trace, stream_once, stream_single_chunk, @@ -568,6 +569,18 @@ empty_set_cookie(Config) when is_list(Config) -> ok = httpc:set_options([{cookies, disabled}]). %%------------------------------------------------------------------------- +invalid_set_cookie(doc) -> + ["Test ignoring invalid Set-Cookie header"]; +invalid_set_cookie(Config) when is_list(Config) -> + ok = httpc:set_options([{cookies, enabled}]), + + URL = url(group_name(Config), "/invalid_set_cookie.html", Config), + {ok, {{_,200,_}, [_|_], [_|_]}} = + httpc:request(get, {URL, []}, [], []), + + ok = httpc:set_options([{cookies, disabled}]). + +%%------------------------------------------------------------------------- headers_as_is(doc) -> ["Test the option headers_as_is"]; headers_as_is(Config) when is_list(Config) -> @@ -1246,8 +1259,9 @@ dummy_server_init(Caller, ip_comm, Inet, _) -> dummy_ipcomm_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE}, {max_header, ?HTTP_MAX_HEADER_SIZE}, {max_version,?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]]}, - [], ListenSocket); + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH}]]}, + [], ListenSocket); dummy_server_init(Caller, ssl, Inet, SSLOptions) -> BaseOpts = [binary, {reuseaddr,true}, {active, false} | @@ -1261,7 +1275,9 @@ dummy_ssl_server_init(Caller, BaseOpts, Inet) -> dummy_ssl_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE}, {max_method, ?HTTP_MAX_METHOD_STRING}, {max_version,?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]]}, + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + ]]}, [], ListenSocket). dummy_ipcomm_server_loop(MFA, Handlers, ListenSocket) -> @@ -1338,16 +1354,20 @@ handle_request(Module, Function, Args, Socket) -> stop -> stop; <<>> -> - {httpd_request, parse, [[<<>>, [{max_uri, ?HTTP_MAX_URI_SIZE}, + {httpd_request, parse, [[{max_uri,?HTTP_MAX_URI_SIZE}, {max_header, ?HTTP_MAX_HEADER_SIZE}, {max_version,?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]]]}; + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + ]]}; Data -> handle_request(httpd_request, parse, [Data, [{max_uri, ?HTTP_MAX_URI_SIZE}, - {max_header, ?HTTP_MAX_HEADER_SIZE}, - {max_version,?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]], Socket) + {max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version,?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + ]], Socket) end; NewMFA -> NewMFA @@ -1437,7 +1457,7 @@ dummy_ssl_server_hang_loop(_) -> ensure_host_header_with_port([]) -> false; -ensure_host_header_with_port(["host: " ++ Host| _]) -> +ensure_host_header_with_port([{"host", Host}| _]) -> case string:tokens(Host, [$:]) of [_ActualHost, _Port] -> true; @@ -1449,7 +1469,7 @@ ensure_host_header_with_port([_|T]) -> auth_header([]) -> auth_header_not_found; -auth_header(["authorization:" ++ Value | _]) -> +auth_header([{"authorization", Value} | _]) -> {ok, string:strip(Value)}; auth_header([_ | Tail]) -> auth_header(Tail). @@ -1466,7 +1486,7 @@ handle_auth("Basic " ++ UserInfo, Challange, DefaultResponse) -> check_cookie([]) -> ct:fail(no_cookie_header); -check_cookie(["cookie:" ++ _Value | _]) -> +check_cookie([{"cookie", _} | _]) -> ok; check_cookie([_Head | Tail]) -> check_cookie(Tail). @@ -1686,6 +1706,14 @@ handle_uri(_,"/empty_set_cookie.html",_,_,_,_) -> "Content-Length:32\r\n\r\n"++ "<HTML><BODY>foobar</BODY></HTML>"; +handle_uri(_,"/invalid_set_cookie.html",_,_,_,_) -> + "HTTP/1.1 200 ok\r\n" ++ + "set-cookie: =\r\n" ++ + "set-cookie: name=\r\n" ++ + "set-cookie: name-or-value\r\n" ++ + "Content-Length:32\r\n\r\n"++ + "<HTML><BODY>foobar</BODY></HTML>"; + handle_uri(_,"/missing_crlf.html",_,_,_,_) -> "HTTP/1.1 200 ok" ++ "Content-Length:32\r\n" ++ diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 4010597657..342004f19b 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -132,6 +132,7 @@ http_get() -> bad_hex, missing_CR, max_header, + max_content_length, ipv6 ]. @@ -979,13 +980,22 @@ max_header(Config) when is_list(Config) -> Host = ?config(host, Config), case Version of "HTTP/0.9" -> - {skip, no_implemented}; + {skip, not_implemented}; _ -> dos_hostname(?config(type, Config), ?config(port, Config), Host, ?config(node, Config), Version, ?MAX_HEADER_SIZE) end. %%------------------------------------------------------------------------- +max_content_length() -> + ["Denial Of Service (DOS) attack, prevented by max_content_length"]. +max_content_length(Config) when is_list(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + garbage_content_length(?config(type, Config), ?config(port, Config), Host, + ?config(node, Config), Version). + +%%------------------------------------------------------------------------- security_1_1(Config) when is_list(Config) -> security([{http_version, "HTTP/1.1"} | Config]). @@ -1368,7 +1378,9 @@ server_config(http_reload, Config) -> server_config(https_reload, Config) -> [{keep_alive_timeout, 2}] ++ server_config(https, Config); server_config(http_limit, Config) -> - [{max_clients, 1}] ++ server_config(http, Config); + [{max_clients, 1}, + %% Make sure option checking code is run + {max_content_length, 100000002}] ++ server_config(http, Config); server_config(https_limit, Config) -> [{max_clients, 1}] ++ server_config(https, Config); server_config(http_basic_auth, Config) -> @@ -1814,7 +1826,7 @@ dos_hostname(Type, Port, Host, Node, Version, Max) -> ok = httpd_test_lib:verify_request(Type, Host, Port, Node, dos_hostname_request(TooLongHeader, Version), - [{statuscode, dos_code(Version)}, + [{statuscode, request_entity_too_large_code(Version)}, {version, Version}]). dos_hostname_request(Host, Version) -> dos_http_request("GET / ", Version, Host). @@ -1824,11 +1836,32 @@ dos_http_request(Request, "HTTP/1.1" = Version, Host) -> dos_http_request(Request, Version, Host) -> Request ++ Version ++ "\r\nhost:" ++ Host ++ "\r\n\r\n". -dos_code("HTTP/1.0") -> +request_entity_too_large_code("HTTP/1.0") -> 403; %% 413 not defined in HTTP/1.0 -dos_code(_) -> +request_entity_too_large_code(_) -> 413. +length_required_code("HTTP/1.0") -> + 403; %% 411 not defined in HTTP/1.0 +length_required_code(_) -> + 411. + +garbage_content_length(Type, Port, Host, Node, Version) -> + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + garbage_content_length_request("GET / ", Version, Host, "aaaa"), + [{statuscode, length_required_code(Version)}, + {version, Version}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + garbage_content_length_request("GET / ", Version, Host, + lists:duplicate($a, 100)), + [{statuscode, request_entity_too_large_code(Version)}, + {version, Version}]). + +garbage_content_length_request(Request, Version, Host, Garbage) -> + http_request(Request, Version, Host, + {"content-length:" ++ Garbage, "Body with garbage content length indicator"}). + + update_password(Node, ServerRoot, _Address, Port, AuthPrefix, Dir, Old, New)-> Directory = filename:join([ServerRoot, "htdocs", AuthPrefix ++ Dir]), rpc:call(Node, mod_auth, update_password, diff --git a/lib/inets/test/uri_SUITE.erl b/lib/inets/test/uri_SUITE.erl index 9ba09e1474..f75e347d0c 100644 --- a/lib/inets/test/uri_SUITE.erl +++ b/lib/inets/test/uri_SUITE.erl @@ -46,6 +46,7 @@ all() -> userinfo, scheme, queries, + fragments, escaped, hexed_query ]. @@ -105,6 +106,42 @@ queries(Config) when is_list(Config) -> {ok, {http,[],"localhost",8888,"/foobar.html","?foo=bar&foobar=42"}} = http_uri:parse("http://localhost:8888/foobar.html?foo=bar&foobar=42"). +fragments(Config) when is_list(Config) -> + {ok, {http,[],"localhost",80,"/",""}} = + http_uri:parse("http://localhost#fragment"), + {ok, {http,[],"localhost",80,"/path",""}} = + http_uri:parse("http://localhost/path#fragment"), + {ok, {http,[],"localhost",80,"/","?query"}} = + http_uri:parse("http://localhost?query#fragment"), + {ok, {http,[],"localhost",80,"/path","?query"}} = + http_uri:parse("http://localhost/path?query#fragment"), + {ok, {http,[],"localhost",80,"/","","#fragment"}} = + http_uri:parse("http://localhost#fragment", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/path","","#fragment"}} = + http_uri:parse("http://localhost/path#fragment", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/","?query","#fragment"}} = + http_uri:parse("http://localhost?query#fragment", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/path","?query","#fragment"}} = + http_uri:parse("http://localhost/path?query#fragment", + [{fragment,true}]), + {ok, {http,[],"localhost",80,"/","",""}} = + http_uri:parse("http://localhost", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/path","",""}} = + http_uri:parse("http://localhost/path", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/","?query",""}} = + http_uri:parse("http://localhost?query", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/path","?query",""}} = + http_uri:parse("http://localhost/path?query", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/","","#"}} = + http_uri:parse("http://localhost#", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/path","","#"}} = + http_uri:parse("http://localhost/path#", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/","?query","#"}} = + http_uri:parse("http://localhost?query#", [{fragment,true}]), + {ok, {http,[],"localhost",80,"/path","?query","#"}} = + http_uri:parse("http://localhost/path?query#", [{fragment,true}]), + ok. + escaped(Config) when is_list(Config) -> {ok, {http,[],"www.somedomain.com",80,"/%2Eabc",[]}} = http_uri:parse("http://www.somedomain.com/%2Eabc"), diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index dbae5e4b3c..7d11916454 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.10.4 +INETS_VSN = 5.10.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml index dc9e4766a9..ee8cd441d4 100644 --- a/lib/kernel/doc/src/gen_sctp.xml +++ b/lib/kernel/doc/src/gen_sctp.xml @@ -961,7 +961,7 @@ <pre> #sctp_paddrinfo{ assoc_id = assoc_id(), address = {IP, Port}, - state = inactive | active, + state = inactive | active | unconfirmed, cwnd = integer(), srtt = integer(), rto = integer(), diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl index 10cf77e0d4..1c43063937 100644 --- a/lib/kernel/src/standard_error.erl +++ b/lib/kernel/src/standard_error.erl @@ -63,7 +63,7 @@ server(PortName,PortSettings) -> run(Port). run(P) -> - put(unicode,false), + put(encoding, latin1), server_loop(P). server_loop(Port) -> @@ -95,25 +95,47 @@ do_io_request(Req, From, ReplyAs, Port) -> io_reply(From, ReplyAs, Reply). %% New in R13B -% Wide characters (Unicode) -io_request({put_chars,Encoding,Chars}, Port) -> % Binary new in R9C - put_chars(wrap_characters_to_binary(Chars,Encoding, - case get(unicode) of - true -> unicode; - _ -> latin1 - end), Port); -io_request({put_chars,Encoding,Mod,Func,Args}, Port) -> - Result = case catch apply(Mod,Func,Args) of - Data when is_list(Data); is_binary(Data) -> - wrap_characters_to_binary(Data,Encoding, - case get(unicode) of - true -> unicode; - _ -> latin1 - end); - Undef -> - Undef - end, - put_chars(Result, Port); +%% Encoding option (unicode/latin1) +io_request({put_chars,unicode,Chars}, Port) -> + case wrap_characters_to_binary(Chars, unicode, get(encoding)) of + error -> + {error,{error,put_chars}}; + Bin -> + put_chars(Bin, Port) + end; +io_request({put_chars,unicode,Mod,Func,Args}, Port) -> + case catch apply(Mod, Func, Args) of + Data when is_list(Data); is_binary(Data) -> + case wrap_characters_to_binary(Data, unicode, get(encoding)) of + Bin when is_binary(Bin) -> + put_chars(Bin, Port); + error -> + {error,{error,put_chars}} + end; + _ -> + {error,{error,put_chars}} + end; +io_request({put_chars,latin1,Chars}, Port) -> + case catch unicode:characters_to_binary(Chars, latin1, get(encoding)) of + Data when is_binary(Data) -> + put_chars(Data, Port); + _ -> + {error,{error,put_chars}} + end; +io_request({put_chars,latin1,Mod,Func,Args}, Port) -> + case catch apply(Mod, Func, Args) of + Data when is_list(Data); is_binary(Data) -> + case + catch unicode:characters_to_binary(Data, latin1, get(encoding)) + of + Bin when is_binary(Bin) -> + put_chars(Bin, Port); + _ -> + {error,{error,put_chars}} + end; + _ -> + {error,{error,put_chars}} + end; %% BC if called from pre-R13 node io_request({put_chars,Chars}, Port) -> io_request({put_chars,latin1,Chars}, Port); @@ -134,10 +156,10 @@ io_request({get_geometry,rows},Port) -> _ -> {error,{error,enotsup}} end; -io_request({getopts,[]}, Port) -> - getopts(Port); -io_request({setopts,Opts}, Port) when is_list(Opts) -> - setopts(Opts, Port); +io_request(getopts, _Port) -> + getopts(); +io_request({setopts,Opts}, _Port) when is_list(Opts) -> + setopts(Opts); io_request({requests,Reqs}, Port) -> io_requests(Reqs, {ok,ok}, Port); io_request(R, _Port) -> %Unknown request @@ -176,47 +198,48 @@ io_reply(From, ReplyAs, Reply) -> %% put_chars put_chars(Chars, Port) when is_binary(Chars) -> _ = put_port(Chars, Port), - {ok,ok}; -put_chars(Chars, Port) -> - case catch list_to_binary(Chars) of - Binary when is_binary(Binary) -> - put_chars(Binary, Port); - _ -> - {error,{error,put_chars}} - end. + {ok,ok}. %% setopts -setopts(Opts0,Port) -> - Opts = proplists:unfold( - proplists:substitute_negations( - [{latin1,unicode}], - Opts0)), +setopts(Opts0) -> + Opts = expand_encoding(Opts0), case check_valid_opts(Opts) of - true -> - do_setopts(Opts,Port); - false -> - {error,{error,enotsup}} + true -> + do_setopts(Opts); + false -> + {error,{error,enotsup}} end. + check_valid_opts([]) -> true; -check_valid_opts([{unicode,Valid}|T]) when Valid =:= true; Valid =:= utf8; Valid =:= false -> +check_valid_opts([{encoding,Valid}|T]) when Valid =:= unicode; + Valid =:= utf8; Valid =:= latin1 -> check_valid_opts(T); check_valid_opts(_) -> false. -do_setopts(Opts, _Port) -> - case proplists:get_value(unicode,Opts) of - Valid when Valid =:= true; Valid =:= utf8 -> - put(unicode,true); - false -> - put(unicode,false); - undefined -> - ok +expand_encoding([]) -> + []; +expand_encoding([latin1 | T]) -> + [{encoding,latin1} | expand_encoding(T)]; +expand_encoding([unicode | T]) -> + [{encoding,unicode} | expand_encoding(T)]; +expand_encoding([H|T]) -> + [H|expand_encoding(T)]. + +do_setopts(Opts) -> + case proplists:get_value(encoding, Opts) of + Valid when Valid =:= unicode; Valid =:= utf8 -> + put(encoding, unicode); + latin1 -> + put(encoding, latin1); + undefined -> + ok end, {ok,ok}. -getopts(_Port) -> - Uni = {unicode, get(unicode) =:= true}, +getopts() -> + Uni = {encoding,get(encoding)}, {ok,[Uni]}. wrap_characters_to_binary(Chars,From,To) -> @@ -227,17 +250,17 @@ wrap_characters_to_binary(Chars,From,To) -> _Else -> 16#10ffff end, - unicode:characters_to_binary( - [ case X of - $\n -> - if - TrNl -> - "\r\n"; - true -> - $\n - end; - High when High > Limit -> - ["\\x{",erlang:integer_to_list(X, 16),$}]; - Ordinary -> - Ordinary - end || X <- unicode:characters_to_list(Chars,From) ],unicode,To). + case catch unicode:characters_to_list(Chars, From) of + L when is_list(L) -> + unicode:characters_to_binary( + [ case X of + $\n when TrNl -> + "\r\n"; + High when High > Limit -> + ["\\x{",erlang:integer_to_list(X, 16),$}]; + Low -> + Low + end || X <- L ], unicode, To); + _ -> + error + end. diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index f1b8a105ed..ef351a25fb 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -77,7 +77,8 @@ MODULES= \ ignore_cores \ zlib_SUITE \ loose_node \ - sendfile_SUITE + sendfile_SUITE \ + standard_error_SUITE APP_FILES = \ appinc.app \ diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 56c35678b6..2ce2303ba3 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -424,7 +424,7 @@ make_del_dir(Config) when is_list(Config) -> ?line ok = ?FILE_MODULE:del_dir(NewDir), ?line {error, enoent} = ?FILE_MODULE:del_dir(NewDir), % Make sure we are not in a directory directly under test_server - % as that would result in eacess errors when trying to delere '..', + % as that would result in eacces errors when trying to delete '..', % because there are processes having that directory as current. ?line ok = ?FILE_MODULE:make_dir(NewDir), ?line {ok,CurrentDir} = file:get_cwd(), diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 05bd5b3a3d..f55716cbec 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -262,7 +262,7 @@ make_del_dir(Config, Handle, Suffix) -> ?line {error, enoent} = ?PRIM_FILE_call(del_dir, Handle, [NewDir]), % Make sure we are not in a directory directly under test_server - % as that would result in eacess errors when trying to delere '..', + % as that would result in eacces errors when trying to delete '..', % because there are processes having that directory as current. ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), ?line {ok, CurrentDir} = ?PRIM_FILE_call(get_cwd, Handle, []), diff --git a/lib/kernel/test/standard_error_SUITE.erl b/lib/kernel/test/standard_error_SUITE.erl new file mode 100644 index 0000000000..b290454b40 --- /dev/null +++ b/lib/kernel/test/standard_error_SUITE.erl @@ -0,0 +1,38 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(standard_error_SUITE). + +-export([all/0,suite/0]). +-export([badarg/1,getopts/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [badarg,getopts]. + +badarg(Config) when is_list(Config) -> + {'EXIT',{badarg,_}} = (catch io:put_chars(standard_error, [oops])), + true = erlang:is_process_alive(whereis(standard_error)), + ok. + +getopts(Config) when is_list(Config) -> + [{encoding,latin1}] = io:getopts(standard_error), + ok. diff --git a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc index 65b950bd46..127c23e0f7 100644 --- a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc +++ b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc @@ -867,6 +867,7 @@ ok </section> <section> + <marker id="event_handling"></marker> <title>Mnesia Event Handling</title> <p>System events and table events are the two categories of events that Mnesia will generate in various situations. diff --git a/lib/mnesia/doc/src/mnesia.xml b/lib/mnesia/doc/src/mnesia.xml index 268dc18e65..ed5b879f7f 100644 --- a/lib/mnesia/doc/src/mnesia.xml +++ b/lib/mnesia/doc/src/mnesia.xml @@ -151,9 +151,9 @@ If a new item is inserted with the same key as </item> <item> <p><c>local_content</c> When an application requires - tables whose contents is local to each node, + tables whose contents are local to each node, <c>local_content</c> tables may be used. The name of the - table is known to all Mnesia nodes, but its contents is + table is known to all Mnesia nodes, but its contents are unique on each node. This means that access to such a table must be done locally. Set the <c>local_content</c> field to <c>true</c> if you want to enable the <c>local_content</c> @@ -579,7 +579,7 @@ mnesia:add_table_index(person, age) <desc> <p>The tables are backed up to external media using the backup module <c>BackupMod</c>. Tables with the local contents - property is being backed up as they exist on the current + property are backed up as they exist on the current node. <c>BackupMod</c> is the default backup callback module obtained by <c>mnesia:system_info(backup_module)</c>. See the User's @@ -863,7 +863,7 @@ mnesia:create_table(person, {attributes, record_info(fields,person)}]). </code> <p>The specification of <c>index</c> and <c>attributes</c> may be - hard coded as <c>{index, [2]}</c> and + hard coded as <c>{index, [4]}</c> and <c>{attributes, [name, age, address, salary, children]}</c> respectively. </p> @@ -2188,12 +2188,13 @@ mnesia:create_table(employee, </desc> </func> <func> - <name>subscribe(EventCategory)</name> + <name>subscribe(EventCategory) -> {ok, Node} | {error, Reason} </name> <fsummary>Subscribe to events of type <c>EventCategory</c>.</fsummary> <desc> <p>Ensures that a copy of all events of type <c>EventCategory</c> are sent to the caller. The event - types available are described in the Mnesia User's Guide.</p> + types available are described in the Mnesia User's Guide at <seealso marker="Mnesia_chap5#event_handling">Mnesia Event Handling</seealso>.</p> + <p><c>Node</c> is the local node. For table events to be subscribed, mnesia must have a readable local copy of the table on the node.</p> </desc> </func> <func> @@ -2861,11 +2862,12 @@ raise(Name, Amount) -> </desc> </func> <func> - <name>unsubscribe(EventCategory)</name> + <name>unsubscribe(EventCategory) -> {ok, Node} | {error, Reason} </name> <fsummary>Subscribe to events of type <c>EventCategory</c>.</fsummary> <desc> <p>Stops sending events of type <c>EventCategory</c> to the caller.</p> + <p><c>Node</c> is the local node.</p> </desc> </func> <func> diff --git a/lib/mnesia/src/mnesia_recover.erl b/lib/mnesia/src/mnesia_recover.erl index b6492707e2..eeb4fa0ced 100644 --- a/lib/mnesia/src/mnesia_recover.erl +++ b/lib/mnesia/src/mnesia_recover.erl @@ -689,12 +689,29 @@ handle_call({connect_nodes, Ns}, From, State) -> %% called from handle_info gen_server:reply(From, {[], AlreadyConnected}), {noreply, State}; - GoodNodes -> + ProbablyGoodNodes -> %% Now we have agreed upon a protocol with some new nodes - %% and we may use them when we recover transactions + %% and we may use them when we recover transactions. + %% + %% Just in case Mnesia was stopped on some of those nodes + %% between the protocol negotiation and now, we check one + %% more time the state of Mnesia. + %% + %% Of course, there is still a chance that mnesia_down + %% events occur during this check and we miss them. To + %% prevent it, handle_cast({mnesia_down, ...}, ...) removes + %% the down node again, in addition to mnesia_down/1. + %% + %% See a comment in handle_cast({mnesia_down, ...}, ...). + Verify = fun(N) -> + Run = mnesia_lib:is_running(N), + Run =:= yes orelse Run =:= starting + end, + GoodNodes = [N || N <- ProbablyGoodNodes, Verify(N)], + mnesia_lib:add_list(recover_nodes, GoodNodes), cast({announce_all, GoodNodes}), - case get_master_nodes(schema) of + case get_master_nodes(schema) of [] -> Context = starting_partitioned_network, mnesia_monitor:detect_inconcistency(GoodNodes, Context); @@ -842,6 +859,14 @@ handle_cast({what_decision, Node, OtherD}, State) -> {noreply, State}; handle_cast({mnesia_down, Node}, State) -> + %% The node was already removed from recover_nodes in mnesia_down/1, + %% but we do it again here in the mnesia_recover process, in case + %% another event incorrectly added it back. This can happen during + %% Mnesia startup which takes time betweenthe connection, the + %% protocol negotiation and the merge of the schema. + %% + %% See a comment in handle_call({connect_nodes, ...), ...). + mnesia_lib:del(recover_nodes, Node), case State#state.unclear_decision of undefined -> {noreply, State}; diff --git a/lib/orber/src/cdr_decode.erl b/lib/orber/src/cdr_decode.erl index 36ef6ce02f..9aec64892e 100644 --- a/lib/orber/src/cdr_decode.erl +++ b/lib/orber/src/cdr_decode.erl @@ -193,7 +193,7 @@ dec_message_header(TypeCodes, Message, Bytes) -> %% Args: %% The message as a byte sequence. %% Returns: -%% A tuple {Endianess, Rest} where Endianess is big or little. +%% A tuple {Endianness, Rest} where Endianness is big or little. %% Rest is the remaining message byte sequence. %%----------------------------------------------------------------- dec_byte_order(<<0:8,T/binary>>) -> @@ -206,7 +206,7 @@ dec_byte_order(<<1:8,T/binary>>) -> %% Args: %% The message as a byte sequence. %% Returns: -%% A tuple {Endianess, Rest} where Endianess is big or little. +%% A tuple {Endianness, Rest} where Endianness is big or little. %% Rest is the remaining message byte sequence. %%----------------------------------------------------------------- dec_byte_order_list([0|T]) -> diff --git a/lib/os_mon/c_src/memsup.c b/lib/os_mon/c_src/memsup.c index 409db84aa7..5dcab07dd8 100644 --- a/lib/os_mon/c_src/memsup.c +++ b/lib/os_mon/c_src/memsup.c @@ -104,7 +104,7 @@ #if !defined (__OpenBSD__) && !defined (__NetBSD__) #include <vm/vm_param.h> #endif -#if defined (__FreeBSD__) || defined(__DragonFly__) || defined (__NetBSD__) +#if defined (__FreeBSD__) || defined(__DragonFly__) || defined (__NetBSD__) || defined(__OpenBSD__) #include <sys/vmmeter.h> #endif #endif diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 9f5d1c003d..d481a75c9a 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -234,11 +234,11 @@ <taglist> <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag> <item> IP version to use when the host address is specified as <c>any</c>. </item> - <tag><c><![CDATA[{subsystems, [subsystem_spec()]]]></c></tag> + <tag><c><![CDATA[{subsystems, [subsystem_spec()]}]]></c></tag> <item> Provides specifications for handling of subsystems. The "sftp" subsystem spec can be retrieved by calling - ssh_sftpd:subsystem_spec/1. If the subsystems option in + ssh_sftpd:subsystem_spec/1. If the subsystems option is not present the value of <c>[ssh_sftpd:subsystem_spec([])]</c> will be used. It is of course possible to set the option to the empty list if diff --git a/lib/ssh/doc/src/ssh_connection.xml b/lib/ssh/doc/src/ssh_connection.xml index ff72cf7ee0..5e2926dfa6 100644 --- a/lib/ssh/doc/src/ssh_connection.xml +++ b/lib/ssh/doc/src/ssh_connection.xml @@ -62,6 +62,7 @@ <p><c>ssh_request_status() = success | failure</c></p> <p><c>event() = {ssh_cm, ssh_connection_ref(), ssh_event_msg()} </c></p> <p><c>ssh_event_msg() = data_events() | status_events() | terminal_events() </c></p> + <p><c>reason() = timeout | closed </c></p> <taglist> <tag><b>data_events()</b></tag> @@ -218,7 +219,7 @@ </func> <func> - <name>exec(ConnectionRef, ChannelId, Command, TimeOut) -> ssh_request_status() </name> + <name>exec(ConnectionRef, ChannelId, Command, TimeOut) -> ssh_request_status() | {error, reason()} </name> <fsummary>Request that the server start the execution of the given command. </fsummary> <type> <v> ConnectionRef = ssh_connection_ref() </v> @@ -274,7 +275,8 @@ </func> <func> - <name>ptty_alloc(ConnectionRef, ChannelId, Options, Timeout) -> success | failure</name> + <name>ptty_alloc(ConnectionRef, ChannelId, Options) -> </name> + <name>ptty_alloc(ConnectionRef, ChannelId, Options, Timeout) -> > ssh_request_status() | {error, reason()} </name> <fsummary>Send status replies to requests that want such replies. </fsummary> <type> <v> ConnectionRef = ssh_connection_ref() </v> @@ -374,7 +376,7 @@ <func> <name>session_channel(ConnectionRef, Timeout) -> </name> <name>session_channel(ConnectionRef, InitialWindowSize, - MaxPacketSize, Timeout) -> {ok, ssh_channel_id()} | {error, Reason}</name> + MaxPacketSize, Timeout) -> {ok, ssh_channel_id()} | {error, reason()}</name> <fsummary>Opens a channel for a ssh session. </fsummary> <type> <v> ConnectionRef = ssh_connection_ref()</v> @@ -391,7 +393,7 @@ </func> <func> - <name>setenv(ConnectionRef, ChannelId, Var, Value, TimeOut) -> ssh_request_status()</name> + <name>setenv(ConnectionRef, ChannelId, Var, Value, TimeOut) -> ssh_request_status() | {error, reason()} </name> <fsummary> Environment variables may be passed to the shell/command to be started later.</fsummary> <type> @@ -409,7 +411,7 @@ </func> <func> - <name>shell(ConnectionRef, ChannelId) -> ssh_request_status() + <name>shell(ConnectionRef, ChannelId) -> ssh_request_status() | {error, closed} </name> <fsummary> Requests that the user's default shell (typically defined in /etc/passwd in UNIX systems) shall be executed at the server @@ -426,7 +428,7 @@ </func> <func> - <name>subsystem(ConnectionRef, ChannelId, Subsystem, Timeout) -> ssh_request_status()</name> + <name>subsystem(ConnectionRef, ChannelId, Subsystem, Timeout) -> ssh_request_status() | {error, reason()} </name> <fsummary> </fsummary> <type> <v> ConnectionRef = ssh_connection_ref() </v> diff --git a/lib/ssh/doc/src/using_ssh.xml b/lib/ssh/doc/src/using_ssh.xml index 9ab71260d3..46178d4018 100644 --- a/lib/ssh/doc/src/using_ssh.xml +++ b/lib/ssh/doc/src/using_ssh.xml @@ -79,7 +79,7 @@ <p> The option user_dir defaults to the users ~/.ssh directory</p> <p>In the following example we generate new keys and host keys as - to be able to run the example without having root privilages</p> + to be able to run the example without having root privileges</p> <code> $bash> ssh-keygen -t rsa -f /tmp/ssh_daemon/ssh_host_rsa_key diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index 01141622d6..c66f810948 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -56,8 +56,8 @@ %%-------------------------------------------------------------------- %%-------------------------------------------------------------------- --spec session_channel(pid(), timeout()) -> {ok, channel_id()} | {error, term()}. --spec session_channel(pid(), integer(), integer(), timeout()) -> {ok, channel_id()} | {error, term()}. +-spec session_channel(pid(), timeout()) -> {ok, channel_id()} | {error, timeout | closed}. +-spec session_channel(pid(), integer(), integer(), timeout()) -> {ok, channel_id()} | {error, timeout | closed}. %% Description: Opens a channel for a ssh session. A session is a %% remote execution of a program. The program may be a shell, an @@ -81,7 +81,8 @@ session_channel(ConnectionHandler, InitialWindowSize, end. %%-------------------------------------------------------------------- --spec exec(pid(), channel_id(), string(), timeout()) -> success | failure. +-spec exec(pid(), channel_id(), string(), timeout()) -> + success | failure | {error, timeout | closed}. %% Description: Will request that the server start the %% execution of the given command. @@ -101,8 +102,8 @@ shell(ConnectionHandler, ChannelId) -> ssh_connection_handler:request(ConnectionHandler, self(), ChannelId, "shell", false, <<>>, 0). %%-------------------------------------------------------------------- --spec subsystem(pid(), channel_id(), string(), timeout()) -> - success | failure | {error, timeout}. +-spec subsystem(pid(), channel_id(), string(), timeout()) -> + success | failure | {error, timeout | closed}. %% %% Description: Executes a predefined subsystem. %%-------------------------------------------------------------------- @@ -142,7 +143,7 @@ send_eof(ConnectionHandler, Channel) -> ssh_connection_handler:send_eof(ConnectionHandler, Channel). %%-------------------------------------------------------------------- --spec adjust_window(pid(), channel_id(), integer()) -> ok. +-spec adjust_window(pid(), channel_id(), integer()) -> ok | {error, closed}. %% %% %% Description: Adjusts the ssh flowcontrol window. @@ -151,7 +152,8 @@ adjust_window(ConnectionHandler, Channel, Bytes) -> ssh_connection_handler:adjust_window(ConnectionHandler, Channel, Bytes). %%-------------------------------------------------------------------- --spec setenv(pid(), channel_id(), string(), string(), timeout()) -> success | failure. +-spec setenv(pid(), channel_id(), string(), string(), timeout()) -> + success | failure | {error, timeout | closed}. %% %% %% Description: Environment variables may be passed to the shell/command to be @@ -183,7 +185,11 @@ reply_request(_,false, _, _) -> ok. %%-------------------------------------------------------------------- --spec ptty_alloc(pid(), channel_id(), proplists:proplist()) -> success | failiure. +-spec ptty_alloc(pid(), channel_id(), proplists:proplist()) -> + success | failiure | {error, closed}. +-spec ptty_alloc(pid(), channel_id(), proplists:proplist(), timeout()) -> + success | failiure | {error, timeout} | {error, closed}. + %% %% %% Description: Sends a ssh connection protocol pty_req. diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index fdb9d3b3e6..68523aa72b 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -289,8 +289,13 @@ renegotiate_data(ConnectionHandler) -> -spec close(pid(), channel_id()) -> ok. %%-------------------------------------------------------------------- close(ConnectionHandler, ChannelId) -> - sync_send_all_state_event(ConnectionHandler, {close, ChannelId}). - + case sync_send_all_state_event(ConnectionHandler, {close, ChannelId}) of + ok -> + ok; + {error, closed} -> + ok + end. + %%-------------------------------------------------------------------- -spec stop(pid()) -> ok | {error, term()}. %%-------------------------------------------------------------------- @@ -1204,7 +1209,11 @@ sync_send_all_state_event(FsmPid, Event) -> sync_send_all_state_event(FsmPid, Event, infinity). sync_send_all_state_event(FsmPid, Event, Timeout) -> - try gen_fsm:sync_send_all_state_event(FsmPid, Event, Timeout) + try gen_fsm:sync_send_all_state_event(FsmPid, Event, Timeout) of + {closed, _Channel} -> + {error, closed}; + Result -> + Result catch exit:{noproc, _} -> {error, closed}; @@ -1702,7 +1711,7 @@ handshake(Pid, Ref, Timeout) -> {error, Reason} after Timeout -> stop(Pid), - {error, Timeout} + {error, timeout} end. start_timeout(_,_, infinity) -> diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index 52665635f0..04ae6b11e2 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -559,56 +559,73 @@ stat(ReqId, RelPath, State0=#state{file_handler=FileMod, send_status({error, E}, ReqId, State1) end. -decode_4_open_flag(create_new) -> - [write]; -decode_4_open_flag(create_truncate) -> - [write]; -decode_4_open_flag(truncate_existing) -> - [write]; -decode_4_open_flag(open_existing) -> - [read]. - -decode_4_flags([OpenFlag | Flags]) -> - decode_4_flags(Flags, decode_4_open_flag(OpenFlag)). - -decode_4_flags([], Flags) -> - Flags; -decode_4_flags([append_data|R], _Flags) -> - decode_4_flags(R, [append]); -decode_4_flags([append_data_atomic|R], _Flags) -> - decode_4_flags(R, [append]); -decode_4_flags([_|R], Flags) -> - decode_4_flags(R, Flags). - -decode_4_access_flag(read_data) -> - [read]; -decode_4_access_flag(list_directory) -> - [read]; -decode_4_access_flag(write_data) -> - [write]; -decode_4_access_flag(add_file) -> - [write]; -decode_4_access_flag(add_subdirectory) -> - [read]; -decode_4_access_flag(append_data) -> - [append]; -decode_4_access_flag(write_attributes) -> - [write]; -decode_4_access_flag(_) -> - [read]. - -decode_4_acess([_ | _] = Flags) -> +sftp_to_erlang_flag(read, Vsn) when Vsn == 3; + Vsn == 4 -> + read; +sftp_to_erlang_flag(write, Vsn) when Vsn == 3; + Vsn == 4 -> + write; +sftp_to_erlang_flag(append, Vsn) when Vsn == 3; + Vsn == 4 -> + append; +sftp_to_erlang_flag(creat, Vsn) when Vsn == 3; + Vsn == 4 -> + write; +sftp_to_erlang_flag(trunc, Vsn) when Vsn == 3; + Vsn == 4 -> + write; +sftp_to_erlang_flag(excl, Vsn) when Vsn == 3; + Vsn == 4 -> + read; +sftp_to_erlang_flag(create_new, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(create_truncate, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(open_existing, Vsn) when Vsn > 4 -> + read; +sftp_to_erlang_flag(open_or_create, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(truncate_existing, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(append_data, Vsn) when Vsn > 4 -> + append; +sftp_to_erlang_flag(append_data_atomic, Vsn) when Vsn > 4 -> + append; +sftp_to_erlang_flag(_, _) -> + read. + +sftp_to_erlang_flags(Flags, Vsn) -> lists:map(fun(Flag) -> - [decode_4_access_flag(Flag)] - end, Flags); -decode_4_acess([]) -> - []. + sftp_to_erlang_flag(Flag, Vsn) + end, Flags). + +sftp_to_erlang_access_flag(read_data, _) -> + read; +sftp_to_erlang_access_flag(list_directory, _) -> + read; +sftp_to_erlang_access_flag(write_data, _) -> + write; +sftp_to_erlang_access_flag(append_data, _) -> + append; +sftp_to_erlang_access_flag(add_subdirectory, _) -> + read; +sftp_to_erlang_access_flag(add_file, _) -> + write; +sftp_to_erlang_access_flag(write_attributes, _) -> + write; +sftp_to_erlang_access_flag(_, _) -> + read. +sftp_to_erlang_access_flags(Flags, Vsn) -> + lists:map(fun(Flag) -> + sftp_to_erlang_access_flag(Flag, Vsn) + end, Flags). open(Vsn, ReqId, Data, State) when Vsn =< 3 -> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(PFlags), _Attrs/binary>> = Data, Path = unicode:characters_to_list(BPath), - Flags = ssh_xfer:decode_open_flags(Vsn, PFlags), + FlagBits = ssh_xfer:decode_open_flags(Vsn, PFlags), + Flags = lists:usort(sftp_to_erlang_flags(FlagBits, Vsn)), do_open(ReqId, State, Path, Flags); open(Vsn, ReqId, Data, State) when Vsn >= 4 -> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(Access), @@ -616,15 +633,12 @@ open(Vsn, ReqId, Data, State) when Vsn >= 4 -> Path = unicode:characters_to_list(BPath), FlagBits = ssh_xfer:decode_open_flags(Vsn, PFlags), AcessBits = ssh_xfer:decode_ace_mask(Access), - %% TODO: This is to make sure the Access flags are not ignored - %% but this should be thought through better. This solution should - %% be considered a hack in order to buy some time. At least - %% it works better than when the Access flags where totally ignored. - %% A better solution may need some code refactoring that we do - %% not have time for right now. - AcessFlags = decode_4_acess(AcessBits), - Flags = lists:append(lists:umerge( - [[decode_4_flags(FlagBits)] | AcessFlags])), + %% TODO: There are still flags that are not + %% fully handled as SSH_FXF_ACCESS_TEXT_MODE and + %% a lot a ACE flags, the later we may not need + %% to understand as they are NFS flags + AcessFlags = sftp_to_erlang_access_flags(AcessBits, Vsn), + Flags = lists:usort(sftp_to_erlang_flags(FlagBits, Vsn) ++ AcessFlags), do_open(ReqId, State, Path, Flags). do_open(ReqId, State0, Path, Flags) -> diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 415cb9fc9c..cb1b4ae945 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -723,7 +723,7 @@ ssh_connect_arg4_timeout(_Config) -> %% Wait for client reaction on the connection try: receive - {done, Client, {error,_E}, T0} -> + {done, Client, {error,timeout}, T0} -> Msp = ms_passed(T0, now()), exit(Server,hasta_la_vista___baby), Low = 0.9*Timeout, @@ -733,6 +733,11 @@ ssh_connect_arg4_timeout(_Config) -> Low<Msp, Msp<High -> ok; true -> {fail, "timeout not within limits"} end; + + {done, Client, {error,Other}, _T0} -> + ct:log("Error message \"~p\" from the client is unexpected.",[{error,Other}]), + {fail, "Unexpected error message"}; + {done, Client, {ok,_Ref}, _T0} -> {fail,"ssh-connected ???"} after diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index 85bd2c75d4..e3871b3feb 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -37,7 +37,6 @@ all() -> [ {group, openssh}, - {group, openssh_payload}, interrupted_send, start_shell, start_shell_exec, @@ -46,7 +45,8 @@ all() -> gracefull_invalid_start, gracefull_invalid_long_start, gracefull_invalid_long_start_no_nl, - stop_listener + stop_listener, + start_subsystem_on_closed_channel ]. groups() -> [{openssh, [], payload() ++ ptty()}]. @@ -576,6 +576,31 @@ stop_listener(Config) when is_list(Config) -> ct:fail({unexpected, Error}) end. +start_subsystem_on_closed_channel(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {subsystems, [{"echo_n", {ssh_echo_server, [4000000]}}]}]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, false}, + {user_dir, UserDir}]), + + {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), + + ok = ssh_connection:close(ConnectionRef, ChannelId), + + {error, closed} = ssh_connection:subsystem(ConnectionRef, ChannelId, "echo_n", infinity), + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index 7b22e45d5e..0ce8eec906 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -56,7 +56,8 @@ all() -> retrieve_attributes, set_attributes, links, - ver3_rename, + ver3_rename, + ver3_open_flags, relpath, sshd_read_file, ver6_basic]. @@ -193,6 +194,39 @@ open_close_file(Config) when is_list(Config) -> ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, ?SSH_FXF_OPEN_EXISTING). +ver3_open_flags() -> + [{doc, "Test open flags"}]. +ver3_open_flags(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, "not_exist.txt"), + {Cm, Channel} = ?config(sftp, Config), + ReqId = 0, + + {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = + open_file_v3(FileName, Cm, Channel, ReqId, + ?SSH_FXF_CREAT bor ?SSH_FXF_TRUNC), + {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), + ?UINT32(?SSH_FX_OK), _/binary>>, _} = close(Handle, ReqId, + Cm, Channel), + + NewFileName = filename:join(PrivDir, "not_exist2.txt"), + NewReqId = ReqId + 1, + {ok, <<?SSH_FXP_HANDLE, ?UINT32(NewReqId), NewHandle/binary>>, _} = + open_file_v3(NewFileName, Cm, Channel, NewReqId, + ?SSH_FXF_CREAT bor ?SSH_FXF_EXCL), + {ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId), + ?UINT32(?SSH_FX_OK), _/binary>>, _} = close(NewHandle, NewReqId, + Cm, Channel), + + NewFileName1 = filename:join(PrivDir, "test.txt"), + NewReqId1 = NewReqId + 1, + {ok, <<?SSH_FXP_HANDLE, ?UINT32(NewReqId1), NewHandle1/binary>>, _} = + open_file_v3(NewFileName1, Cm, Channel, NewReqId1, + ?SSH_FXF_READ bor ?SSH_FXF_WRITE bor ?SSH_FXF_APPEND), + {ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId1), + ?UINT32(?SSH_FX_OK), _/binary>>, _} = close(NewHandle1, NewReqId1, + Cm, Channel). + %%-------------------------------------------------------------------- open_close_dir() -> [{doc,"Test SSH_FXP_OPENDIR and SSH_FXP_CLOSE commands"}]. @@ -662,6 +696,16 @@ open_file(File, Cm, Channel, ReqId, Access, Flags) -> ?SSH_FXP_OPEN, Data/binary>>), reply(Cm, Channel). +open_file_v3(File, Cm, Channel, ReqId, Flags) -> + + Data = list_to_binary([?uint32(ReqId), + ?binary(list_to_binary(File)), + ?uint32(Flags), + ?REG_ATTERS]), + Size = 1 + size(Data), + ssh_connection:send(Cm, Channel, <<?UINT32(Size), + ?SSH_FXP_OPEN, Data/binary>>), + reply(Cm, Channel). close(Handle, ReqId, Cm , Channel) -> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index b53344e381..249fee5760 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2014</year> + <year>1999</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -163,7 +163,7 @@ is supplied it will override the certfile option.</item> <tag>{certfile, path()}</tag> - <item>Path to a file containing the user's certificate.</item> + <item>Path to a file containing the user's PEM encoded certificate.</item> <tag>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' |'PrivateKeyInfo', der_encoded()}}</tag> <item> The DER encoded users private key. If this option @@ -348,11 +348,23 @@ fun(srp, Username :: string(), UserState :: term()) -> </p> </item> + <tag>{padding_check, boolean()}</tag> + <item> + <p> This option only affects TLS-1.0 connections. + If set to false it disables the block cipher padding check + to be able to interoperate with legacy software. + </p> + + <warning><p> Using this option makes TLS vulnerable to + the Poodle attack</p></warning> + + </item> + </taglist> - + </section> - - <section> + + <section> <title>SSL OPTION DESCRIPTIONS - CLIENT SIDE</title> <p>Options described here are client specific or has a slightly different @@ -538,7 +550,19 @@ fun(srp, Username :: string(), UserState :: term()) -> </p> </desc> </func> - + + <func> + <name>clear_pem_cache() -> ok </name> + <fsummary> Clears the pem cache</fsummary> + + <desc><p>PEM files, used by ssl API-functions, are cached. The + cache is regularly checked to see if any cache entries should be + invalidated, however this function provides a way to + unconditionally clear the whole cache. + </p> + </desc> + </func> + <func> <name>connect(Socket, SslOptions) -> </name> <name>connect(Socket, SslOptions, Timeout) -> {ok, SslSocket} diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index 43cb3934f7..f1377cabda 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -82,7 +82,16 @@ callback module, defaults to []. </p> </item> - + + <tag><c><![CDATA[ssl_pem_cache_clean = integer() <optional>]]></c></tag> + <item> + <p> + Number of milliseconds between PEM cache validations. + </p> + <seealso + marker="ssl#clear_pem_cache-0">ssl:clear_pem_cache/0</seealso> + + </item> </taglist> </section> diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index a7bbb6bc40..ae35dd7ea4 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -146,7 +146,7 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, = ConnnectionStates0) -> CompressAlg = SecParams#security_parameters.compression_algorithm, {PlainFragment, Mac, ReadState1} = ssl_record:decipher(dtls_v1:corresponding_tls_version(Version), - CipherFragment, ReadState0), + CipherFragment, ReadState0, true), MacHash = calc_mac_hash(ReadState1, Type, Version, Epoch, Seq, PlainFragment), case ssl_record:is_correct_mac(Mac, MacHash) of true -> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index b4bea25942..4b7f49547b 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -656,7 +656,8 @@ handle_options(Opts0) -> log_alert = handle_option(log_alert, Opts, true), server_name_indication = handle_option(server_name_indication, Opts, undefined), honor_cipher_order = handle_option(honor_cipher_order, Opts, false), - protocol = proplists:get_value(protocol, Opts, tls) + protocol = proplists:get_value(protocol, Opts, tls), + padding_check = proplists:get_value(padding_check, Opts, true) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -669,7 +670,7 @@ handle_options(Opts0) -> cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist, next_protocols_advertised, client_preferred_next_protocols, log_alert, - server_name_indication, honor_cipher_order], + server_name_indication, honor_cipher_order, padding_check], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -847,6 +848,8 @@ validate_option(server_name_indication, undefined) -> undefined; validate_option(honor_cipher_order, Value) when is_boolean(Value) -> Value; +validate_option(padding_check, Value) when is_boolean(Value) -> + Value; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 9c0ed181fe..30d224fee2 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -282,7 +282,7 @@ other_issuer(OtpCert, CertDbHandle) -> handle_path({BinCert, OTPCert}, Path, PartialChainHandler) -> case public_key:pkix_is_self_signed(OTPCert) of true -> - {BinCert, Path}; + {BinCert, lists:delete(BinCert, Path)}; false -> handle_incomplete_chain(Path, PartialChainHandler) end. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 72467ea2a0..ff9c618a35 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -33,8 +33,7 @@ -include_lib("public_key/include/public_key.hrl"). -export([security_parameters/2, security_parameters/3, suite_definition/1, - decipher/5, cipher/5, - suite/1, suites/1, all_suites/1, + decipher/6, cipher/5, suite/1, suites/1, all_suites/1, ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]). @@ -143,17 +142,18 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, {T, CS0#cipher_state{iv=NextIV}}. %%-------------------------------------------------------------------- --spec decipher(cipher_enum(), integer(), #cipher_state{}, binary(), ssl_record:ssl_version()) -> +-spec decipher(cipher_enum(), integer(), #cipher_state{}, binary(), + ssl_record:ssl_version(), boolean()) -> {binary(), binary(), #cipher_state{}} | #alert{}. %% %% Description: Decrypts the data and the MAC using cipher described %% by cipher_enum() and updating the cipher state. %%------------------------------------------------------------------- -decipher(?NULL, _HashSz, CipherState, Fragment, _) -> +decipher(?NULL, _HashSz, CipherState, Fragment, _, _) -> {Fragment, <<>>, CipherState}; -decipher(?RC4, HashSz, CipherState, Fragment, _) -> +decipher(?RC4, HashSz, CipherState, Fragment, _, _) -> State0 = case CipherState#cipher_state.state of - undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key); + undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key); S -> S end, try crypto:stream_decrypt(State0, Fragment) of @@ -171,23 +171,23 @@ decipher(?RC4, HashSz, CipherState, Fragment, _) -> ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end; -decipher(?DES, HashSz, CipherState, Fragment, Version) -> +decipher(?DES, HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(Key, IV, T) -> crypto:block_decrypt(des_cbc, Key, IV, T) - end, CipherState, HashSz, Fragment, Version); -decipher(?'3DES', HashSz, CipherState, Fragment, Version) -> + end, CipherState, HashSz, Fragment, Version, PaddingCheck); +decipher(?'3DES', HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> crypto:block_decrypt(des3_cbc, [K1, K2, K3], IV, T) - end, CipherState, HashSz, Fragment, Version); -decipher(?AES, HashSz, CipherState, Fragment, Version) -> + end, CipherState, HashSz, Fragment, Version, PaddingCheck); +decipher(?AES, HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(Key, IV, T) when byte_size(Key) =:= 16 -> crypto:block_decrypt(aes_cbc128, Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> crypto:block_decrypt(aes_cbc256, Key, IV, T) - end, CipherState, HashSz, Fragment, Version). + end, CipherState, HashSz, Fragment, Version, PaddingCheck). block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, - HashSz, Fragment, Version) -> + HashSz, Fragment, Version, PaddingCheck) -> try Text = Fun(Key, IV, Fragment), NextIV = next_iv(Fragment, IV), @@ -195,7 +195,7 @@ block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, Content = GBC#generic_block_cipher.content, Mac = GBC#generic_block_cipher.mac, CipherState1 = CipherState0#cipher_state{iv=GBC#generic_block_cipher.next_iv}, - case is_correct_padding(GBC, Version) of + case is_correct_padding(GBC, Version, PaddingCheck) of true -> {Content, Mac, CipherState1}; false -> @@ -1288,16 +1288,18 @@ generic_stream_cipher_from_bin(T, HashSz) -> #generic_stream_cipher{content=Content, mac=Mac}. -%% For interoperability reasons we do not check the padding content in -%% SSL 3.0 and TLS 1.0 as it is not strictly required and breaks -%% interopability with for instance Google. is_correct_padding(#generic_block_cipher{padding_length = Len, - padding = Padding}, {3, N}) - when N == 0; N == 1 -> - Len == byte_size(Padding); -%% Padding must be check in TLS 1.1 and after + padding = Padding}, {3, 0}, _) -> + Len == byte_size(Padding); %% Only length check is done in SSL 3.0 spec +%% For interoperability reasons it is possible to disable +%% the padding check when using TLS 1.0, as it is not strictly required +%% in the spec (only recommended), howerver this makes TLS 1.0 vunrable to the Poodle attack +%% so by default this clause will not match +is_correct_padding(GenBlockCipher, {3, 1}, false) -> + is_correct_padding(GenBlockCipher, {3, 0}, false); +%% Padding must be checked in TLS 1.1 and after is_correct_padding(#generic_block_cipher{padding_length = Len, - padding = Padding}, _) -> + padding = Padding}, _, _) -> Len == byte_size(Padding) andalso list_to_binary(lists:duplicate(Len, Len)) == Padding. diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 75efb64e3f..bb4e732517 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -117,7 +117,8 @@ server_name_indication = undefined, %% Should the server prefer its own cipher order over the one provided by %% the client? - honor_cipher_order = false + honor_cipher_order = false, + padding_check = true }). -record(socket_options, diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index d6e5064c39..f2d82a66d3 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -30,10 +30,10 @@ lookup_trusted_cert/4, new_session_id/1, clean_cert_db/2, register_session/2, register_session/3, invalidate_session/2, - invalidate_session/3, clear_pem_cache/0, manager_name/1]). + invalidate_session/3, invalidate_pem/1, clear_pem_cache/0, manager_name/1]). % Spawn export --export([init_session_validator/1]). +-export([init_session_validator/1, init_pem_cache_validator/1]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, @@ -49,7 +49,9 @@ session_lifetime, certificate_db, session_validation_timer, - last_delay_timer = {undefined, undefined}%% Keep for testing purposes + last_delay_timer = {undefined, undefined},%% Keep for testing purposes + last_pem_check, + clear_pem_cache }). -define('24H_in_msec', 86400000). @@ -117,14 +119,13 @@ connection_init(Trustedcerts, Role) -> %% Description: Cache a pem file and return its content. %%-------------------------------------------------------------------- cache_pem_file(File, DbHandle) -> - MD5 = crypto:hash(md5, File), - case ssl_pkix_db:lookup_cached_pem(DbHandle, MD5) of + case ssl_pkix_db:lookup_cached_pem(DbHandle, File) of [{Content,_}] -> {ok, Content}; [Content] -> {ok, Content}; undefined -> - call({cache_pem, {MD5, File}}) + call({cache_pem, File}) end. %%-------------------------------------------------------------------- @@ -191,6 +192,11 @@ invalidate_session(Host, Port, Session) -> invalidate_session(Port, Session) -> cast({invalidate_session, Port, Session}). + +-spec invalidate_pem(File::binary()) -> ok. +invalidate_pem(File) -> + cast({invalidate_pem, File}). + %%==================================================================== %% gen_server callbacks %%==================================================================== @@ -212,12 +218,16 @@ init([Name, Opts]) -> SessionCache = CacheCb:init(proplists:get_value(session_cb_init_args, Opts, [])), Timer = erlang:send_after(SessionLifeTime * 1000 + 5000, self(), validate_sessions), - erlang:send_after(?CLEAR_PEM_CACHE, self(), clear_pem_cache), + Interval = pem_check_interval(), + erlang:send_after(Interval, self(), clear_pem_cache), {ok, #state{certificate_db = CertDb, session_cache = SessionCache, session_cache_cb = CacheCb, session_lifetime = SessionLifeTime, - session_validation_timer = Timer}}. + session_validation_timer = Timer, + last_pem_check = os:timestamp(), + clear_pem_cache = Interval + }}. %%-------------------------------------------------------------------- -spec handle_call(msg(), from(), #state{}) -> {reply, reply(), #state{}}. @@ -256,7 +266,7 @@ handle_call({{new_session_id,Port}, _}, {reply, Id, State}; -handle_call({{cache_pem, File}, _Pid}, _, +handle_call({{cache_pem,File}, _Pid}, _, #state{certificate_db = Db} = State) -> try ssl_pkix_db:cache_pem_file(File, Db) of Result -> @@ -303,7 +313,12 @@ handle_cast({invalidate_session, Host, Port, handle_cast({invalidate_session, Port, #session{session_id = ID} = Session}, #state{session_cache = Cache, session_cache_cb = CacheCb} = State) -> - invalidate_session(Cache, CacheCb, {Port, ID}, Session, State). + invalidate_session(Cache, CacheCb, {Port, ID}, Session, State); + +handle_cast({invalidate_pem, File}, + #state{certificate_db = [_, _, PemCache]} = State) -> + ssl_pkix_db:remove(File, PemCache), + {noreply, State}. %%-------------------------------------------------------------------- -spec handle_info(msg(), #state{}) -> {noreply, #state{}}. @@ -325,18 +340,16 @@ handle_info(validate_sessions, #state{session_cache_cb = CacheCb, handle_info({delayed_clean_session, Key}, #state{session_cache = Cache, session_cache_cb = CacheCb } = State) -> - CacheCb:delete(Cache, Key), + CacheCb:remove(Cache, Key), {noreply, State}; -handle_info(clear_pem_cache, #state{certificate_db = [_,_,PemChace]} = State) -> - case ssl_pkix_db:db_size(PemChace) of - N when N < ?NOT_TO_BIG -> - ok; - _ -> - ssl_pkix_db:clear(PemChace) - end, - erlang:send_after(?CLEAR_PEM_CACHE, self(), clear_pem_cache), - {noreply, State}; +handle_info(clear_pem_cache, #state{certificate_db = [_,_,PemChace], + clear_pem_cache = Interval, + last_pem_check = CheckPoint} = State) -> + NewCheckPoint = os:timestamp(), + start_pem_cache_validator(PemChace, CheckPoint), + erlang:send_after(Interval, self(), clear_pem_cache), + {noreply, State#state{last_pem_check = NewCheckPoint}}; handle_info({clean_cert_db, Ref, File}, @@ -482,10 +495,9 @@ new_id(Port, Tries, Cache, CacheCb) -> clean_cert_db(Ref, CertDb, RefDb, PemCache, File) -> case ssl_pkix_db:ref_count(Ref, RefDb, 0) of 0 -> - MD5 = crypto:hash(md5, File), - case ssl_pkix_db:lookup_cached_pem(PemCache, MD5) of + case ssl_pkix_db:lookup_cached_pem(PemCache, File) of [{Content, Ref}] -> - ssl_pkix_db:insert(MD5, Content, PemCache); + ssl_pkix_db:insert(File, Content, PemCache); _ -> ok end, @@ -494,3 +506,39 @@ clean_cert_db(Ref, CertDb, RefDb, PemCache, File) -> _ -> ok end. + +start_pem_cache_validator(PemCache, CheckPoint) -> + spawn_link(?MODULE, init_pem_cache_validator, + [[get(ssl_manager), PemCache, CheckPoint]]). + +init_pem_cache_validator([SslManagerName, PemCache, CheckPoint]) -> + put(ssl_manager, SslManagerName), + ssl_pkix_db:foldl(fun pem_cache_validate/2, + CheckPoint, PemCache). + +pem_cache_validate({File, _}, CheckPoint) -> + case file:read_file_info(File, []) of + {ok, #file_info{mtime = Time}} -> + case is_before_checkpoint(Time, CheckPoint) of + true -> + ok; + false -> + invalidate_pem(File) + end; + _ -> + invalidate_pem(File) + end, + CheckPoint. + +pem_check_interval() -> + case application:get_env(ssl, ssl_pem_cache_clean) of + {ok, Interval} when is_integer(Interval) -> + Interval; + _ -> + ?CLEAR_PEM_CACHE + end. + +is_before_checkpoint(Time, CheckPoint) -> + calendar:datetime_to_gregorian_seconds(calendar:now_to_datetime(CheckPoint)) - + calendar:datetime_to_gregorian_seconds(Time) > 0. + diff --git a/lib/ssl/src/ssl_pkix_db.erl b/lib/ssl/src/ssl_pkix_db.erl index e59aba0618..8531445ba4 100644 --- a/lib/ssl/src/ssl_pkix_db.erl +++ b/lib/ssl/src/ssl_pkix_db.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -81,10 +81,10 @@ lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer) -> {ok, Certs} end. -lookup_cached_pem([_, _, PemChache], MD5) -> - lookup_cached_pem(PemChache, MD5); -lookup_cached_pem(PemChache, MD5) -> - lookup(MD5, PemChache). +lookup_cached_pem([_, _, PemChache], File) -> + lookup_cached_pem(PemChache, File); +lookup_cached_pem(PemChache, File) -> + lookup(File, PemChache). %%-------------------------------------------------------------------- -spec add_trusted_certs(pid(), {erlang:timestamp(), string()} | @@ -100,36 +100,35 @@ add_trusted_certs(_Pid, {der, DerList}, [CerDb, _,_]) -> {ok, NewRef}; add_trusted_certs(_Pid, File, [CertsDb, RefDb, PemChache] = Db) -> - MD5 = crypto:hash(md5, File), - case lookup_cached_pem(Db, MD5) of + case lookup_cached_pem(Db, File) of [{_Content, Ref}] -> ref_count(Ref, RefDb, 1), {ok, Ref}; [Content] -> Ref = make_ref(), update_counter(Ref, 1, RefDb), - insert(MD5, {Content, Ref}, PemChache), + insert(File, {Content, Ref}, PemChache), add_certs_from_pem(Content, Ref, CertsDb), {ok, Ref}; undefined -> - new_trusted_cert_entry({MD5, File}, Db) + new_trusted_cert_entry(File, Db) end. %%-------------------------------------------------------------------- %% %% Description: Cache file as binary in DB %%-------------------------------------------------------------------- --spec cache_pem_file({binary(), binary()}, [db_handle()]) -> {ok, term()}. -cache_pem_file({MD5, File}, [_CertsDb, _RefDb, PemChache]) -> +-spec cache_pem_file(binary(), [db_handle()]) -> {ok, term()}. +cache_pem_file(File, [_CertsDb, _RefDb, PemChache]) -> {ok, PemBin} = file:read_file(File), Content = public_key:pem_decode(PemBin), - insert(MD5, Content, PemChache), + insert(File, Content, PemChache), {ok, Content}. --spec cache_pem_file(reference(), {binary(), binary()}, [db_handle()]) -> {ok, term()}. -cache_pem_file(Ref, {MD5, File}, [_CertsDb, _RefDb, PemChache]) -> +-spec cache_pem_file(reference(), binary(), [db_handle()]) -> {ok, term()}. +cache_pem_file(Ref, File, [_CertsDb, _RefDb, PemChache]) -> {ok, PemBin} = file:read_file(File), Content = public_key:pem_decode(PemBin), - insert(MD5, {Content, Ref}, PemChache), + insert(File, {Content, Ref}, PemChache), {ok, Content}. %%-------------------------------------------------------------------- @@ -245,9 +244,9 @@ add_certs(Cert, Ref, CertsDb) -> error_logger:info_report(Report) end. -new_trusted_cert_entry(FileRef, [CertsDb, RefDb, _] = Db) -> +new_trusted_cert_entry(File, [CertsDb, RefDb, _] = Db) -> Ref = make_ref(), update_counter(Ref, 1, RefDb), - {ok, Content} = cache_pem_file(Ref, FileRef, Db), + {ok, Content} = cache_pem_file(Ref, File, Db), add_certs_from_pem(Content, Ref, CertsDb), {ok, Ref}. diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 7337225bc4..025a46bf65 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -48,7 +48,7 @@ -export([compress/3, uncompress/3, compressions/0]). %% Payload encryption/decryption --export([cipher/4, decipher/3, is_correct_mac/2]). +-export([cipher/4, decipher/4, is_correct_mac/2]). -export_type([ssl_version/0, ssl_atom_version/0]). @@ -376,8 +376,9 @@ cipher(Version, Fragment, {CipherFragment, CipherS1} = ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version), {CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}. + %%-------------------------------------------------------------------- --spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}} | #alert{}. +-spec decipher(ssl_version(), binary(), #connection_state{}, boolean()) -> {binary(), binary(), #connection_state{}} | #alert{}. %% %% Description: Payload decryption %%-------------------------------------------------------------------- @@ -387,8 +388,8 @@ decipher(Version, CipherFragment, BulkCipherAlgo, hash_size = HashSz}, cipher_state = CipherS0 - } = ReadState) -> - case ssl_cipher:decipher(BulkCipherAlgo, HashSz, CipherS0, CipherFragment, Version) of + } = ReadState, PaddingCheck) -> + case ssl_cipher:decipher(BulkCipherAlgo, HashSz, CipherS0, CipherFragment, Version, PaddingCheck) of {PlainFragment, Mac, CipherS1} -> CS1 = ReadState#connection_state{cipher_state = CipherS1}, {PlainFragment, Mac, CS1}; diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 7df73fb581..77d3aa7889 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -482,8 +482,9 @@ next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_ci next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = [CT | Rest]} = Buffers, - connection_states = ConnStates0} = State) -> - case tls_record:decode_cipher_text(CT, ConnStates0) of + connection_states = ConnStates0, + ssl_options = #ssl_options{padding_check = Check}} = State) -> + case tls_record:decode_cipher_text(CT, ConnStates0, Check) of {Plain, ConnStates} -> {Plain, State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = Rest}, diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index f50ea22f39..ed61da2d62 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -34,7 +34,7 @@ -export([get_tls_records/2]). %% Decoding --export([decode_cipher_text/2]). +-export([decode_cipher_text/3]). %% Encoding -export([encode_plain_text/4]). @@ -142,19 +142,21 @@ encode_plain_text(Type, Version, Data, {CipherText, ConnectionStates#connection_states{current_write = WriteState#connection_state{sequence_number = Seq +1}}}. %%-------------------------------------------------------------------- --spec decode_cipher_text(#ssl_tls{}, #connection_states{}) -> +-spec decode_cipher_text(#ssl_tls{}, #connection_states{}, boolean()) -> {#ssl_tls{}, #connection_states{}}| #alert{}. %% %% Description: Decode cipher text %%-------------------------------------------------------------------- decode_cipher_text(#ssl_tls{type = Type, version = Version, - fragment = CipherFragment} = CipherText, ConnnectionStates0) -> - ReadState0 = ConnnectionStates0#connection_states.current_read, - #connection_state{compression_state = CompressionS0, - sequence_number = Seq, - security_parameters = SecParams} = ReadState0, - CompressAlg = SecParams#security_parameters.compression_algorithm, - case ssl_record:decipher(Version, CipherFragment, ReadState0) of + fragment = CipherFragment} = CipherText, + #connection_states{current_read = + #connection_state{ + compression_state = CompressionS0, + sequence_number = Seq, + security_parameters= + #security_parameters{compression_algorithm = CompressAlg} + } = ReadState0} = ConnnectionStates0, PaddingCheck) -> + case ssl_record:decipher(Version, CipherFragment, ReadState0, PaddingCheck) of {PlainFragment, Mac, ReadState1} -> MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1), case ssl_record:is_correct_mac(Mac, MacHash) of diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 2f8ff6f04e..0d241707d9 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2013. All Rights Reserved. +# Copyright Ericsson AB 1999-2015. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -46,6 +46,7 @@ MODULES = \ ssl_npn_handshake_SUITE \ ssl_packet_SUITE \ ssl_payload_SUITE \ + ssl_pem_cache_SUITE \ ssl_session_cache_SUITE \ ssl_to_openssl_SUITE \ ssl_ECC_SUITE \ diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 1da4e88077..2d4d2452e3 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -256,11 +256,6 @@ init_per_testcase(Case, Config) when Case == unordered_protocol_versions_client _ -> {skip, "TLS 1.2 need but not supported on this platform"} end; -init_per_testcase(no_authority_key_identifier, Config) -> - %% Clear cach so that root cert will not - %% be found. - ssl:clear_pem_cache(), - Config; init_per_testcase(protocol_versions, Config) -> ssl:stop(), diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index b7864ba6e7..dab7a941db 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -443,7 +443,7 @@ verify_fun_always_run_client(Config) when is_list(Config) -> {unknown, UserState}; (_, valid, [ChainLen]) -> {valid, [ChainLen + 1]}; - (_, valid_peer, [2]) -> + (_, valid_peer, [1]) -> {fail, "verify_fun_was_always_run"}; (_, valid_peer, UserState) -> {valid, UserState} @@ -482,7 +482,7 @@ verify_fun_always_run_server(Config) when is_list(Config) -> {unknown, UserState}; (_, valid, [ChainLen]) -> {valid, [ChainLen + 1]}; - (_, valid_peer, [2]) -> + (_, valid_peer, [1]) -> {fail, "verify_fun_was_always_run"}; (_, valid_peer, UserState) -> {valid, UserState} diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl index 45e91786d4..0e48b674e0 100644 --- a/lib/ssl/test/ssl_cipher_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -38,7 +38,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [aes_decipher_good, aes_decipher_good_tls11, aes_decipher_fail, aes_decipher_fail_tls11]. + [aes_decipher_good, aes_decipher_fail, padding_test]. groups() -> []. @@ -73,93 +73,123 @@ end_per_testcase(_TestCase, Config) -> %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- aes_decipher_good() -> - [{doc,"Decipher a known cryptotext."}]. + [{doc,"Decipher a known cryptotext using a correct key"}]. aes_decipher_good(Config) when is_list(Config) -> HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Content = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56, "HELLO\n">>, - Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, - Version = {3,0}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), - Version1 = {3,1}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), - ok. - -%%-------------------------------------------------------------------- - -aes_decipher_good_tls11() -> - [{doc,"Decipher a known TLS 1.1 cryptotext."}]. - -%% the fragment is actuall a TLS 1.1 record, with -%% Version = TLS 1.1, we get the correct NextIV in #cipher_state -aes_decipher_good_tls11(Config) when is_list(Config) -> - HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Content = <<"HELLO\n">>, - NextIV = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>>, - Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, - Version = {3,2}, - {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), - Version1 = {3,2}, - {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), - ok. + CipherState = correct_cipher_state(), + decipher_check_good(HashSz, CipherState, {3,0}), + decipher_check_good(HashSz, CipherState, {3,1}), + decipher_check_good(HashSz, CipherState, {3,2}), + decipher_check_good(HashSz, CipherState, {3,3}). %%-------------------------------------------------------------------- aes_decipher_fail() -> - [{doc,"Decipher a known cryptotext."}]. + [{doc,"Decipher a known cryptotext using a incorrect key"}]. -%% same as above, last byte of key replaced aes_decipher_fail(Config) when is_list(Config) -> HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Version = {3,0}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), - 32 = byte_size(Content), - 32 = byte_size(Mac), - Version1 = {3,1}, - {Content1, Mac1, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), - 32 = byte_size(Content1), - 32 = byte_size(Mac1), - ok. -%%-------------------------------------------------------------------- - -aes_decipher_fail_tls11() -> - [{doc,"Decipher a known TLS 1.1 cryptotext."}]. - -%% same as above, last byte of key replaced -%% stricter padding checks in TLS 1.1 mean we get an alert instead -aes_decipher_fail_tls11(Config) when is_list(Config) -> - HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Version = {3,2}, - #alert{level = ?FATAL, description = ?BAD_RECORD_MAC} = - ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), - Version1 = {3,3}, - #alert{level = ?FATAL, description = ?BAD_RECORD_MAC} = - ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), - ok. + CipherState = incorrect_cipher_state(), + decipher_check_fail(HashSz, CipherState, {3,0}), + decipher_check_fail(HashSz, CipherState, {3,1}), + decipher_check_fail(HashSz, CipherState, {3,2}), + decipher_check_fail(HashSz, CipherState, {3,3}). %%-------------------------------------------------------------------- +padding_test(Config) when is_list(Config) -> + HashSz = 16, + CipherState = correct_cipher_state(), + pad_test(HashSz, CipherState, {3,0}), + pad_test(HashSz, CipherState, {3,1}), + pad_test(HashSz, CipherState, {3,2}), + pad_test(HashSz, CipherState, {3,3}). + +%%-------------------------------------------------------------------- +% Internal functions -------------------------------------------------------- +%%-------------------------------------------------------------------- +decipher_check_good(HashSz, CipherState, Version) -> + {Content, NextIV, Mac} = content_nextiv_mac(Version), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, aes_fragment(Version), Version, true). + +decipher_check_fail(HashSz, CipherState, Version) -> + {Content, NextIV, Mac} = content_nextiv_mac(Version), + true = {Content, Mac, #cipher_state{iv = NextIV}} =/= + ssl_cipher:decipher(?AES, HashSz, CipherState, aes_fragment(Version), Version, true). + +pad_test(HashSz, CipherState, {3,0} = Version) -> + %% 3.0 does not have padding test + {Content, NextIV, Mac} = badpad_content_nextiv_mac(Version), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, badpad_aes_fragment({3,0}), {3,0}, true), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, badpad_aes_fragment({3,0}), {3,0}, false); +pad_test(HashSz, CipherState, {3,1} = Version) -> + %% 3.1 should have padding test, but may be disabled + {Content, NextIV, Mac} = badpad_content_nextiv_mac(Version), + BadCont = badpad_content(Content), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, badpad_aes_fragment({3,1}) , {3,1}, false), + {BadCont, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, badpad_aes_fragment({3,1}), {3,1}, true); +pad_test(HashSz, CipherState, Version) -> + %% 3.2 and 3.3 must have padding test + {Content, NextIV, Mac} = badpad_content_nextiv_mac(Version), + BadCont = badpad_content(Content), + {BadCont, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, + badpad_aes_fragment(Version), Version, false), + {BadCont, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, + badpad_aes_fragment(Version), Version, true). + +aes_fragment({3,N}) when N == 0; N == 1-> + <<197,9,6,109,242,87,80,154,85,250,110,81,119,95,65,185,53,206,216,153,246,169, + 119,177,178,238,248,174,253,220,242,81,33,0,177,251,91,44,247,53,183,198,165, + 63,20,194,159,107>>; + +aes_fragment(_) -> + <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, + 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, + 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, + 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>. + +badpad_aes_fragment({3,N}) when N == 0; N == 1 -> + <<186,139,125,10,118,21,26,248,120,108,193,104,87,118,145,79,225,55,228,10,105, + 30,190,37,1,88,139,243,210,99,65,41>>; +badpad_aes_fragment(_) -> + <<137,31,14,77,228,80,76,103,183,125,55,250,68,190,123,131,117,23,229,180,207, + 94,121,137,117,157,109,99,113,61,190,138,131,229,201,120,142,179,172,48,77, + 234,19,240,33,38,91,93>>. + +content_nextiv_mac({3,N}) when N == 0; N == 1 -> + {<<"HELLO\n">>, + <<33,0, 177,251, 91,44, 247,53, 183,198, 165,63, 20,194, 159,107>>, + <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>}; +content_nextiv_mac(_) -> + {<<"HELLO\n">>, + <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>>, + <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>}. + +badpad_content_nextiv_mac({3,N}) when N == 0; N == 1 -> + {<<"HELLO\n">>, + <<225,55,228,10,105,30,190,37,1,88,139,243,210,99,65,41>>, + <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>> + }; +badpad_content_nextiv_mac(_) -> + {<<"HELLO\n">>, + <<133,211,45,189,179,229,56,86,11,178,239,159,14,160,253,140>>, + <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>> + }. + +badpad_content(Content) -> + %% BadContent will fail mac test + <<16#F0, Content/binary>>. + +correct_cipher_state() -> + #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}. + +incorrect_cipher_state() -> + #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}. diff --git a/lib/ssl/test/ssl_pem_cache_SUITE.erl b/lib/ssl/test/ssl_pem_cache_SUITE.erl new file mode 100644 index 0000000000..843079e2fe --- /dev/null +++ b/lib/ssl/test/ssl_pem_cache_SUITE.erl @@ -0,0 +1,127 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/.2 +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssl_pem_cache_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("kernel/include/file.hrl"). + +-define(CLEANUP_INTERVAL, 5000). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- +all() -> + [pem_cleanup]. + +groups() -> + []. + +init_per_suite(Config0) -> + catch crypto:stop(), + try crypto:start() of + ok -> + ssl:start(), + %% make rsa certs using oppenssl + Result = + (catch make_certs:all(?config(data_dir, Config0), + ?config(priv_dir, Config0))), + ct:log("Make certs ~p~n", [Result]), + + Config1 = ssl_test_lib:make_dsa_cert(Config0), + ssl_test_lib:cert_options(Config1) + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(_Config) -> + application:stop(crypto). + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(pem_cleanup, Config) -> + ssl:stop(), + application:load(ssl), + application:set_env(ssl, ssl_pem_cache_clean, ?CLEANUP_INTERVAL), + ssl:start(), + Config. + +end_per_testcase(_TestCase, Config) -> + %%ssl:stop(), + Config. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- +pem_cleanup() -> + [{doc, "Test pem cache invalidate mechanism"}]. +pem_cleanup(Config)when is_list(Config) -> + process_flag(trap_exit, true), + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + + Size = ssl_pkix_db:db_size(get_pem_cache()), + Certfile = proplists:get_value(certfile, ServerOpts), + {ok, FileInfo} = file:read_file_info(Certfile), + Time = later(), + ok = file:write_file_info(Certfile, FileInfo#file_info{mtime = Time}), + ct:sleep(2 * ?CLEANUP_INTERVAL), + Size1 = ssl_pkix_db:db_size(get_pem_cache()), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client), + false = Size == Size1. + +get_pem_cache() -> + {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), + [_, _,_, _, Prop] = StatusInfo, + State = ssl_test_lib:state(Prop), + case element(5, State) of + [_CertDb, _FileRefDb, PemChace] -> + PemChace; + _ -> + undefined + end. + +later()-> + DateTime = calendar:now_to_local_time(os:timestamp()), + Gregorian = calendar:datetime_to_gregorian_seconds(DateTime), + calendar:gregorian_seconds_to_datetime(Gregorian + (2 * ?CLEANUP_INTERVAL)). + diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl index 4850a59eb6..8d07a356dd 100644 --- a/lib/stdlib/src/binary.erl +++ b/lib/stdlib/src/binary.erl @@ -89,9 +89,9 @@ copy(_, _) -> decode_unsigned(_) -> erlang:nif_error(undef). --spec decode_unsigned(Subject, Endianess) -> Unsigned when +-spec decode_unsigned(Subject, Endianness) -> Unsigned when Subject :: binary(), - Endianess :: big | little, + Endianness :: big | little, Unsigned :: non_neg_integer(). decode_unsigned(_, _) -> @@ -103,9 +103,9 @@ decode_unsigned(_, _) -> encode_unsigned(_) -> erlang:nif_error(undef). --spec encode_unsigned(Unsigned, Endianess) -> binary() when +-spec encode_unsigned(Unsigned, Endianness) -> binary() when Unsigned :: non_neg_integer(), - Endianess :: big | little. + Endianness :: big | little. encode_unsigned(_, _) -> erlang:nif_error(undef). diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index 7e12eab1b5..3ca7a8197e 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -88,7 +88,7 @@ %% This is a so-called Erlang I/O ErrorInfo structure; see the {@link %% //stdlib/io} module for details. --type errorinfo() :: term(). % {integer(), atom(), term()}. +-type errorinfo() :: {integer(), atom(), term()}. -type option() :: atom() | {atom(), term()}. @@ -208,8 +208,8 @@ do_parse_file(DefEncoding, File, Parser, Options) -> try Parser(Dev, 1, Options) after ok = file:close(Dev) end; - {error, _} = Error -> - Error + {error, Error} -> + {error, {0, file, Error}} % defer to file:format_error/1 end. find_invalid_unicode([H|T]) -> diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index f1251fddab..d5ba8aa52f 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -305,7 +305,7 @@ handle_call({inspect, Lockname, InOpts}, _From, #state{ duration=Duration, locks {true, true} -> locks_ids(Filtered); _ -> [] end, - Combos = combine_classes(Filtered, proplists:get_value(combine, Opts)), + Combos = combine_classes(Filtered, proplists:get_value(combine, Opts)), case proplists:get_value(locations, Opts) of true -> lists:foreach(fun @@ -329,9 +329,8 @@ handle_call({inspect, Lockname, InOpts}, _From, #state{ duration=Duration, locks end end, Combos); _ -> - Print1 = locks2print(Combos, Duration), - Print2 = filter_print(Print1, Opts), - print_lock_information(Print2, proplists:get_value(print, Opts)) + Print = filter_print(locks2print(Combos, Duration), Opts), + print_lock_information(Print, proplists:get_value(print, Opts)) end, {reply, ok, State}; @@ -357,8 +356,7 @@ handle_call({histogram, Lockname, InOpts}, _From, #state{ duration=Duration, loc {thresholds, [{tries, -1}, {colls, -1}, {time, -1}]}], Opts), Prints = locks2print([L], Duration), print_lock_information(Prints, proplists:get_value(print, Opts1)), - print_full_histogram(SumStats#stats.hist), - io:format("~n") + print_full_histogram(SumStats#stats.hist) end, Combos), {reply, ok, State}; @@ -509,20 +507,23 @@ filter_locks(Locks, Lockname) -> % 4. max length of locks filter_print(PLs, Opts) -> - TLs = threshold_locks(PLs, proplists:get_value(thresholds, Opts, [])), - SLs = sort_locks(TLs, proplists:get_value(sort, Opts, time)), - CLs = cut_locks(SLs, proplists:get_value(max_locks, Opts, none)), - reverse_locks(CLs, not proplists:get_value(reverse,Opts, false)). - -sort_locks(Locks, name) -> lists:keysort(#print.name, Locks); -sort_locks(Locks, id) -> lists:keysort(#print.id, Locks); -sort_locks(Locks, type) -> lists:keysort(#print.type, Locks); -sort_locks(Locks, tries) -> lists:keysort(#print.tries, Locks); -sort_locks(Locks, colls) -> lists:keysort(#print.colls, Locks); -sort_locks(Locks, ratio) -> lists:keysort(#print.cr, Locks); -sort_locks(Locks, time) -> lists:keysort(#print.time, Locks); + TLs = threshold_locks(PLs, proplists:get_value(thresholds, Opts, [])), + SLs = sort_locks(TLs, proplists:get_value(sort, Opts, time)), + CLs = cut_locks(SLs, proplists:get_value(max_locks, Opts, none)), + reverse_locks(CLs, proplists:get_value(reverse, Opts, false)). + +sort_locks(Locks, name) -> reverse_sort_locks(#print.name, Locks); +sort_locks(Locks, id) -> reverse_sort_locks(#print.id, Locks); +sort_locks(Locks, type) -> reverse_sort_locks(#print.type, Locks); +sort_locks(Locks, tries) -> reverse_sort_locks(#print.tries, Locks); +sort_locks(Locks, colls) -> reverse_sort_locks(#print.colls, Locks); +sort_locks(Locks, ratio) -> reverse_sort_locks(#print.cr, Locks); +sort_locks(Locks, time) -> reverse_sort_locks(#print.time, Locks); sort_locks(Locks, _) -> sort_locks(Locks, time). +reverse_sort_locks(Ix, Locks) -> + lists:reverse(lists:keysort(Ix, Locks)). + % cut locks not above certain thresholds threshold_locks(Locks, Thresholds) -> Tries = proplists:get_value(tries, Thresholds, -1), @@ -647,15 +648,19 @@ format_histogram(Tup) when is_tuple(Tup) -> _ -> string_histogram([case V of 0 -> 0; _ -> V/Max end || V <- Vs]) end. -string_histogram([0|Vs]) -> - [$\s|string_histogram(Vs)]; -string_histogram([V|Vs]) when V > 0.66 -> - [$X|string_histogram(Vs)]; -string_histogram([V|Vs]) when V > 0.33 -> - [$x|string_histogram(Vs)]; -string_histogram([_|Vs]) -> - [$.|string_histogram(Vs)]; -string_histogram([]) -> []. +string_histogram(Vs) -> + [$||histogram_values_to_string(Vs,$|)]. + +histogram_values_to_string([0|Vs],End) -> + [$\s|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([V|Vs],End) when V > 0.66 -> + [$X|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([V|Vs],End) when V > 0.33 -> + [$x|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([_|Vs],End) -> + [$.|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([],End) -> + [End]. %% state making @@ -778,7 +783,7 @@ auto_print_width(Locks, Print) -> ({print,print}, Out) -> [print|Out]; ({Str, Len}, Out) -> [erlang:min(erlang:max(length(s(Str))+1,Len),80)|Out] end, [], lists:zip(tuple_to_list(L), tuple_to_list(Max))))) - end, #print{ id = 4, type = 5, entry = 5, name = 6, tries = 8, colls = 13, cr = 16, time = 11, dtr = 14, hist=20 }, + end, #print{ id=4, type=5, entry=5, name=6, tries=8, colls=13, cr=16, time=11, dtr=14, hist=20 }, Locks), % Setup the offsets for later pruning Offsets = [ @@ -820,7 +825,7 @@ print_header(Opts) -> cr = "collisions [%]", time = "time [us]", dtr = "duration [%]", - hist = "histogram" + hist = "histogram [log2(us)]" }, Divider = #print{ name = lists:duplicate(1 + length(Header#print.name), 45), @@ -863,9 +868,9 @@ format_lock(L, [Opt|Opts]) -> {time, W} -> [{space, W, s(L#print.time) } | format_lock(L, Opts)]; duration -> [{space, 20, s(L#print.dtr) } | format_lock(L, Opts)]; {duration, W} -> [{space, W, s(L#print.dtr) } | format_lock(L, Opts)]; - histogram -> [{space, 0, s(L#print.hist) } | format_lock(L, Opts)]; - {histogram, W} -> [{space, W, s(L#print.hist) } | format_lock(L, Opts)]; - _ -> format_lock(L, Opts) + histogram -> [{space, 20, s(L#print.hist) } | format_lock(L, Opts)]; + {histogram, W} -> [{left, W - length(s(L#print.hist)) - 1, s(L#print.hist)} | format_lock(L, Opts)]; + _ -> format_lock(L, Opts) end. print_state_information(#state{locks = Locks} = State) -> @@ -926,6 +931,7 @@ s(T) -> term2string(T). strings(Strings) -> strings(Strings, []). strings([], Out) -> Out; strings([{space, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string("~~~ws", [N]), [S])); +strings([{left, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string(" ~~s~~~ws", [N]), [S,""])); strings([{format, Format, S} | Ss], Out) -> strings(Ss, Out ++ term2string(Format, [S])); strings([S|Ss], Out) -> strings(Ss, Out ++ term2string("~ts", [S])). diff --git a/lib/wx/src/wxe_server.erl b/lib/wx/src/wxe_server.erl index 465b9da2e0..153e2475ba 100644 --- a/lib/wx/src/wxe_server.erl +++ b/lib/wx/src/wxe_server.erl @@ -223,14 +223,18 @@ handle_connect(Object, #evh{handler=undefined, cb=Callback} = EvData0, Error -> {reply, Error, State0} end; -handle_connect(Object, EvData=#evh{handler=Handler}, +handle_connect(Object, EvData=#evh{handler=Handler}, From, State0 = #state{users=Users}) -> %% Correct process is already listening just register it put(Handler, From), - User0 = #user{events=Listeners0} = gb_trees:get(From, Users), - User = User0#user{events=[{Object,EvData}|Listeners0]}, - State = State0#state{users=gb_trees:update(From, User, Users)}, - {reply, ok, State}. + case gb_trees:lookup(From, Users) of + {value, User0 = #user{events=Listeners0}} -> + User = User0#user{events=[{Object,EvData}|Listeners0]}, + State = State0#state{users=gb_trees:update(From, User, Users)}, + {reply, ok, State}; + none -> %% We are closing up the shop + {reply, {error, terminating}, State0} + end. invoke_cb({{Ev=#wx{}, Ref=#wx_ref{}}, FunId,_}, _S) -> %% Event callbacks diff --git a/lib/wx/test/wx_event_SUITE.erl b/lib/wx/test/wx_event_SUITE.erl index 076f16ba16..f9f8788d8f 100644 --- a/lib/wx/test/wx_event_SUITE.erl +++ b/lib/wx/test/wx_event_SUITE.erl @@ -336,12 +336,14 @@ connect_in_callback(Config) -> end}]), wxWindow:show(F1), receive - {continue, F1} -> Tester ! {continue, F1} + {continue, F1} -> + true = wxFrame:disconnect(F1, size), + Tester ! {continue, F1} end end, - wxFrame:connect(Frame,size, + wxFrame:connect(Frame,show, [{callback, - fun(#wx{event=#wxSize{}},_SizeEv) -> + fun(#wx{event=#wxShow{}},_SizeEv) -> io:format("Frame got size~n",[]), spawn(TestWindow) end}]), |