diff options
Diffstat (limited to 'lib')
61 files changed, 1704 insertions, 562 deletions
diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 3f24e15c04..500f4a1358 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -135,7 +135,7 @@ $(EBIN)/asn1ct_func.$(EMULATOR): asn1ct_func.erl asn1ct_eval_%.erl: asn1ct_eval_%.funcs $(gen_verbose)erl -pa $(EBIN) -noshell -noinput \ - -run prepare_templates gen_asn1ct_eval $< >$@ + -run prepare_templates gen_asn1ct_eval $< $(APP_TARGET): $(APP_SRC) ../vsn.mk $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ @@ -180,7 +180,7 @@ RT_TEMPLATES_TARGET = $(RT_TEMPLATES:%=%.$(EMULATOR)) asn1ct_rtt.erl: prepare_templates.$(EMULATOR) $(RT_TEMPLATES_TARGET) $(gen_verbose)erl -noshell -noinput -run prepare_templates gen_asn1ct_rtt \ - $(RT_TEMPLATES_TARGET) >asn1ct_rtt.erl + $(RT_TEMPLATES_TARGET) prepare_templates.$(EMULATOR): prepare_templates.erl $(V_ERLC) prepare_templates.erl diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index eddcda0018..04227fd23b 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2534,89 +2534,54 @@ normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) -> normalize_integer(_,Int,_) -> exit({'Unknown INTEGER value',Int}). -normalize_bitstring(S,Value,Type)-> - %% There are four different Erlang formats of BIT STRING: - %% 1 - a list of ones and zeros. - %% 2 - a list of atoms. - %% 3 - as an integer, for instance in hexadecimal form. - %% 4 - as a tuple {Unused, Binary} where Unused is an integer - %% and tells how many bits of Binary are unused. - %% - %% normalize_bitstring/3 transforms Value according to: - %% A to 3, - %% B to 1, - %% C to 1 or 3 - %% D to 2, - %% Value can be on format: - %% A - {hstring, String}, where String is a hexadecimal string. - %% B - {bstring, String}, where String is a string on bit format - %% C - #'Externalvaluereference'{value=V}, where V is a defined value - %% D - list of #'Externalvaluereference', where each value component - %% is an identifier corresponing to NamedBits in Type. - %% E - list of ones and zeros, if Value already is normalized. +%% normalize_bitstring(S, Value, Type) -> bitstring() +%% Convert a literal value for a BIT STRING to an Erlang bit string. +%% +normalize_bitstring(S, Value, Type)-> case Value of {hstring,String} when is_list(String) -> - hstring_to_int(String); + hstring_to_bitstring(String); {bstring,String} when is_list(String) -> - bstring_to_bitlist(String); - Rec when is_record(Rec,'Externalvaluereference') -> - get_normalized_value(S,Value,Type, - fun normalize_bitstring/3,[]); + bstring_to_bitstring(String); + #'Externalvaluereference'{} -> + get_normalized_value(S, Value, Type, + fun normalize_bitstring/3, []); RecList when is_list(RecList) -> - case Type of - NBL when is_list(NBL) -> - F = fun(#'Externalvaluereference'{value=Name}) -> - case lists:keysearch(Name,1,NBL) of - {value,{Name,_}} -> - Name; - Other -> - throw({error,Other}) - end; - (I) when I =:= 1; I =:= 0 -> - I; - (Other) -> - throw({error,Other}) - end, - case catch lists:map(F,RecList) of - {error,Reason} -> - asn1ct:warning("default value not " - "compatible with type definition ~p~n", - [Reason],S, - "default value not " - "compatible with type definition"), - Value; - NewList -> - NewList - end; - _ -> + F = fun(#'Externalvaluereference'{value=Name}) -> + case lists:keymember(Name, 1, Type) of + true -> Name; + false -> throw({error,false}) + end; + (Name) when is_atom(Name) -> + %% Already normalized. + Name; + (Other) -> + throw({error,Other}) + end, + try + lists:map(F, RecList) + catch + throw:{error,Reason} -> asn1ct:warning("default value not " "compatible with type definition ~p~n", - [RecList],S, + [Reason],S, "default value not " "compatible with type definition"), Value end; - {Name,String} when is_atom(Name) -> - normalize_bitstring(S,String,Type); - Other -> - asn1ct:warning("illegal default value ~p~n",[Other],S, - "illegal default value"), - Value + Bs when is_bitstring(Bs) -> + %% Already normalized. + Bs end. -hstring_to_int(L) when is_list(L) -> - hstring_to_int(L,0). -hstring_to_int([H|T],Acc) when H >= $A, H =< $F -> - hstring_to_int(T,(Acc bsl 4) + (H - $A + 10) ) ; -hstring_to_int([H|T],Acc) when H >= $0, H =< $9 -> - hstring_to_int(T,(Acc bsl 4) + (H - $0)); -hstring_to_int([],Acc) -> - Acc. +hstring_to_bitstring(L) -> + << <<(hex_to_int(D)):4>> || D <- L >>. -bstring_to_bitlist([H|T]) when H == $0; H == $1 -> - [H - $0 | bstring_to_bitlist(T)]; -bstring_to_bitlist([]) -> - []. +bstring_to_bitstring(L) -> + << <<(D-$0):1>> || D <- L >>. + +hex_to_int(D) when $0 =< D, D =< $9 -> D - $0; +hex_to_int(D) when $A =< D, D =< $F -> D - ($A - 10). %% normalize_octetstring/1 changes representation of input Value to a %% list of octets. diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index 8359b81b33..a38da8bcc2 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -1155,7 +1155,8 @@ gen_dec_line(Erules,TopType,Cname,CTags,Type,OptOrMand,DecObjInf) -> emit([indent(4),"_ ->",nl]), case OptOrMand of - {'DEFAULT', Def} -> + {'DEFAULT', Def0} -> + Def = asn1ct_gen:conform_value(Type, Def0), emit([indent(8),"{",{asis,Def},",",{prev,tlv},"}",nl]); 'OPTIONAL' -> emit([indent(8),"{ asn1_NOVALUE, ",{prev,tlv},"}",nl]) diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index 8d4afc0a0b..4672f7edd3 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -770,8 +770,10 @@ optionals(L) -> optionals(L,[],2). optionals([#'ComponentType'{prop='OPTIONAL'}|Rest], Acc, Pos) -> optionals(Rest, [Pos|Acc], Pos+1); -optionals([#'ComponentType'{prop={'DEFAULT',Val}}|Rest], Acc, Pos) -> - optionals(Rest, [{Pos,Val}|Acc], Pos+1); +optionals([#'ComponentType'{typespec=T,prop={'DEFAULT',Val}}|Rest], + Acc, Pos) -> + Vals = def_values(T, Val), + optionals(Rest, [{Pos,Vals}|Acc], Pos+1); optionals([#'ComponentType'{}|Rest], Acc, Pos) -> optionals(Rest, Acc, Pos+1); optionals([], Acc, _) -> @@ -888,7 +890,8 @@ gen_enc_components_call1(Erule,TopType, optional -> asn1ct_imm:enc_absent(Element, [asn1_NOVALUE], Imm1); {default,Def} -> - asn1ct_imm:enc_absent(Element, [asn1_DEFAULT,Def], Imm1) + DefValues = def_values(Type, Def), + asn1ct_imm:enc_absent(Element, DefValues, Imm1) end, Imm = case Imm2 of [] -> []; @@ -899,6 +902,38 @@ gen_enc_components_call1(_Erule,_TopType,[],Pos,_,_, Acc) -> ImmList = lists:reverse(Acc), {ImmList,Pos}. +def_values(#type{def=#'Externaltypereference'{module=Mod,type=Type}}, Def) -> + #typedef{typespec=T} = asn1_db:dbget(Mod, Type), + def_values(T, Def); +def_values(#type{def={'BIT STRING',[]}}, Bs) when is_bitstring(Bs) -> + ListBs = [B || <<B:1>> <= Bs], + IntBs = lists:foldl(fun(B, A) -> + (A bsl 1) bor B + end, 0, lists:reverse(ListBs)), + Sz = bit_size(Bs), + Compact = case 8 - Sz rem 8 of + 8 -> + {0,Bs}; + Unused -> + {Unused,<<Bs:Sz/bits,0:Unused>>} + end, + [asn1_DEFAULT,Bs,Compact,ListBs,IntBs]; +def_values(#type{def={'BIT STRING',[_|_]=Ns}}, List) when is_list(List) -> + Bs = asn1ct_gen:named_bitstring_value(List, Ns), + ListBs = [B || <<B:1>> <= Bs], + IntBs = lists:foldl(fun(B, A) -> + (A bsl 1) bor B + end, 0, lists:reverse(ListBs)), + Args = [List,Bs,ListBs,IntBs], + {call,per_common,is_default_bitstring,Args}; +def_values(#type{def={'INTEGER',Ns}}, Def) -> + [asn1_DEFAULT,Def|case lists:keyfind(Def, 2, Ns) of + false -> []; + {Val,Def} -> [Val] + end]; +def_values(_, Def) -> + [asn1_DEFAULT,Def]. + gen_enc_line_imm(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext) -> Imm0 = gen_enc_line_imm_1(Erule, TopType, Cname, Type, Element, DynamicEnc), @@ -1207,7 +1242,8 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, comp_call_pre_post(noext, mandatory, _, _, _, _, _, _) -> {[],[]}; -comp_call_pre_post(noext, Prop, _, _, TextPos, OptTable, NumOptionals, Ext) -> +comp_call_pre_post(noext, Prop, _, Type, TextPos, + OptTable, NumOptionals, Ext) -> %% OPTIONAL or DEFAULT OptPos = get_optionality_pos(TextPos, OptTable), Element = case NumOptionals - OptPos of @@ -1225,7 +1261,7 @@ comp_call_pre_post(noext, Prop, _, _, TextPos, OptTable, NumOptionals, Ext) -> emit([";",nl, "0 ->",nl, "{"]), - gen_dec_component_no_val(Ext, Prop), + gen_dec_component_no_val(Ext, Type, Prop), emit([",",{curr,bytes},"}",nl, "end"]), St @@ -1247,10 +1283,10 @@ comp_call_pre_post({ext,_,_}, Prop, Pos, Type, _, _, _, Ext) -> components=ExtGroupCompList2}} when is_integer(Number2)-> emit("{extAddGroup,"), - gen_dec_extaddGroup_no_val(Ext, ExtGroupCompList2), + gen_dec_extaddGroup_no_val(Ext, Type, ExtGroupCompList2), emit("}"); _ -> - gen_dec_component_no_val(Ext, Prop) + gen_dec_component_no_val(Ext, Type, Prop) end, emit([",",{curr,bytes},"}",nl, "end"]), @@ -1265,21 +1301,22 @@ is_mandatory_predef_tab_c(_, _, {"got objfun through args","ObjFun"}) -> is_mandatory_predef_tab_c(_,_,_) -> true. -gen_dec_extaddGroup_no_val(Ext,[#'ComponentType'{prop=Prop}])-> - gen_dec_component_no_val(Ext,Prop), +gen_dec_extaddGroup_no_val(Ext, Type, [#'ComponentType'{prop=Prop}])-> + gen_dec_component_no_val(Ext, Type, Prop), ok; -gen_dec_extaddGroup_no_val(Ext,[#'ComponentType'{prop=Prop}|Rest])-> - gen_dec_component_no_val(Ext,Prop), - emit({","}), - gen_dec_extaddGroup_no_val(Ext,Rest); -gen_dec_extaddGroup_no_val(_, []) -> +gen_dec_extaddGroup_no_val(Ext, Type, [#'ComponentType'{prop=Prop}|Rest])-> + gen_dec_component_no_val(Ext, Type, Prop), + emit(","), + gen_dec_extaddGroup_no_val(Ext, Type, Rest); +gen_dec_extaddGroup_no_val(_, _, []) -> ok. -gen_dec_component_no_val(_,{'DEFAULT',DefVal}) -> +gen_dec_component_no_val(_, Type, {'DEFAULT',DefVal0}) -> + DefVal = asn1ct_gen:conform_value(Type, DefVal0), emit([{asis,DefVal}]); -gen_dec_component_no_val(_,'OPTIONAL') -> +gen_dec_component_no_val(_, _, 'OPTIONAL') -> emit({"asn1_NOVALUE"}); -gen_dec_component_no_val({ext,_,_},mandatory) -> +gen_dec_component_no_val({ext,_,_}, _, mandatory) -> emit({"asn1_NOVALUE"}). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 3452d29085..30d337635b 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -33,7 +33,9 @@ insert_once/2, ct_gen_module/1, index2suffix/1, - get_record_name_prefix/0]). + get_record_name_prefix/0, + conform_value/2, + named_bitstring_value/2]). -export([pgen/5, mk_var/1, un_hyphen_var/1]). @@ -1485,8 +1487,14 @@ gen_prim_check_call(PrimType, Default, Element, Type) -> end, check_call(check_int, [Default,Element,{asis,NNL}]); 'BIT STRING' -> - {_,NBL} = Type#type.def, - check_call(check_bitstring, [Default,Element,{asis,NBL}]); + case Type#type.def of + {_,[]} -> + check_call(check_bitstring, + [Default,Element]); + {_,[_|_]=NBL} -> + check_call(check_named_bitstring, + [Default,Element,{asis,NBL}]) + end; 'OCTET STRING' -> check_call(check_octetstring, [Default,Element]); 'NULL' -> @@ -1640,9 +1648,33 @@ unify_if_string(PrimType) -> Other -> Other end. - - - +conform_value(#type{def={'BIT STRING',[]}}, Bs) -> + case asn1ct:get_bit_string_format() of + compact when is_binary(Bs) -> + {0,Bs}; + compact when is_bitstring(Bs) -> + Sz = bit_size(Bs), + Unused = 8 - bit_size(Bs), + {Unused,<<Bs:Sz/bits,0:Unused>>}; + legacy -> + [B || <<B:1>> <= Bs]; + bitstring when is_bitstring(Bs) -> + Bs + end; +conform_value(_, Value) -> Value. + +named_bitstring_value(List, Names) -> + Int = lists:foldl(fun(N, A) -> + {N,Pos} = lists:keyfind(N, 1, Names), + A bor (1 bsl Pos) + end, 0, List), + named_bitstring_value_1(<<>>, Int). + +named_bitstring_value_1(Bs, 0) -> + Bs; +named_bitstring_value_1(Bs, Int) -> + B = Int band 1, + named_bitstring_value_1(<<Bs/bitstring,B:1>>, Int bsr 1). get_inner(A) when is_atom(A) -> A; get_inner(Ext) when is_record(Ext,'Externaltypereference') -> Ext; diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 892178f61b..20785cda8c 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -319,14 +319,22 @@ per_enc_extensions(Val0, Pos0, NumBits, Aligned) when NumBits > 0 -> {'cond',[[{eq,Bitmap,0}], ['_'|Length ++ PutBits]],{var,"Extensions"}}]. -per_enc_optional(Val0, {Pos,Def}, _Aligned) when is_integer(Pos) -> +per_enc_optional(Val0, {Pos,DefVals}, _Aligned) when is_integer(Pos), + is_list(DefVals) -> Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), {B,[Val]} = mk_vars(Val1, []), Zero = {put_bits,0,1,[1]}, One = {put_bits,1,1,[1]}, - B++[{'cond',[[{eq,Val,asn1_DEFAULT},Zero], - [{eq,Val,Def},Zero], - ['_',One]]}]; + B++[{'cond', + [[{eq,Val,DefVal},Zero] || DefVal <- DefVals] ++ [['_',One]]}]; +per_enc_optional(Val0, {Pos,{call,M,F,A}}, _Aligned) when is_integer(Pos) -> + Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), + {B,[Val,Tmp]} = mk_vars(Val1, [tmp]), + Zero = {put_bits,0,1,[1]}, + One = {put_bits,1,1,[1]}, + B++[{call,M,F,[Val|A],Tmp}, + {'cond', + [[{eq,Tmp,true},Zero],['_',One]]}]; per_enc_optional(Val0, Pos, _Aligned) when is_integer(Pos) -> Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), {B,[Val]} = mk_vars(Val1, []), @@ -352,7 +360,12 @@ per_enc_sof(Val0, Constraint, ElementVar, ElementImm, Aligned) -> PreBlock ++ EncLen ++ Lc end. -enc_absent(Val0, AbsVals, Body) -> +enc_absent(Val0, {call,M,F,A}, Body) -> + {B,[Var,Tmp]} = mk_vars(Val0, [tmp]), + B++[{call,M,F,[Var|A],Tmp}, + {'cond', + [[{eq,Tmp,true}],['_'|Body]]}]; +enc_absent(Val0, AbsVals, Body) when is_list(AbsVals) -> {B,[Var]} = mk_vars(Val0, []), Cs = [[{eq,Var,Aval}] || Aval <- AbsVals] ++ [['_'|Body]], B++build_cond(Cs). @@ -994,6 +1007,25 @@ mk_var(Base, V) -> per_enc_integer_1(Val, [], Aligned) -> [{'cond',[['_'|per_enc_unconstrained(Val, Aligned)]]}]; +per_enc_integer_1(Val, [{{'SingleValue',[_|_]=Svs}=Constr,[]}], Aligned) -> + %% An extensible constraint such as (1|17, ...). + %% + %% A subtle detail is that the extension root as described in the + %% ASN.1 spec should be used to determine whether a particular value + %% belongs to the extension root (as opposed to the effective + %% constraint, which will be used for the actual encoding). + %% + %% So for the example above, only the integers 1 and 17 should be + %% encoded as root values (extension bit = 0). + + [{'ValueRange',{Lb,Ub}}] = effective_constraint(integer, [Constr]), + Root = [begin + {[],_,Put} = per_enc_constrained(Sv, Lb, Ub, Aligned), + [{eq,Val,Sv},{put_bits,0,1,[1]}|Put] + end || Sv <- Svs], + Cs = Root ++ [['_',{put_bits,1,1,[1]}| + per_enc_unconstrained(Val, Aligned)]], + build_cond(Cs); per_enc_integer_1(Val0, [{{_,_}=Constr,[]}], Aligned) -> {Prefix,Check,Action} = per_enc_integer_2(Val0, Constr, Aligned), Prefix++build_cond([[Check,{put_bits,0,1,[1]}|Action], @@ -1004,7 +1036,7 @@ per_enc_integer_1(Val0, [Constr], Aligned) -> Prefix++build_cond([[Check|Action], ['_',{error,Val0}]]). -per_enc_integer_2(Val, {'SingleValue',Sv}, Aligned) -> +per_enc_integer_2(Val, {'SingleValue',Sv}, Aligned) when is_integer(Sv) -> per_enc_constrained(Val, Sv, Sv, Aligned); per_enc_integer_2(Val0, {'ValueRange',{Lb,'MAX'}}, Aligned) when is_integer(Lb) -> diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 992210232f..862b3c4ea5 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -167,17 +167,16 @@ from_type_prim(M, D) -> case D#type.def of 'INTEGER' -> i_random(C); - {'INTEGER',NamedNumberList} -> - NN = [X||{X,_} <- NamedNumberList], - case NN of + {'INTEGER',[_|_]=NNL} -> + case C of [] -> - i_random(C); + {N,_} = lists:nth(random(length(NNL)), NNL), + N; _ -> - case C of - [] -> - lists:nth(random(length(NN)),NN); - _ -> - lists:nth((fun(0)->1;(X)->X end(i_random(C))),NN) + V = i_random(C), + case lists:keyfind(V, 2, NNL) of + false -> V; + {N,V} -> N end end; Enum when is_tuple(Enum),element(1,Enum)=='ENUMERATED' -> diff --git a/lib/asn1/src/asn1rtt_check.erl b/lib/asn1/src/asn1rtt_check.erl index e78b65a8fb..be4f9c8bff 100644 --- a/lib/asn1/src/asn1rtt_check.erl +++ b/lib/asn1/src/asn1rtt_check.erl @@ -20,7 +20,7 @@ -export([check_bool/2, check_int/3, - check_bitstring/3, + check_bitstring/2,check_named_bitstring/3, check_octetstring/2, check_null/2, check_objectidentifier/2, @@ -50,31 +50,54 @@ check_int(DefValue, Value, NNL) when is_atom(Value) -> check_int(DefaultValue, _Value, _) -> throw({error,DefaultValue}). -%% Two equal lists or integers -check_bitstring(_, asn1_DEFAULT, _) -> +%% check_bitstring(Default, UserBitstring) -> true|false +%% Default = bitstring() +%% UserBitstring = integeger() | list(0|1) | {Unused,binary()} | bitstring() +check_bitstring(_, asn1_DEFAULT) -> true; -check_bitstring(V, V, _) -> - true; -%% Default value as a list of 1 and 0 and user value as an integer -check_bitstring(L=[H|T], Int, _) when is_integer(Int), is_integer(H) -> - case bit_list_to_int(L, length(T)) of - Int -> true; - _ -> throw({error,L,Int}) +check_bitstring(DefVal, {Unused,Binary}) -> + %% User value in compact format. + Sz = bit_size(Binary) - Unused, + <<Val:Sz/bitstring,_:Unused>> = Binary, + check_bitstring(DefVal, Val); +check_bitstring(DefVal, Val) when is_bitstring(Val) -> + case Val =:= DefVal of + false -> throw(error); + true -> true end; -%% Default value as an integer, val as list -check_bitstring(Int, Val, NBL) when is_integer(Int), is_list(Val) -> - BL = int_to_bit_list(Int, [], length(Val)), - check_bitstring(BL, Val, NBL); +check_bitstring(Def, Val) when is_list(Val) -> + check_bitstring_list(Def, Val); +check_bitstring(Def, Val) when is_integer(Val) -> + check_bitstring_integer(Def, Val). + +check_bitstring_list(<<H:1,T1/bitstring>>, [H|T2]) -> + check_bitstring_list(T1, T2); +check_bitstring_list(<<>>, []) -> + true; +check_bitstring_list(_, _) -> + throw(error). + +check_bitstring_integer(<<H:1,T1/bitstring>>, Int) when H =:= Int band 1 -> + check_bitstring_integer(T1, Int bsr 1); +check_bitstring_integer(<<>>, 0) -> + true; +check_bitstring_integer(_, _) -> + throw(error). + +check_named_bitstring(_, asn1_DEFAULT, _) -> + true; +check_named_bitstring(V, V, _) -> + true; %% Default value and user value as lists of ones and zeros -check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL=[_H|_T]) when is_integer(H1), is_integer(H2) -> +check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL=[_H|_T]) when is_integer(H1), is_integer(H2) -> L2new = remove_trailing_zeros(L2), - check_bitstring(L1, L2new, NBL); + check_named_bitstring(L1, L2new, NBL); %% Default value as a list of 1 and 0 and user value as a list of atoms -check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_integer(H1), is_atom(H2) -> +check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_integer(H1), is_atom(H2) -> L3 = bit_list_to_nbl(L1, NBL, 0, []), - check_bitstring(L3, L2, NBL); + check_named_bitstring(L3, L2, NBL); %% Both default value and user value as a list of atoms -check_bitstring(L1=[H1|T1], L2=[H2|_T2], _) +check_named_bitstring(L1=[H1|T1], L2=[H2|_T2], _) when is_atom(H1), is_atom(H2), length(L1) =:= length(L2) -> case lists:member(H1, L2) of true -> @@ -82,27 +105,29 @@ check_bitstring(L1=[H1|T1], L2=[H2|_T2], _) false -> throw({error,L2}) end; %% Default value as a list of atoms and user value as a list of 1 and 0 -check_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_atom(H1), is_integer(H2) -> +check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_atom(H1), is_integer(H2) -> L3 = bit_list_to_nbl(L2, NBL, 0, []), - check_bitstring(L1, L3, NBL); + check_named_bitstring(L1, L3, NBL); %% User value in compact format -check_bitstring(DefVal,CBS={_,_}, NBL) -> +check_named_bitstring(DefVal,CBS={_,_}, NBL) -> NewVal = cbs_to_bit_list(CBS), - check_bitstring(DefVal, NewVal, NBL); -check_bitstring(DV, V, _) -> + check_named_bitstring(DefVal, NewVal, NBL); +%% User value as a binary +check_named_bitstring(DefVal, CBS, NBL) when is_binary(CBS) -> + NewVal = cbs_to_bit_list({0,CBS}), + check_named_bitstring(DefVal, NewVal, NBL); +%% User value as a bitstring +check_named_bitstring(DefVal, CBS, NBL) when is_bitstring(CBS) -> + BitSize = bit_size(CBS), + Unused = 8 - (BitSize band 7), + NewVal = cbs_to_bit_list({Unused,<<CBS:BitSize/bits,0:Unused>>}), + check_named_bitstring(DefVal, NewVal, NBL); +check_named_bitstring(DV, V, _) -> throw({error,DV,V}). - -bit_list_to_int([0|Bs], ShL)-> - bit_list_to_int(Bs, ShL-1) + 0; -bit_list_to_int([1|Bs], ShL) -> - bit_list_to_int(Bs, ShL-1) + (1 bsl ShL); -bit_list_to_int([], _) -> - 0. - int_to_bit_list(0, Acc, 0) -> Acc; -int_to_bit_list(Int, Acc, Len) -> +int_to_bit_list(Int, Acc, Len) when Len > 0 -> int_to_bit_list(Int bsr 1, [Int band 1|Acc], Len - 1). bit_list_to_nbl([0|T], NBL, Pos, Acc) -> diff --git a/lib/asn1/src/asn1rtt_per_common.erl b/lib/asn1/src/asn1rtt_per_common.erl index 9e9fd87ec3..3309e6a4ca 100644 --- a/lib/asn1/src/asn1rtt_per_common.erl +++ b/lib/asn1/src/asn1rtt_per_common.erl @@ -37,6 +37,7 @@ bitstring_from_positions/1,bitstring_from_positions/2, to_bitstring/1,to_bitstring/2, to_named_bitstring/1,to_named_bitstring/2, + is_default_bitstring/5, extension_bitmap/3]). -define('16K',16384). @@ -271,6 +272,36 @@ to_named_bitstring(Val, Lb) -> %% for correctness, not speed. adjust_trailing_zeroes(to_bitstring(Val), Lb). +is_default_bitstring(asn1_DEFAULT, _, _, _, _) -> + true; +is_default_bitstring({Unused,Bin}, V0, V1, V2, V3) when is_integer(Unused) -> + %% Convert compact bitstring to a bitstring. + Sz = bit_size(Bin) - Unused, + <<Bs:Sz/bitstring,_:Unused>> = Bin, + is_default_bitstring(Bs, V0, V1, V2, V3); +is_default_bitstring(Named, Named, _, _, _) -> + true; +is_default_bitstring(Bs, _, Bs, _, _) -> + true; +is_default_bitstring(List, _, _, List, _) -> + true; +is_default_bitstring(Int, _, _, _, Int) -> + true; +is_default_bitstring(Val, _, Def, _, _) when is_bitstring(Val) -> + Sz = bit_size(Def), + case Val of + <<Def:Sz/bitstring,T/bitstring>> -> + NumZeroes = bit_size(T), + case T of + <<0:NumZeroes>> -> true; + _ -> false + end; + _ -> + false + end; +is_default_bitstring(Val, _, _, List, _) when is_list(Val) -> + is_default_bitstring_list(List, Val); +is_default_bitstring(_, _, _, _, _) -> false. extension_bitmap(Val, Pos, Limit) -> extension_bitmap(Val, Pos, Limit, 0). @@ -447,6 +478,16 @@ ntz(Byte) -> 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0}, element(Byte+1, T). +is_default_bitstring_list([H|Def], [H|Val]) -> + is_default_bitstring_list(Def, Val); +is_default_bitstring_list([], []) -> + true; +is_default_bitstring_list([], [_|_]=Val) -> + lists:all(fun(0) -> true; + (_) -> false + end, Val); +is_default_bitstring_list(_, _) -> false. + extension_bitmap(_Val, Pos, Limit, Acc) when Pos >= Limit -> Acc; extension_bitmap(Val, Pos, Limit, Acc) -> diff --git a/lib/asn1/src/prepare_templates.erl b/lib/asn1/src/prepare_templates.erl index 83155b2e52..ccd15548d8 100644 --- a/lib/asn1/src/prepare_templates.erl +++ b/lib/asn1/src/prepare_templates.erl @@ -21,69 +21,77 @@ -export([gen_asn1ct_rtt/1,gen_asn1ct_eval/1]). gen_asn1ct_rtt(Ms) -> - io:format("%% Generated by ~s. DO NOT EDIT THIS FILE.\n" + {ok,Fd} = file:open("asn1ct_rtt.erl", [write]), + io:format(Fd, + "%% Generated by ~s. DO NOT EDIT THIS FILE.\n" "%%\n" "%% Input files:\n", [?MODULE]), - [io:put_chars(["%% ",M,$\n]) || M <- Ms], - io:nl(), - io:put_chars("-module(asn1ct_rtt).\n" + [io:put_chars(Fd, ["%% ",M,$\n]) || M <- Ms], + io:nl(Fd), + io:put_chars(Fd, + "-module(asn1ct_rtt).\n" "-export([assert_defined/1,dependencies/1,code/0]).\n" "\n"), Forms = lists:sort(lists:append([abstract(M) || M <- Ms])), Exp = lists:sort(exports(Forms)), - defined(Exp), - io:nl(), + defined(Fd, Exp), + io:nl(Fd), Calls = calls(Forms), R = sofs:relation(Calls), Fam0 = sofs:relation_to_family(R), Fam = sofs:to_external(Fam0), - dependencies(Fam), - io:nl(), + dependencies(Fd, Fam), + io:nl(Fd), Funcs = [begin Bin = list_to_binary([$\n|erl_pp:function(Func)]), {{M,F,A},Bin} end || {M,{function,_,F,A,_}=Func} <- Forms], - io:format("code() ->\n~p.\n\n", [Funcs]), + io:format(Fd, "code() ->\n~p.\n\n", [Funcs]), + ok = file:close(Fd), halt(0). gen_asn1ct_eval([File]) -> + Output = filename:rootname(File, ".funcs") ++ ".erl", + {ok,Fd} = file:open(Output, [write]), {ok,Funcs} = file:consult(File), asn1ct_func:start_link(), [asn1ct_func:need(MFA) || MFA <- Funcs], - io:format("%% Generated by ~s. DO NOT EDIT THIS FILE.\n" + io:format(Fd, + "%% Generated by ~s. DO NOT EDIT THIS FILE.\n" "%%\n" "%% Input file: ~s\n\n", [?MODULE,File]), - io:format("-module(~s).\n", [filename:rootname(File)]), - gen_asn1ct_eval_exp(Funcs), - asn1ct_func:generate(group_leader()), + io:format(Fd, "-module(~s).\n", [filename:rootname(File)]), + gen_asn1ct_eval_exp(Fd, Funcs), + asn1ct_func:generate(Fd), + ok = file:close(Fd), halt(0). -gen_asn1ct_eval_exp(Funcs) -> - io:put_chars("-export(["), - gen_asn1ct_eval_exp_1(Funcs, ""), - io:put_chars("]).\n"). +gen_asn1ct_eval_exp(Fd, Funcs) -> + io:put_chars(Fd, "-export(["), + gen_asn1ct_eval_exp_1(Fd, Funcs, ""), + io:put_chars(Fd, "]).\n"). -gen_asn1ct_eval_exp_1([{_,F,A}|T], Sep) -> - io:put_chars(Sep), - io:format("~p/~p", [F,A]), - gen_asn1ct_eval_exp_1(T, ",\n"); -gen_asn1ct_eval_exp_1([], _) -> ok. +gen_asn1ct_eval_exp_1(Fd, [{_,F,A}|T], Sep) -> + io:put_chars(Fd, Sep), + io:format(Fd, "~p/~p", [F,A]), + gen_asn1ct_eval_exp_1(Fd, T, ",\n"); +gen_asn1ct_eval_exp_1(_, [], _) -> ok. -defined([H|T]) -> - io:format("assert_defined(~p) -> ok", [H]), +defined(Fd, [H|T]) -> + io:format(Fd, "assert_defined(~p) -> ok", [H]), case T of [] -> - io:put_chars(".\n"); + io:put_chars(Fd, ".\n"); [_|_] -> - io:put_chars(";\n"), - defined(T) + io:put_chars(Fd, ";\n"), + defined(Fd, T) end. -dependencies([{K,V}|T]) -> - io:format("dependencies(~p) ->\n~p;\n", [K,V]), - dependencies(T); -dependencies([]) -> - io:put_chars("dependencies(_) -> [].\n"). +dependencies(Fd, [{K,V}|T]) -> + io:format(Fd, "dependencies(~p) ->\n~p;\n", [K,V]), + dependencies(Fd, T); +dependencies(Fd, []) -> + io:put_chars(Fd, "dependencies(_) -> [].\n"). abstract(File) -> {ok,{M0,[{abstract_code,Abstract}]}} = diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index 61b360ddf2..83bd66a631 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -96,7 +96,6 @@ groups() -> testChoTypeRefSeq, testChoTypeRefSet, testMultipleLevels, - testDef, testOpt, testSeqDefault, % Uses 'External' @@ -141,9 +140,9 @@ groups() -> testDeepTConstr, testExport, testImport, - % Uses 'ParamBasic' - {group, [], [testParamBasic, - testDER]}, + testParamBasic, + testDER, + testDEFAULT, testMvrasn6, testContextSwitchingTypes, testOpenTypeImplicitTag, @@ -326,20 +325,21 @@ testCompactBitString(Config, Rule, Opts) -> [Rule, compact_bit_string|Opts]), testCompactBitString:otp_4869(Rule). -testPrimStrings(Config) -> test(Config, fun testPrimStrings/3). +testPrimStrings(Config) -> + test(Config, fun testPrimStrings/3, [ber,{ber,[der]},per,uper]). testPrimStrings(Config, Rule, Opts) -> asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [Rule|Opts]), - testPrimStrings_cases(Rule), + testPrimStrings_cases(Rule, Opts), asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [legacy_bit_string,Rule|Opts]), - testPrimStrings:bit_string(Rule), + testPrimStrings:bit_string(Rule, Opts), asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [compact_bit_string,Rule|Opts]), - testPrimStrings:bit_string(Rule), + testPrimStrings:bit_string(Rule, Opts), testPrimStrings:more_strings(Rule). -testPrimStrings_cases(Rule) -> - testPrimStrings:bit_string(Rule), +testPrimStrings_cases(Rule, Opts) -> + testPrimStrings:bit_string(Rule, Opts), testPrimStrings:octet_string(Rule), testPrimStrings:numeric_string(Rule), testPrimStrings:other_strings(Rule), @@ -429,6 +429,13 @@ testDef(Config, Rule, Opts) -> asn1_test_lib:compile("Def", Config, [Rule|Opts]), testDef:main(Rule). +testDEFAULT(Config) -> + test(Config, fun testDEFAULT/3, [ber,{ber,[der]},per,uper]). +testDEFAULT(Config, Rule, Opts) -> + asn1_test_lib:compile_all(["Def","Default"], Config, [Rule|Opts]), + testDef:main(Rule), + testSeqSetDefaultVal:main(Rule, Opts). + testOpt(Config) -> test(Config, fun testOpt/3). testOpt(Config, Rule, Opts) -> asn1_test_lib:compile("Opt", Config, [Rule|Opts]), @@ -516,7 +523,8 @@ testSetDefault(Config, Rule, Opts) -> asn1_test_lib:compile("SetDefault", Config, [Rule|Opts]), testSetDefault:main(Rule). -testParamBasic(Config) -> test(Config, fun testParamBasic/3). +testParamBasic(Config) -> + test(Config, fun testParamBasic/3, [ber,{ber,[der]},per,uper]). testParamBasic(Config, Rule, Opts) -> asn1_test_lib:compile("ParamBasic", Config, [Rule|Opts]), testParamBasic:main(Rule). @@ -873,11 +881,7 @@ testDER(Config) -> test(Config, fun testDER/3, [ber]). testDER(Config, Rule, Opts) -> asn1_test_lib:compile("DERSpec", Config, [Rule, der|Opts]), - testDER:test(), - asn1_test_lib:compile("ParamBasic", Config, [Rule, der|Opts]), - testParamBasic:main(der), - asn1_test_lib:compile("Default", Config, [Rule, der|Opts]), - testSeqSetDefaultVal:main(Rule). + testDER:test(). specialized_decodes(Config) -> test(Config, fun specialized_decodes/3, [ber]). diff --git a/lib/asn1/test/asn1_SUITE_data/Constraints.py b/lib/asn1/test/asn1_SUITE_data/Constraints.py index e4bc987e4c..581ec2f467 100644 --- a/lib/asn1/test/asn1_SUITE_data/Constraints.py +++ b/lib/asn1/test/asn1_SUITE_data/Constraints.py @@ -17,6 +17,11 @@ NegSemiConstrained ::= INTEGER (-128..MAX) SemiConstrainedExt ::= INTEGER (42..MAX, ...) NegSemiConstrainedExt ::= INTEGER (-128..MAX, ...) +-- Union of single values +Sv1 ::= INTEGER (2|3|17) +Sv2 ::= INTEGER (2|3|17, ...) +Sv3 ::= INTEGER {a(2),b(3),z(17)} (2|3|17, ...) + -- Other constraints FixedSize ::= OCTET STRING (SIZE(10)) FixedSize2 ::= OCTET STRING (SIZE(10|20)) diff --git a/lib/asn1/test/asn1_SUITE_data/Default.asn b/lib/asn1/test/asn1_SUITE_data/Default.asn index 6604953c1f..168ce50bb2 100644 --- a/lib/asn1/test/asn1_SUITE_data/Default.asn +++ b/lib/asn1/test/asn1_SUITE_data/Default.asn @@ -21,7 +21,8 @@ SeqBS ::= SEQUENCE { a BIT STRING DEFAULT '1010110'B, b BIT STRING DEFAULT 'A8A'H, c BIT STRING {first(0),second(1),third(2)} DEFAULT {second}, - d BIT STRING DEFAULT onelist + d BIT STRING DEFAULT onelist, + e BIT STRING DEFAULT '01011010'B } SetBS ::= SET { diff --git a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 index 08e7f94ab6..a5b4c8a53d 100644 --- a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 @@ -46,7 +46,13 @@ BS256 ::= BIT STRING (SIZE (256)) BS1024 ::= BIT STRING (SIZE (1024)) - + BsDef1 ::= SEQUENCE { + s BIT STRING DEFAULT '101111'B + } + + BsDef2 ::= SEQUENCE { + s BIT STRING DEFAULT 'DEADBEEF'H + } Os ::= OCTET STRING OsCon ::= [60] OCTET STRING diff --git a/lib/asn1/test/testConstraints.erl b/lib/asn1/test/testConstraints.erl index 9a1d62993d..34fbbcf6cc 100644 --- a/lib/asn1/test/testConstraints.erl +++ b/lib/asn1/test/testConstraints.erl @@ -122,6 +122,42 @@ int_constraints(Rules) -> range_error(Rules, 'X1', 21), %%========================================================== + %% Union of single values + %% Sv1 ::= INTEGER (2|3|17) + %% Sv2 ::= INTEGER (2|3|17, ...) + %% Sv3 ::= INTEGER {a(2),b(3),z(17)} (2|3|17, ...) + %%========================================================== + + range_error(Rules, 'Sv1', 1), + range_error(Rules, 'Sv1', 18), + roundtrip('Sv1', 2), + roundtrip('Sv1', 3), + roundtrip('Sv1', 7), + + %% Encoded as root + v_roundtrip(Rules, 'Sv2', 2), + v_roundtrip(Rules, 'Sv2', 3), + v_roundtrip(Rules, 'Sv2', 17), + + %% Encoded as extension + v_roundtrip(Rules, 'Sv2', 1), + v_roundtrip(Rules, 'Sv2', 4), + v_roundtrip(Rules, 'Sv2', 18), + + %% Encoded as root + v_roundtrip(Rules, 'Sv3', a), + v_roundtrip(Rules, 'Sv3', b), + v_roundtrip(Rules, 'Sv3', z), + v_roundtrip(Rules, 'Sv3', 2, a), + v_roundtrip(Rules, 'Sv3', 3, b), + v_roundtrip(Rules, 'Sv3', 17, z), + + %% Encoded as extension + v_roundtrip(Rules, 'Sv3', 1), + v_roundtrip(Rules, 'Sv3', 4), + v_roundtrip(Rules, 'Sv3', 18), + + %%========================================================== %% SemiConstrained %%========================================================== @@ -197,7 +233,29 @@ v(per, 'SemiConstrainedExt', 42+128) -> "000180"; v(uper, 'SemiConstrainedExt', 42+128) -> "00C000"; v(ber, 'NegSemiConstrainedExt', 0) -> "020100"; v(per, 'NegSemiConstrainedExt', 0) -> "000180"; -v(uper, 'NegSemiConstrainedExt', 0) -> "00C000". +v(uper, 'NegSemiConstrainedExt', 0) -> "00C000"; +v(ber, 'Sv2', 1) -> "020101"; +v(per, 'Sv2', 1) -> "800101"; +v(uper, 'Sv2', 1) -> "808080"; +v(ber, 'Sv2', 2) -> "020102"; +v(per, 'Sv2', 2) -> "00"; +v(uper, 'Sv2', 2) -> "00"; +v(ber, 'Sv2', 3) -> "020103"; +v(per, 'Sv2', 3) -> "08"; +v(uper, 'Sv2', 3) -> "08"; +v(ber, 'Sv2', 4) -> "020104"; +v(per, 'Sv2', 4) -> "800104"; +v(uper, 'Sv2', 4) -> "808200"; +v(ber, 'Sv2', 17) -> "020111"; +v(per, 'Sv2', 17) -> "78"; +v(uper, 'Sv2', 17) -> "78"; +v(ber, 'Sv2', 18) -> "020112"; +v(per, 'Sv2', 18) -> "800112"; +v(uper, 'Sv2', 18) -> "808900"; +v(Rule, 'Sv3', a) -> v(Rule, 'Sv2', 2); +v(Rule, 'Sv3', b) -> v(Rule, 'Sv2', 3); +v(Rule, 'Sv3', z) -> v(Rule, 'Sv2', 17); +v(Rule, 'Sv3', Val) when is_integer(Val) -> v(Rule, 'Sv2', Val). shorter_ext(per, "a") -> <<16#80,16#01,16#61>>; shorter_ext(uper, "a") -> <<16#80,16#E1>>; @@ -211,6 +269,10 @@ v_roundtrip(Erule, Type, Value) -> Encoded = asn1_test_lib:hex_to_bin(v(Erule, Type, Value)), Encoded = roundtrip('Constraints', Type, Value). +v_roundtrip(Erule, Type, Value, Expected) -> + Encoded = asn1_test_lib:hex_to_bin(v(Erule, Type, Value)), + Encoded = asn1_test_lib:roundtrip_enc('Constraints', Type, Value, Expected). + roundtrip(Type, Value) -> roundtrip('Constraints', Type, Value). diff --git a/lib/asn1/test/testParamBasic.erl b/lib/asn1/test/testParamBasic.erl index 3a55408e94..3db89ca174 100644 --- a/lib/asn1/test/testParamBasic.erl +++ b/lib/asn1/test/testParamBasic.erl @@ -38,7 +38,9 @@ main(Rules) -> <<48,3,128,1,11>> = roundtrip_enc('T11', #'T11'{number=11,string="hej"}), <<48,3,128,1,11>> = - roundtrip_enc('T12', #'T12'{number=11,string=[1,0,1,0]}); + roundtrip_enc('T12', + #'T12'{number=11,string=[1,0,1,0]}, + #'T12'{number=11,string = <<10:4>>}); _ -> ok end, ok. @@ -48,3 +50,6 @@ roundtrip(Type, Value) -> roundtrip_enc(Type, Value) -> asn1_test_lib:roundtrip_enc('ParamBasic', Type, Value). + +roundtrip_enc(Type, Value, Expected) -> + asn1_test_lib:roundtrip_enc('ParamBasic', Type, Value, Expected). diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index be5409aa92..2fe0780701 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -19,7 +19,7 @@ %% -module(testPrimStrings). --export([bit_string/1]). +-export([bit_string/2]). -export([octet_string/1]). -export([numeric_string/1]). -export([other_strings/1]). @@ -68,7 +68,7 @@ fragmented_lengths() -> K64-1,K64,K64+1,K64+(1 bsl 7)-1,K64+(1 bsl 7),K64+(1 bsl 7)+1, K64+K16-1,K64+K16,K64+K16+1]. -bit_string(Rules) -> +bit_string(Rules, Opts) -> %%========================================================== %% Bs1 ::= BIT STRING @@ -90,9 +90,10 @@ bit_string(Rules) -> bs_roundtrip('Bs1', [0,1,0,0,1,0]), bs_roundtrip('Bs1', [1,0,0,0,0,0,0,0,0]), bs_roundtrip('Bs1', [0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]), - - case Rules of - ber -> + + + case {Rules,Opts} of + {ber,[]} -> bs_decode('Bs1', <<35,8,3,2,0,73,3,2,4,32>>, [0,1,0,0,1,0,0,1,0,0,1,0]), bs_decode('Bs1', <<35,9,3,2,0,234,3,3,7,156,0>>, @@ -100,7 +101,17 @@ bit_string(Rules) -> bs_decode('Bs1', <<35,128,3,2,0,234,3,3,7,156,0,0,0>>, [1,1,1,0,1,0,1,0,1,0,0,1,1,1,0,0,0]); _ -> - ok + %% DER, PER, UPER + consistent_def_enc('BsDef1', + [2#111101, + [1,0,1,1,1,1], + {2,<<2#101111:6,0:2>>}, + <<2#101111:6>>]), + consistent_def_enc('BsDef2', + [[1,1,0,1, 1,1,1,0, 1,0,1,0, 1,1,0,1, + 1,0,1,1, 1,1,1,0, 1,1,1,0, 1,1,1,1], + {0,<<16#DEADBEEF:4/unit:8>>}, + <<16#DEADBEEF:4/unit:8>>]) end, @@ -217,6 +228,24 @@ bit_string(Rules) -> _ -> per_bs_strings() end. +consistent_def_enc(Type, Vs) -> + M = 'PrimStrings', + {ok,Enc} = M:encode(Type, {Type,asn1_DEFAULT}), + {ok,Val} = M:decode(Type, Enc), + + %% Ensure that the value has the correct format. + case {M:bit_string_format(),Val} of + {bitstring,{_,Bs}} when is_bitstring(Bs) -> ok; + {compact,{_,{Unused,Bin}}} when is_integer(Unused), + is_binary(Bin) -> ok; + {legacy,{_,Bs}} when is_list(Bs) -> ok + end, + + %% All values should be recognized and encoded as the + %% the default value (i.e. not encoded at all). + _ = [{ok,Enc} = M:encode(Type, {Type,V}) || V <- Vs], + ok. + %% The PER encoding rules requires that a BIT STRING with %% named positions should never have any trailing zeroes %% (except to reach the minimum number of bits as given by diff --git a/lib/asn1/test/testSeqSetDefaultVal.erl b/lib/asn1/test/testSeqSetDefaultVal.erl index fb61bf1647..044099199f 100644 --- a/lib/asn1/test/testSeqSetDefaultVal.erl +++ b/lib/asn1/test/testSeqSetDefaultVal.erl @@ -18,7 +18,7 @@ %% %% -module(testSeqSetDefaultVal). --export([main/1]). +-export([main/2]). -include("External.hrl"). -include_lib("test_server/include/test_server.hrl"). @@ -34,7 +34,8 @@ -record('SeqBS',{a = asn1_DEFAULT, b = asn1_DEFAULT, c = asn1_DEFAULT, - d = asn1_DEFAULT}). + d = asn1_DEFAULT, + e = asn1_DEFAULT}). -record('SetBS',{a = asn1_DEFAULT, b = asn1_DEFAULT, c = asn1_DEFAULT, @@ -93,7 +94,119 @@ -record('S4_b',{ba = asn1_DEFAULT, bb = asn1_DEFAULT}). -main(_Rules) -> +main(ber, []) -> + %% Nothing to test because plain BER will only use + %% default values when explicitly told to do so by + %% asn1_DEFAULT. + ok; +main(Rule, Opts) -> + %% DER, PER, UPER. These encodings should not encode + %% values that are equal to the default value. + + case {Rule,Opts} of + {ber,[der]} -> + der(); + {_,_} -> + ok + end, + + Ts = [{#'SeqInts'{}, + [{#'SeqInts'.c, + [asn1_DEFAULT, + three, + 3]}]}, + + {#'SeqBS'{}, + [{#'SeqBS'.a, + [asn1_DEFAULT, + 2#0110101, + [1,0,1,0,1,1,0], + {1,<<16#AC>>}, + <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>]}, + {#'SeqBS'.b, + [asn1_DEFAULT, + 2#10100010101, + [1,0,1,0,1,0,0,0,1,0,1,0], + {4,<<16#A8,16#A0>>}, + <<16#A8:8,16#A:4>>]}, + {#'SeqBS'.c, + [asn1_DEFAULT, + [second], + [0,1], + {6,<<0:1,1:1,0:6>>}, + <<1:2>>]}, + {#'SeqBS'.c, %Zeroes on the right + [asn1_DEFAULT, + [second], + [0,1,0,0,0], + {4,<<0:1,1:1,0:6>>}, + <<1:2,0:17>>]}, + {#'SeqBS'.d, + [asn1_DEFAULT, + 2#1001, + [1,0,0,1], + {4,<<2#1001:4,0:4>>}, + <<2#1001:4>>]}, + {#'SeqBS'.e, + [asn1_DEFAULT, + [0,1,0,1,1,0,1,0], + {0,<<2#01011010:8>>}, + <<2#01011010:8>>]}, + %% Not EQUAL to DEFAULT. + {#'SeqBS'.b, + [[1,1,0], %Not equal to DEFAULT + {5,<<6:3,0:5>>}, + <<6:3>>]} + ]}, + + {#'SeqOS'{}, + [{#'SeqOS'.a, + [asn1_DEFAULT, + [172]]}]}, + + {#'SeqOI'{}, + [{#'SeqOI'.a, + [asn1_DEFAULT, + {1,2,14,15}]}, + {#'SeqOI'.b, + [asn1_DEFAULT, +%% {iso,'member-body',250,3,4}, + {1,2,250,3,4}]}, + {#'SeqOI'.c, + [asn1_DEFAULT, +%% {iso,standard,8571,2,250,4}, + {1,0,8571,2,250,4}]}]} + ], + io:format("~p\n", [Ts]), + R0 = [[consistency(Rec, Pos, Vs) || {Pos,Vs} <- Fs] || {Rec,Fs} <- Ts], + case lists:flatten(R0) of + [] -> + ok; + [_|_]=R -> + io:format("~p\n", [R]), + ?t:fail() + end. + +consistency(Rec0, Pos, [V|Vs]) -> + T = element(1, Rec0), + Rec = setelement(Pos, Rec0, V), + {ok,Enc} = 'Default':encode(T, Rec), + {ok,_SmokeTest} = 'Default':decode(T, Enc), + consistency_1(Vs, Rec0, Pos, Enc). + +consistency_1([V|Vs], Rec0, Pos, Enc) -> + Rec = setelement(Pos, Rec0, V), + case 'Default':encode(element(1, Rec), Rec) of + {ok,Enc} -> + consistency_1(Vs, Rec0, Pos, Enc); + {ok,WrongEnc} -> + [{Rec,{wrong,WrongEnc},{should_be,Enc}}| + consistency_1(Vs, Rec0, Pos, Enc)] + end; +consistency_1([], _, _, _) -> []. + +der() -> + io:put_chars("Peforming DER-specific tests..."), roundtrip(<<48,0>>, 'SeqInts', #'SeqInts'{a=asn1_DEFAULT,b=asn1_DEFAULT, @@ -117,50 +230,88 @@ main(_Rules) -> roundtrip(<<48,0>>, 'SeqBS', - #'SeqBS'{a=2#1010110,b=16#A8A,c=[second],d=[1,0,0,1]}, - #'SeqBS'{a=[1,0,1,0,1,1,0],b=16#A8A,c=[second],d=[1,0,0,1]}), + #'SeqBS'{a=2#0110101, + b=2#010100010101, + c=[second], + d=[1,0,0,1]}, + #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<2#1001:4>>, + e = <<2#01011010:8>>}), roundtrip(<<48,0>>, 'SeqBS', #'SeqBS'{a=[1,0,1,0,1,1,0], b=[1,0,1,0,1,0,0,0,1,0,1,0], c={5,<<64>>}, d=2#1001}, - #'SeqBS'{a=[1,0,1,0,1,1,0],b=16#A8A,c=[second],d=[1,0,0,1]}), + #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<2#1001:4>>, + e = <<2#01011010:8>>}), roundtrip(<<48,3,131,1,0>>, 'SeqBS', #'SeqBS'{a=[1,0,1,0,1,1,0], b=[1,0,1,0,1,0,0,0,1,0,1,0], c={5,<<64>>}, d=0}, - #'SeqBS'{a=[1,0,1,0,1,1,0], - b=16#A8A, - c=[second], - d = <<>>}), + #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<>>, + e = <<2#01011010:8>>}), + roundtrip(<<48,3,131,1,0>>, + 'SeqBS', + #'SeqBS'{a = <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>, + b = <<1:1,0:1,1:1,0:1,1:1,0:1,0:1,0:1,1:1,0:1,1:1,0:1>>, + c = <<2:3>>, + d=0, + e = <<16#5A:8>>}, + #'SeqBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<>>, + e = <<2#01011010:8>>}), + + %% None of the default values are used. + roundtrip(<<48,19,128,2,7,128,129,2,5,64,130,2,5,32,131,1,0,132,2,5,224>>, + 'SeqBS', + #'SeqBS'{a = <<1:1>>, + b = {5,<<64>>}, + c = [third], + d = 0, + e = <<7:3>>}, + #'SeqBS'{a = <<1:1>>, + b = <<2:3>>, + c = [third], + d = <<>>, + e = <<7:3>>}), roundtrip(<<49,0>>, 'SetBS', - #'SetBS'{a=2#1010110,b=16#A8A,c=[second],d=[1,0,0,1]}, - #'SetBS'{a=[1,0,1,0,1,1,0],b=16#A8A,c=[second],d=[1,0,0,1]}), + #'SetBS'{a=2#0110101, + b=2#010100010101, + c=[second], + d=[1,0,0,1]}, + #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<2#1001:4>>}), roundtrip(<<49,0>>, 'SetBS', #'SetBS'{a=[1,0,1,0,1,1,0], b=[1,0,1,0,1,0,0,0,1,0,1,0], c={5,<<64>>}, d=9}, - #'SetBS'{a=[1,0,1,0,1,1,0], - b=16#A8A, - c=[second], - d=[1,0,0,1]}), + #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<2#1001:4>>}), roundtrip(<<49,3,131,1,0>>, 'SetBS', #'SetBS'{a=[1,0,1,0,1,1,0], b=[1,0,1,0,1,0,0,0,1,0,1,0], c={5,<<64>>}, d=0}, - #'SetBS'{a=[1,0,1,0,1,1,0], - b=16#A8A, - c=[second], - d = <<>>}), + #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<>>}), + roundtrip(<<49,3,131,1,0>>, + 'SetBS', + #'SetBS'{a = <<1:1,0:1,1:1,0:1,1:1,1:1,0:1>>, + b = <<1:1,0:1,1:1,0:1,1:1,0:1,0:1,0:1,1:1,0:1,1:1,0:1>>, + c = <<2:3>>, + d=0}, + #'SetBS'{a = <<2#1010110:7>>, b = <<16#A8A:12>>, + c=[second], d = <<>>}), roundtrip(<<48,0>>, 'SeqOS', #'SeqOS'{a=[172],b=[16#A8,16#A0],c='NULL'}), diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index f5e769e1ba..8fed341600 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -34,7 +34,7 @@ %% Event handler Callbacks -export([init/1, handle_event/2, handle_call/2, handle_info/2, - terminate/2, code_change/3]). + terminate/1, terminate/2, code_change/3]). %% Other -export([handle_remote_events/1]). @@ -186,10 +186,13 @@ handle_call({handle_remote_events,Bool}, State) -> handle_call(_Query, _State) -> {error, bad_query}. -terminate(_Arg, _State) -> +terminate(_) -> error_logger:delete_report_handler(?MODULE), []. +terminate(_Arg, _State) -> + ok. + tag_event(Event) -> {calendar:local_time(), Event}. diff --git a/lib/common_test/test/common_test.cover b/lib/common_test/test/common_test.cover index 3aa49623e7..87d00c420f 100644 --- a/lib/common_test/test/common_test.cover +++ b/lib/common_test/test/common_test.cover @@ -4,7 +4,6 @@ test_server, test_server_ctrl, test_server_gl, - test_server_h, test_server_io, test_server_node, test_server_sup]}]}. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 70279ab658..48f5135aca 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -530,7 +530,7 @@ valfun_2(I, #vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) -> %% Update branched state valfun_3(I, branch_state(Fail, Vst)); valfun_2(_, _) -> - error(ambigous_catch_try_state). + error(ambiguous_catch_try_state). %% Handle the remaining floating point instructions here. %% Floating point. diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index 32082e565d..cf87a13225 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -42,6 +42,36 @@ first.</p> <!-- ===================================================================== --> +<section><title>diameter 1.4.4</title> + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + Fix setting of End-to-End and Hop-by-Hop Identifiers in + outgoing DWA.</p> + <p> + Broken by OTP-11184, which caused the identifiers to be + set anew, discarding the values from the incoming DWR.</p> + <p> + Own Id: OTP-11367</p> + </item> + <item> + <p> + Fix handling of 5014, DIAMETER_INVALID_AVP_LENGTH.</p> + <p> + The error was detected as 5004, + DIAMETER_INVALID_AVP_VALUE, for some Diameter types, in + which case an AVP length that pointed past the end of a + message resulted in encode failure.</p> + <p> + Own Id: OTP-11395</p> + </item> + </list> + </section> + +</section> + <section><title>diameter 1.4.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index 1d647b8c87..0de4d53973 100644 --- a/lib/diameter/src/base/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -477,8 +477,11 @@ split_head(<<Code:32, 1:1, M:1, P:1, _:5, Len:24, V:32, _/bitstring>>) -> split_head(<<Code:32, 0:1, M:1, P:1, _:5, Len:24, _/bitstring>>) -> {Code, undefined, M, P, Len, 8}; -split_head(Bin) -> - ?THROW({5014, #diameter_avp{data = Bin}}). +%% Header is truncated: pack_avp/1 will pad to the minimum header +%% length. +split_head(B) + when is_bitstring(B) -> + ?THROW({5014, #diameter_avp{data = B}}). %% 3588: %% @@ -523,9 +526,8 @@ split_data(_, _, _) -> %% split_data/4 split_data(Bin, HdrLen, Len, Pad) -> - <<_:HdrLen/binary, T/bitstring>> = Bin, - case T of - <<Data:Len/binary, _:Pad/binary, Rest/bitstring>> -> + case Bin of + <<_:HdrLen/binary, Data:Len/binary, _:Pad/binary, Rest/bitstring>> -> {Data, Rest}; _ -> invalid_avp_length() @@ -573,15 +575,15 @@ pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) -> {Name, Type} = Dict:avp_name(Code, Vid), pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}}); -pack_avp(#diameter_avp{code = undefined, data = Bin}) - when is_binary(Bin) -> +pack_avp(#diameter_avp{code = undefined, data = B}) + when is_bitstring(B) -> %% Reset the AVP Length of an AVP Header resulting from a 5014 %% error. The RFC doesn't explicitly say to do this but the %% receiver can't correctly extract this and following AVP's %% without a correct length. On the downside, the header doesn't %% reveal if the received header has been padded. - Pad = 8*header_length(Bin) - bit_size(Bin), - Len = size(<<H:5/binary, _:24, T/binary>> = <<Bin/bitstring, 0:Pad>>), + Pad = 8*header_length(B) - bit_size(B), + Len = size(<<H:5/binary, _:24, T/binary>> = <<B/bitstring, 0:Pad>>), <<H/binary, Len:24, T/binary>>; %% ... or as an iolist. diff --git a/lib/diameter/src/base/diameter_types.erl b/lib/diameter/src/base/diameter_types.erl index 8c07e84777..ca3338be5f 100644 --- a/lib/diameter/src/base/diameter_types.erl +++ b/lib/diameter/src/base/diameter_types.erl @@ -92,6 +92,9 @@ when is_binary(Bin) -> binary_to_list(Bin); +'OctetString'(decode, B) -> + ?INVALID_LENGTH(B); + 'OctetString'(encode = M, zero) -> 'OctetString'(M, []); @@ -255,9 +258,7 @@ 2 == A, 16 == size(B) -> list_to_tuple([N || <<N:A/unit:8>> <= B]); -'Address'(decode, <<A:16, _/binary>> = B) - when 1 == A; - 2 == A -> +'Address'(decode, B) -> ?INVALID_LENGTH(B); 'Address'(encode, T) -> @@ -278,7 +279,10 @@ <<_,_/binary>> = 'OctetString'(M, X); 'DiameterIdentity'(decode = M, <<_,_/binary>> = X) -> - 'OctetString'(M, X). + 'OctetString'(M, X); + +'DiameterIdentity'(decode, X) -> + ?INVALID_LENGTH(X). %% -------------------- @@ -286,6 +290,9 @@ when is_binary(Bin) -> scan_uri(Bin); +'DiameterURI'(decode, B) -> + ?INVALID_LENGTH(B); + %% The minimal DiameterURI is "aaa://x", 7 characters. 'DiameterURI'(encode = M, zero) -> 'OctetString'(M, lists:duplicate(0,7)); @@ -330,9 +337,13 @@ %% -------------------- -'UTF8String'(decode, Bin) -> +'UTF8String'(decode, Bin) + when is_binary(Bin) -> tl([0|_] = unicode:characters_to_list([0, Bin])); %% assert list return +'UTF8String'(decode, B) -> + ?INVALID_LENGTH(B); + 'UTF8String'(encode = M, zero) -> 'UTF8String'(M, []); diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index 7e75801718..127a647b89 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -461,15 +461,28 @@ eraser(Key) -> %% encode/3 -encode(Msg, Mask, Dict) -> +encode(dwr = M, Dict0, Mask) -> + Msg = getr(M), Seq = diameter_session:sequence(Mask), Hdr = #diameter_header{version = ?DIAMETER_VERSION, end_to_end_id = Seq, hop_by_hop_id = Seq}, Pkt = #diameter_packet{header = Hdr, msg = Msg}, - #diameter_packet{bin = Bin} = diameter_codec:encode(Dict, Pkt), - Bin. + #diameter_packet{bin = Bin} = diameter_codec:encode(Dict0, Pkt), + Bin; + + +encode(dwa, Dict0, #diameter_packet{header = H, transport_data = TD} + = ReqPkt) -> + AnsPkt = #diameter_packet{header + = H#diameter_header{is_request = false, + is_error = undefined, + is_retransmitted = false}, + msg = dwa(ReqPkt), + transport_data = TD}, + + diameter_codec:encode(Dict0, AnsPkt). %% okay/3 @@ -527,7 +540,7 @@ send_watchdog(#watchdog{pending = false, dictionary = Dict0, sequence = Mask} = S) -> - send(TPid, {send, encode(getr(dwr), Mask, Dict0)}), + send(TPid, {send, encode(dwr, Dict0, Mask)}), ?LOG(send, 'DWR'), S#watchdog{pending = true}. @@ -546,9 +559,8 @@ recv(Name, Pkt, S) -> %% rcv/3 rcv('DWR', Pkt, #watchdog{transport = TPid, - dictionary = Dict0, - sequence = Mask}) -> - send(TPid, {send, encode(dwa(Pkt), Mask, Dict0)}), + dictionary = Dict0}) -> + send(TPid, {send, encode(dwa, Dict0, Pkt)}), ?LOG(send, 'DWA'); rcv(N, _, _) diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index c6828e6705..76fb54e03a 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -35,7 +35,10 @@ {load_module, diameter_config}, {load_module, diameter_service}, {load_module, diameter_peer_fsm}, - {load_module, diameter_watchdog}]} + {load_module, diameter_watchdog}]}, + {"1.4.3", [{load_module, diameter_watchdog}, %% R16B02 + {load_module, diameter_codec}, + {load_module, diameter_types}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -49,6 +52,9 @@ {"1.4", [{restart_application, diameter}]}, {"1.4.1", [{restart_application, diameter}]}, {"1.4.1.1", [{restart_application, diameter}]}, - {"1.4.2", [{restart_application, diameter}]} + {"1.4.2", [{restart_application, diameter}]}, + {"1.4.3", [{load_module, diameter_types}, + {load_module, diameter_codec}, + {load_module, diameter_watchdog}]} ] }. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index e003fe76b9..023c5307b2 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -18,5 +18,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.4.3 +DIAMETER_VSN = 1.4.4 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index 30767abd7e..5b81716543 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -35,6 +35,7 @@ <p>References:</p> <list type="bulleted"> <item> <p>RFC 4510 - RFC 4519</p> </item> + <item> <p>RFC 2830</p> </item> </list> <p>The above publications can be found at <url href="http://www.ietf.org">IETF</url>. </p> @@ -87,6 +88,38 @@ filter() See present/1, substrings/2, </desc> </func> <func> + <name>start_tls(Handle, Options) -> ok | {error,Error}</name> + <fsummary>Upgrade a connection to TLS.</fsummary> + <desc> + <p>Same as start_tls(Handle, Options, infinity)</p> + </desc> + </func> + <func> + <name>start_tls(Handle, Options, Timeout) -> ok | {error,Error}</name> + <fsummary>Upgrade a connection to TLS.</fsummary> + <type> + <v>Handle = handle()</v> + <v>Options = ssl:ssl_options()</v> + <v>Timeout = inifinity | positive_integer()</v> + </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> + <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> + <taglist> + <tag><c>Error</c></tag> + <item>Any error responded from ssl:connect/3</item> + </taglist> + </desc> + </func> + <func> <name>simple_bind(Handle, Dn, Password) -> ok | {error, Reason}</name> <fsummary>Authenticate the connection.</fsummary> <type> diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 8ebb88e35b..af5bf94c97 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -6,10 +6,12 @@ %%% draft-ietf-asid-ldap-c-api-00.txt %%% %%% Copyright (c) 2010 Torbjorn Tornkvist +%%% Copyright Ericsson AB 2011-2013. All Rights Reserved. %%% See MIT-LICENSE at the top dir for licensing information. %%% -------------------------------------------------------------------- -vc('$Id$ '). -export([open/1,open/2,simple_bind/3,controlling_process/2, + start_tls/2, start_tls/3, baseObject/0,singleLevel/0,wholeSubtree/0,close/1, equalityMatch/2,greaterOrEqual/2,lessOrEqual/2, approxMatch/2,search/2,substrings/2,present/1, @@ -36,14 +38,16 @@ host, % Host running LDAP server port = ?LDAP_PORT, % The LDAP server port fd, % Socket filedescriptor. + prev_fd, % Socket that was upgraded by start_tls binddn = "", % Name of the entry to bind as passwd, % Password for (above) entry id = 0, % LDAP Request ID log, % User provided log function timeout = infinity, % Request timeout anon_auth = false, % Allow anonymous authentication - use_tls = false, % LDAP/LDAPS - tls_opts = [] % ssl:ssloption() + ldaps = false, % LDAP/LDAPS + using_tls = false, % true if LDAPS or START_TLS executed + tls_opts = [] % ssl:ssloption() }). %%% For debug purposes @@ -77,6 +81,16 @@ open(Hosts, Opts) when is_list(Hosts), is_list(Opts) -> recv(Pid). %%% -------------------------------------------------------------------- +%%% Upgrade an existing connection to tls +%%% -------------------------------------------------------------------- +start_tls(Handle, TlsOptions) -> + start_tls(Handle, TlsOptions, infinity). + +start_tls(Handle, TlsOptions, Timeout) -> + send(Handle, {start_tls,TlsOptions,Timeout}), + recv(Handle). + +%%% -------------------------------------------------------------------- %%% Shutdown connection (and process) asynchronous. %%% -------------------------------------------------------------------- @@ -351,11 +365,11 @@ parse_args([{anon_auth, true}|T], Cpid, Data) -> parse_args([{anon_auth, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([{ssl, true}|T], Cpid, Data) -> - parse_args(T, Cpid, Data#eldap{use_tls = true}); + parse_args(T, Cpid, Data#eldap{ldaps = true, using_tls=true}); parse_args([{ssl, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([{sslopts, Opts}|T], Cpid, Data) when is_list(Opts) -> - parse_args(T, Cpid, Data#eldap{use_tls = true, tls_opts = Opts ++ Data#eldap.tls_opts}); + parse_args(T, Cpid, Data#eldap{ldaps = true, using_tls=true, tls_opts = Opts ++ Data#eldap.tls_opts}); parse_args([{sslopts, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([{log, F}|T], Cpid, Data) when is_function(F) -> @@ -386,10 +400,10 @@ try_connect([Host|Hosts], Data) -> try_connect([],_) -> {error,"connect failed"}. -do_connect(Host, Data, Opts) when Data#eldap.use_tls == false -> +do_connect(Host, Data, Opts) when Data#eldap.ldaps == false -> gen_tcp:connect(Host, Data#eldap.port, Opts, Data#eldap.timeout); -do_connect(Host, Data, Opts) when Data#eldap.use_tls == true -> - ssl:connect(Host, Data#eldap.port, Opts ++ Data#eldap.tls_opts). +do_connect(Host, Data, Opts) when Data#eldap.ldaps == true -> + ssl:connect(Host, Data#eldap.port, Opts++Data#eldap.tls_opts). loop(Cpid, Data) -> receive @@ -430,6 +444,11 @@ loop(Cpid, Data) -> ?PRINT("New Cpid is: ~p~n",[NewCpid]), ?MODULE:loop(NewCpid, Data); + {From, {start_tls,TlsOptions,Timeout}} -> + {Res,NewData} = do_start_tls(Data, TlsOptions, Timeout), + send(From,Res), + ?MODULE:loop(Cpid, NewData); + {_From, close} -> unlink(Cpid), exit(closed); @@ -444,6 +463,51 @@ loop(Cpid, Data) -> end. + +%%% -------------------------------------------------------------------- +%%% startTLS Request +%%% -------------------------------------------------------------------- + +do_start_tls(Data=#eldap{using_tls=true}, _, _) -> + {{error,tls_already_started}, Data}; +do_start_tls(Data=#eldap{fd=FD} , TlsOptions, Timeout) -> + case catch exec_start_tls(Data) of + {ok,NewData} -> + case ssl:connect(FD,TlsOptions,Timeout) of + {ok, SslSocket} -> + {ok, NewData#eldap{prev_fd = FD, + fd = SslSocket, + using_tls = true + }}; + {error,Error} -> + {{error,Error}, Data} + end; + {error,Error} -> {{error,Error},Data}; + Else -> {{error,Else},Data} + end. + +-define(START_TLS_OID, "1.3.6.1.4.1.1466.20037"). + +exec_start_tls(Data) -> + Req = #'ExtendedRequest'{requestName = ?START_TLS_OID}, + Reply = request(Data#eldap.fd, Data, Data#eldap.id, {extendedReq, Req}), + exec_extended_req_reply(Data, Reply). + +exec_extended_req_reply(Data, {ok,Msg}) when + Msg#'LDAPMessage'.messageID == Data#eldap.id -> + case Msg#'LDAPMessage'.protocolOp of + {extendedResp, Result} -> + case Result#'ExtendedResponse'.resultCode of + success -> + {ok,Data}; + Error -> + {error, {response,Error}} + end; + Other -> {error, Other} + end; +exec_extended_req_reply(_, Error) -> + {error, Error}. + %%% -------------------------------------------------------------------- %%% bindRequest %%% -------------------------------------------------------------------- @@ -685,14 +749,14 @@ send_request(S, Data, ID, Request) -> Else -> Else end. -do_send(S, Data, Bytes) when Data#eldap.use_tls == false -> +do_send(S, Data, Bytes) when Data#eldap.using_tls == false -> gen_tcp:send(S, Bytes); -do_send(S, Data, Bytes) when Data#eldap.use_tls == true -> +do_send(S, Data, Bytes) when Data#eldap.using_tls == true -> ssl:send(S, Bytes). -do_recv(S, #eldap{use_tls=false, timeout=Timeout}, Len) -> +do_recv(S, #eldap{using_tls=false, timeout=Timeout}, Len) -> gen_tcp:recv(S, Len, Timeout); -do_recv(S, #eldap{use_tls=true, timeout=Timeout}, Len) -> +do_recv(S, #eldap{using_tls=true, timeout=Timeout}, Len) -> ssl:recv(S, Len, Timeout). recv_response(S, Data) -> @@ -800,7 +864,7 @@ recv(From) -> {error, {internal_error, Reason}} end. -ldap_closed_p(Data, Emsg) when Data#eldap.use_tls == true -> +ldap_closed_p(Data, Emsg) when Data#eldap.using_tls == true -> %% Check if the SSL socket seems to be alive or not case catch ssl:sockname(Data#eldap.fd) of {error, _} -> diff --git a/lib/eldap/test/README b/lib/eldap/test/README new file mode 100644 index 0000000000..8774db1504 --- /dev/null +++ b/lib/eldap/test/README @@ -0,0 +1,36 @@ + +This works for me on Ubuntu. + +To run thoose test you need + 1) some certificates + 2) a running ldap server, for example OpenLDAPs slapd. See http://www.openldap.org/doc/admin24 + +1)------- +To generate certificates: +erl +> make_certs:all("/dev/null", "eldap_basic_SUITE_data/certs"). + +2)------- +To start slapd: + sudo slapd -f $ERL_TOP/lib/eldap/test/ldap_server/slapd.conf -F /tmp/slapd/slapd.d -h "ldap://localhost:9876 ldaps://localhost:9877" + +This will however not work, since slapd is guarded by apparmor that checks that slapd does not access other than allowed files... + +To make a local extension of alowed operations: + sudo emacs /etc/apparmor.d/local/usr.sbin.slapd + +and, after the change (yes, at least on Ubuntu it is right to edit ../local/.. but run with an other file) : + + sudo apparmor_parser -r /etc/apparmor.d/usr.sbin.slapd + + +The local file looks like this for me: + +# Site-specific additions and overrides for usr.sbin.slapd. +# For more details, please see /etc/apparmor.d/local/README. + +/etc/pkcs11/** r, +/usr/lib/x86_64-linux-gnu/** rm, + +/ldisk/hans_otp/otp/lib/eldap/test/** rw, +/tmp/slapd/** rwk, diff --git a/lib/eldap/test/eldap.cfg b/lib/eldap/test/eldap.cfg new file mode 100644 index 0000000000..3a24afa067 --- /dev/null +++ b/lib/eldap/test/eldap.cfg @@ -0,0 +1 @@ +{eldap_server,{"localhost",389}}. diff --git a/lib/eldap/test/eldap_basic_SUITE.erl b/lib/eldap/test/eldap_basic_SUITE.erl index c7e3052b29..127d753b92 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. All Rights Reserved. +%% Copyright Ericsson AB 2012-2013. 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 @@ -27,39 +27,36 @@ -define(TIMEOUT, 120000). % 2 min -init_per_suite(Config0) -> - {{EldapHost,Port}, Config1} = - case catch ct:get_config(eldap_server, undefined) of - undefined -> %% Dev test only - Server = {"localhost", 9876}, - {Server, [{eldap_server, {"localhost", 9876}}|Config0]}; - {'EXIT', _} -> %% Dev test only - Server = {"localhost", 9876}, - {Server, [{eldap_server, {"localhost", 9876}}|Config0]}; - Server -> - {Server, [{eldap_server, Server}|Config0]} - end, - %% Add path for this test run +init_per_suite(Config) -> + ssl:start(), + chk_config(ldap_server, {"localhost",9876}, + chk_config(ldaps_server, {"localhost",9877}, + 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, 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", - Config = [{eldap_path,Path}|Config1], 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"]}]), - Config + [{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", [EldapHost]))} + {skip, lists:flatten(io_lib:format("Ldap init failed with host ~p:~p. Error=~p", [EldapHost,Port,Error]))} end. -end_per_suite(Config) -> - %% Cleanup everything - {EHost, Port} = proplists:get_value(eldap_server, Config), + +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"), @@ -71,16 +68,20 @@ end_per_suite(Config) -> [ok = eldap:delete(H, Entry) || {eldap_entry, Entry, _} <- Entries]; _ -> ignore end, - ok. -init_per_testcase(_TestCase, Config) -> Config. -end_per_testcase(_TestCase, _Config) -> ok. + ok. %% suite() -> all() -> [app, - api]. + 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) -> []; @@ -90,21 +91,89 @@ app(Config) when is_list(Config) -> api(doc) -> "Basic test that all api functions works as expected"; api(suite) -> []; api(Config) -> - {Host,Port} = proplists:get_value(eldap_server, Config), + {Host,Port} = proplists:get_value(ldap_server, Config), {ok, H} = eldap:open([Host], [{port,Port}]), %% {ok, H} = eldap:open([Host], [{port,Port+1}, {ssl, true}]), + do_api_checks(H, Config), + eldap:close(H), + ok. + + +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. + + +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). + + +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), + 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, []), + {error,tls_already_started} = eldap:start_tls(H, []), + do_api_checks(H, Config), + eldap:close(H). + + +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] + end. + + + +do_api_checks(H, Config) -> BasePath = proplists:get_value(eldap_path, Config), + All = fun(Where) -> eldap:search(H, #eldap_search{base=Where, filter=eldap:present("objectclass"), scope= eldap:wholeSubtree()}) end, - Search = fun(Filter) -> - eldap:search(H, #eldap_search{base=BasePath, - filter=Filter, - scope=eldap:singleLevel()}) - end, - {ok, #eldap_search_result{entries=[_]}} = All(BasePath), + {ok, #eldap_search_result{entries=[_XYZ]}} = All(BasePath), +%% ct:log("XYZ=~p",[_XYZ]), {error, noSuchObject} = All("cn=Bar,"++BasePath), {error, _} = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, @@ -112,52 +181,67 @@ api(Config) -> {"cn", ["Jonas Jonsson"]}, {"sn", ["Jonsson"]}]), eldap:simple_bind(H, "cn=Manager,dc=ericsson,dc=se", "hejsan"), - %% Add + chk_add(H, BasePath), + {ok,FB} = chk_search(H, BasePath), + chk_modify(H, FB), + chk_delete(H, BasePath), + chk_modify_dn(H, FB). + + +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"]}]), + {"ou", ["Team"]}]). - %% Search +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,FB}. %% FIXME - %% MODIFY +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", [])]), + ok = eldap:modify(H, FB, [eldap:mod_delete("telephoneNumber", [])]). - %% DELETE + +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), + {error, noSuchObject} = eldap:delete(H, "cn=Jonas Jonsson," ++ BasePath). - %% MODIFY_DN - ok = eldap:modify_dn(H, FB, "cn=Niclas Andre", true, ""), - %%io:format("Res ~p~n ~p~n",[R, All(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)]). - eldap:close(H), - ok. +%%%---------------- add(H, Attr, Value, Path0, Attrs, Class) -> Path = case Path0 of [] -> Attr ++ "=" ++ Value; diff --git a/lib/eldap/test/eldap_basic_SUITE_data/certs/README b/lib/eldap/test/eldap_basic_SUITE_data/certs/README new file mode 100644 index 0000000000..a7c8e9dc2e --- /dev/null +++ b/lib/eldap/test/eldap_basic_SUITE_data/certs/README @@ -0,0 +1 @@ +See ../../README diff --git a/lib/eldap/test/ldap_server/slapd.conf b/lib/eldap/test/ldap_server/slapd.conf index 87be676d9f..eca298c866 100644 --- a/lib/eldap/test/ldap_server/slapd.conf +++ b/lib/eldap/test/ldap_server/slapd.conf @@ -1,14 +1,32 @@ -include /etc/ldap/schema/core.schema -pidfile /tmp/openldap-data/slapd.pid -argsfile /tmp/openldap-data/slapd.args +modulepath /usr/lib/ldap +moduleload back_bdb.la + +# example config file - global configuration section +include /etc/ldap/schema/core.schema +referral ldap://root.openldap.org +access to * by * read + +TLSCACertificateFile /ldisk/hans_otp/otp/lib/eldap/test/eldap_basic_SUITE_data/certs/server/cacerts.pem +TLSCertificateFile /ldisk/hans_otp/otp/lib/eldap/test/eldap_basic_SUITE_data/certs/server/cert.pem +TLSCertificateKeyFile /ldisk/hans_otp/otp/lib/eldap/test/eldap_basic_SUITE_data/certs/server/keycert.pem + database bdb suffix "dc=ericsson,dc=se" rootdn "cn=Manager,dc=ericsson,dc=se" rootpw hejsan + # The database must exist before running slapd -directory /tmp/openldap-data +directory /tmp/slapd/openldap-data-ericsson.se + # Indices to maintain index objectClass eq -# URI "ldap://0.0.0.0:9876 ldaps://0.0.0.0:9870" -# servers/slapd/slapd -d 255 -h "ldap://0.0.0.0:9876 ldaps://0.0.0.0:9870" -f /ldisk/dgud/src/otp/lib/eldap/test/ldap_server/slapd.conf
\ No newline at end of file +access to attrs=userPassword + by self write + by anonymous auth + by dn.base="cn=Manager,dc=ericsson,dc=se" write + by * none +access to * + by self write + by dn.base="cn=Manager,dc=ericsson,dc=se" write + by * read diff --git a/lib/eldap/test/make_certs.erl b/lib/eldap/test/make_certs.erl new file mode 100644 index 0000000000..f963af180d --- /dev/null +++ b/lib/eldap/test/make_certs.erl @@ -0,0 +1,313 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2013. 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). + +-export([all/2]). + +-record(dn, {commonName, + organizationalUnitName = "Erlang OTP", + organizationName = "Ericsson AB", + localityName = "Stockholm", + countryName = "SE", + emailAddress = "[email protected]"}). + +all(DataDir, PrivDir) -> + OpenSSLCmd = "openssl", + 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 + SDir = filename:join([PrivDir, "server"]), + SC = filename:join([SDir, "cert.pem"]), + SK = filename:join([SDir, "key.pem"]), + SKC = filename:join([SDir, "keycert.pem"]), + append_files([SK, SC], SKC), + CDir = filename:join([PrivDir, "client"]), + CC = filename:join([CDir, "cert.pem"]), + CK = filename:join([CDir, "key.pem"]), + CKC = filename:join([CDir, "keycert.pem"]), + append_files([CK, CC], CKC), + remove_rnd(PrivDir). + +append_files(FileNames, ResultFileName) -> + {ok, ResultFile} = file:open(ResultFileName, [write]), + do_append_files(FileNames, ResultFile). + +do_append_files([], RF) -> + ok = file:close(RF); +do_append_files([F|Fs], RF) -> + {ok, Data} = file:read_file(F), + 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. + +intermediateCA(Root, OpenSSLCmd, CA, ParentCA) -> + CA = "otpCA", + create_ca_dir(Root, CA, ca_cnf(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), + 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) -> + 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), + CertFileAllUsage = filename:join([UsrRoot, "cert.pem"]), + sign_req(Root, OpenSSLCmd, CA, "user_cert", ReqFile, CertFileAllUsage), + 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). + +create_self_signed_cert(Root, OpenSSLCmd, CAName, Cnf) -> + 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" + " -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). + +create_ca_dir(Root, CAName, Cnf) -> + CARoot = filename:join([Root, CAName]), + file:make_dir(CARoot), + create_dirs(CARoot, ["certs", "crl", "newcerts", "private"]), + create_rnd(Root, filename:join([CAName, "private"])), + create_files(CARoot, [{"serial", "01\n"}, + {"index.txt", ""}, + {"ca.cnf", Cnf}]). + +create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile) -> + Cmd = [OpenSSLCmd, " req" + " -new" + " -config ", CnfFile, + " -keyout ", KeyFile, + " -out ", ReqFile], + Env = [{"ROOTDIR", Root}], + cmd(Cmd, Env), + fix_key_file(OpenSSLCmd, KeyFile). + +sign_req(Root, OpenSSLCmd, CA, CertType, ReqFile, CertFile) -> + CACnfFile = filename:join([Root, CA, "ca.cnf"]), + Cmd = [OpenSSLCmd, " ca" + " -batch" + " -notext" + " -config ", CACnfFile, + " -extensions ", CertType, + " -in ", ReqFile, + " -out ", CertFile], + Env = [{"ROOTDIR", Root}], + cmd(Cmd, Env). + +%% +%% Misc +%% + +create_dirs(Root, Dirs) -> + lists:foreach(fun(Dir) -> + file:make_dir(filename:join([Root, Dir])) end, + Dirs). + +create_files(Root, NameContents) -> + lists:foreach( + fun({Name, Contents}) -> + file:write_file(filename:join([Root, Name]), Contents) end, + NameContents). + +create_rnd(FromDir, ToDir) -> + From = filename:join([FromDir, "RAND"]), + To = filename:join([ToDir, "RAND"]), + file:copy(From, To). + +remove_rnd(Dir) -> + File = filename:join([Dir, "RAND"]), + file:delete(File). + +cmd(Cmd, Env) -> + FCmd = lists:flatten(Cmd), + Port = open_port({spawn, FCmd}, [stream, eof, exit_status, stderr_to_stdout, + {env, Env}]), + eval_cmd(Port). + +eval_cmd(Port) -> + receive + {Port, {data, _}} -> + eval_cmd(Port); + {Port, eof} -> + ok + end, + receive + {Port, {exit_status, Status}} when Status /= 0 -> + %% io:fwrite("exit status: ~w~n", [Status]), + exit({eval_cmd, Status}) + after 0 -> + ok + end. + +%% +%% Contents of configuration files +%% + +req_cnf(DN) -> + ["# Purpose: Configuration for requests (end users and CAs)." + "\n" + "ROOTDIR = $ENV::ROOTDIR\n" + "\n" + + "[req]\n" + "input_password = secret\n" + "output_password = secret\n" + "default_bits = 1024\n" + "RANDFILE = $ROOTDIR/RAND\n" + "encrypt_key = no\n" + "default_md = sha1\n" + "#string_mask = pkix\n" + "x509_extensions = ca_ext\n" + "prompt = no\n" + "distinguished_name= name\n" + "\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" + "\n" + + "[ca_ext]\n" + "basicConstraints = critical, CA:true\n" + "keyUsage = cRLSign, keyCertSign\n" + "subjectKeyIdentifier = hash\n" + "subjectAltName = email:copy\n"]. + + +ca_cnf(CA) -> + ["# Purpose: Configuration for CAs.\n" + "\n" + "ROOTDIR = $ENV::ROOTDIR\n" + "default_ca = ca\n" + "\n" + + "[ca]\n" + "dir = $ROOTDIR/", CA, "\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" + "private_key = $dir/private/key.pem\n" + "RANDFILE = $dir/private/RAND\n" + "\n" + "x509_extensions = user_cert\n" + "unique_subject = no\n" + "default_days = 3600\n" + "default_md = sha1\n" + "preserve = no\n" + "policy = policy_match\n" + "\n" + + "[policy_match]\n" + "commonName = supplied\n" + "organizationalUnitName = optional\n" + "organizationName = match\n" + "countryName = match\n" + "localityName = match\n" + "emailAddress = supplied\n" + "\n" + + "[user_cert]\n" + "basicConstraints = CA:false\n" + "keyUsage = nonRepudiation, digitalSignature, keyEncipherment\n" + "subjectKeyIdentifier = hash\n" + "authorityKeyIdentifier = keyid,issuer:always\n" + "subjectAltName = email:copy\n" + "issuerAltName = issuer:copy\n" + "\n" + + "[user_cert_digital_signature_only]\n" + "basicConstraints = CA:false\n" + "keyUsage = digitalSignature\n" + "subjectKeyIdentifier = hash\n" + "authorityKeyIdentifier = keyid,issuer:always\n" + "subjectAltName = email:copy\n" + "issuerAltName = issuer:copy\n" + "\n" + + "[ca_cert]\n" + "basicConstraints = critical,CA:true\n" + "keyUsage = cRLSign, keyCertSign\n" + "subjectKeyIdentifier = hash\n" + "authorityKeyIdentifier = keyid:always,issuer:always\n" + "subjectAltName = email:copy\n" + "issuerAltName = issuer:copy\n"]. diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml index 7ea58fffff..33f1c20608 100644 --- a/lib/kernel/doc/src/gen_sctp.xml +++ b/lib/kernel/doc/src/gen_sctp.xml @@ -322,7 +322,7 @@ <p> Branch off an existing association <anno>Assoc</anno> in a socket <anno>Socket</anno> of type <c>seqpacket</c> - (one-to-may style) into + (one-to-many style) into a new socket <anno>NewSocket</anno> of type <c>stream</c> (one-to-one style). </p> diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index 58d84ae924..067e07304d 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.erl @@ -423,7 +423,11 @@ error_string(9) -> error_string(10) -> "Cookie Received While Shutting Down"; error_string(11) -> + "Restart of an Association with New Addresses"; +error_string(12) -> "User Initiated Abort"; +error_string(13) -> + "Protocol Violation"; %% For more info on principal SCTP error codes: phone +44 7981131933 error_string(N) when is_integer(N) -> unknown_error; diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl index 3c1ffd59d3..41a309ff16 100644 --- a/lib/orber/test/multi_ORB_SUITE.erl +++ b/lib/orber/test/multi_ORB_SUITE.erl @@ -75,8 +75,6 @@ close_connections_local_interface_ctx_override_api/1, ssl_1_multi_orber_generation_3_api/1, ssl_2_multi_orber_generation_3_api/1, ssl_reconfigure_generation_3_api/1, - ssl_1_multi_orber_generation_3_api_old/1, ssl_2_multi_orber_generation_3_api_old/1, - ssl_reconfigure_generation_3_api_old/1, close_connections_alt_iiop_addr_api/1, close_connections_multiple_profiles_api/1]). @@ -137,13 +135,10 @@ cases() -> setup_multi_connection_timeout_attempts_api, setup_multi_connection_timeout_random_api, ssl_1_multi_orber_api, - ssl_1_multi_orber_generation_3_api_old, ssl_1_multi_orber_generation_3_api, ssl_2_multi_orber_api, - ssl_2_multi_orber_generation_3_api_old, ssl_2_multi_orber_generation_3_api, ssl_reconfigure_api, - ssl_reconfigure_generation_3_api_old, ssl_reconfigure_generation_3_api]. %%----------------------------------------------------------------- @@ -155,10 +150,7 @@ init_per_testcase(TC,Config) TC =:= ssl_reconfigure_api -> init_ssl(Config); init_per_testcase(TC,Config) - when TC =:= ssl_1_multi_orber_generation_3_api_old; - TC =:= ssl_2_multi_orber_generation_3_api_old; - TC =:= ssl_reconfigure_generation_3_api_old; - TC =:= ssl_1_multi_orber_generation_3_api; + when TC =:= ssl_1_multi_orber_generation_3_api; TC =:= ssl_2_multi_orber_generation_3_api; TC =:= ssl_reconfigure_generation_3_api -> init_ssl_3(Config); @@ -1632,22 +1624,6 @@ ssl_1_multi_orber_api(_Config) -> ssl_suite(ServerOptions, ClientOptions). -ssl_1_multi_orber_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", - "This case set up two secure orbs and test if they can", - "communicate. The case also test to access one of the", - "secure orbs which must raise a NO_PERMISSION exception."]; -ssl_1_multi_orber_generation_3_api_old(suite) -> []; -ssl_1_multi_orber_generation_3_api_old(_Config) -> - - ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, - 1, [{ssl_generation, 3}, - {iiop_ssl_port, 0}]), - ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, - 1, [{ssl_generation, 3}, - {iiop_ssl_port, 0}]), - ssl_suite(ServerOptions, ClientOptions). - - ssl_1_multi_orber_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", "This case set up two secure orbs and test if they can", "communicate. The case also test to access one of the", @@ -1681,22 +1657,6 @@ ssl_2_multi_orber_api(_Config) -> ssl_suite(ServerOptions, ClientOptions). -ssl_2_multi_orber_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", - "This case set up two secure orbs and test if they can", - "communicate. The case also test to access one of the", - "secure orbs which must raise a NO_PERMISSION exception."]; -ssl_2_multi_orber_generation_3_api_old(suite) -> []; -ssl_2_multi_orber_generation_3_api_old(_Config) -> - - ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, - 2, [{ssl_generation, 3}, - {iiop_ssl_port, 0}]), - ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, - 2, [{ssl_generation, 3}, - {iiop_ssl_port, 0}]), - ssl_suite(ServerOptions, ClientOptions). - - ssl_2_multi_orber_generation_3_api(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", "This case set up two secure orbs and test if they can", "communicate. The case also test to access one of the", @@ -1724,11 +1684,6 @@ ssl_reconfigure_api(_Config) -> ssl_reconfigure_old([]). -ssl_reconfigure_generation_3_api_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 2)", - "This case set up two secure orbs and test if they can", - "communicate. The case also test to access one of the", - "secure orbs which must raise a NO_PERMISSION exception."]; -ssl_reconfigure_generation_3_api_old(suite) -> []; ssl_reconfigure_generation_3_api_old(_Config) -> ssl_reconfigure_old([{ssl_generation, 3}]). diff --git a/lib/orber/test/orber_nat_SUITE.erl b/lib/orber/test/orber_nat_SUITE.erl index ee31b162c2..a21bd4d499 100644 --- a/lib/orber/test/orber_nat_SUITE.erl +++ b/lib/orber/test/orber_nat_SUITE.erl @@ -57,7 +57,6 @@ nat_ip_address_local/1, nat_ip_address_local_local/1, nat_iiop_port/1, nat_iiop_port_local/1, nat_iiop_port_local_local/1, - nat_iiop_ssl_port_old/1, nat_iiop_ssl_port_local_old/1, nat_iiop_ssl_port/1, nat_iiop_ssl_port_local/1]). @@ -93,8 +92,6 @@ cases() -> nat_iiop_port_local, nat_ip_address_local_local, nat_iiop_port_local_local, - nat_iiop_ssl_port_old, - nat_iiop_ssl_port_local_old, nat_iiop_ssl_port, nat_iiop_ssl_port_local]. @@ -103,9 +100,7 @@ cases() -> %%----------------------------------------------------------------- init_per_testcase(TC, Config) when TC =:= nat_iiop_ssl_port; - TC =:= nat_iiop_ssl_port_local; - TC =:= nat_iiop_ssl_port_old; - TC =:= nat_iiop_ssl_port_local_old -> + TC =:= nat_iiop_ssl_port_local -> case ?config(crypto_started, Config) of true -> case orber_test_lib:ssl_version() of @@ -291,106 +286,6 @@ nat_iiop_port_local_local(_Config) -> %% API tests for ORB to ORB, ssl security depth 1 %%----------------------------------------------------------------- -nat_iiop_ssl_port_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", - "Make sure NAT works for SSL"]; -nat_iiop_ssl_port_old(suite) -> []; -nat_iiop_ssl_port_old(_Config) -> - - IP = orber_test_lib:get_host(), - ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, - 1, [{iiop_ssl_port, 0}, - {flags, ?ORB_ENV_ENABLE_NAT}, - {ip_address, IP}]), - ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, - 1, [{iiop_ssl_port, 0}]), - {ok, ServerNode, _ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)), - ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), - NATSSLServerPort = SSLServerPort+1, - {ok, Ref} = ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, - [IP, ssl, NATSSLServerPort])), - orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, - [nat_iiop_ssl_port, - {local, NATSSLServerPort, [{4001, 43}]}]), - - {ok, ClientNode, _ClientHost} = - ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, - [ssl])), - - IOR1 = ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, - string_to_object, - ["corbaname::1.2@"++IP++":"++ - integer_to_list(ServerPort)++"/NameService#mamba"])), - - ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP, - #host_data{protocol = ssl, - ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}}, - iop_ior:get_key(IOR1)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - uninstall_test_data, - [ssl])), - ?match(ok, - orber_test_lib:remote_apply(ServerNode, orber, - remove_listen_interface, [Ref])), - ok. - -nat_iiop_ssl_port_local_old(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", - "Make sure NAT works for SSL"]; -nat_iiop_ssl_port_local_old(suite) -> []; -nat_iiop_ssl_port_local_old(_Config) -> - - IP = orber_test_lib:get_host(), - ServerOptions = orber_test_lib:get_options_old(iiop_ssl, server, - 1, [{iiop_ssl_port, 0}, - {flags, - (?ORB_ENV_LOCAL_INTERFACE bor - ?ORB_ENV_ENABLE_NAT)}, - {ip_address, IP}]), - ClientOptions = orber_test_lib:get_options_old(iiop_ssl, client, - 1, [{iiop_ssl_port, 0}]), - {ok, ServerNode, _ServerHost} = - ?match({ok,_,_}, orber_test_lib:js_node(ServerOptions)), - ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), - SSLServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_ssl_port, []), - NATSSLServerPort = SSLServerPort+1, - {ok, Ref} = ?match({ok, _}, - orber_test_lib:remote_apply(ServerNode, orber, - add_listen_interface, - [IP, ssl, NATSSLServerPort])), - orber_test_lib:remote_apply(ServerNode, orber_env, configure_override, - [nat_iiop_ssl_port, - {local, NATSSLServerPort, [{NATSSLServerPort, NATSSLServerPort}]}]), - - {ok, ClientNode, _ClientHost} = - ?match({ok,_,_}, orber_test_lib:js_node(ClientOptions)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - install_test_data, - [ssl])), - - IOR1 = ?match(#'IOP_IOR'{}, - orber_test_lib:remote_apply(ClientNode, corba, - string_to_object, - ["corbaname::1.2@"++IP++":"++ - integer_to_list(ServerPort)++"/NameService#mamba"])), - - ?match({'external', {_IP, _Port, _ObjectKey, _Counter, _TP, - #host_data{protocol = ssl, - ssl_data = #'SSLIOP_SSL'{port = NATSSLServerPort}}}}, - iop_ior:get_key(IOR1)), - ?match(ok, orber_test_lib:remote_apply(ServerNode, orber_test_lib, - uninstall_test_data, - [ssl])), - ?match(ok, - orber_test_lib:remote_apply(ServerNode, orber, - remove_listen_interface, [Ref])), - ok. - nat_iiop_ssl_port(doc) -> ["SECURE MULTI ORB API tests (SSL depth 1)", "Make sure NAT works for SSL"]; diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl index a1b8591c8c..b178732fae 100644 --- a/lib/os_mon/src/memsup.erl +++ b/lib/os_mon/src/memsup.erl @@ -721,20 +721,19 @@ reply(Pending, MemUsage, SysMemUsage) -> %% get_memory_usage(OS) -> {Alloc, Total} %% Darwin: -%% Uses vm_stat command. This appears to lie about the page size in -%% Mac OS X 10.2.2 - the pages given are based on 4000 bytes, but -%% the vm_stat command tells us that it is 4096... +%% Uses vm_stat command. get_memory_usage({unix,darwin}) -> Str1 = os:cmd("/usr/bin/vm_stat"), - - {[Free], Str2} = fread_value("Pages free:~d.", Str1), - {[Active], Str3} = fread_value("Pages active:~d.", Str2), - {[Inactive], Str4} = fread_value("Pages inactive:~d.", Str3), - {[_], Str5} = fread_value("Pages speculative:~d.", Str4), + PageSize = 4096, + + {[Free], Str2} = fread_value("Pages free:~d.", Str1), + {[Active], Str3} = fread_value("Pages active:~d.", Str2), + {[Inactive], Str4} = fread_value("Pages inactive:~d.", Str3), + {[Speculative], Str5} = fread_value("Pages speculative:~d.", Str4), {[Wired], _} = fread_value("Pages wired down:~d.", Str5), - NMemUsed = (Wired + Active + Inactive) * 4000, - NMemTotal = NMemUsed + Free * 4000, + NMemUsed = (Wired + Active + Inactive) * PageSize, + NMemTotal = NMemUsed + (Free + Speculative) * PageSize, {NMemUsed,NMemTotal}; %% FreeBSD: Look in /usr/include/sys/vmmeter.h for the format of struct diff --git a/lib/sasl/src/sasl.erl b/lib/sasl/src/sasl.erl index 989f99dc82..fdea6da13e 100644 --- a/lib/sasl/src/sasl.erl +++ b/lib/sasl/src/sasl.erl @@ -82,8 +82,8 @@ get_mf() -> MaxB = get_mf_maxb(), MaxF = get_mf_maxf(), case {Dir, MaxB, MaxF} of - {undefined,undefined,undefined} = R -> - R; + {undefined,undefined,undefined} -> + undefined; {undefined,_,_} -> exit({missing_config, {sasl, error_logger_mf_dir}}); {_,undefined,_} -> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 141d3df38e..896b98edc2 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -141,7 +141,7 @@ <p>Sets the preferred public key algorithm to use for user authentication. If the the preferred algorithm fails for some reason, the other algorithm is tried. The default is - to try <c><![CDATA[ssh_rsa]]></c> first.</p> + to try <c><![CDATA['ssh-rsa']]></c> first.</p> </item> <tag><c><![CDATA[{pref_public_key_algs, list()}]]></c></tag> <item> @@ -248,7 +248,7 @@ requested by the client. Default is to use the erlang shell: <c><![CDATA[{shell, start, []}]]></c> </item> - <tag><c><![CDATA[{ssh_cli,{channel_callback(), + <tag><c><![CDATA[{ssh_cli, {channel_callback(), channel_init_args()}}]]></c></tag> <item> Provides your own cli implementation, i.e. a channel callback @@ -334,6 +334,20 @@ </func> <func> + <name>peername(ConnectionRef) -> {ok, {Address,Port}} | {error,Error} </name> + <fsummary> </fsummary> + <type> + <v> ConnectionRef = ssh_connection_ref()</v> + <v> Address = ip_address()</v> + <v> Port = integer()</v> + </type> + <desc> + <p>Returns the address and port for the other end of a connection. + </p> + </desc> + </func> + + <func> <name>shell(Host) -> </name> <name>shell(Host, Option) -> </name> <name>shell(Host, Port, Option) -> _</name> @@ -353,6 +367,20 @@ </func> <func> + <name>sockname(ConnectionRef) -> {ok, {Address,Port}} | {error,Error} </name> + <fsummary> </fsummary> + <type> + <v> ConnectionRef = ssh_connection_ref()</v> + <v> Address = ip_address()</v> + <v> Port = integer()</v> + </type> + <desc> + <p>Returns the local address and port number for a connection. + </p> + </desc> + </func> + + <func> <name>start() -> </name> <name>start(Type) -> ok | {error, Reason}</name> <fsummary>Starts the SSH application. </fsummary> diff --git a/lib/ssh/doc/src/ssh_server_key_api.xml b/lib/ssh/doc/src/ssh_server_key_api.xml index c4562e1211..51e1fc1f2e 100644 --- a/lib/ssh/doc/src/ssh_server_key_api.xml +++ b/lib/ssh/doc/src/ssh_server_key_api.xml @@ -29,7 +29,7 @@ -behaviour(ssh_server_key_api). </modulesummary> <description> - <p> Behaviour describing the API for an SSH server's public key handling.By implementing the callbacks defined + <p> Behaviour describing the API for an SSH server's public key handling. By implementing the callbacks defined in this behavior it is possible to customize the SSH server's public key handling. By default the SSH application implements this behavior with help of the standard openssh files, see <seealso marker="SSH_app"> ssh(6)</seealso>.</p> @@ -44,9 +44,9 @@ <p> boolean() = true | false</p> <p> string() = [byte()]</p> - <p> public_key() = #'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</p> - <p> private_key() = #'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</p> - <p> public_key_algorithm() = 'ssh-rsa'| 'ssh-dss' | atom()</p> + <p> public_key() = #'RSAPublicKey'{} | {integer(), #'Dss-Parms'{}} | term()</p> + <p> private_key() = #'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</p> + <p> public_key_algorithm() = 'ssh-rsa' | 'ssh-dss' | atom()</p> </section> <funcs> @@ -56,7 +56,7 @@ <fsummary>Fetches the hosts private key </fsummary> <type> <v>Algorithm = public_key_algorithm()</v> - <d> Host key algorithm. Should support 'ssh-rsa'| 'ssh-dss' but additional algorithms + <d> Host key algorithm. Should support 'ssh-rsa' | 'ssh-dss' but additional algorithms can be handled.</d> <v> DaemonOptions = proplists:proplist() </v> <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso></d> diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 7d5478c3f6..80d20abbbd 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -28,6 +28,8 @@ -export([start/0, start/1, stop/0, connect/3, connect/4, close/1, connection_info/2, channel_info/3, daemon/1, daemon/2, daemon/3, + peername/1, + sockname/1, stop_listener/1, stop_listener/2, stop_daemon/1, stop_daemon/2, shell/1, shell/2, shell/3]). @@ -245,6 +247,28 @@ shell(Host, Port, Options) -> end. %%-------------------------------------------------------------------- +%% Function: peername(ConnectionRef) -> {ok, {Host,Port}} +%% | {error,Error} +%% +%% Description: Returns the peer address of the connection +%%-------------------------------------------------------------------- +peername(ConnectionRef) -> + [{peer, {_Name,{IP,Port}}}] = + ssh_connection_manager:connection_info(ConnectionRef, [peer]), + {ok, {IP,Port}}. + +%%-------------------------------------------------------------------- +%% Function: sockname(ConnectionRef) -> {ok, {Host,Port}} +%% | {error,Error} +%% +%% Description: Returns the local address of the connection +%%-------------------------------------------------------------------- +sockname(ConnectionRef) -> + [{sockname, Result}] = + ssh_connection_manager:connection_info(ConnectionRef, [sockname]), + Result. + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- fix_idle_time(SshOptions) -> diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 9de4dd5967..c3e8a3c742 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -46,7 +46,7 @@ handle_sync_event/4, handle_info/3, terminate/3, code_change/4]). %% spawn export --export([ssh_info_handler/3]). +-export([ssh_info_handler/4]). -record(state, { transport_protocol, % ex: tcp @@ -533,7 +533,7 @@ handle_event(renegotiate, StateName, State) -> {next_state, StateName, State}; handle_event({info, From, Options}, StateName, #state{ssh_params = Ssh} = State) -> - spawn(?MODULE, ssh_info_handler, [Options, Ssh, From]), + spawn(?MODULE, ssh_info_handler, [Options, Ssh, State, From]), {next_state, StateName, State}; handle_event(data_size, connected, #state{ssh_params = Ssh0} = State) -> {ok, [{send_oct,Sent}]} = inet:getstat(State#state.socket, [send_oct]), @@ -1022,26 +1022,29 @@ retry_fun(User, Reason, Opts) -> catch Fun(User, Reason) end. -ssh_info_handler(Options, Ssh, From) -> - Info = ssh_info(Options, Ssh, []), +ssh_info_handler(Options, Ssh, State, From) -> + Info = ssh_info(Options, Ssh, State, []), ssh_connection_manager:send_msg({channel_requst_reply, From, Info}). -ssh_info([], _, Acc) -> +ssh_info([], _, _, Acc) -> Acc; ssh_info([client_version | Rest], #ssh{c_vsn = IntVsn, - c_version = StringVsn} = SshParams, Acc) -> - ssh_info(Rest, SshParams, [{client_version, {IntVsn, StringVsn}} | Acc]); + c_version = StringVsn} = SshParams, State, Acc) -> + ssh_info(Rest, SshParams, State, [{client_version, {IntVsn, StringVsn}} | Acc]); ssh_info([server_version | Rest], #ssh{s_vsn = IntVsn, - s_version = StringVsn} = SshParams, Acc) -> - ssh_info(Rest, SshParams, [{server_version, {IntVsn, StringVsn}} | Acc]); + s_version = StringVsn} = SshParams, State, Acc) -> + ssh_info(Rest, SshParams, State, [{server_version, {IntVsn, StringVsn}} | Acc]); -ssh_info([peer | Rest], #ssh{peer = Peer} = SshParams, Acc) -> - ssh_info(Rest, SshParams, [{peer, Peer} | Acc]); +ssh_info([peer | Rest], #ssh{peer = Peer} = SshParams, State, Acc) -> + ssh_info(Rest, SshParams, State, [{peer, Peer} | Acc]); -ssh_info([ _ | Rest], SshParams, Acc) -> - ssh_info(Rest, SshParams, Acc). +ssh_info([sockname | Rest], SshParams, #state{socket=Socket}=State, Acc) -> + ssh_info(Rest, SshParams, State, [{sockname,inet:sockname(Socket)}|Acc]); + +ssh_info([ _ | Rest], SshParams, State, Acc) -> + ssh_info(Rest, SshParams, State, Acc). log_error(Reason) -> Report = io_lib:format("Erlang ssh connection handler failed with reason: " diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index f5db31baee..13caafc055 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2012. All Rights Reserved. +# Copyright Ericsson AB 2004-2013. 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,8 @@ MODULES= \ ssh_sftpd_SUITE \ ssh_sftpd_erlclient_SUITE \ ssh_connection_SUITE \ - ssh_echo_server + ssh_echo_server \ + ssh_peername_sockname_server HRL_FILES_NEEDED_IN_TEST= \ $(ERL_TOP)/lib/ssh/src/ssh.hrl \ diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 0aa60624bf..e8f1d5213c 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -22,6 +22,7 @@ -module(ssh_basic_SUITE). -include_lib("common_test/include/ct.hrl"). +-include_lib("kernel/include/inet.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). @@ -48,7 +49,9 @@ all() -> close]. groups() -> - [{dsa_key, [], [send, exec, exec_compressed, shell, known_hosts, idle_time, rekey, openssh_zlib_basic_test]}, + [{dsa_key, [], [send, + peername_sockname, + exec, exec_compressed, shell, known_hosts, idle_time, rekey, openssh_zlib_basic_test]}, {rsa_key, [], [send, exec, exec_compressed, shell, known_hosts, idle_time, rekey, openssh_zlib_basic_test]}, {dsa_pass_key, [], [pass_phrase]}, {rsa_pass_key, [], [pass_phrase]}, @@ -473,6 +476,52 @@ send(Config) when is_list(Config) -> %%-------------------------------------------------------------------- +peername_sockname() -> + [{doc, "Test ssh:peername/1 and ssh:sockname/1"}]. +peername_sockname(Config) when is_list(Config) -> + process_flag(trap_exit, true), + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), + + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {subsystems, [{"peername_sockname", + {ssh_peername_sockname_server, []}} + ]} + ]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user_interaction, false}]), + {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), + success = ssh_connection:subsystem(ConnectionRef, ChannelId, "peername_sockname", infinity), + {ok,{HostPeerClient,PortPeerClient}} = ssh:peername(ConnectionRef), + {ok,{HostSockClient,PortSockClient}} = ssh:sockname(ConnectionRef), + receive + {ssh_cm, ConnectionRef, {data, ChannelId, _, Response}} -> + {PeerNameSrv,SockNameSrv} = binary_to_term(Response), + {ok,{HostPeerSrv,PortPeerSrv}} = PeerNameSrv, + {ok,{HostSockSrv,PortSockSrv}} = SockNameSrv, + host_equal(HostPeerSrv, HostSockClient), + PortPeerSrv = PortSockClient, + host_equal(HostSockSrv, HostPeerClient), + PortSockSrv = PortPeerClient, + host_equal(HostSockSrv, Host), + PortSockSrv = Port + after 10000 -> + throw(timeout) + end. + +host_equal(H1, H2) -> + not ordsets:is_disjoint(ips(H1), ips(H2)). + +ips(IP) when is_tuple(IP) -> ordsets:from_list([IP]); +ips(Name) when is_list(Name) -> + {ok,#hostent{h_addr_list=IPs4}} = inet:gethostbyname(Name,inet), + {ok,#hostent{h_addr_list=IPs6}} = inet:gethostbyname(Name,inet6), + ordsets:from_list(IPs4++IPs6). + +%%-------------------------------------------------------------------- close() -> [{doc, "Simulate that we try to close an already closed connection"}]. close(Config) when is_list(Config) -> diff --git a/lib/ssh/test/ssh_peername_sockname_server.erl b/lib/ssh/test/ssh_peername_sockname_server.erl new file mode 100644 index 0000000000..7664f3ee25 --- /dev/null +++ b/lib/ssh/test/ssh_peername_sockname_server.erl @@ -0,0 +1,56 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2013. 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(ssh_peername_sockname_server). + +%% The purpose of this module is to perform tests on the server side of an +%% ssh connection. + + +-behaviour(ssh_daemon_channel). +-record(state, {}). + +-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]). + +init([]) -> + {ok, #state{}}. + +handle_msg({ssh_channel_up, ChannelId, ConnectionManager}, State) -> + ssh_connection:send(ConnectionManager, ChannelId, + term_to_binary( + {catch ssh:peername(ConnectionManager), + catch ssh:sockname(ConnectionManager) + }) + ), + {ok, State}. + +handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, _Error, _}}, + State) -> + {stop, ChannelId, State}; + +handle_ssh_msg({ssh_cm, _, {exit_status, ChannelId, _Status}}, State) -> + {stop, ChannelId, State}; + +handle_ssh_msg({ssh_cm, _CM, _}, State) -> + {ok, State}. + +terminate(_Reason, _State) -> + ok. diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 6029a09730..445a47c07b 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -86,7 +86,7 @@ {user_lookup_fun, {fun(), term()}}, {psk_identity, string()}, {srp_identity, {string(), string()}} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | {reuse_session, fun()} {next_protocols_advertised, [binary()]} | - {client_preferred_next_protocols, client | server, [binary()]} | + {client_preferred_next_protocols, {client | server, [binary()]} | {client | server, [binary()], binary()}} | {log_alert, boolean()} </c></p> @@ -353,8 +353,8 @@ fun(srp, Username :: string(), UserState :: term()) -> when possible. </item> - <tag>{client_preferred_next_protocols, Precedence :: server | client, ClientPrefs :: [binary()]}</tag> - <tag>{client_preferred_next_protocols, Precedence :: server | client, ClientPrefs :: [binary()], Default :: binary()}</tag> + <tag>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()]}}</tag> + <tag>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()], Default :: binary()}}</tag> <item> <p>Indicates the client will try to perform Next Protocol Negotiation.</p> diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index 57c859bf24..7367b5c224 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -95,11 +95,6 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> end. close(Socket) -> - try - erlang:error(foo) - catch _:_ -> - io:format("close called ~p ~p~n",[Socket, erlang:get_stacktrace()]) - end, gen_tcp:close(Socket), ok. diff --git a/lib/stdlib/doc/src/re.xml b/lib/stdlib/doc/src/re.xml index 71a6e34513..7a9f37ca90 100644 --- a/lib/stdlib/doc/src/re.xml +++ b/lib/stdlib/doc/src/re.xml @@ -40,8 +40,8 @@ <p>This module contains regular expression matching functions for strings and binaries.</p> - <p>The regular expression syntax and semantics resemble that of - Perl.</p> + <p>The <seealso marker="#regexp_syntax">regular expression</seealso> + syntax and semantics resemble that of Perl.</p> <p>The library's matching algorithms are currently based on the PCRE library, but not all of the PCRE library is interfaced and @@ -702,7 +702,7 @@ This option makes it possible to include comments inside complicated patterns. N </func> </funcs> - + <marker id="regexp_syntax"></marker> <section> <title>PERL LIKE REGULAR EXPRESSIONS SYNTAX</title> <p>The following sections contain reference material for the diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el index f2c0db67dd..0adeff1a02 100644 --- a/lib/tools/emacs/erlang-eunit.el +++ b/lib/tools/emacs/erlang-eunit.el @@ -40,6 +40,10 @@ This is useful, reducing the save-compile-load-test cycle to one keychord.") (defvar erlang-eunit-recent-info '((mode . nil) (module . nil) (test . nil) (cover . nil)) "Info about the most recent running of an EUnit test representation.") +(defvar erlang-error-regexp-alist + '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2))) + "*Patterns for matching Erlang errors.") + ;;; ;;; Switch between src/EUnit test buffers ;;; diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index b8699a616d..c395d22356 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -697,6 +697,7 @@ resulting regexp is surrounded by \\_< and \\_>." "char" "cons" "deep_string" + "iodata" "iolist" "maybe_improper_list" "module" @@ -708,6 +709,7 @@ resulting regexp is surrounded by \\_< and \\_>." "nonempty_list" "nonempty_improper_list" "nonempty_maybe_improper_list" + "nonempty_string" "no_return" "pos_integer" "string" diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index bf21aa6b48..13d9aefb0c 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -255,16 +255,7 @@ compile_directory(Dir, Options) when is_list(Dir), is_list(Options) -> end. compile_modules(Files,Options) -> - Options2 = lists:filter(fun(Option) -> - case Option of - {i, Dir} when is_list(Dir) -> true; - {d, _Macro} -> true; - {d, _Macro, _Value} -> true; - export_all -> true; - _ -> false - end - end, - Options), + Options2 = filter_options(Options), compile_modules(Files,Options2,[]). compile_modules([File|Files], Options, Result) -> @@ -273,6 +264,17 @@ compile_modules([File|Files], Options, Result) -> compile_modules([],_Opts,Result) -> reverse(Result). +filter_options(Options) -> + lists:filter(fun(Option) -> + case Option of + {i, Dir} when is_list(Dir) -> true; + {d, _Macro} -> true; + {d, _Macro, _Value} -> true; + export_all -> true; + _ -> false + end + end, + Options). %% compile_beam(ModFile) -> Result | {error,Reason} %% ModFile - see compile/1 @@ -622,8 +624,9 @@ main_process_loop(State) -> Compiled0 = State#main_state.compiled, case get_beam_file(Module,BeamFile0,Compiled0) of {ok,BeamFile} -> + UserOptions = get_compile_options(Module,BeamFile), {Reply,Compiled} = - case do_compile_beam(Module,BeamFile,[]) of + case do_compile_beam(Module,BeamFile,UserOptions) of {ok, Module} -> remote_load_compiled(State#main_state.nodes, [{Module,BeamFile}]), @@ -1421,12 +1424,23 @@ get_abstract_code(Module, Beam) -> end. get_source_info(Module, Beam) -> + Compile = get_compile_info(Module, Beam), + case lists:keyfind(source, 1, Compile) of + { source, _ } = Tuple -> [Tuple]; + false -> [] + end. + +get_compile_options(Module, Beam) -> + Compile = get_compile_info(Module, Beam), + case lists:keyfind(options, 1, Compile) of + {options, Options } -> filter_options(Options); + false -> [] + end. + +get_compile_info(Module, Beam) -> case beam_lib:chunks(Beam, [compile_info]) of {ok, {Module, [{compile_info, Compile}]}} -> - case lists:keyfind(source, 1, Compile) of - { source, _ } = Tuple -> [Tuple]; - false -> [] - end; + Compile; _ -> [] end. diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index c033be98a3..29b26c7a76 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -28,7 +28,7 @@ export_import/1, otp_5031/1, eif/1, otp_5305/1, otp_5418/1, otp_6115/1, otp_7095/1, otp_8188/1, otp_8270/1, otp_8273/1, otp_8340/1, - otp_10979_hanging_node/1]). + otp_10979_hanging_node/1, compile_beam_opts/1]). -include_lib("test_server/include/test_server.hrl"). @@ -53,7 +53,7 @@ all() -> dont_reconnect_after_stop, stop_node_after_disconnect, export_import, otp_5031, eif, otp_5305, otp_5418, otp_6115, otp_7095, otp_8188, otp_8270, otp_8273, - otp_8340, otp_10979_hanging_node]; + otp_8340, otp_10979_hanging_node, compile_beam_opts]; _pid -> {skip, "It looks like the test server is running " @@ -1401,6 +1401,39 @@ otp_10979_hanging_node(_Config) -> ok. +compile_beam_opts(doc) -> + ["Take compiler options from beam in cover:compile_beam"]; +compile_beam_opts(suite) -> []; +compile_beam_opts(Config) when is_list(Config) -> + {ok, Cwd} = file:get_cwd(), + ok = file:set_cwd(?config(priv_dir, Config)), + IncDir = filename:join(?config(data_dir, Config), + "included_functions"), + File = filename:join([?config(data_dir, Config), "otp_11439", "t.erl"]), + %% use all compiler options allowed by cover:filter_options + %% i and d don't make sense when compiling from beam though + {ok, t} = + compile:file(File, [{i, IncDir}, + {d, 'BOOL'}, + {d, 'MACRO', macro_defined}, + export_all, + debug_info, + return_errors]), + Exports = + [{func1,0}, + {macro, 0}, + {exported,0}, + {nonexported,0}, + {module_info,0}, + {module_info,1}], + Exports = t:module_info(exports), + {ok, t} = cover:compile_beam("t"), + Exports = t:module_info(exports), + cover:stop(), + ok = file:delete("t.beam"), + ok = file:set_cwd(Cwd), + ok. + %%--Auxiliary------------------------------------------------------------ analyse_expr(Expr, Config) -> diff --git a/lib/tools/test/cover_SUITE_data/otp_11439/t.erl b/lib/tools/test/cover_SUITE_data/otp_11439/t.erl new file mode 100644 index 0000000000..d1eb9f16ee --- /dev/null +++ b/lib/tools/test/cover_SUITE_data/otp_11439/t.erl @@ -0,0 +1,11 @@ +-module(t). +-export([exported/0]). +-include("cover_inc.hrl"). +-ifdef(BOOL). +macro() -> + ?MACRO. +-endif. +exported() -> + ok. +nonexported() -> + ok. diff --git a/lib/xmerl/src/xmerl.erl b/lib/xmerl/src/xmerl.erl index 3249094e78..01af183eef 100644 --- a/lib/xmerl/src/xmerl.erl +++ b/lib/xmerl/src/xmerl.erl @@ -303,18 +303,17 @@ apply_tag_cb(Ms, F, Args) -> apply_cb(Ms, F, '#element#', Args). apply_cb(Ms, F, Df, Args) -> - apply_cb(Ms, F, Df, Args, Ms). - -apply_cb([M|Ms], F, Df, Args, Ms0) -> - case catch apply(M, F, Args) of - {'EXIT', {undef,[{M,F,_,_}|_]}} -> - apply_cb(Ms, F, Df, Args, Ms0); - {'EXIT', Reason} -> - exit(Reason); - Res -> - Res + apply_cb(Ms, F, Df, Args, length(Args)). + +apply_cb(Ms, F, Df, Args, A) -> + apply_cb(Ms, F, Df, Args, A, Ms). + +apply_cb([M|Ms], F, Df, Args, A, Ms0) -> + case erlang:function_exported(M, F, A) of + true -> apply(M, F, Args); + false -> apply_cb(Ms, F, Df, Args, A, Ms0) end; -apply_cb([], Df, Df, Args, _Ms0) -> +apply_cb([], Df, Df, Args, A, _Ms0) -> exit({unknown_tag, {Df, Args}}); -apply_cb([], F, Df, Args, Ms0) -> - apply_cb(Ms0, Df, Df, [F|Args]). +apply_cb([], F, Df, Args, A, Ms0) -> + apply_cb(Ms0, Df, Df, [F|Args], A+1). diff --git a/lib/xmerl/src/xmerl_xpath.erl b/lib/xmerl/src/xmerl_xpath.erl index b3301f2faf..be0e863ce4 100644 --- a/lib/xmerl/src/xmerl_xpath.erl +++ b/lib/xmerl/src/xmerl_xpath.erl @@ -713,10 +713,26 @@ node_test(_Test, node_test({wildcard, _}, #xmlNode{type=ElAt}, _Context) when ElAt==element; ElAt==attribute; ElAt==namespace -> true; -node_test({prefix_test, Prefix}, #xmlNode{node = N}, _Context) -> +node_test({prefix_test, Prefix}, #xmlNode{node = N}, Context) -> case N of - #xmlElement{nsinfo = {Prefix, _}} -> true; - #xmlAttribute{nsinfo = {Prefix, _}} -> true; + #xmlElement{nsinfo = {Prefix, _}} -> + true; + #xmlElement{expanded_name = {Uri, _}} -> + case expanded_name(Prefix, "_", Context) of + {Uri, _} -> + true; + _ -> + false + end; + #xmlAttribute{nsinfo = {Prefix, _}} -> + true; + #xmlAttribute{expanded_name = {Uri, _}} -> + case expanded_name(Prefix, "_", Context) of + {Uri, _} -> + true; + _ -> + false + end; _ -> false end; @@ -760,20 +776,21 @@ node_test({name, {_Tag, Prefix, Local}}, node_test({name, {Tag,_Prefix,_Local}}, #xmlNode{node = #xmlAttribute{name = Tag}}, _Context) -> true; -node_test({name, {_Tag, Prefix, Local}}, - #xmlNode{node = #xmlAttribute{expanded_name = {URI, Local}, - nsinfo = {_Prefix1, _}, - namespace = NS}}, _Context) -> - NSNodes = NS#xmlNamespace.nodes, - case lists:keysearch(Prefix, 1, NSNodes) of - {value, {_, URI}} -> - ?dbg("node_test(~, ~p) -> true.~n", - [{_Tag, Prefix, Local}, write_node(NSNodes)]), - true; - false -> - ?dbg("node_test(~, ~p) -> false.~n", - [{_Tag, Prefix, Local}, write_node(NSNodes)]), - false +node_test({name, {Tag, Prefix, Local}}, + #xmlNode{node = #xmlAttribute{name = Name, + expanded_name = EExpName + }}, Context) -> + case expanded_name(Prefix, Local, Context) of + [] -> + Res = (Tag == Name), + ?dbg("node_test(~p, ~p) -> ~p.~n", + [{Tag, Prefix, Local}, write_node(Name), Res]), + Res; + ExpName -> + Res = (ExpName == EExpName), + ?dbg("node_test(~p, ~p) -> ~p.~n", + [{Tag, Prefix, Local}, write_node(Name), Res]), + Res end; node_test({name, {_Tag, [], Local}}, #xmlNode{node = #xmlNsNode{prefix = Local}}, _Context) -> diff --git a/lib/xmerl/test/xmerl_SUITE.erl b/lib/xmerl/test/xmerl_SUITE.erl index e21355f877..8432e66a97 100644 --- a/lib/xmerl/test/xmerl_SUITE.erl +++ b/lib/xmerl/test/xmerl_SUITE.erl @@ -42,7 +42,7 @@ %%---------------------------------------------------------------------- all() -> [{group, cpd_tests}, xpath_text1, xpath_main, - xpath_abbreviated_syntax, xpath_functions, + xpath_abbreviated_syntax, xpath_functions, xpath_namespaces, {group, misc}, {group, eventp_tests}, {group, ticket_tests}, {group, app_test}, {group, appup_test}]. @@ -205,6 +205,11 @@ xpath_functions(Config) -> ?line file:set_cwd(filename:join(?config(data_dir,Config),xpath)), ?line ok = xpath_abbrev:functions(). +xpath_namespaces(suite) -> []; +xpath_namespaces(Config) -> + ?line file:set_cwd(filename:join(?config(data_dir,Config),xpath)), + ?line ok = xpath_abbrev:namespaces(). + %%---------------------------------------------------------------------- latin1_alias(suite) -> []; diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/purchaseOrder.xml b/lib/xmerl/test/xmerl_SUITE_data/xpath/purchaseOrder.xml index a5ae223d65..16090c3590 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/xpath/purchaseOrder.xml +++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/purchaseOrder.xml @@ -1,7 +1,8 @@ <?xml version="1.0"?> <apo:purchaseOrder xmlns:apo="http://www.example.com/PO1" + xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" orderDate="1999-10-20"> - <billTo country="US"> + <billTo country="US" xsi:type="apo:USAddress"> <name>Robert Smith</name> <street>8 Oak Avenue</street> <!-- etc. --> @@ -10,7 +11,7 @@ <zip>95819</zip> </billTo> <apo:comment>Hurry, my lawn is going wild!</apo:comment> - <shipTo country="US"> + <shipTo country="US" xsi:type="apo:USAddress"> <name>Alice Smith</name> <street>123 Maple Street</street> <!-- etc. --> diff --git a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl index 7b6f1e95b3..afd39b6598 100644 --- a/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl +++ b/lib/xmerl/test/xmerl_SUITE_data/xpath/xpath_abbrev.erl @@ -8,6 +8,7 @@ -module(xpath_abbrev). -export([test/0, check_node_set/2, ticket_6873/0, ticket_7496/0, functions/0]). +-export([namespaces/0]). -include("test_server.hrl"). -include_lib("xmerl/include/xmerl.hrl"). @@ -264,3 +265,33 @@ functions() -> [city,city,comment]), ?line ok = Test(Doc2,"//*[starts-with(name(),'{http://www.example.com/PO1')]", ['apo:purchaseOrder','apo:comment']). + + +namespaces() -> + {Doc,_} = xmerl_scan:file("purchaseOrder.xml", [{namespace_conformant, true}]), + + %% Element name using regular namespace and context namespace declaration. + ?line [#xmlElement{nsinfo = {_, "purchaseOrder"}}] = + xmerl_xpath:string("/apo:purchaseOrder", Doc), + ?line [#xmlElement{nsinfo = {_, "purchaseOrder"}}] = + xmerl_xpath:string("/t:purchaseOrder", Doc, [{namespace, [{"t", "http://www.example.com/PO1"}]}]), + + %% Wildcard element name using regular namespace and context namespace declaration. + ?line [#xmlElement{nsinfo = {_, "comment"}}] = + xmerl_xpath:string("./apo:*", Doc), + ?line [#xmlElement{nsinfo = {_, "comment"}}] = + xmerl_xpath:string("./t:*", Doc, [{namespace, [{"t", "http://www.example.com/PO1"}]}]), + + %% Attribute name using regular namespace and context namespace declaration. + ?line [#xmlAttribute{nsinfo = {_, "type"}}, #xmlAttribute{nsinfo = {_, "type"}}] = + xmerl_xpath:string("//@xsi:type", Doc), + ?line [#xmlAttribute{nsinfo = {_, "type"}}, #xmlAttribute{nsinfo = {_, "type"}}] = + xmerl_xpath:string("//@t:type", Doc, [{namespace, [{"t", "http://www.w3.org/2001/XMLSchema-instance"}]}]), + + %% Wildcard attribute name using regular namespace and context namespace declaration. + ?line [#xmlAttribute{nsinfo = {_, "type"}}, #xmlAttribute{nsinfo = {_, "type"}}] = + xmerl_xpath:string("//@xsi:*", Doc), + ?line [#xmlAttribute{nsinfo = {_, "type"}}, #xmlAttribute{nsinfo = {_, "type"}}] = + xmerl_xpath:string("//@t:*", Doc, [{namespace, [{"t", "http://www.w3.org/2001/XMLSchema-instance"}]}]), + + ok. |