diff options
Diffstat (limited to 'lib')
43 files changed, 1015 insertions, 509 deletions
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index a8cfdffdf3..85d332c56e 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -262,12 +262,17 @@ opt_move_1(R, [{set,[D],[R],move}|Is0], Acc) -> {yes,Is} -> opt_move_rev(D, Acc, Is); no -> not_possible end; -opt_move_1({x,_}, [{set,_,_,{alloc,_,_}}|_], _) -> - %% The optimization is not possible. If the X register is not - %% killed by allocation, the optimization would not be safe. - %% If the X register is killed, it means that there cannot - %% follow a 'move' instruction with this X register as the - %% source. +opt_move_1(_R, [{set,_,_,{alloc,_,_}}|_], _) -> + %% The optimization is either not possible or not safe. + %% + %% If R is an X register killed by allocation, the optimization is + %% not safe. On the other hand, if the X register is killed, there + %% will not follow a 'move' instruction with this X register as + %% the source. + %% + %% If R is a Y register, the optimization is still not safe + %% because the new target register is an X register that cannot + %% safely pass the alloc instruction. not_possible; opt_move_1(R, [{set,_,_,_}=I|Is], Acc) -> %% If the source register is either killed or used by this diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 13aa31b7c9..4c0cb6780a 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -658,8 +658,10 @@ valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) -> case Src of {Tag,_} when Tag =:= x; Tag =:= y -> set_type_reg(map, Src, Vst); + {literal,Map} when is_map(Map) -> + Vst; _ -> - Vst + kill_state(Vst) end; valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> validate_src(Src, Vst), diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl index 936c5f6106..cdc513e57c 100644 --- a/lib/compiler/src/rec_env.erl +++ b/lib/compiler/src/rec_env.erl @@ -22,8 +22,7 @@ %% @doc Abstract environments, supporting self-referential bindings and %% automatic new-key generation. -%% The current implementation is based on Erlang standard library -%% dictionaries. +%% The current implementation is based on Erlang standard library maps. %%% -define(DEBUG, true). @@ -62,7 +61,7 @@ test_0(Type, N) -> io:fwrite("\ncalls: ~w.\n", [get(new_key_calls)]), io:fwrite("\nretries: ~w.\n", [get(new_key_retries)]), io:fwrite("\nmax: ~w.\n", [get(new_key_max)]), - dict:to_list(element(1,Env)). + maps:to_list(element(1,Env)). test_1(integer = Type, N, Env) when is_integer(N), N > 0 -> Key = new_key(Env), @@ -80,14 +79,13 @@ test_1(_,0, Env) -> %% %% environment() = [Mapping] %% -%% Mapping = {map, Dict} | {rec, Dict, Dict} -%% Dict = dict:dictionary() +%% Mapping = {map, map()} | {rec, map(), map()} %% -%% An empty environment is a list containing a single `{map, Dict}' +%% An empty environment is a list containing a single `{map, map()}' %% element - empty lists are not valid environments. To find a key in an %% environment, it is searched for in each mapping in the list, in %% order, until it the key is found in some mapping, or the end of the -%% list is reached. In a 'rec' mapping, we keep the original dictionary +%% list is reached. In a 'rec' mapping, we keep the original map %% together with a version where entries may have been deleted - this %% makes it possible to garbage collect the entire 'rec' mapping when %% all its entries are unused (for example, by being shadowed by later @@ -97,7 +95,7 @@ test_1(_,0, Env) -> %% ===================================================================== %% @type environment(). An abstract environment. --type mapping() :: {'map', dict:dict()} | {'rec', dict:dict(), dict:dict()}. +-type mapping() :: {'map', map()} | {'rec', map(), map()}. -type environment() :: [mapping(),...]. %% ===================================================================== @@ -108,7 +106,7 @@ test_1(_,0, Env) -> -spec empty() -> environment(). empty() -> - [{map, dict:new()}]. + [{map, #{}}]. %% ===================================================================== @@ -119,14 +117,14 @@ empty() -> -spec is_empty(environment()) -> boolean(). -is_empty([{map, Dict} | Es]) -> - N = dict:size(Dict), +is_empty([{map, Map} | Es]) -> + N = map_size(Map), if N =/= 0 -> false; Es =:= [] -> true; true -> is_empty(Es) end; -is_empty([{rec, Dict, _} | Es]) -> - N = dict:size(Dict), +is_empty([{rec, Map, _} | Es]) -> + N = map_size(Map), if N =/= 0 -> false; Es =:= [] -> true; true -> is_empty(Es) @@ -146,12 +144,12 @@ is_empty([{rec, Dict, _} | Es]) -> size(Env) -> env_size(Env). -env_size([{map, Dict}]) -> - dict:size(Dict); -env_size([{map, Dict} | Env]) -> - dict:size(Dict) + env_size(Env); -env_size([{rec, Dict, _Dict0} | Env]) -> - dict:size(Dict) + env_size(Env). +env_size([{map, Map}]) -> + map_size(Map); +env_size([{map, Map} | Env]) -> + map_size(Map) + env_size(Env); +env_size([{rec, Map, _Map0} | Env]) -> + map_size(Map) + env_size(Env). %% ===================================================================== @@ -165,8 +163,8 @@ env_size([{rec, Dict, _Dict0} | Env]) -> -spec is_defined(term(), environment()) -> boolean(). -is_defined(Key, [{map, Dict} | Env]) -> - case dict:is_key(Key, Dict) of +is_defined(Key, [{map, Map} | Env]) -> + case maps:is_key(Key, Map) of true -> true; false when Env =:= [] -> @@ -174,8 +172,8 @@ is_defined(Key, [{map, Dict} | Env]) -> false -> is_defined(Key, Env) end; -is_defined(Key, [{rec, Dict, _Dict0} | Env]) -> - dict:is_key(Key, Dict) orelse is_defined(Key, Env). +is_defined(Key, [{rec, Map, _Map0} | Env]) -> + maps:is_key(Key, Map) orelse is_defined(Key, Env). %% ===================================================================== @@ -188,12 +186,12 @@ is_defined(Key, [{rec, Dict, _Dict0} | Env]) -> keys(Env) -> lists:sort(keys(Env, [])). -keys([{map, Dict}], S) -> - dict:fetch_keys(Dict) ++ S; -keys([{map, Dict} | Env], S) -> - keys(Env, dict:fetch_keys(Dict) ++ S); -keys([{rec, Dict, _Dict0} | Env], S) -> - keys(Env, dict:fetch_keys(Dict) ++ S). +keys([{map, Map}], S) -> + maps:keys(Map) ++ S; +keys([{map, Map} | Env], S) -> + keys(Env, maps:keys(Map) ++ S); +keys([{rec, Map, _Map0} | Env], S) -> + keys(Env, maps:keys(Map) ++ S). %% ===================================================================== @@ -212,12 +210,12 @@ keys([{rec, Dict, _Dict0} | Env], S) -> to_list(Env) -> lists:sort(to_list(Env, [])). -to_list([{map, Dict}], S) -> - dict:to_list(Dict) ++ S; -to_list([{map, Dict} | Env], S) -> - to_list(Env, dict:to_list(Dict) ++ S); -to_list([{rec, Dict, _Dict0} | Env], S) -> - to_list(Env, dict:to_list(Dict) ++ S). +to_list([{map, Map}], S) -> + maps:to_list(Map) ++ S; +to_list([{map, Map} | Env], S) -> + to_list(Env, maps:to_list(Map) ++ S); +to_list([{rec, Map, _Map0} | Env], S) -> + to_list(Env, maps:to_list(Map) ++ S). %% ===================================================================== @@ -236,12 +234,12 @@ to_list([{rec, Dict, _Dict0} | Env], S) -> -spec bind(term(), term(), environment()) -> environment(). -bind(Key, Value, [{map, Dict}]) -> - [{map, dict:store(Key, Value, Dict)}]; -bind(Key, Value, [{map, Dict} | Env]) -> - [{map, dict:store(Key, Value, Dict)} | delete_any(Key, Env)]; +bind(Key, Value, [{map, Map}]) -> + [{map, maps:put(Key, Value, Map)}]; +bind(Key, Value, [{map, Map} | Env]) -> + [{map, maps:put(Key, Value, Map)} | delete_any(Key, Env)]; bind(Key, Value, Env) -> - [{map, dict:store(Key, Value, dict:new())} | delete_any(Key, Env)]. + [{map, maps:put(Key, Value, #{})} | delete_any(Key, Env)]. %% ===================================================================== @@ -259,17 +257,17 @@ bind(Key, Value, Env) -> -spec bind_list([term()], [term()], environment()) -> environment(). -bind_list(Ks, Vs, [{map, Dict}]) -> - [{map, store_list(Ks, Vs, Dict)}]; -bind_list(Ks, Vs, [{map, Dict} | Env]) -> - [{map, store_list(Ks, Vs, Dict)} | delete_list(Ks, Env)]; +bind_list(Ks, Vs, [{map, Map}]) -> + [{map, store_list(Ks, Vs, Map)}]; +bind_list(Ks, Vs, [{map, Map} | Env]) -> + [{map, store_list(Ks, Vs, Map)} | delete_list(Ks, Env)]; bind_list(Ks, Vs, Env) -> - [{map, store_list(Ks, Vs, dict:new())} | delete_list(Ks, Env)]. + [{map, store_list(Ks, Vs, #{})} | delete_list(Ks, Env)]. -store_list([K | Ks], [V | Vs], Dict) -> - store_list(Ks, Vs, dict:store(K, V, Dict)); -store_list([], _, Dict) -> - Dict. +store_list([K | Ks], [V | Vs], Map) -> + store_list(Ks, Vs, maps:put(K, V, Map)); +store_list([], _, Map) -> + Map. delete_list([K | Ks], Env) -> delete_list(Ks, delete_any(K, Env)); @@ -298,48 +296,40 @@ delete_any(Key, Env) -> -spec delete(term(), environment()) -> environment(). -delete(Key, [{map, Dict} = E | Env]) -> - case dict:is_key(Key, Dict) of - true -> - [{map, dict:erase(Key, Dict)} | Env]; - false -> +delete(Key, [{map, Map} = E | Env]) -> + case maps:take(Key, Map) of + {_, Map1} -> + [{map, Map1} | Env]; + error -> delete_1(Key, Env, E) end; -delete(Key, [{rec, Dict, Dict0} = E | Env]) -> - case dict:is_key(Key, Dict) of - true -> - %% The Dict0 component must be preserved as it is until all - %% keys in Dict have been deleted. - Dict1 = dict:erase(Key, Dict), - case dict:size(Dict1) of - 0 -> - Env; % the whole {rec,...} is now garbage - _ -> - [{rec, Dict1, Dict0} | Env] - end; - false -> +delete(Key, [{rec, Map, Map0} = E | Env]) -> + case maps:take(Key, Map) of + {_, Map1} when map_size(Map1) =:= 0 -> + Env; % the whole {rec,...} is now garbage + %% The Map0 component must be preserved as it is until all + %% keys in Map have been deleted. + {_, Map1} -> + [{rec, Map1, Map0} | Env]; + error -> [E | delete(Key, Env)] end. %% This is just like above, except we pass on the preceding 'map' %% mapping in the list to enable merging when removing 'rec' mappings. -delete_1(Key, [{rec, Dict, Dict0} = E | Env], E1) -> - case dict:is_key(Key, Dict) of - true -> - Dict1 = dict:erase(Key, Dict), - case dict:size(Dict1) of - 0 -> - concat(E1, Env); - _ -> - [E1, {rec, Dict1, Dict0} | Env] - end; - false -> +delete_1(Key, [{rec, Map, Map0} = E | Env], E1) -> + case maps:take(Key, Map) of + {_, Map1} when map_size(Map1) =:= 0 -> + concat(E1, Env); + {_, Map1} -> + [E1, {rec, Map1, Map0} | Env]; + error -> [E1, E | delete(Key, Env)] end. -concat({map, D1}, [{map, D2} | Env]) -> - [dict:merge(fun (_K, V1, _V2) -> V1 end, D1, D2) | Env]; +concat({map, M1}, [{map, M2} | Env]) -> + [maps:merge(M2, M1) | Env]; concat(E1, Env) -> [E1 | Env]. @@ -392,15 +382,15 @@ bind_recursive([], [], _, Env) -> Env; bind_recursive(Ks, Vs, F, Env) -> F1 = fun (V) -> - fun (Dict) -> F(V, [{rec, Dict, Dict} | Env]) end + fun (Map) -> F(V, [{rec, Map, Map} | Env]) end end, - Dict = bind_recursive_1(Ks, Vs, F1, dict:new()), - [{rec, Dict, Dict} | Env]. + Map = bind_recursive_1(Ks, Vs, F1, #{}), + [{rec, Map, Map} | Env]. -bind_recursive_1([K | Ks], [V | Vs], F, Dict) -> - bind_recursive_1(Ks, Vs, F, dict:store(K, F(V), Dict)); -bind_recursive_1([], [], _, Dict) -> - Dict. +bind_recursive_1([K | Ks], [V | Vs], F, Map) -> + bind_recursive_1(Ks, Vs, F, maps:put(K, F(V), Map)); +bind_recursive_1([], [], _, Map) -> + Map. %% ===================================================================== @@ -416,8 +406,8 @@ bind_recursive_1([], [], _, Dict) -> -spec lookup(term(), environment()) -> 'error' | {'ok', term()}. -lookup(Key, [{map, Dict} | Env]) -> - case dict:find(Key, Dict) of +lookup(Key, [{map, Map} | Env]) -> + case maps:find(Key, Map) of {ok, _}=Value -> Value; error when Env =:= [] -> @@ -425,10 +415,10 @@ lookup(Key, [{map, Dict} | Env]) -> error -> lookup(Key, Env) end; -lookup(Key, [{rec, Dict, Dict0} | Env]) -> - case dict:find(Key, Dict) of +lookup(Key, [{rec, Map, Map0} | Env]) -> + case maps:find(Key, Map) of {ok, F} -> - {ok, F(Dict0)}; + {ok, F(Map0)}; error -> lookup(Key, Env) end. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index dbc27db377..e0de50f3ae 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -786,7 +786,7 @@ fold_lit_args(Call, Module, Name, Args0) -> Val -> case cerl:is_literal_term(Val) of true -> - cerl:abstract(Val); + cerl:ann_abstract(cerl:get_ann(Call), Val); false -> %% Successful evaluation, but it was not possible %% to express the computed value as a literal. @@ -2176,24 +2176,22 @@ opt_not_in_let_1(V, Call, Body) -> #c_call{module=#c_literal{val=erlang}, name=#c_literal{val='not'}, args=[#c_var{name=V}]} -> - opt_not_in_let_2(Body); + opt_not_in_let_2(Body, Call); _ -> no end. -opt_not_in_let_2(#c_case{clauses=Cs0}=Case) -> +opt_not_in_let_2(#c_case{clauses=Cs0}=Case, NotCall) -> Vars = make_vars([], 1), - Body = #c_call{module=#c_literal{val=erlang}, - name=#c_literal{val='not'}, - args=Vars}, + Body = NotCall#c_call{args=Vars}, Cs = [begin Let = #c_let{vars=Vars,arg=B,body=Body}, C#c_clause{body=opt_not_in_let(Let)} end || #c_clause{body=B}=C <- Cs0], {yes,Case#c_case{clauses=Cs}}; -opt_not_in_let_2(#c_call{}=Call0) -> +opt_not_in_let_2(#c_call{}=Call0, _NotCall) -> invert_call(Call0); -opt_not_in_let_2(_) -> no. +opt_not_in_let_2(_, _) -> no. invert_call(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=Name0}, diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index f5f3c73793..4df1aadd0a 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1551,12 +1551,10 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{bfail=Bfail}=St) -> %% Now generate the complete code for constructing the binary. Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a), {Sis++Code,Aft,St}; -% Map single variable key -set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, - #cg{bfail=Bfail}=St) -> - Fail = {f,Bfail}, - {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), +%% Map: single variable key. +set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, St0) -> + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), SrcReg = cg_reg_arg_prefer_y(Map, Int0), Line = line(Le#l.a), @@ -1570,21 +1568,16 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)}, Target = fetch_reg(R, Aft#sr.reg), - I = case Op of - assoc -> put_map_assoc; - exact -> put_map_exact - end, - {Sis++[Line]++[{I,Fail,SrcReg,Target,Live,{list,List}}],Aft,St}; + {Is,St1} = set_cg_map(Line, Op, SrcReg, Target, Live, List, St0), + {Sis++Is,Aft,St1}; -% Map (possibly) multiple literal keys -set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, - #cg{bfail=Bfail}=St) -> +%% Map: (possibly) multiple literal keys. +set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, St0) -> %% assert key literals [] = [Var||{map_pair,{var,_}=Var,_} <- Es], - Fail = {f,Bfail}, - {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), SrcReg = cg_reg_arg_prefer_y(Map, Int0), Line = line(Le#l.a), @@ -1599,11 +1592,10 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)}, Target = fetch_reg(R, Aft#sr.reg), - I = case Op of - assoc -> put_map_assoc; - exact -> put_map_exact - end, - {Sis++[Line]++[{I,Fail,SrcReg,Target,Live,{list,List}}],Aft,St}; + {Is,St1} = set_cg_map(Line, Op, SrcReg, Target, Live, List, St0), + {Sis++Is,Aft,St1}; + +%% Everything else. set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> %% Find a place for the return register first. Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, @@ -1616,6 +1608,34 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> end, {Ais,clear_dead(Int, Le#l.i, Vdb),St}. + +set_cg_map(Line, Op0, SrcReg, Target, Live, List, St0) -> + Bfail = St0#cg.bfail, + Fail = {f,St0#cg.bfail}, + Op = case Op0 of + assoc -> put_map_assoc; + exact -> put_map_exact + end, + {OkLbl,St1} = new_label(St0), + {BadLbl,St2} = new_label(St1), + Is = if + Bfail =:= 0 orelse Op =:= put_map_assoc -> + [Line,{Op,{f,0},SrcReg,Target,Live,{list,List}}]; + true -> + %% Ensure that Target is always set, even if + %% the map update operation fails. That is necessary + %% because Target may be included in a test_heap + %% instruction. + [Line, + {Op,{f,BadLbl},SrcReg,Target,Live,{list,List}}, + {jump,{f,OkLbl}}, + {label,BadLbl}, + {move,{atom,ok},Target}, + {jump,Fail}, + {label,OkLbl}] + end, + {Is,St2}. + %%% %%% Code generation for constructing binaries. %%% diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index a3b0236134..d71411de80 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -868,12 +868,16 @@ try_exception(Ecs0, St0) -> {Evs,St1} = new_vars(3, St0), % Tag, Value, Info {Ecs1,Ceps,St2} = clauses(Ecs0, St1), [_,Value,Info] = Evs, - Ec = #iclause{anno=#a{anno=[compiler_generated]}, + LA = case Ecs1 of + [] -> []; + [C|_] -> get_lineno_anno(C) + end, + Ec = #iclause{anno=#a{anno=[compiler_generated|LA]}, pats=[c_tuple(Evs)],guard=[#c_literal{val=true}], body=[#iprimop{anno=#a{}, %Must have an #a{} name=#c_literal{val=raise}, args=[Info,Value]}]}, - Hs = [#icase{anno=#a{},args=[c_tuple(Evs)],clauses=Ecs1,fc=Ec}], + Hs = [#icase{anno=#a{anno=LA},args=[c_tuple(Evs)],clauses=Ecs1,fc=Ec}], {Evs,Ceps++Hs,St2}. try_after(As, St0) -> @@ -2098,7 +2102,8 @@ upattern(#c_var{name=V}=Var, Ks, St0) -> true -> {N,St1} = new_var_name(St0), New = #c_var{name=N}, - Test = #icall{anno=#a{us=add_element(N, [V])}, + LA = get_lineno_anno(Var), + Test = #icall{anno=#a{anno=LA,us=add_element(N, [V])}, module=#c_literal{val=erlang}, name=#c_literal{val='=:='}, args=[New,Var]}, diff --git a/lib/compiler/test/beam_block_SUITE.erl b/lib/compiler/test/beam_block_SUITE.erl index d343e26737..4bcb252833 100644 --- a/lib/compiler/test/beam_block_SUITE.erl +++ b/lib/compiler/test/beam_block_SUITE.erl @@ -21,7 +21,7 @@ -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, init_per_group/2,end_per_group/2, - get_map_elements/1,otp_7345/1]). + get_map_elements/1,otp_7345/1,move_opt_across_gc_bif/1]). %% The only test for the following functions is that %% the code compiles and is accepted by beam_validator. @@ -36,7 +36,8 @@ all() -> groups() -> [{p,[parallel], [get_map_elements, - otp_7345 + otp_7345, + move_opt_across_gc_bif ]}]. init_per_suite(Config) -> @@ -118,6 +119,22 @@ otp_7345(ObjRef, _RdEnv, Args) -> 10}, id(LlUnitdataReq). + +%% Doing move optimizations across GC bifs are in general not safe. +move_opt_across_gc_bif(_Config) -> + [0,true,1] = positive(speaking), + ok. + +positive(speaking) -> + try + Positive = 0, + [+Positive, case Positive of _ -> true end, paris([], Positive)] + after + mailing + end. + +paris([], P) -> P + 1. + %%% %%% The only test of the following code is that it compiles. %%% diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 442b2d424c..376d2c8e9a 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -25,7 +25,8 @@ eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1, unused_multiple_values_error/1,unused_multiple_values/1, multiple_aliases/1,redundant_boolean_clauses/1, - mixed_matching_clauses/1,unnecessary_building/1]). + mixed_matching_clauses/1,unnecessary_building/1, + no_no_file/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -43,7 +44,8 @@ groups() -> eq,nested_call_in_case,guard_try_catch,coverage, unused_multiple_values_error,unused_multiple_values, multiple_aliases,redundant_boolean_clauses, - mixed_matching_clauses,unnecessary_building]}]. + mixed_matching_clauses,unnecessary_building, + no_no_file]}]. init_per_suite(Config) -> @@ -454,4 +456,47 @@ do_unnecessary_building_2({a,_,_}=T) -> [_,_] = [T,none], x}. +%% This test tests that v3_core has provided annotations and that +%% sys_core_fold retains them, so that warnings produced by +%% sys_core_fold will have proper filenames and line numbers. Thus, no +%% "no_file" warnings. +no_no_file(_Config) -> + {'EXIT',{{case_clause,0},_}} = (catch source(true, any)), + surgery = (tim(#{reduction => any}))(), + + false = soul(#{[] => true}), + {'EXIT',{{case_clause,true},_}} = (catch soul(#{[] => false})), + + ok = experiment(), + ok. + +source(true, Activities) -> + case 0 of + Activities when [] -> + Activities + end. + +tim(#{reduction := Emergency}) -> + try + fun() -> surgery end + catch + _ when [] -> + planet + end. + +soul(#{[] := Properly}) -> + not case true of + Properly -> true; + Properly -> 0 + end. + +experiment() -> + case kingdom of + _ -> + +case "map" of + _ -> 0.0 + end + end, + ok. + id(I) -> I. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index c3c4862794..36e82c1459 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -1287,6 +1287,7 @@ t_guard_update(Config) when is_list(Config) -> first = map_guard_update(#{}, #{x=>first}), second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), third = map_guard_update(#{x=>old,y=>old}, #{x=>third,y=>old}), + bad_map_guard_update(), ok. t_guard_update_large(Config) when is_list(Config) -> @@ -1353,6 +1354,29 @@ map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second; map_guard_update(M1, M2) when M1#{x:=third} =:= M2 -> third; map_guard_update(_, _) -> error. +bad_map_guard_update() -> + do_bad_map_guard_update(fun burns/1), + do_bad_map_guard_update(fun turns/1), + ok. + +do_bad_map_guard_update(Fun) -> + do_bad_map_guard_update_1(Fun, #{}), + do_bad_map_guard_update_1(Fun, #{true=>1}), + ok. + +do_bad_map_guard_update_1(Fun, Value) -> + %% Note: The business with the seemingly redundant fun + %% disables inlining, which would otherwise change the + %% EXIT reason. + {'EXIT',{function_clause,_}} = (catch Fun(Value)), + ok. + +burns(Richmond) when not (Richmond#{true := 0}); [Richmond] -> + specification. + +turns(Richmond) when not (Richmond#{true => 0}); [Richmond] -> + specification. + t_guard_receive(Config) when is_list(Config) -> M0 = #{ id => 0 }, Pid = spawn_link(fun() -> guard_receive_loop() end), diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index f05fe6c943..f543f0d4de 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -256,12 +256,15 @@ silly_coverage(Config) when is_list(Config) -> {jump,{f,42}}]}],99}, expect_error(fun() -> beam_clean:module(CleanInput, []) end), - %% beam_peep + %% beam_peep. This is tricky. Use a select instruction with + %% an odd number of elements in the list to crash + %% prune_redundant_values/2 but not beam_clean:clean_labels/1. PeepInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, [{label,1}, {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}|non_proper_list]}],99}, + {label,2},{select,op,r,{f,2},[{f,2}]}]}], + 2}, expect_error(fun() -> beam_peep:module(PeepInput, []) end), %% beam_bsm. This is tricky. Our function must be sane enough to not crash diff --git a/lib/edoc/src/edoc_run.erl b/lib/edoc/src/edoc_run.erl index 9a569d0879..261a649c70 100644 --- a/lib/edoc/src/edoc_run.erl +++ b/lib/edoc/src/edoc_run.erl @@ -44,6 +44,8 @@ -import(edoc_report, [report/2, error/1]). +-type args() :: [string()]. + %% @spec application([string()]) -> none() %% @@ -58,6 +60,7 @@ %% automatically terminated when the call has completed, signalling %% success or failure to the operating system. +-spec application(args()) -> no_return(). application(Args) -> F = fun () -> case parse_args(Args) of @@ -81,6 +84,7 @@ application(Args) -> %% automatically terminated when the call has completed, signalling %% success or failure to the operating system. +-spec files(args()) -> no_return(). files(Args) -> F = fun () -> case parse_args(Args) of @@ -93,6 +97,7 @@ files(Args) -> run(F). %% @hidden Not official yet +-spec toc(args()) -> no_return(). toc(Args) -> F = fun () -> case parse_args(Args) of @@ -126,6 +131,7 @@ toc(Args) -> %% automatically terminated when the call has completed, signalling %% success or failure to the operating system. +-spec file(args()) -> no_return(). file(Args) -> F = fun () -> case parse_args(Args) of @@ -137,8 +143,7 @@ file(Args) -> end, run(F). --spec invalid_args(string(), list()) -> no_return(). - +-spec invalid_args(string(), args()) -> no_return(). invalid_args(Where, Args) -> report("invalid arguments to ~ts: ~w.", [Where, Args]), shutdown_error(). @@ -169,10 +174,12 @@ wait_init() -> %% When and if a function init:stop/1 becomes generally available, we %% can use that instead of delay-and-pray when there is an error. +-spec shutdown_ok() -> no_return(). shutdown_ok() -> %% shut down emulator nicely, signalling "normal termination" init:stop(). +-spec shutdown_error() -> no_return(). shutdown_error() -> %% delay 1 second to allow I/O to finish receive after 1000 -> ok end, diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml index 8bd94892ad..b75d42d198 100644 --- a/lib/kernel/doc/src/gen_tcp.xml +++ b/lib/kernel/doc/src/gen_tcp.xml @@ -172,6 +172,14 @@ do_recv(Sock, Bs) -> <item><p>Sets up the socket for IPv4.</p></item> <tag><c>inet6</c></tag> <item><p>Sets up the socket for IPv6.</p></item> + <tag><c>local</c></tag> + <item> + <p> + Sets up the socket for local address family. This option is only + valid together with <c>{fd, integer()}</c> when the file descriptor + is of local address family (e.g. a Unix Domain Socket) + </p> + </item> <tag><c>{port, Port}</c></tag> <item><p>Specifies which local port number to use.</p></item> <tag><c>{tcp_module, module()}</c></tag> diff --git a/lib/kernel/doc/src/gen_udp.xml b/lib/kernel/doc/src/gen_udp.xml index 3db291600d..ca9d9c978c 100644 --- a/lib/kernel/doc/src/gen_udp.xml +++ b/lib/kernel/doc/src/gen_udp.xml @@ -104,6 +104,14 @@ <item><p>Sets up the socket for IPv6.</p></item> <tag><c>inet</c></tag> <item><p>Sets up the socket for IPv4.</p></item> + <tag><c>local</c></tag> + <item> + <p> + Sets up the socket for local address family. This option is only + valid together with <c>{fd, integer()}</c> when the file descriptor + is of local address family (e.g. a Unix Domain Socket) + </p> + </item> <tag><c>{udp_module, module()}</c></tag> <item><p>Overrides which callback module is used. Defaults to <c>inet_udp</c> for IPv4 and <c>inet6_udp</c> for IPv6.</p></item> diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml index c587e39345..864f8facac 100644 --- a/lib/kernel/doc/src/heart.xml +++ b/lib/kernel/doc/src/heart.xml @@ -83,6 +83,17 @@ <c><![CDATA[SIGKILL]]></c>:</p> <pre> % <input>erl -heart -env HEART_KILL_SIGNAL SIGABRT ...</input></pre> + <p> If heart should <b>not</b> kill the Erlang runtime system, this can be indicated + using the environment variable <c><![CDATA[HEART_NO_KILL=TRUE]]></c>. + This can be useful if the command executed by heart takes care of this, + for example as part of a specific cleanup sequence. + If unset, or not set to <c><![CDATA[TRUE]]></c>, the default behaviour + will be to kill as described above. + </p> + + <pre> +% <input>erl -heart -env HEART_NO_KILL 1 ...</input></pre> + <p>Furthermore, <c><![CDATA[ERL_CRASH_DUMP_SECONDS]]></c> has the following behavior on <c>heart</c>:</p> <taglist> diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 8bf02afec9..2b72f78dcf 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -104,6 +104,8 @@ MODULES = \ inet_sctp \ kernel \ kernel_config \ + local_udp \ + local_tcp \ net \ net_adm \ net_kernel \ @@ -244,6 +246,8 @@ $(EBIN)/inet_tcp.beam: inet_int.hrl $(EBIN)/inet_udp_dist.beam: ../include/net_address.hrl ../include/dist.hrl ../include/dist_util.hrl $(EBIN)/inet_udp.beam: inet_int.hrl $(EBIN)/inet_sctp.beam: inet_int.hrl ../include/inet_sctp.hrl +$(EBIN)/local_udp.beam: inet_int.hrl +$(EBIN)/local_tcp.beam: inet_int.hrl $(EBIN)/net_kernel.beam: ../include/net_address.hrl $(EBIN)/os.beam: ../include/file.hrl $(EBIN)/ram_file.beam: ../include/file.hrl diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index d00ed828a7..b133e6fed4 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.erl @@ -124,8 +124,8 @@ open() -> SockType :: seqpacket | stream, Socket :: sctp_socket(). -open(Opts) when is_list(Opts) -> - Mod = mod(Opts, undefined), +open(Opts0) when is_list(Opts0) -> + {Mod, Opts} = inet:sctp_module(Opts0), case Mod:open(Opts) of {error,badarg} -> erlang:error(badarg, [Opts]); @@ -445,32 +445,3 @@ controlling_process(S, Pid) when is_port(S), is_pid(Pid) -> inet:udp_controlling_process(S, Pid); controlling_process(S, Pid) -> erlang:error(badarg, [S,Pid]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Utilites -%% - -%% Get the SCTP module, but IPv6 address overrides default IPv4 -mod(Address) -> - case inet_db:sctp_module() of - inet_sctp when tuple_size(Address) =:= 8 -> - inet6_sctp; - Mod -> - Mod - end. - -%% Get the SCTP module, but option sctp_module|inet|inet6 overrides -mod([{sctp_module,Mod}|_], _Address) -> - Mod; -mod([inet|_], _Address) -> - inet_sctp; -mod([inet6|_], _Address) -> - inet6_sctp; -mod([{ip, Address}|Opts], _) -> - mod(Opts, Address); -mod([{ifaddr, Address}|Opts], _) -> - mod(Opts, Address); -mod([_|Opts], Address) -> - mod(Opts, Address); -mod([], Address) -> - mod(Address). diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index 1f0d44b8e1..2b3afcd44c 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -151,8 +151,8 @@ connect(Address, Port, Opts, Time) -> Error -> Error end. -connect1(Address,Port,Opts,Timer) -> - Mod = mod(Opts, Address), +connect1(Address, Port, Opts0, Timer) -> + {Mod, Opts} = inet:tcp_module(Opts0, Address), case Mod:getaddrs(Address,Timer) of {ok,IPs} -> case Mod:getserv(Port) of @@ -185,8 +185,8 @@ try_connect([], _Port, _Opts, _Timer, _Mod, Err) -> ListenSocket :: socket(), Reason :: system_limit | inet:posix(). -listen(Port, Opts) -> - Mod = mod(Opts, undefined), +listen(Port, Opts0) -> + {Mod, Opts} = inet:tcp_module(Opts0), case Mod:getserv(Port) of {ok,TP} -> Mod:listen(TP, Opts); @@ -335,32 +335,6 @@ controlling_process(S, NewOwner) -> %% %% Create a port/socket from a file descriptor %% -fdopen(Fd, Opts) -> - Mod = mod(Opts, undefined), +fdopen(Fd, Opts0) -> + {Mod, Opts} = inet:tcp_module(Opts0), Mod:fdopen(Fd, Opts). - -%% Get the tcp_module, but IPv6 address overrides default IPv4 -mod(Address) -> - case inet_db:tcp_module() of - inet_tcp when tuple_size(Address) =:= 8 -> - inet6_tcp; - Mod -> - Mod - end. - -%% Get the tcp_module, but option tcp_module|inet|inet6 overrides -mod([{tcp_module,Mod}|_], _Address) -> - Mod; -mod([inet|_], _Address) -> - inet_tcp; -mod([inet6|_], _Address) -> - inet6_tcp; -mod([{ip, Address}|Opts], _) -> - mod(Opts, Address); -mod([{ifaddr, Address}|Opts], _) -> - mod(Opts, Address); -mod([_|Opts], Address) -> - mod(Opts, Address); -mod([], Address) -> - mod(Address). - diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index 5e85c61dd9..2227bb3562 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -101,9 +101,9 @@ open(Port) -> Socket :: socket(), Reason :: inet:posix(). -open(Port, Opts) -> - Mod = mod(Opts, undefined), - {ok,UP} = Mod:getserv(Port), +open(Port, Opts0) -> + {Mod, Opts} = inet:udp_module(Opts0), + {ok, UP} = Mod:getserv(Port), Mod:open(UP, Opts). -spec close(Socket) -> ok when @@ -203,32 +203,6 @@ controlling_process(S, NewOwner) -> %% %% Create a port/socket from a file descriptor %% -fdopen(Fd, Opts) -> - Mod = mod(Opts, undefined), +fdopen(Fd, Opts0) -> + {Mod,Opts} = inet:udp_module(Opts0), Mod:fdopen(Fd, Opts). - - -%% Get the udp_module, but IPv6 address overrides default IPv4 -mod(Address) -> - case inet_db:udp_module() of - inet_udp when tuple_size(Address) =:= 8 -> - inet6_udp; - Mod -> - Mod - end. - -%% Get the udp_module, but option udp_module|inet|inet6 overrides -mod([{udp_module,Mod}|_], _Address) -> - Mod; -mod([inet|_], _Address) -> - inet_udp; -mod([inet6|_], _Address) -> - inet6_udp; -mod([{ip, Address}|Opts], _) -> - mod(Opts, Address); -mod([{ifaddr, Address}|Opts], _) -> - mod(Opts, Address); -mod([_|Opts], Address) -> - mod(Opts, Address); -mod([], Address) -> - mod(Address). diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index 713a9cf725..de43ea792b 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -37,6 +37,7 @@ parse_ipv6strict_address/1, parse_address/1, parse_strict_address/1, ntoa/1]). -export([connect_options/2, listen_options/2, udp_options/2, sctp_options/2]). +-export([udp_module/1, tcp_module/1, tcp_module/2, sctp_module/1]). -export([i/0, i/1, i/2]). @@ -133,9 +134,11 @@ 'running' | 'multicast' | 'loopback']} | {'hwaddr', ether_address()}. --type address_family() :: 'inet' | 'inet6'. +-type address_family() :: 'inet' | 'inet6' | 'local'. -type socket_protocol() :: 'tcp' | 'udp' | 'sctp'. -type socket_type() :: 'stream' | 'dgram' | 'seqpacket'. +-type socket_address() :: + ip_address() | {address_family(), any()} | 'any' | 'loopback'. -type stat_option() :: 'recv_cnt' | 'recv_max' | 'recv_avg' | 'recv_oct' | 'recv_dvi' | 'send_cnt' | 'send_max' | 'send_avg' | 'send_oct' | 'send_pend'. @@ -681,7 +684,7 @@ connect_options() -> low_msgq_watermark, send_timeout, send_timeout_close, delay_send, raw, show_econnreset]. -connect_options(Opts, Family) -> +connect_options(Opts, Mod) -> BaseOpts = case application:get_env(kernel, inet_default_connect_options) of {ok,List} when is_list(List) -> @@ -698,7 +701,7 @@ connect_options(Opts, Family) -> {ok, R} -> {ok, R#connect_opts { opts = lists:reverse(R#connect_opts.opts), - ifaddr = translate_ip(R#connect_opts.ifaddr, Family) + ifaddr = Mod:translate_ip(R#connect_opts.ifaddr) }}; Error -> Error end. @@ -713,9 +716,6 @@ con_opt([Opt | Opts], #connect_opts{} = R, As) -> {fd,Fd} -> con_opt(Opts, R#connect_opts { fd = Fd }, As); binary -> con_add(mode, binary, R, Opts, As); list -> con_add(mode, list, R, Opts, As); - {tcp_module,_} -> con_opt(Opts, R, As); - inet -> con_opt(Opts, R, As); - inet6 -> con_opt(Opts, R, As); {netns,NS} -> BinNS = filename2binary(NS), case prim_inet:is_sockopt_val(netns, BinNS) of @@ -752,7 +752,7 @@ listen_options() -> low_msgq_watermark, send_timeout, send_timeout_close, delay_send, packet_size, raw, show_econnreset]. -listen_options(Opts, Family) -> +listen_options(Opts, Mod) -> BaseOpts = case application:get_env(kernel, inet_default_listen_options) of {ok,List} when is_list(List) -> @@ -769,7 +769,7 @@ listen_options(Opts, Family) -> {ok, R} -> {ok, R#listen_opts { opts = lists:reverse(R#listen_opts.opts), - ifaddr = translate_ip(R#listen_opts.ifaddr, Family) + ifaddr = Mod:translate_ip(R#listen_opts.ifaddr) }}; Error -> Error end. @@ -785,9 +785,6 @@ list_opt([Opt | Opts], #listen_opts{} = R, As) -> {backlog,BL} -> list_opt(Opts, R#listen_opts { backlog = BL }, As); binary -> list_add(mode, binary, R, Opts, As); list -> list_add(mode, list, R, Opts, As); - {tcp_module,_} -> list_opt(Opts, R, As); - inet -> list_opt(Opts, R, As); - inet6 -> list_opt(Opts, R, As); {netns,NS} -> BinNS = filename2binary(NS), case prim_inet:is_sockopt_val(netns, BinNS) of @@ -812,6 +809,19 @@ list_add(Name, Val, #listen_opts{} = R, Opts, As) -> Error -> Error end. +tcp_module(Opts) -> + tcp_module_1(Opts, undefined). + +tcp_module(Opts, Addr) -> + Address = {undefined,Addr}, + %% Address has to be a 2-tuple but the first element is ignored + tcp_module_1(Opts, Address). + +tcp_module_1(Opts, Address) -> + mod( + Opts, tcp_module, Address, + #{inet => inet_tcp, inet6 => inet6_tcp, local => local_tcp}). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Available options for udp:open %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -823,12 +833,12 @@ udp_options() -> high_msgq_watermark, low_msgq_watermark]. -udp_options(Opts, Family) -> +udp_options(Opts, Mod) -> case udp_opt(Opts, #udp_opts { }, udp_options()) of {ok, R} -> {ok, R#udp_opts { opts = lists:reverse(R#udp_opts.opts), - ifaddr = translate_ip(R#udp_opts.ifaddr, Family) + ifaddr = Mod:translate_ip(R#udp_opts.ifaddr) }}; Error -> Error end. @@ -843,9 +853,6 @@ udp_opt([Opt | Opts], #udp_opts{} = R, As) -> {fd,Fd} -> udp_opt(Opts, R#udp_opts { fd = Fd }, As); binary -> udp_add(mode, binary, R, Opts, As); list -> udp_add(mode, list, R, Opts, As); - {udp_module,_} -> udp_opt(Opts, R, As); - inet -> udp_opt(Opts, R, As); - inet6 -> udp_opt(Opts, R, As); {netns,NS} -> BinNS = filename2binary(NS), case prim_inet:is_sockopt_val(netns, BinNS) of @@ -870,6 +877,11 @@ udp_add(Name, Val, #udp_opts{} = R, Opts, As) -> Error -> Error end. +udp_module(Opts) -> + mod( + Opts, udp_module, undefined, + #{inet => inet_udp, inet6 => inet6_udp, local => local_udp}). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Available options for sctp:open %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -926,9 +938,6 @@ sctp_opt([Opt|Opts], Mod, #sctp_opts{} = R, As) -> sctp_opt(Opts, Mod, R#sctp_opts{type=Type}, As); binary -> sctp_opt (Opts, Mod, R, As, mode, binary); list -> sctp_opt (Opts, Mod, R, As, mode, list); - {sctp_module,_} -> sctp_opt (Opts, Mod, R, As); % Done with - inet -> sctp_opt (Opts, Mod, R, As); % Done with - inet6 -> sctp_opt (Opts, Mod, R, As); % Done with {netns,NS} -> BinNS = filename2binary(NS), case prim_inet:is_sockopt_val(netns, BinNS) of @@ -970,6 +979,11 @@ sctp_opt_ifaddr(Opts, Mod, #sctp_opts{ifaddr=IfAddr}=R, As, Addr) -> _ -> [IP,IfAddr] end}, As). +sctp_module(Opts) -> + mod( + Opts, sctp_module, undefined, + #{inet => inet_sctp, inet6 => inet6_sctp}). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Util to check and insert option in option list %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1028,6 +1042,53 @@ translate_ip(any, inet6) -> {0,0,0,0,0,0,0,0}; translate_ip(loopback, inet6) -> {0,0,0,0,0,0,0,1}; translate_ip(IP, _) -> IP. +mod(Opts, Tag, Address, Map) -> + mod(Opts, Tag, Address, Map, undefined, []). +%% +mod([{Tag, M}|Opts], Tag, Address, Map, Mod, Acc) -> + mod(Opts, Tag, Address, Map, Mod, Acc, M); +mod([{T, _} = Opt|Opts], Tag, _Address, Map, Mod, Acc) + when T =:= ip; T =:= ifaddr-> + mod(Opts, Tag, Opt, Map, Mod, [Opt|Acc]); +mod([Family|Opts], Tag, Address, Map, Mod, Acc) when is_atom(Family) -> + case Map of + #{Family := M} -> + mod(Opts, Tag, Address, Map, Mod, Acc, M); + #{} -> + mod(Opts, Tag, Address, Map, Mod, [Family|Acc]) + end; +mod([Opt|Opts], Tag, Address, Map, Mod, Acc) -> + mod(Opts, Tag, Address, Map, Mod, [Opt|Acc]); +mod([], Tag, Address, Map, undefined, Acc) -> + {case Address of + {_, {local, _}} -> + case Map of + #{local := Mod} -> + Mod; + #{} -> + inet_db:Tag() + end; + {_, IP} when tuple_size(IP) =:= 8 -> + #{inet := IPv4Mod} = Map, + %% Get the mod, but IPv6 address overrides default IPv4 + case inet_db:Tag() of + IPv4Mod -> + #{inet6 := IPv6Mod} = Map, + IPv6Mod; + Mod -> + Mod + end; + _ -> + inet_db:Tag() + end, lists:reverse(Acc)}; +mod([], _Tag, _Address, _Map, Mod, Acc) -> + {Mod, lists:reverse(Acc)}. +%% +mod(Opts, Tag, Address, Map, undefined, Acc, M) -> + mod(Opts, Tag, Address, Map, M, Acc); +mod(Opts, Tag, Address, Map, Mod, Acc, _M) -> + mod(Opts, Tag, Address, Map, Mod, Acc). + getaddrs_tm({A,B,C,D} = IP, Fam, _) -> %% Only "syntactic" validation and check of family. @@ -1235,7 +1296,7 @@ gethostbyaddr_tm_native(Addr, Timer, Opts) -> end. -spec open(Fd_or_OpenOpts :: integer() | list(), - Addr :: ip_address(), + Addr :: socket_address(), Port :: port_number(), Opts :: [socket_setopt()], Protocol :: socket_protocol(), diff --git a/lib/kernel/src/inet6_sctp.erl b/lib/kernel/src/inet6_sctp.erl index cc98bc0ccb..a5503f6f54 100644 --- a/lib/kernel/src/inet6_sctp.erl +++ b/lib/kernel/src/inet6_sctp.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 2007-2016. All Rights Reserved. -%% +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,13 +14,12 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% %% SCTP protocol contribution by Leonid Timochouk and Serge Aleynikov. %% See also: $ERL_TOP/lib/kernel/AUTHORS %% -%% -module(inet6_sctp). %% This module provides functions for communicating with @@ -31,6 +30,7 @@ -include("inet_sctp.hrl"). -include("inet_int.hrl"). +-define(PROTO, sctp). -define(FAMILY, inet6). -export([getserv/1,getaddr/1,getaddr/2,translate_ip/1]). -export([open/1,close/1,listen/2,peeloff/2,connect/5]). @@ -39,25 +39,19 @@ getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> - inet:getservbyname(Name, sctp); -getserv(_) -> - {error,einval}. - -getaddr(Address) -> - inet:getaddr(Address, ?FAMILY). -getaddr(Address, Timer) -> - inet:getaddr_tm(Address, ?FAMILY, Timer). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO); +getserv(_) -> {error,einval}. -translate_ip(IP) -> - inet:translate_ip(IP, ?FAMILY). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr_tm(Address, ?FAMILY, Timer). +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). open(Opts) -> case inet:sctp_options(Opts, ?MODULE) of {ok,#sctp_opts{fd=Fd,ifaddr=Addr,port=Port,type=Type,opts=SOs}} -> - inet:open(Fd, Addr, Port, SOs, sctp, ?FAMILY, Type, ?MODULE); + inet:open(Fd, Addr, Port, SOs, ?PROTO, ?FAMILY, Type, ?MODULE); Error -> Error end. diff --git a/lib/kernel/src/inet6_tcp.erl b/lib/kernel/src/inet6_tcp.erl index 3dfe5dfc86..a0d5d3df70 100644 --- a/lib/kernel/src/inet6_tcp.erl +++ b/lib/kernel/src/inet6_tcp.erl @@ -25,13 +25,18 @@ -export([controlling_process/2]). -export([fdopen/2]). --export([family/0, mask/2, parse_address/1]). +-export([family/0, mask/2, parse_address/1]). % inet_tcp_dist -export([getserv/1, getaddr/1, getaddr/2, getaddrs/1, getaddrs/2]). +-export([translate_ip/1]). -include("inet_int.hrl"). +-define(FAMILY, inet6). +-define(PROTO, tcp). +-define(TYPE, stream). + %% my address family -family() -> inet6. +family() -> ?FAMILY. %% Apply netmask on address mask({M1,M2,M3,M4,M5,M6,M7,M8}, {IP1,IP2,IP3,IP4,IP5,IP6,IP7,IP8}) -> @@ -50,15 +55,18 @@ parse_address(Host) -> %% inet_tcp port lookup getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,tcp). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO). %% inet_tcp address lookup -getaddr(Address) -> inet:getaddr(Address, inet6). -getaddr(Address,Timer) -> inet:getaddr_tm(Address, inet6, Timer). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr_tm(Address, ?FAMILY, Timer). %% inet_tcp address lookup -getaddrs(Address) -> inet:getaddrs(Address, inet6). -getaddrs(Address,Timer) -> inet:getaddrs_tm(Address,inet6,Timer). +getaddrs(Address) -> inet:getaddrs(Address, ?FAMILY). +getaddrs(Address, Timer) -> inet:getaddrs_tm(Address, ?FAMILY, Timer). + +%% inet_udp special this side addresses +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). %% %% Send data on a socket @@ -73,11 +81,6 @@ recv(Socket, Length) -> prim_inet:recv(Socket, Length). recv(Socket, Length, Timeout) -> prim_inet:recv(Socket, Length, Timeout). unrecv(Socket, Data) -> prim_inet:unrecv(Socket, Data). -%% -%% Close a socket (async) -%% -close(Socket) -> - inet:tcp_close(Socket). %% %% Shutdown one end of a socket @@ -86,6 +89,12 @@ shutdown(Socket, How) -> prim_inet:shutdown(Socket, How). %% +%% Close a socket (async) +%% +close(Socket) -> + inet:tcp_close(Socket). + +%% %% Set controlling process %% FIXME: move messages to new owner!!! %% @@ -100,24 +109,28 @@ connect(Address, Port, Opts) -> connect(Address, Port, Opts, infinity) -> do_connect(Address, Port, Opts, infinity); -connect(Address, Port, Opts, Timeout) when is_integer(Timeout), - Timeout >= 0 -> +connect(Address, Port, Opts, Timeout) + when is_integer(Timeout), Timeout >= 0 -> do_connect(Address, Port, Opts, Timeout). -do_connect(Addr = {A,B,C,D,E,F,G,H}, Port, Opts, Time) when - ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> - case inet:connect_options(Opts, inet6) of +do_connect(Addr = {A,B,C,D,E,F,G,H}, Port, Opts, Time) + when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> + case inet:connect_options(Opts, ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #connect_opts{fd=Fd, - ifaddr=BAddr={Ab,Bb,Cb,Db,Eb,Fb,Gb,Hb}, - port=BPort, - opts=SockOpts}} + {ok, + #connect_opts{ + fd = Fd, + ifaddr = BAddr = {Ab,Bb,Cb,Db,Eb,Fb,Gb,Hb}, + port = BPort, + opts = SockOpts}} when ?ip6(Ab,Bb,Cb,Db,Eb,Fb,Gb,Hb), ?port(BPort) -> - case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet6,stream,?MODULE) of + case inet:open( + Fd, BAddr, BPort, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of {ok, S} -> case prim_inet:connect(S, Addr, Port, Time) of - ok -> {ok,S}; - Error -> prim_inet:close(S), Error + ok -> {ok,S}; + Error -> prim_inet:close(S), Error end; Error -> Error end; @@ -128,14 +141,18 @@ do_connect(Addr = {A,B,C,D,E,F,G,H}, Port, Opts, Time) when %% Listen %% listen(Port, Opts) -> - case inet:listen_options([{port,Port} | Opts], inet6) of + case inet:listen_options([{port,Port} | Opts], ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #listen_opts{fd=Fd, - ifaddr=BAddr={A,B,C,D,E,F,G,H}, - port=BPort, - opts=SockOpts}=R} + {ok, + #listen_opts{ + fd = Fd, + ifaddr = BAddr = {A,B,C,D,E,F,G,H}, + port = BPort, + opts = SockOpts} = R} when ?ip6(A,B,C,D,E,F,G,H), ?port(BPort) -> - case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet6,stream,?MODULE) of + case inet:open( + Fd, BAddr, BPort, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of {ok, S} -> case prim_inet:listen(S, R#listen_opts.backlog) of ok -> {ok, S}; @@ -156,18 +173,17 @@ accept(L) -> {ok,S}; Error -> Error end. - -accept(L,Timeout) -> - case prim_inet:accept(L,Timeout) of + +accept(L, Timeout) -> + case prim_inet:accept(L, Timeout) of {ok, S} -> inet_db:register_socket(S, ?MODULE), {ok,S}; Error -> Error end. - + %% %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, Opts, tcp, inet6, stream, ?MODULE). - + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/inet6_udp.erl b/lib/kernel/src/inet6_udp.erl index eb6945f60a..71db0357cd 100644 --- a/lib/kernel/src/inet6_udp.erl +++ b/lib/kernel/src/inet6_udp.erl @@ -24,29 +24,44 @@ -export([controlling_process/2]). -export([fdopen/2]). --export([getserv/1, getaddr/1, getaddr/2]). +-export([getserv/1, getaddr/1, getaddr/2, translate_ip/1]). -include("inet_int.hrl"). +-define(FAMILY, inet6). +-define(PROTO, udp). +-define(TYPE, dgram). + + %% inet_udp port lookup getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,udp). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO). %% inet_udp address lookup -getaddr(Address) -> inet:getaddr(Address, inet6). -getaddr(Address,Timer) -> inet:getaddr(Address, inet6, Timer). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr(Address, ?FAMILY, Timer). + +%% inet_udp special this side addresses +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). +-spec open(_) -> {ok, inet:socket()} | {error, atom()}. open(Port) -> open(Port, []). +-spec open(_, _) -> {ok, inet:socket()} | {error, atom()}. open(Port, Opts) -> - case inet:udp_options([{port,Port} | Opts], inet6) of + case inet:udp_options( + [{port,Port} | Opts], + ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #udp_opts{fd=Fd, - ifaddr=BAddr={A,B,C,D,E,F,G,H}, - port=BPort, - opts=SockOpts}} + {ok, + #udp_opts{ + fd = Fd, + ifaddr = BAddr = {A,B,C,D,E,F,G,H}, + port = BPort, + opts = SockOpts}} when ?ip6(A,B,C,D,E,F,G,H), ?port(BPort) -> - inet:open(Fd,BAddr,BPort,SockOpts,udp,inet6,dgram,?MODULE); + inet:open( + Fd, BAddr, BPort, SockOpts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE); {ok, _} -> exit(badarg) end. @@ -61,12 +76,13 @@ connect(S, Addr = {A,B,C,D,E,F,G,H}, P) when ?ip6(A,B,C,D,E,F,G,H), ?port(P) -> prim_inet:connect(S, Addr, P). -recv(S,Len) -> +recv(S, Len) -> prim_inet:recvfrom(S, Len). -recv(S,Len,Time) -> +recv(S, Len, Time) -> prim_inet:recvfrom(S, Len, Time). +-spec close(inet:socket()) -> ok. close(S) -> inet:udp_close(S). @@ -85,4 +101,4 @@ controlling_process(Socket, NewOwner) -> %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, Opts, udp, inet6, dgram, ?MODULE). + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl index 65d78b66c9..32d09fb63c 100644 --- a/lib/kernel/src/inet_int.hrl +++ b/lib/kernel/src/inet_int.hrl @@ -29,6 +29,8 @@ -define(INET_AF_INET6, 2). -define(INET_AF_ANY, 3). % Fake for ANY in any address family -define(INET_AF_LOOPBACK, 4). % Fake for LOOPBACK in any address family +-define(INET_AF_LOCAL, 5). % For Unix Domain address family +-define(INET_AF_UNDEFINED, 6). % For any unknown address family %% type codes to open and gettype - INET_REQ_GETTYPE -define(INET_TYPE_STREAM, 1). @@ -378,7 +380,7 @@ { ifaddr = any, %% bind to interface address port = 0, %% bind to port (default is dynamic port) - fd = -1, %% fd >= 0 => already bound + fd = -1, %% fd >= 0 => already bound opts = [] %% [{active,true}] added in inet:connect_options }). diff --git a/lib/kernel/src/inet_sctp.erl b/lib/kernel/src/inet_sctp.erl index 60677cb7de..8569cacb29 100644 --- a/lib/kernel/src/inet_sctp.erl +++ b/lib/kernel/src/inet_sctp.erl @@ -30,6 +30,7 @@ -include("inet_sctp.hrl"). -include("inet_int.hrl"). +-define(PROTO, sctp). -define(FAMILY, inet). -export([getserv/1,getaddr/1,getaddr/2,translate_ip/1]). -export([open/1,close/1,listen/2,peeloff/2,connect/5]). @@ -38,25 +39,19 @@ getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> - inet:getservbyname(Name, sctp); -getserv(_) -> - {error,einval}. +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO); +getserv(_) -> {error,einval}. -getaddr(Address) -> - inet:getaddr(Address, ?FAMILY). -getaddr(Address, Timer) -> - inet:getaddr_tm(Address, ?FAMILY, Timer). - -translate_ip(IP) -> - inet:translate_ip(IP, ?FAMILY). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr_tm(Address, ?FAMILY, Timer). +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). open(Opts) -> case inet:sctp_options(Opts, ?MODULE) of {ok,#sctp_opts{fd=Fd,ifaddr=Addr,port=Port,type=Type,opts=SOs}} -> - inet:open(Fd, Addr, Port, SOs, sctp, ?FAMILY, Type, ?MODULE); + inet:open(Fd, Addr, Port, SOs, ?PROTO, ?FAMILY, Type, ?MODULE); Error -> Error end. diff --git a/lib/kernel/src/inet_tcp.erl b/lib/kernel/src/inet_tcp.erl index ee885af3b0..dac6b3119d 100644 --- a/lib/kernel/src/inet_tcp.erl +++ b/lib/kernel/src/inet_tcp.erl @@ -27,13 +27,18 @@ -export([controlling_process/2]). -export([fdopen/2]). --export([family/0, mask/2, parse_address/1]). +-export([family/0, mask/2, parse_address/1]). % inet_tcp_dist -export([getserv/1, getaddr/1, getaddr/2, getaddrs/1, getaddrs/2]). +-export([translate_ip/1]). -include("inet_int.hrl"). +-define(FAMILY, inet). +-define(PROTO, tcp). +-define(TYPE, stream). + %% my address family -family() -> inet. +family() -> ?FAMILY. %% Apply netmask on address mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) -> @@ -48,16 +53,19 @@ parse_address(Host) -> %% inet_tcp port lookup getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,tcp). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO). %% inet_tcp address lookup -getaddr(Address) -> inet:getaddr(Address, inet). -getaddr(Address,Timer) -> inet:getaddr_tm(Address, inet, Timer). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr_tm(Address, ?FAMILY, Timer). %% inet_tcp address lookup -getaddrs(Address) -> inet:getaddrs(Address, inet). -getaddrs(Address,Timer) -> inet:getaddrs_tm(Address,inet,Timer). - +getaddrs(Address) -> inet:getaddrs(Address, ?FAMILY). +getaddrs(Address, Timer) -> inet:getaddrs_tm(Address, ?FAMILY, Timer). + +%% inet_udp special this side addresses +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). + %% %% Send data on a socket %% @@ -77,7 +85,7 @@ unrecv(Socket, Data) -> prim_inet:unrecv(Socket, Data). %% shutdown(Socket, How) -> prim_inet:shutdown(Socket, How). - + %% %% Close a socket (async) %% @@ -88,7 +96,7 @@ close(Socket) -> %% Set controlling process %% controlling_process(Socket, NewOwner) -> - inet:tcp_controlling_process(Socket, NewOwner). + inet:tcp_controlling_process(Socket, NewOwner). %% %% Connect @@ -98,23 +106,28 @@ connect(Address, Port, Opts) -> connect(Address, Port, Opts, infinity) -> do_connect(Address, Port, Opts, infinity); -connect(Address, Port, Opts, Timeout) when is_integer(Timeout), - Timeout >= 0 -> +connect(Address, Port, Opts, Timeout) + when is_integer(Timeout), Timeout >= 0 -> do_connect(Address, Port, Opts, Timeout). -do_connect({A,B,C,D}, Port, Opts, Time) when ?ip(A,B,C,D), ?port(Port) -> - case inet:connect_options(Opts, inet) of +do_connect(Addr = {A,B,C,D}, Port, Opts, Time) + when ?ip(A,B,C,D), ?port(Port) -> + case inet:connect_options(Opts, ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #connect_opts{fd=Fd, - ifaddr=BAddr={Ab,Bb,Cb,Db}, - port=BPort, - opts=SockOpts}} + {ok, + #connect_opts{ + fd = Fd, + ifaddr = BAddr = {Ab,Bb,Cb,Db}, + port = BPort, + opts = SockOpts}} when ?ip(Ab,Bb,Cb,Db), ?port(BPort) -> - case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet,stream,?MODULE) of + case inet:open( + Fd, BAddr, BPort, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of {ok, S} -> - case prim_inet:connect(S, {A,B,C,D}, Port, Time) of - ok -> {ok,S}; - Error -> prim_inet:close(S), Error + case prim_inet:connect(S, Addr, Port, Time) of + ok -> {ok,S}; + Error -> prim_inet:close(S), Error end; Error -> Error end; @@ -125,14 +138,18 @@ do_connect({A,B,C,D}, Port, Opts, Time) when ?ip(A,B,C,D), ?port(Port) -> %% Listen %% listen(Port, Opts) -> - case inet:listen_options([{port,Port} | Opts], inet) of - {error,Reason} -> exit(Reason); - {ok, #listen_opts{fd=Fd, - ifaddr=BAddr={A,B,C,D}, - port=BPort, - opts=SockOpts}=R} + case inet:listen_options([{port,Port} | Opts], ?MODULE) of + {error, Reason} -> exit(Reason); + {ok, + #listen_opts{ + fd = Fd, + ifaddr = BAddr = {A,B,C,D}, + port = BPort, + opts = SockOpts} = R} when ?ip(A,B,C,D), ?port(BPort) -> - case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet,stream,?MODULE) of + case inet:open( + Fd, BAddr, BPort, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of {ok, S} -> case prim_inet:listen(S, R#listen_opts.backlog) of ok -> {ok, S}; @@ -146,23 +163,24 @@ listen(Port, Opts) -> %% %% Accept %% -accept(L) -> +accept(L) -> case prim_inet:accept(L) of {ok, S} -> inet_db:register_socket(S, ?MODULE), {ok,S}; Error -> Error end. - -accept(L,Timeout) -> - case prim_inet:accept(L,Timeout) of + +accept(L, Timeout) -> + case prim_inet:accept(L, Timeout) of {ok, S} -> inet_db:register_socket(S, ?MODULE), {ok,S}; Error -> Error end. + %% %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, Opts, tcp, inet, stream, ?MODULE). + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/inet_udp.erl b/lib/kernel/src/inet_udp.erl index 7e8d9cdb72..8a8aa8ecca 100644 --- a/lib/kernel/src/inet_udp.erl +++ b/lib/kernel/src/inet_udp.erl @@ -24,21 +24,26 @@ -export([controlling_process/2]). -export([fdopen/2]). --export([getserv/1, getaddr/1, getaddr/2]). +-export([getserv/1, getaddr/1, getaddr/2, translate_ip/1]). -include("inet_int.hrl"). +-define(FAMILY, inet). +-define(PROTO, udp). +-define(TYPE, dgram). -define(RECBUF, (8*1024)). - %% inet_udp port lookup getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,udp). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO). %% inet_udp address lookup -getaddr(Address) -> inet:getaddr(Address, inet). -getaddr(Address,Timer) -> inet:getaddr_tm(Address, inet, Timer). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr(Address, ?FAMILY, Timer). + +%% inet_udp special this side addresses +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). -spec open(_) -> {ok, inet:socket()} | {error, atom()}. open(Port) -> open(Port, []). @@ -47,33 +52,38 @@ open(Port) -> open(Port, []). open(Port, Opts) -> case inet:udp_options( [{port,Port}, {recbuf, ?RECBUF} | Opts], - inet) of + ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #udp_opts{fd=Fd, - ifaddr=BAddr={A,B,C,D}, - port=BPort, - opts=SockOpts}} when ?ip(A,B,C,D), ?port(BPort) -> - inet:open(Fd,BAddr,BPort,SockOpts,udp,inet,dgram,?MODULE); + {ok, + #udp_opts{ + fd = Fd, + ifaddr = BAddr = {A,B,C,D}, + port = BPort, + opts = SockOpts}} + when ?ip(A,B,C,D), ?port(BPort) -> + inet:open( + Fd, BAddr, BPort, SockOpts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE); {ok, _} -> exit(badarg) end. -send(S,{A,B,C,D},P,Data) when ?ip(A,B,C,D), ?port(P) -> - prim_inet:sendto(S, {A,B,C,D}, P, Data). +send(S, {A,B,C,D} = Addr, P, Data) + when ?ip(A,B,C,D), ?port(P) -> + prim_inet:sendto(S, Addr, P, Data). send(S, Data) -> prim_inet:sendto(S, {0,0,0,0}, 0, Data). -connect(S, {A,B,C,D}, P) when ?ip(A,B,C,D), ?port(P) -> - prim_inet:connect(S, {A,B,C,D}, P). +connect(S, Addr = {A,B,C,D}, P) + when ?ip(A,B,C,D), ?port(P) -> + prim_inet:connect(S, Addr, P). -recv(S,Len) -> +recv(S, Len) -> prim_inet:recvfrom(S, Len). -recv(S,Len,Time) -> +recv(S, Len, Time) -> prim_inet:recvfrom(S, Len, Time). -spec close(inet:socket()) -> ok. - close(S) -> inet:udp_close(S). @@ -92,9 +102,9 @@ controlling_process(Socket, NewOwner) -> %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, - optuniquify([{recbuf, ?RECBUF} | Opts]), - udp, inet, dgram, ?MODULE). + inet:fdopen( + Fd, optuniquify([{recbuf, ?RECBUF} | Opts]), + ?PROTO, ?FAMILY, ?TYPE, ?MODULE). %% Remove all duplicate options from an option list. diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 1acd6803b2..56d1699656 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -55,6 +55,8 @@ inet_tcp_dist, kernel, kernel_config, + local_tcp, + local_udp, net, net_adm, net_kernel, diff --git a/lib/kernel/src/local_tcp.erl b/lib/kernel/src/local_tcp.erl new file mode 100644 index 0000000000..64085ec42e --- /dev/null +++ b/lib/kernel/src/local_tcp.erl @@ -0,0 +1,172 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(local_tcp). + +%% Socket server for TCP/IP + +-export([connect/3, connect/4, listen/2, accept/1, accept/2, close/1]). +-export([send/2, send/3, recv/2, recv/3, unrecv/2]). +-export([shutdown/2]). +-export([controlling_process/2]). +-export([fdopen/2]). + +-export([getserv/1, getaddr/1, getaddr/2, getaddrs/1, getaddrs/2]). +-export([translate_ip/1]). + +-include("inet_int.hrl"). + +-define(FAMILY, local). +-define(PROTO, tcp). +-define(TYPE, stream). + +%% port lookup +getserv(0) -> {ok, 0}. + +%% no address lookup +getaddr({?FAMILY, _} = Address) -> {ok, Address}. +getaddr({?FAMILY, _} = Address, _Timer) -> {ok, Address}. + +%% no address lookup +getaddrs({?FAMILY, _} = Address) -> {ok, [Address]}. +getaddrs({?FAMILY, _} = Address, _Timer) -> {ok, [Address]}. + +%% special this side addresses +translate_ip(IP) -> IP. + +%% +%% Send data on a socket +%% +send(Socket, Packet, Opts) -> prim_inet:send(Socket, Packet, Opts). +send(Socket, Packet) -> prim_inet:send(Socket, Packet, []). + +%% +%% Receive data from a socket (inactive only) +%% +recv(Socket, Length) -> prim_inet:recv(Socket, Length). +recv(Socket, Length, Timeout) -> prim_inet:recv(Socket, Length, Timeout). + +unrecv(Socket, Data) -> prim_inet:unrecv(Socket, Data). + +%% +%% Shutdown one end of a socket +%% +shutdown(Socket, How) -> + prim_inet:shutdown(Socket, How). + +%% +%% Close a socket (async) +%% +close(Socket) -> + inet:tcp_close(Socket). + +%% +%% Set controlling process +%% FIXME: move messages to new owner!!! +%% +controlling_process(Socket, NewOwner) -> + inet:tcp_controlling_process(Socket, NewOwner). + +%% +%% Connect +%% +connect(Address, Port, Opts) -> + do_connect(Address, Port, Opts, infinity). +%% +connect(Address, Port, Opts, infinity) -> + do_connect(Address, Port, Opts, infinity); +connect(Address, Port, Opts, Timeout) + when is_integer(Timeout), Timeout >= 0 -> + do_connect(Address, Port, Opts, Timeout). + +do_connect(Addr = {?FAMILY, _}, 0, Opts, Time) -> + case inet:connect_options(Opts, ?MODULE) of + {error, Reason} -> exit(Reason); + {ok, + #connect_opts{ + fd = Fd, + ifaddr = BAddr, + port = 0, + opts = SockOpts}} + when tuple_size(BAddr) =:= 2, element(1, BAddr) =:= ?FAMILY; + BAddr =:= any -> + case inet:open( + Fd, BAddr, 0, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of + {ok, S} -> + case prim_inet:connect(S, Addr, 0, Time) of + ok -> {ok,S}; + Error -> prim_inet:close(S), Error + end; + Error -> Error + end; + {ok, _} -> exit(badarg) + end. + +%% +%% Listen +%% +listen(0, Opts) -> + case inet:listen_options([{port,0} | Opts], ?MODULE) of + {error, Reason} -> exit(Reason); + {ok, + #listen_opts{ + fd = Fd, + ifaddr = BAddr, + port = 0, + opts = SockOpts} = R} + when tuple_size(BAddr) =:= 2, element(1, BAddr) =:= ?FAMILY; + BAddr =:= any -> + case inet:open( + Fd, BAddr, 0, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of + {ok, S} -> + case prim_inet:listen(S, R#listen_opts.backlog) of + ok -> {ok, S}; + Error -> prim_inet:close(S), Error + end; + Error -> Error + end; + {ok, _} -> exit(badarg) + end. + +%% +%% Accept +%% +accept(L) -> + case prim_inet:accept(L) of + {ok, S} -> + inet_db:register_socket(S, ?MODULE), + {ok,S}; + Error -> Error + end. +%% +accept(L, Timeout) -> + case prim_inet:accept(L, Timeout) of + {ok, S} -> + inet_db:register_socket(S, ?MODULE), + {ok,S}; + Error -> Error + end. + +%% +%% Create a port/socket from a file descriptor +%% +fdopen(Fd, Opts) -> + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/local_udp.erl b/lib/kernel/src/local_udp.erl new file mode 100644 index 0000000000..ebb4d2b33f --- /dev/null +++ b/lib/kernel/src/local_udp.erl @@ -0,0 +1,99 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(local_udp). + +-export([open/1, open/2, close/1]). +-export([send/2, send/4, recv/2, recv/3, connect/3]). +-export([controlling_process/2]). +-export([fdopen/2]). + +-export([getserv/1, getaddr/1, getaddr/2, translate_ip/1]). + +-include("inet_int.hrl"). + +-define(FAMILY, local). +-define(PROTO, udp). +-define(TYPE, dgram). + + +%% port lookup +getserv(0) -> {ok, 0}. + +%% no address lookup +getaddr({?FAMILY, _} = Address) -> {ok, Address}. +getaddr({?FAMILY, _} = Address, _Timer) -> {ok, Address}. + +%% special this side addresses +translate_ip(IP) -> IP. + +open(0) -> open(0, []). +%% +open(0, Opts) -> + case inet:udp_options( + [{port,0} | Opts], + ?MODULE) of + {error, Reason} -> exit(Reason); + {ok, + #udp_opts{ + fd = Fd, + ifaddr = BAddr, + port = 0, + opts = SockOpts}} + when tuple_size(BAddr) =:= 2, element(1, BAddr) =:= ?FAMILY; + BAddr =:= any -> + inet:open( + Fd, BAddr, 0, SockOpts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE); + {ok, _} -> exit(badarg) + end. + +send(S, Addr = {?FAMILY,_}, 0, Data) -> + prim_inet:sendto(S, Addr, 0, Data). +%% +send(S, Data) -> + prim_inet:sendto(S, {?FAMILY,<<>>}, 0, Data). + +connect(S, Addr = {?FAMILY,_}, 0) -> + prim_inet:connect(S, Addr, 0). + +recv(S, Len) -> + prim_inet:recvfrom(S, Len). +%% +recv(S, Len, Time) -> + prim_inet:recvfrom(S, Len, Time). + +close(S) -> + inet:udp_close(S). + +%% +%% Set controlling process: +%% 1) First sync socket into a known state +%% 2) Move all messages onto the new owners message queue +%% 3) Commit the owner +%% 4) Wait for ack of new Owner (since socket does some link and unlink) +%% + +controlling_process(Socket, NewOwner) -> + inet:udp_controlling_process(Socket, NewOwner). + +%% +%% Create a port/socket from a file descriptor +%% +fdopen(Fd, Opts) -> + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 548b27db97..e63ed34973 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -29,11 +29,11 @@ set_cmd/1, clear_cmd/1, get_cmd/1, callback_api/1, options_api/1, - dont_drop/1, kill_pid/1]). + dont_drop/1, kill_pid/1, heart_no_kill/1]). -export([init_per_testcase/2, end_per_testcase/2]). --export([start_heart_stress/1, mangle/1, suicide_by_heart/0]). +-export([start_heart_stress/1, mangle/1, suicide_by_heart/0, non_suicide_by_heart/0]). -define(DEFAULT_TIMEOUT_SECS, 120). @@ -491,6 +491,30 @@ do_kill_pid(_Config) -> false end. + +heart_no_kill(suite) -> + []; +heart_no_kill(doc) -> + ["Tests that heart doesn't kill the old erlang node when ", + "HEART_NO_KILL is set."]; +heart_no_kill(Config) when is_list(Config) -> + ok = do_no_kill(Config). + +do_no_kill(_Config) -> + Name = heart_test, + {ok,Node} = start_node_run(Name,[],non_suicide_by_heart,[]), + io:format("Node is ~p~n", [Node]), + ok = wait_for_node(Node,15), + io:format("wait_for_node is ~p~n", [ok]), + erlang:monitor_node(Node, true), + receive {nodedown,Node} -> false + after 30000 -> + io:format("Node didn't die..\n"), + rpc:call(Node,init,stop,[]), + io:format("done init:stop..\n"), + ok + end. + wait_for_node(_,0) -> false; wait_for_node(Node,N) -> @@ -609,6 +633,18 @@ suicide_by_heart() -> sallad end. +non_suicide_by_heart() -> + P = open_port({spawn,"heart -ht 11 -pid "++os:getpid()},[exit_status, {env, {"HEART_NO_KILL", "TRUE"}}, {packet,2}]), + receive X -> X end, + %% Just hang and wait for heart to timeout + receive + {P,{exit_status,_}} -> + ok + after + 20000 -> + exit(timeout) + end. + %% generate a module from binary generate(Module, Attributes, FunStrings) -> diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index c93b10fa1c..6248d7478c 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -1002,12 +1002,12 @@ getifaddrs(Config) when is_list (Config) -> [check_addr(Addr) || Addr <- Addrs], ok. -check_addr(Addr) +check_addr({addr,Addr}) when tuple_size(Addr) =:= 8, element(1, Addr) band 16#FFC0 =:= 16#FE80 -> io:format("Addr: ~p link local; SKIPPED!~n", [Addr]), ok; -check_addr(Addr) -> +check_addr({addr,Addr}) -> io:format("Addr: ~p.~n", [Addr]), Ping = "ping", Pong = "pong", @@ -1021,74 +1021,82 @@ check_addr(Addr) -> ok = gen_tcp:close(S1), {ok,Pong} = gen_tcp:recv(S2, length(Pong)), ok = gen_tcp:close(S2), - ok = gen_tcp:close(L), - ok. + ok = gen_tcp:close(L). -record(ifopts, {name,flags,addrs=[],hwaddr}). ifaddrs([]) -> []; ifaddrs([{If,Opts}|IOs]) -> - #ifopts{flags=Flags} = Ifopts = - check_ifopts(Opts, #ifopts{name=If}), - case Flags =/= undefined andalso lists:member(up, Flags) of - true -> - Ifopts#ifopts.addrs; - false -> - [] - end++ifaddrs(IOs). + #ifopts{flags=F} = Ifopts = check_ifopts(Opts, #ifopts{name=If}), + case F of + {flags,Flags} -> + case lists:member(up, Flags) of + true -> + Ifopts#ifopts.addrs; + false -> + [] + end ++ ifaddrs(IOs); + undefined -> + ifaddrs(IOs) + end. -check_ifopts([], #ifopts{name=If,flags=Flags,addrs=Raddrs}=Ifopts) -> +check_ifopts([], #ifopts{flags=F,addrs=Raddrs}=Ifopts) -> Addrs = lists:reverse(Raddrs), R = Ifopts#ifopts{addrs=Addrs}, io:format("~p.~n", [R]), %% See how we did... - if is_list(Flags) -> ok; - true -> - ct:fail({flags_undefined,If}) - end, + {flags,Flags} = F, case lists:member(broadcast, Flags) of true -> [case A of - {_,_,_} -> A; - {T,_} when tuple_size(T) =:= 8 -> A; - _ -> - ct:fail({broaddr_missing,If,A}) + {{addr,_},{netmask,_},{broadaddr,_}} -> + A; + {{addr,T},{netmask,_}} when tuple_size(T) =:= 8 -> + A end || A <- Addrs]; false -> - [case A of {_,_} -> A; - _ -> - ct:fail({should_have_netmask,If,A}) - end || A <- Addrs] + case lists:member(pointtopoint, Flags) of + true -> + [case A of + {{addr,_},{netmask,_},{dstaddr,_}} -> + A + end || A <- Addrs]; + false -> + [case A of + {{addr,_},{netmask,_}} -> + A + end || A <- Addrs] + end end, R; -check_ifopts([{flags,Flags}|Opts], #ifopts{flags=undefined}=Ifopts) -> - check_ifopts(Opts, Ifopts#ifopts{flags=Flags}); -check_ifopts([{flags,Fs}|Opts], #ifopts{flags=Flags}=Ifopts) -> - case Fs of +check_ifopts([{flags,_}=F|Opts], #ifopts{flags=undefined}=Ifopts) -> + check_ifopts(Opts, Ifopts#ifopts{flags=F}); +check_ifopts([{flags,_}=F|Opts], #ifopts{flags=Flags}=Ifopts) -> + case F of Flags -> - check_ifopts(Opts, Ifopts#ifopts{}); + check_ifopts(Opts, Ifopts); _ -> - ct:fail({multiple_flags,Fs,Ifopts}) + ct:fail({multiple_flags,F,Ifopts}) end; check_ifopts( - [{addr,Addr},{netmask,Netmask},{broadaddr,Broadaddr}|Opts], + [{addr,_}=A,{netmask,_}=N,{dstaddr,_}=D|Opts], #ifopts{addrs=Addrs}=Ifopts) -> - check_ifopts(Opts, Ifopts#ifopts{addrs=[{Addr,Netmask,Broadaddr}|Addrs]}); + check_ifopts(Opts, Ifopts#ifopts{addrs=[{A,N,D}|Addrs]}); check_ifopts( - [{addr,Addr},{netmask,Netmask},{dstaddr,_}|Opts], + [{addr,_}=A,{netmask,_}=N,{broadaddr,_}=B|Opts], #ifopts{addrs=Addrs}=Ifopts) -> - check_ifopts(Opts, Ifopts#ifopts{addrs=[{Addr,Netmask}|Addrs]}); + check_ifopts(Opts, Ifopts#ifopts{addrs=[{A,N,B}|Addrs]}); check_ifopts( - [{addr,Addr},{netmask,Netmask}|Opts], + [{addr,_}=A,{netmask,_}=N|Opts], #ifopts{addrs=Addrs}=Ifopts) -> - check_ifopts(Opts, Ifopts#ifopts{addrs=[{Addr,Netmask}|Addrs]}); -check_ifopts([{addr,Addr}|Opts], #ifopts{addrs=Addrs}=Ifopts) -> - check_ifopts(Opts, Ifopts#ifopts{addrs=[{Addr}|Addrs]}); -check_ifopts([{hwaddr,Hwaddr}|Opts], #ifopts{hwaddr=undefined}=Ifopts) + check_ifopts(Opts, Ifopts#ifopts{addrs=[{A,N}|Addrs]}); +check_ifopts([{addr,_}=A|Opts], #ifopts{addrs=Addrs}=Ifopts) -> + check_ifopts(Opts, Ifopts#ifopts{addrs=[{A}|Addrs]}); +check_ifopts([{hwaddr,Hwaddr}=H|Opts], #ifopts{hwaddr=undefined}=Ifopts) when is_list(Hwaddr) -> - check_ifopts(Opts, Ifopts#ifopts{hwaddr=Hwaddr}); -check_ifopts([{hwaddr,HwAddr}|_], #ifopts{}=Ifopts) -> - ct:fail({multiple_hwaddrs,HwAddr,Ifopts}). + check_ifopts(Opts, Ifopts#ifopts{hwaddr=H}); +check_ifopts([{hwaddr,_}=H|_], #ifopts{}=Ifopts) -> + ct:fail({multiple_hwaddrs,H,Ifopts}). %% Works just like lists:member/2, except that any {127,_,_,_} tuple %% matches any other {127,_,_,_}. We do this to handle Linux systems diff --git a/lib/megaco/src/app/megaco.appup.src b/lib/megaco/src/app/megaco.appup.src index 93bf1d980c..46da79cfe3 100644 --- a/lib/megaco/src/app/megaco.appup.src +++ b/lib/megaco/src/app/megaco.appup.src @@ -192,34 +192,11 @@ {"%VSN%", [ - {"3.17.3", [{restart_application,megaco}]}, - {"3.17.2", []}, - {"3.17.1", [{restart_application,megaco}]}, - {"3.17.0.3", [{restart_application,megaco}]}, - {"3.17.0.2", []}, - {"3.17.0.1", []}, - {"3.17", []}, - {"3.16.0.3", - [ - {update, megaco_flex_scanner_handler, {advanced, upgrade_from_pre_3_17}, - soft_purge, soft_purge, []} - ] - } + {<<"3\\..*">>, [{restart_application, megaco}]} ], + [ - {"3.17.3", [{restart_application,megaco}]}, - {"3.17.2", []}, - {"3.17.1", [{restart_application,megaco}]}, - {"3.17.0.3", [{restart_application,megaco}]}, - {"3.17.0.2", []}, - {"3.17.0.1", []}, - {"3.17", []}, - {"3.16.0.3", - [ - {update, megaco_flex_scanner_handler, {advanced, downgrade_to_pre_3_17}, - soft_purge, soft_purge, []} - ] - } + {<<"3\\..*">>, [{restart_application, megaco}]} ] }. diff --git a/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl b/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl index e6c147b003..07707c6a12 100644 --- a/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl +++ b/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl @@ -247,10 +247,16 @@ t_call_silent(Config) when is_list(Config) -> t_receive(Config) when is_list(Config) -> ok = lttng_start_event("com_ericsson_dyntrace:message_receive", Config), _ = erlang:trace(new, true, [{tracer, dyntrace, []},'receive']), + timer:sleep(20), + + Pid1 = spawn_link(fun() -> waiter() end), + Pid1 ! {self(), ok}, + ok = receive {Pid1,ok} -> ok end, + + Pid2 = spawn_link(fun() -> waiter() end), + Pid2 ! {self(), ok}, + ok = receive {Pid2,ok} -> ok end, - Pid = spawn_link(fun() -> waiter() end), - Pid ! {self(), ok}, - ok = receive {Pid,ok} -> ok end, timer:sleep(10), _ = erlang:trace(all, false, ['receive']), Res = lttng_stop_and_view(Config), diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 33ece8f769..62f6263e9e 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -423,7 +423,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <tag><c>{beast_mitigation, one_n_minus_one | zero_n | disabled}</c></tag> <item><p>Affects SSL-3.0 and TLS-1.0 connections only. Used to change the BEAST mitigation strategy to interoperate with legacy software. - Defaults to <c>one_n_minus_one</c></p>. + Defaults to <c>one_n_minus_one</c>.</p> <p><c>one_n_minus_one</c> - Perform 1/n-1 BEAST mitigation.</p> @@ -706,6 +706,12 @@ fun(srp, Username :: string(), UserState :: term()) -> client certificate is requested. For more details see the <seealso marker="#client_signature_algs">corresponding client option</seealso>. </p> </item> + <tag><c>{v2_hello_compatible, boolean()}</c></tag> + <item>If true, the server accepts clients that send hello messages on SSL-2.0 format but offers + supported SSL/TLS versions. Defaults to false, that is the server will not interoperate with clients that + offers SSL-2.0. + </item> + </taglist> </section> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 33d5c1c6d6..0058e5ec9a 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -732,7 +732,8 @@ handle_options(Opts0, Role) -> false, Role)), client, Role), crl_check = handle_option(crl_check, Opts, false), - crl_cache = handle_option(crl_cache, Opts, {ssl_crl_cache, {internal, []}}) + crl_cache = handle_option(crl_cache, Opts, {ssl_crl_cache, {internal, []}}), + v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -747,7 +748,7 @@ handle_options(Opts0, Role) -> alpn_preferred_protocols, next_protocols_advertised, client_preferred_next_protocols, log_alert, server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache, - fallback, signature_algs, beast_mitigation], + fallback, signature_algs, beast_mitigation, v2_hello_compatible], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -991,6 +992,8 @@ validate_option(beast_mitigation, Value) when Value == one_n_minus_one orelse Value == zero_n orelse Value == disabled -> Value; +validate_option(v2_hello_compatible, Value) when is_boolean(Value) -> + Value; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index dddcbdeeda..c19c1787ff 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -139,7 +139,8 @@ fallback = false :: boolean(), crl_check :: boolean() | peer | best_effort, crl_cache, - signature_algs + signature_algs, + v2_hello_compatible :: boolean() }). -record(socket_options, diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 56e516bce2..eaf2dd002d 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -399,9 +399,10 @@ handle_common_event(internal, #alert{} = Alert, StateName, handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, StateName, #state{protocol_buffers = #protocol_buffers{tls_handshake_buffer = Buf0} = Buffers, - negotiated_version = Version} = State0) -> - try - {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0), + negotiated_version = Version, + ssl_options = Options} = State0) -> + try + {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0, Options), State = State0#state{protocol_buffers = Buffers#protocol_buffers{tls_handshake_buffer = Buf}}, diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 871eb970eb..397f963ad5 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -33,7 +33,7 @@ -include_lib("public_key/include/public_key.hrl"). -export([client_hello/8, hello/4, - get_tls_handshake/3, encode_handshake/2, decode_handshake/3]). + get_tls_handshake/4, encode_handshake/2, decode_handshake/4]). -type tls_handshake() :: #client_hello{} | ssl_handshake:ssl_handshake(). @@ -133,17 +133,17 @@ encode_handshake(Package, Version) -> [MsgType, ?uint24(Len), Bin]. %%-------------------------------------------------------------------- --spec get_tls_handshake(tls_record:tls_version(), binary(), binary() | iolist()) -> +-spec get_tls_handshake(tls_record:tls_version(), binary(), binary() | iolist(), #ssl_options{}) -> {[tls_handshake()], binary()}. %% %% Description: Given buffered and new data from ssl_record, collects %% and returns it as a list of handshake messages, also returns leftover %% data. %%-------------------------------------------------------------------- -get_tls_handshake(Version, Data, <<>>) -> - get_tls_handshake_aux(Version, Data, []); -get_tls_handshake(Version, Data, Buffer) -> - get_tls_handshake_aux(Version, list_to_binary([Buffer, Data]), []). +get_tls_handshake(Version, Data, <<>>, Options) -> + get_tls_handshake_aux(Version, Data, Options, []); +get_tls_handshake(Version, Data, Buffer, Options) -> + get_tls_handshake_aux(Version, list_to_binary([Buffer, Data]), Options, []). %%-------------------------------------------------------------------- %%% Internal functions @@ -184,24 +184,24 @@ handle_client_hello(Version, #client_hello{session_id = SugesstedId, end. get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length), - Body:Length/binary,Rest/binary>>, Acc) -> + Body:Length/binary,Rest/binary>>, #ssl_options{v2_hello_compatible = V2Hello} = Opts, Acc) -> Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>, - Handshake = decode_handshake(Version, Type, Body), - get_tls_handshake_aux(Version, Rest, [{Handshake,Raw} | Acc]); -get_tls_handshake_aux(_Version, Data, Acc) -> + Handshake = decode_handshake(Version, Type, Body, V2Hello), + get_tls_handshake_aux(Version, Rest, Opts, [{Handshake,Raw} | Acc]); +get_tls_handshake_aux(_Version, Data, _, Acc) -> {lists:reverse(Acc), Data}. -decode_handshake(_, ?HELLO_REQUEST, <<>>) -> +decode_handshake(_, ?HELLO_REQUEST, <<>>, _) -> #hello_request{}; %% Client hello v2. %% The server must be able to receive such messages, from clients that %% are willing to use ssl v3 or higher, but have ssl v2 compatibility. decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), - ?UINT16(CSLength), ?UINT16(0), - ?UINT16(CDLength), - CipherSuites:CSLength/binary, - ChallengeData:CDLength/binary>>) -> + ?UINT16(CSLength), ?UINT16(0), + ?UINT16(CDLength), + CipherSuites:CSLength/binary, + ChallengeData:CDLength/binary>>, true) -> #client_hello{client_version = {Major, Minor}, random = ssl_v2:client_random(ChallengeData, CDLength), session_id = 0, @@ -209,12 +209,18 @@ decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), compression_methods = [?NULL], extensions = #hello_extensions{} }; +decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(_), ?BYTE(_), + ?UINT16(CSLength), ?UINT16(0), + ?UINT16(CDLength), + _CipherSuites:CSLength/binary, + _ChallengeData:CDLength/binary>>, false) -> + throw(?ALERT_REC(?FATAL, ?PROTOCOL_VERSION, ssl_v2_client_hello_no_supported)); decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, - ?BYTE(SID_length), Session_ID:SID_length/binary, - ?UINT16(Cs_length), CipherSuites:Cs_length/binary, - ?BYTE(Cm_length), Comp_methods:Cm_length/binary, - Extensions/binary>>) -> - + ?BYTE(SID_length), Session_ID:SID_length/binary, + ?UINT16(Cs_length), CipherSuites:Cs_length/binary, + ?BYTE(Cm_length), Comp_methods:Cm_length/binary, + Extensions/binary>>, _) -> + DecodedExtensions = ssl_handshake:decode_hello_extensions({client, Extensions}), #client_hello{ @@ -226,7 +232,7 @@ decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:3 extensions = DecodedExtensions }; -decode_handshake(Version, Tag, Msg) -> +decode_handshake(Version, Tag, Msg, _) -> ssl_handshake:decode_handshake(Version, Tag, Msg). enc_handshake(#hello_request{}, _Version) -> diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 99f7c9b780..efe996e57c 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -3059,7 +3059,7 @@ tls_ciphersuite_vs_version(Config) when is_list(Config) -> >>), {ok, <<22, RecMajor:8, RecMinor:8, _RecLen:16, 2, HelloLen:24>>} = gen_tcp:recv(Socket, 9, 10000), {ok, <<HelloBin:HelloLen/binary>>} = gen_tcp:recv(Socket, HelloLen, 5000), - ServerHello = tls_handshake:decode_handshake({RecMajor, RecMinor}, 2, HelloBin), + ServerHello = tls_handshake:decode_handshake({RecMajor, RecMinor}, 2, HelloBin, false), case ServerHello of #server_hello{server_version = {3,0}, cipher_suite = <<0,57>>} -> ok; diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index 26e83413c1..a671e3e307 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -99,7 +99,8 @@ decode_hello_handshake(_Config) -> 16#70, 16#64, 16#79, 16#2f, 16#32>>, Version = {3, 0}, - {Records, _Buffer} = tls_handshake:get_tls_handshake(Version, HelloPacket, <<>>), + {Records, _Buffer} = tls_handshake:get_tls_handshake(Version, HelloPacket, <<>>, + #ssl_options{v2_hello_compatible = false}), {Hello, _Data} = hd(Records), #renegotiation_info{renegotiated_connection = <<0>>} diff --git a/lib/ssl/test/ssl_npn_hello_SUITE.erl b/lib/ssl/test/ssl_npn_hello_SUITE.erl index 533501e788..00eb9fee4f 100644 --- a/lib/ssl/test/ssl_npn_hello_SUITE.erl +++ b/lib/ssl/test/ssl_npn_hello_SUITE.erl @@ -57,7 +57,7 @@ encode_and_decode_client_hello_test(Config) -> HandShakeData = create_client_handshake(undefined), Version = ssl_test_lib:protocol_version(Config), {[{DecodedHandshakeMessage, _Raw}], _} = - tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), + tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>, #ssl_options{}), NextProtocolNegotiation = (DecodedHandshakeMessage#client_hello.extensions)#hello_extensions.next_protocol_negotiation, NextProtocolNegotiation = undefined. %%-------------------------------------------------------------------- @@ -65,7 +65,7 @@ encode_and_decode_npn_client_hello_test(Config) -> HandShakeData = create_client_handshake(#next_protocol_negotiation{extension_data = <<>>}), Version = ssl_test_lib:protocol_version(Config), {[{DecodedHandshakeMessage, _Raw}], _} = - tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), + tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>, #ssl_options{}), NextProtocolNegotiation = (DecodedHandshakeMessage#client_hello.extensions)#hello_extensions.next_protocol_negotiation, NextProtocolNegotiation = #next_protocol_negotiation{extension_data = <<>>}. %%-------------------------------------------------------------------- @@ -73,7 +73,7 @@ encode_and_decode_server_hello_test(Config) -> HandShakeData = create_server_handshake(undefined), Version = ssl_test_lib:protocol_version(Config), {[{DecodedHandshakeMessage, _Raw}], _} = - tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), + tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>, #ssl_options{}), NextProtocolNegotiation = (DecodedHandshakeMessage#server_hello.extensions)#hello_extensions.next_protocol_negotiation, NextProtocolNegotiation = undefined. %%-------------------------------------------------------------------- @@ -81,7 +81,7 @@ encode_and_decode_npn_server_hello_test(Config) -> HandShakeData = create_server_handshake(#next_protocol_negotiation{extension_data = <<6, "spdy/2">>}), Version = ssl_test_lib:protocol_version(Config), {[{DecodedHandshakeMessage, _Raw}], _} = - tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), + tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>, #ssl_options{}), NextProtocolNegotiation = (DecodedHandshakeMessage#server_hello.extensions)#hello_extensions.next_protocol_negotiation, ct:log("~p ~n", [NextProtocolNegotiation]), NextProtocolNegotiation = #next_protocol_negotiation{extension_data = <<6, "spdy/2">>}. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 9df31a3381..d9a4657a79 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -131,6 +131,13 @@ end_per_suite(_Config) -> ssl:stop(), application:stop(crypto). +init_per_group(basic, Config) -> + case ssl_test_lib:supports_ssl_tls_version(sslv2) of + true -> + [{v2_hello_compatible, true} | Config]; + false -> + [{v2_hello_compatible, false} | Config] + end; init_per_group(GroupName, Config) -> case ssl_test_lib:is_tls_version(GroupName) of true -> @@ -296,15 +303,18 @@ basic_erlang_server_openssl_client() -> basic_erlang_server_openssl_client(Config) when is_list(Config) -> process_flag(trap_exit, true), ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + V2Compat = proplists:get_value(v2_hello_compatible, Config), {_, ServerNode, _} = ssl_test_lib:run_where(Config), Data = "From openssl to erlang", + ct:pal("v2_hello_compatible: ~p", [V2Compat]), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, - {options, ServerOpts}]), + {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, + {options,[{v2_hello_compatible, V2Compat} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), Exe = "openssl", @@ -318,8 +328,8 @@ basic_erlang_server_openssl_client(Config) when is_list(Config) -> %% Clean close down! Server needs to be closed first !! ssl_test_lib:close(Server), ssl_test_lib:close_port(OpenSslPort), - process_flag(trap_exit, false), - ok. + process_flag(trap_exit, false). + %%-------------------------------------------------------------------- erlang_client_openssl_server() -> [{doc,"Test erlang client with openssl server"}]. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 8c1c625676..40764a943d 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -215,7 +215,7 @@ memory_check_summary(_Config) -> receive {get_failed_memchecks, FailedMemchecks} -> ok end, io:format("Failed memchecks: ~p\n",[FailedMemchecks]), NoFailedMemchecks = length(FailedMemchecks), - if NoFailedMemchecks > 3 -> + if NoFailedMemchecks > 300 -> ct:fail("Too many failed (~p) memchecks", [NoFailedMemchecks]); true -> ok @@ -604,9 +604,9 @@ memory(Config) when is_list(Config) -> memory_do(Opts) -> L = [T1,T2,T3,T4] = fill_sets_int(1000,Opts), XR1 = case mem_mode(T1) of - {normal,_} -> {13836,13046,13046,13052}; %{13862,13072,13072,13078}; - {compressed,4} -> {11041,10251,10251,10252}; %{11067,10277,10277,10278}; - {compressed,8} -> {10050,9260,9260,9260} %{10076,9286,9286,9286} + {normal,_} -> {13836,13560,13560,13566}; %{13836,13046,13046,13052} + {compressed,4} -> {11041,10865,10865,10866}; %{11041,10251,10251,10252} + {compressed,8} -> {10050,9774,9774,9774} % {10050,9260,9260,9260} end, XRes1 = adjust_xmem(L, XR1), Res1 = {?S(T1),?S(T2),?S(T3),?S(T4)}, @@ -620,9 +620,9 @@ memory_do(Opts) -> end, L), XR2 = case mem_mode(T1) of - {normal,_} -> {13826,13037,13028,13034}; %{13852,13063,13054,13060}; - {compressed,4} -> {11031,10242,10233,10234}; %{11057,10268,10259,10260}; - {compressed,8} -> {10040,9251,9242,9242} %10066,9277,9268,9268} + {normal,_} -> {13826,13551,13542,13548}; %{13826,13037,13028,13034}; + {compressed,4} -> {11031,10856,10747,10748}; %{11031,10242,10233,10234}; + {compressed,8} -> {10040,9765,9756,9756} %{10040,9251,9242,9242} end, XRes2 = adjust_xmem(L, XR2), Res2 = {?S(T1),?S(T2),?S(T3),?S(T4)}, @@ -636,9 +636,9 @@ memory_do(Opts) -> end, L), XR3 = case mem_mode(T1) of - {normal,_} -> {13816,13028,13010,13016}; %{13842,13054,13036,13042}; - {compressed,4} -> {11021,10233,10215,10216}; %{11047,10259,10241,10242}; - {compressed,8} -> {10030,9242,9224,9224} %{10056,9268,9250,9250} + {normal,_} -> {13816,13542,13524,13530}; %{13816,13028,13010,13016} + {compressed,4} -> {11021,10747,10729,10730}; %{11021,10233,10215,10216} + {compressed,8} -> {10030,9756,9738,9738} %{10030,9242,9224,9224} end, XRes3 = adjust_xmem(L, XR3), Res3 = {?S(T1),?S(T2),?S(T3),?S(T4)}, @@ -5350,12 +5350,12 @@ verify_table_load(T) -> Stats = ets:info(T,stats), {Buckets,AvgLen,StdDev,ExpSD,_MinLen,_MaxLen,_} = Stats, ok = if - AvgLen > 7 -> + AvgLen > 2 -> io:format("Table overloaded: Stats=~p\n~p\n", [Stats, ets:info(T)]), false; - Buckets>256, AvgLen < 6 -> + Buckets>256, AvgLen < 0.5 -> io:format("Table underloaded: Stats=~p\n~p\n", [Stats, ets:info(T)]), false; |