diff options
Diffstat (limited to 'lib')
128 files changed, 2315 insertions, 1021 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 4ee7e48a67..8fed341600 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -34,13 +34,15 @@ %% Event handler Callbacks -export([init/1, handle_event/2, handle_call/2, handle_info/2, - terminate/1]). + terminate/1, terminate/2, code_change/3]). %% Other -export([handle_remote_events/1]). -include("ct.hrl"). +-behaviour(gen_event). + -record(eh_state, {log_func, curr_suite, curr_group, @@ -184,10 +186,13 @@ handle_call({handle_remote_events,Bool}, State) -> handle_call(_Query, _State) -> {error, bad_query}. -terminate(_State) -> +terminate(_) -> error_logger:delete_report_handler(?MODULE), []. +terminate(_Arg, _State) -> + ok. + tag_event(Event) -> {calendar:local_time(), Event}. @@ -236,3 +241,6 @@ format_header(#eh_state{curr_suite = Suite, curr_func = TC}) -> io_lib:format("System report during ~w:~w/1 in ~w", [Suite,TC,Group]). + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. 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/common_test/test/ct_pre_post_test_io_SUITE.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl index 84341a0b99..5de1ecc2bd 100644 --- a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl @@ -89,28 +89,31 @@ pre_post_io(Config) -> %%!-------------------------------------------------------------------- spawn(fun() -> + ct:pal("CONTROLLER: Started!", []), %% --- test run 1 --- - ct:sleep(3000), - ct_test_support:ct_rpc({cth_log_redirect, - handle_remote_events, - [true]}, Config), - ct:sleep(2000), - io:format(user, "Starting test run!~n", []), - ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), - ct:sleep(6000), - io:format(user, "Finishing off!~n", []), - ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + timer:sleep(3000), + ct:pal("CONTROLLER: Handle remote events = true", []), + ok = ct_test_support:ct_rpc({cth_log_redirect, + handle_remote_events, + [true]}, Config), + timer:sleep(2000), + ct:pal("CONTROLLER: Proceeding with test run #1!", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + timer:sleep(6000), + ct:pal("CONTROLLER: Proceeding with shutdown #1!", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), %% --- test run 2 --- - ct:sleep(3000), - ct_test_support:ct_rpc({cth_log_redirect, - handle_remote_events, - [true]}, Config), - ct:sleep(2000), - io:format(user, "Starting test run!~n", []), - ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), - ct:sleep(6000), - io:format(user, "Finishing off!~n", []), - ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config) + timer:sleep(3000), + ct:pal("CONTROLLER: Handle remote events = true", []), + ok = ct_test_support:ct_rpc({cth_log_redirect, + handle_remote_events, + [true]}, Config), + timer:sleep(2000), + ct:pal("CONTROLLER: Proceeding with test run #2!", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + timer:sleep(6000), + ct:pal("CONTROLLER: Proceeding with shutdown #2!", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config) end), ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl index c8c08a5735..2ba991fc61 100644 --- a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl @@ -28,7 +28,8 @@ %%%=================================================================== proceed() -> - ?MODULE ! proceed. + ?MODULE ! proceed, + ok. %%-------------------------------------------------------------------- %% Hook functions diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index e208ffec1f..9d89e21a4e 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -86,7 +86,7 @@ add_to_work_list(F, {Fs,Used}=Sets) -> false -> {[F|Fs],sets:add_element(F, Used)} end. - + %%% %%% Coalesce adjacent labels. Renumber all labels to eliminate gaps. %%% This cleanup will slightly reduce file size and slightly speed up loading. diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 3b51216a6c..3ec57a67da 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -600,7 +600,7 @@ checkerror_1([], OrigIs) -> OrigIs. checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. - + %%% Routines for maintaining a type database. The type database %%% associates type information with registers. %%% 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/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 802e3dfa2f..47d446273b 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1556,7 +1556,7 @@ restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. - + -spec options() -> 'ok'. options() -> @@ -1593,7 +1593,7 @@ help([_|T]) -> help(_) -> ok. - + %% compile(AbsFileName, Outfilename, Options) %% Compile entry point for erl_compile. diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index 0ca2f57dde..c0dfecd1dc 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -96,7 +96,7 @@ format_error(Other) -> io_lib:write(Other). string_thing($') -> "atom"; %' stupid emacs string_thing($") -> "string". %" stupid emacs - + %% Re-entrant pre-scanner. %% %% If the input list of characters is insufficient to build a term the @@ -214,7 +214,7 @@ pre_comment(eof, Sofar, Pos) -> pre_error(E, Epos, Pos) -> {error,{Epos,core_scan,E}, Pos}. - + %% scan(CharList, StartPos) %% This takes a list of characters and tries to tokenise them. %% diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 1195937d91..01bb8635cd 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1912,7 +1912,7 @@ new_in_all([Le|Les]) -> foldl(fun (L, Ns) -> intersection((get_anno(L))#a.ns, Ns) end, (get_anno(Le))#a.ns, Les); new_in_all([]) -> []. - + %% The AfterVars are the variables which are used afterwards. We need %% this to work out which variables are actually exported and used %% from case/receive. In subblocks/clauses the AfterVars of the block diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 2b2b8bf550..65f1251099 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -160,8 +160,8 @@ function({#c_var{name={F,Arity}=FA},Body}, St0) -> io:fwrite("Function: ~w/~w\n", [F,Arity]), erlang:raise(Class, Error, Stack) end. - - + + %% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}. %% Do the main sequence of a body. A body ends in an atomic value or %% values. Must check if vector first so do expr. @@ -834,7 +834,7 @@ last([_|T]) -> last(T). first([_]) -> []; first([H|T]) -> [H|first(T)]. - + %% This code implements the algorithm for an optimizing compiler for %% pattern matching given "The Implementation of Functional %% Programming Languages" by Simon Peyton Jones. The code is much @@ -1428,7 +1428,7 @@ arg_val(Arg, C) -> {set_kanno(S, []),U,T,Fs} end end. - + %% ubody_used_vars(Expr, State) -> [UsedVar] %% Return all used variables for the body sequence. Much more %% efficient than using ubody/3 if the body contains nested letrecs. diff --git a/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl b/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl index 0214983c11..db84ee5fc8 100644 --- a/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl +++ b/lib/debugger/test/dbg_ui_SUITE_data/manual_data/src/lists1.erl @@ -236,7 +236,7 @@ flatlength([H|T], L) when list(H) -> flatlength([H|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) %% keysearch(Key, Index, [Tuple]) %% keydelete(Key, Index, [Tuple]) @@ -298,7 +298,7 @@ keymap(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap(Fun, ExtraArgs, Index, Tail)]; keymap( _, _ , _, []) -> []. - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) diff --git a/lib/debugger/test/int_SUITE_data/lists1.erl b/lib/debugger/test/int_SUITE_data/lists1.erl index 0214983c11..db84ee5fc8 100644 --- a/lib/debugger/test/int_SUITE_data/lists1.erl +++ b/lib/debugger/test/int_SUITE_data/lists1.erl @@ -236,7 +236,7 @@ flatlength([H|T], L) when list(H) -> flatlength([H|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) %% keysearch(Key, Index, [Tuple]) %% keydelete(Key, Index, [Tuple]) @@ -298,7 +298,7 @@ keymap(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap(Fun, ExtraArgs, Index, Tail)]; keymap( _, _ , _, []) -> []. - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) diff --git a/lib/debugger/test/int_SUITE_data/my_lists.erl b/lib/debugger/test/int_SUITE_data/my_lists.erl index 98eb4396e3..f9399b1085 100644 --- a/lib/debugger/test/int_SUITE_data/my_lists.erl +++ b/lib/debugger/test/int_SUITE_data/my_lists.erl @@ -237,7 +237,7 @@ flatlength([H|T], L) when list(H) -> flatlength([H|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) %% keysearch(Key, Index, [Tuple]) %% keydelete(Key, Index, [Tuple]) @@ -299,7 +299,7 @@ keymap(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap(Fun, ExtraArgs, Index, Tail)]; keymap( _, _ , _, []) -> []. - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) @@ -698,7 +698,7 @@ flatlength_1([H|T], L) when list(H) -> flatlength_1([H|T], L) -> flatlength_1(T, L + 1); flatlength_1([], L) -> L. - + %% keymember(Key, Index, [Tuple]) %% keysearch(Key, Index, [Tuple]) %% keydelete(Key, Index, [Tuple]) @@ -760,7 +760,7 @@ keymap_1(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap_1(Fun, ExtraArgs, Index, Tail)]; keymap_1( _, _ , _, []) -> []. - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) @@ -1162,7 +1162,7 @@ flatlength_2([H|T], L) when list(H) -> flatlength_2([H|T], L) -> flatlength_2(T, L + 1); flatlength_2([], L) -> L. - + %% keymember_2(Key, Index, [Tuple]) %% keysearch_2(Key, Index, [Tuple]) %% keydelete_2(Key, Index, [Tuple]) @@ -1224,7 +1224,7 @@ keymap_2(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap_2(Fun, ExtraArgs, Index, Tail)]; keymap_2( _, _ , _, []) -> []. - + %% all_2(Predicate, List) %% any_2(Predicate, List) %% map_2(Function, List) @@ -1624,7 +1624,7 @@ flatlength_3([H|T], L) when list(H) -> flatlength_3([H|T], L) -> flatlength_3(T, L + 1); flatlength_3([], L) -> L. - + %% keymember_3(Key, Index, [Tuple]) %% keysearch_3(Key, Index, [Tuple]) %% keydelete_3(Key, Index, [Tuple]) @@ -1686,7 +1686,7 @@ keymap_3(Fun, ExtraArgs, Index, [Tup|Tail]) -> [setelement(Index, Tup, apply(Fun, [element(Index, Tup)|ExtraArgs]))| keymap_3(Fun, ExtraArgs, Index, Tail)]; keymap_3( _, _ , _, []) -> []. - + %% all_3(Predicate, List) %% any_3(Predicate, List) %% map_3(Function, List) diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl index 04225e9bd0..4fc4e89ce9 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_clean.erl @@ -80,7 +80,7 @@ add_to_work_list(F, {Fs,Used}=Sets) -> false -> {[F|Fs],sets:add_element(F, Used)} end. - + %%% %%% Coalesce adjacent labels. Renumber all labels to eliminate gaps. %%% This cleanup will slightly reduce file size and slightly speed up loading. diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl index d2ac3fcd99..f59cc897d6 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/beam_type.erl @@ -456,7 +456,7 @@ are_live_regs_determinable([{'%live',_}|_]) -> true; are_live_regs_determinable([_|Is]) -> are_live_regs_determinable(Is); are_live_regs_determinable([]) -> false. - + %%% Routines for maintaining a type database. The type database %%% associates type information with registers. %%% diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl index 2b6d14e300..9b56d384ab 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/compile.erl @@ -990,7 +990,7 @@ listing(LFun, Ext, St) -> Es = [{Lfile,[{none,compile,write_error}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end. - + options() -> help(standard_passes()). @@ -1022,7 +1022,7 @@ help([_|T]) -> help(_) -> ok. - + %% compile(AbsFileName, Outfilename, Options) %% Compile entry point for erl_compile. diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl index f4e609bf5b..879af3efea 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/core_scan.erl @@ -123,7 +123,7 @@ format_error(Other) -> io_lib:write(Other). string_thing($') -> "atom"; string_thing($") -> "string". - + %% Re-entrant pre-scanner. %% %% If the input list of characters is insufficient to build a term the @@ -241,7 +241,7 @@ pre_comment(eof, Sofar, Pos) -> pre_error(E, Epos, Pos) -> {error,{Epos,core_scan,E}, Pos}. - + %% scan(CharList, StartPos) %% This takes a list of characters and tries to tokenise them. %% diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl index 41b7cb248d..590cc682c9 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_pre_expand.erl @@ -647,7 +647,7 @@ new_fun_name(#expand{func=F,arity=A,fcount=I}=St) -> ++ "-fun-" ++ integer_to_list(I) ++ "-", {list_to_atom(Name),St#expand{fcount=I+1}}. - + %% normalise_fields([RecDef]) -> [Field]. %% Normalise the field definitions to always have a default value. If %% none has been given then use 'undefined'. @@ -881,7 +881,7 @@ bin_expand_strings(Es) -> end, Es1, S); (E, Es1) -> [E|Es1] end, [], Es). - + %% new_var_name(State) -> {VarName,State}. new_var_name(St) -> diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl index c96837ab5e..45a8bc4ad9 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_core.erl @@ -1127,7 +1127,7 @@ new_in_all([Le|Les]) -> foldl(fun (L, Ns) -> intersection((core_lib:get_anno(L))#a.ns, Ns) end, (core_lib:get_anno(Le))#a.ns, Les); new_in_all([]) -> []. - + %% The AfterVars are the variables which are used afterwards. We need %% this to work out which variables are actually exported and used %% from case/receive. In subblocks/clauses the AfterVars of the block diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl index d7c3e1add9..ecba19b1d1 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/v3_kernel.erl @@ -129,7 +129,7 @@ function(#c_def{anno=Af,name=#c_fname{id=F,arity=Arity},val=Body}, St0) -> %%B1 = B0, St3 = St2, %Null second pass {#k_fdef{anno=#k{us=[],ns=[],a=Af ++ Ab}, func=F,arity=Arity,vars=Kvs,body=B1},St3}. - + %% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}. %% Do the main sequence of a body. A body ends in an atomic value or %% values. Must check if vector first so do expr. @@ -719,7 +719,7 @@ last([_|T]) -> last(T). first([_]) -> []; first([H|T]) -> [H|first(T)]. - + %% This code implements the algorithm for an optimizing compiler for %% pattern matching given "The Implementation of Functional %% Programming Languages" by Simon Peyton Jones. The code is much @@ -1143,7 +1143,7 @@ arg_val(Arg) -> #k_bin_end{} -> 0; #k_binary{} -> 0 end. - + %% ubody(Expr, Break, State) -> {Expr,[UsedVar],State}. %% Tag the body sequence with its used variables. These bodies %% either end with a #k_break{}, or with #k_return{} or an expression diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl index d3f67eb77a..8c91b6f430 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl +++ b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_cgi.erl @@ -338,7 +338,7 @@ exec_script(false,Info,Script,_AfterScript,_RequestURI) -> %% proxy(#mod{config_db = ConfigDb} = Info, Port) -> - Timeout = httpd_util:lookup(ConfigDb, cgi_timeout, ?DEFAULT_CGI_TIMEOUT), + Timeout = httpd_util:lookup(ConfigDb, script_timeout, ?DEFAULT_CGI_TIMEOUT), proxy(Info, Port, 0, undefined,[], Timeout). proxy(Info, Port, Size, StatusCode, AccResponse, Timeout) -> diff --git a/lib/dialyzer/test/small_SUITE_data/results/trec b/lib/dialyzer/test/small_SUITE_data/results/trec index 01ccc63761..b95df1e6ef 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/trec +++ b/lib/dialyzer/test/small_SUITE_data/results/trec @@ -1,7 +1,7 @@ -trec.erl:26: Function test/0 has no local return -trec.erl:27: The call trec:mk_foo_loc(42,any()) will never return since it differs in the 1st argument from the success typing arguments: ('undefined',atom()) -trec.erl:29: Function mk_foo_loc/2 has no local return -trec.erl:30: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() -trec.erl:36: Function mk_foo_exp/2 has no local return -trec.erl:37: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() +trec.erl:28: Function test/0 has no local return +trec.erl:29: The call trec:mk_foo_loc(42,any()) will never return since it differs in the 1st argument from the success typing arguments: ('undefined',atom()) +trec.erl:31: Function mk_foo_loc/2 has no local return +trec.erl:32: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() +trec.erl:38: Function mk_foo_exp/2 has no local return +trec.erl:39: Record construction violates the declared type for #foo{} since variable A cannot be of type atom() diff --git a/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl b/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl index 60ffbe818f..ddb97796fb 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/appmon_place.erl @@ -1,6 +1,6 @@ %%--------------------------------------------------------------------- %% This is added as a test because it was giving a false positive -%% (function move/4 will nevr be called) due to the strange use of +%% (function move/4 will never be called) due to the strange use of %% self-recursive fun construction in placex/3. %% %% The analysis was getting confused that the foldl call will never diff --git a/lib/dialyzer/test/small_SUITE_data/src/contract3.erl b/lib/dialyzer/test/small_SUITE_data/src/contract3.erl index 5b0bee9694..a6ce91882e 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/contract3.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/contract3.erl @@ -18,16 +18,23 @@ t(X, Y, Z) -> (atom()|list()) -> atom(). t1(X) -> - foo:bar(X). + f(X). -spec t2(atom(), integer()) -> integer(); (atom(), list()) -> atom(). t2(X, Y) -> - foo:bar(X, Y). + g(X, Y). -spec t3(atom(), integer(), list()) -> integer(); (X, integer(), list()) -> X. t3(X, Y, Z) -> X. + +%% dummy functions below + +f(X) -> X. + +g(X, Y) when is_atom(X), is_integer(Y) -> Y; +g(X, Y) when is_atom(X), is_list(Y) -> X. diff --git a/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl b/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl index b58fa732cb..3acc5ca065 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl @@ -1,6 +1,6 @@ %% -%% The Original Code is RabbitMQ. -%% +%% This is stripped down code from RabbitMQ. It is used to report an +%% invalid type specification for function list_vhost_permissions/1. %% The Initial Developer of the Original Code is VMware, Inc. %% @@ -38,7 +38,7 @@ vhost_perms_info_keys() -> -spec list_vhost_permissions(vhost()) -> infos(). list_vhost_permissions(VHostPath) -> - list_permissions(vhost_perms_info_keys(), rabbit_foo:some_list()). + list_permissions(vhost_perms_info_keys(), some_mod:some_function()). filter_props(Keys, Props) -> [T || T = {K, _} <- Props, lists:member(K, Keys)]. diff --git a/lib/dialyzer/test/small_SUITE_data/src/gencall.erl b/lib/dialyzer/test/small_SUITE_data/src/gencall.erl index d2875c9df1..762be55007 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/gencall.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/gencall.erl @@ -7,6 +7,6 @@ f() -> gen_server:call(1,2,3), ets:lookup(1,2,3), - gencall2:foo(), + some_mod:some_function(), gencall:foo(), gen_server:handle_cast(1,2). diff --git a/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl b/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl index 1743d81493..6d2a35b7c8 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/maybe_improper.erl @@ -1,7 +1,18 @@ +%%%======================================================================== +%%% Tests handling of maybe improper lists +%%%======================================================================== -module(maybe_improper). --export([s/1]). +-export([s/1, t/0]). -spec s(maybe_improper_list(X,Y)) -> {[X], maybe_improper_list(X,Y)}. -s(A) -> - lists:split(2,A). +s(L) -> + lists:split(2, L). + +%% Having a remote type in the 'tail' of the list crashed dialyzer. +%% The problem was fixed for R16B03. +-type t_mil() :: maybe_improper_list(integer(), orddict:orddict()). + +-spec t() -> t_mil(). +t() -> + [42 | []]. diff --git a/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl b/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl index 0af4f7446f..074a93e2fe 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/overloaded1.erl @@ -1,5 +1,5 @@ %%----------------------------------------------------------------------------- -%% Test that tests overloaded contratcs. +%% Test that tests overloaded contracts. %% In December 2008 it works as far as intersection types are concerned (test1) %% However, it does NOT work as far as type variables are concerned (test2) %%----------------------------------------------------------------------------- @@ -16,13 +16,13 @@ test2() -> -type mod() :: atom(). --spec foo(ATM, list()) -> {'ok', ATM} | {'error', _} when is_subtype(ATM, mod()) - ; (MFA, list()) -> {'ok', MFA} | {'error', _} when is_subtype(MFA, mfa()). +-spec foo(ATM, list()) -> {'ok', ATM} | {'error', _} when ATM :: mod() + ; (MFA, list()) -> {'ok', MFA} | {'error', _} when MFA :: mfa(). foo(F, _) when is_atom(F) -> case atom_to_list(F) of - [42|_] -> {ok, F}; - _Other -> {error, mod:bar(F)} + [42|_] -> {ok, F}; + _Other -> {error, some_mod:some_function()} end; foo({M,F,A}, _) -> case A =:= 0 of diff --git a/lib/dialyzer/test/small_SUITE_data/src/trec.erl b/lib/dialyzer/test/small_SUITE_data/src/trec.erl index ba50c3b401..06706162c1 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/trec.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/trec.erl @@ -18,20 +18,22 @@ %% ('undefined',atom()) %% 3. Function mk_foo_loc/2 has no local return %% -%% Arguably, the second warning is not what most users have in mind -%% when they wrote the type declarations in the 'foo' record, so no -%% doubt they'll find it confusing. But note that it is also inconsistent! -%% How come there is a success typing for a function that has no local return? +%% Arguably, the second warning is not what most users have in mind when +%% they wrote the type declarations in the 'foo' record, so no doubt +%% they'll find it confusing. But note that it is also quite confusing! +%% Many users may be wondering: How come there is a success typing for a +%% function that has no local return? Running typer on this module +%% reveals a success typing for this function that is interesting indeed. %% test() -> - mk_foo_loc(42, bar:f()). + mk_foo_loc(42, some_mod:some_function()). mk_foo_loc(A, B) -> #foo{a = A, b = [A,B]}. %% -%% For this function we currently get "has no local return" but we get -%% no reason; I want us to get a reason. +%% For this function we used to get a "has no local return" warning +%% but we got no reason. This has now been fixed. %% mk_foo_exp(A, B) when is_integer(A) -> #foo{a = A, b = [A,B]}. 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 d11f904996..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:ssloptsion() + 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,11 +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 -> - SslOpts = [{verify,0} | Opts ++ Data#eldap.tls_opts], - ssl:connect(Host, Data#eldap.port, SslOpts). +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 @@ -431,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); @@ -445,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 %%% -------------------------------------------------------------------- @@ -686,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) -> @@ -801,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/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c index 7ca4f430de..636d26b24b 100644 --- a/lib/erl_interface/src/legacy/erl_eterm.c +++ b/lib/erl_interface/src/legacy/erl_eterm.c @@ -686,7 +686,7 @@ int erl_length(const ETERM *ep) return n; } - + /*********************************************************************** * I o l i s t f u n c t i o n s * diff --git a/lib/erl_interface/test/all_SUITE_data/ei_runner.c b/lib/erl_interface/test/all_SUITE_data/ei_runner.c index 205f911e38..cdf32b48c4 100644 --- a/lib/erl_interface/test/all_SUITE_data/ei_runner.c +++ b/lib/erl_interface/test/all_SUITE_data/ei_runner.c @@ -77,7 +77,7 @@ run_tests(char* argv0, TestCase test_cases[], unsigned number) } } - + /*********************************************************************** * * R e a d i n g p a c k e t s @@ -182,7 +182,7 @@ char *read_packet(int *len) return io_buf; } - + /*********************************************************************** * S e n d i n g r e p l i e s * diff --git a/lib/erl_interface/test/all_SUITE_data/runner.c b/lib/erl_interface/test/all_SUITE_data/runner.c index a474c17722..038d651275 100644 --- a/lib/erl_interface/test/all_SUITE_data/runner.c +++ b/lib/erl_interface/test/all_SUITE_data/runner.c @@ -78,7 +78,7 @@ run_tests(char* argv0, TestCase test_cases[], unsigned number) } } - + /*********************************************************************** * * R e a d i n g p a c k e t s @@ -188,7 +188,7 @@ char *read_packet(int *len) return io_buf; } - + /*********************************************************************** * S e n d i n g r e p l i e s * diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl index 48469e68dc..642809ea7a 100644 --- a/lib/erl_interface/test/ei_accept_SUITE.erl +++ b/lib/erl_interface/test/ei_accept_SUITE.erl @@ -155,7 +155,7 @@ start_einode(Einode, N, Host, Port) -> ok. - + %%% Interface functions for ei (erl_interface) functions. ei_connect_init(P, Num, Cookie, Creation) -> diff --git a/lib/erl_interface/test/erl_connect_SUITE.erl b/lib/erl_interface/test/erl_connect_SUITE.erl index bd54013402..c8becc760c 100644 --- a/lib/erl_interface/test/erl_connect_SUITE.erl +++ b/lib/erl_interface/test/erl_connect_SUITE.erl @@ -106,7 +106,7 @@ erl_reg_send(Config) when is_list(Config) -> ?line runner:recv_eot(P), ok. - + %%% Interface functions for erl_interface functions. erl_connect_init(P, Num, Cookie, Creation) -> diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl index 10a27e48e3..100e9b6f68 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE.erl +++ b/lib/erl_interface/test/erl_eterm_SUITE.erl @@ -108,7 +108,7 @@ end_per_group(_GroupName, Config) -> Config. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 1. B a s i c t e s t s @@ -196,7 +196,7 @@ t_erl_free_compound(Config) when is_list(Config) -> ?line runner:test(?t_erl_free_compound), ok. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 2. C o n s t r u c t i n g t e r m s @@ -521,7 +521,7 @@ t_erl_cons(Config) when is_list(Config) -> - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 3. E x t r a c t i n g & i n f o f u n c t i o n s @@ -669,7 +669,7 @@ t_erl_element(Config) when is_list(Config) -> ok. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 4. I / O l i s t f u n c t i o n s @@ -894,7 +894,7 @@ iolist_to_string(Port, Term) -> 'NULL' -> 'NULL' end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% 5. M i s c e l l a n o u s T e s t s diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c b/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c index 80d7f69520..94959187b9 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c +++ b/lib/erl_interface/test/erl_eterm_SUITE_data/eterm_test.c @@ -269,7 +269,7 @@ TESTCASE(t_erl_free_compound) report(1); } - + /*********************************************************************** * * 2. C o n s t r u c t i n g t e r m s @@ -1047,7 +1047,7 @@ TESTCASE(t_erl_cons) - + /*********************************************************************** * * 3. E x t r a c t i n g & i n f o f u n c t i o n s @@ -1296,7 +1296,7 @@ TESTCASE(extractor_macros) } - + /*********************************************************************** * * 4. I / O l i s t f u n c t i o n s @@ -1393,7 +1393,7 @@ TESTCASE(t_erl_iolist_to_string) } } - + /*********************************************************************** * * 5. M i s c e l l a n o u s T e s t s diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl index ec7d93fd48..03d1a18321 100644 --- a/lib/eunit/src/eunit_proc.erl +++ b/lib/eunit/src/eunit_proc.erl @@ -643,11 +643,11 @@ io_request({get_until, _Prompt, _M, _F, _As}, Buf) -> io_request({setopts, _Opts}, Buf) -> {ok, Buf}; io_request(getopts, Buf) -> - {error, {error, enotsup}, Buf}; + {{error, enotsup}, Buf}; io_request({get_geometry,columns}, Buf) -> - {error, {error, enotsup}, Buf}; + {{error, enotsup}, Buf}; io_request({get_geometry,rows}, Buf) -> - {error, {error, enotsup}, Buf}; + {{error, enotsup}, Buf}; io_request({requests, Reqs}, Buf) -> io_requests(Reqs, {ok, Buf}); io_request(_, Buf) -> @@ -657,3 +657,10 @@ io_requests([R | Rs], {ok, Buf}) -> io_requests(Rs, io_request(R, Buf)); io_requests(_, Result) -> Result. + +-ifdef(TEST). +io_error_test_() -> + [?_assertMatch({error, enotsup}, io:getopts()), + ?_assertMatch({error, enotsup}, io:columns()), + ?_assertMatch({error, enotsup}, io:rows())]. +-endif. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index d1243b2325..d7d8a878c5 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -671,8 +671,9 @@ t_solve_remote(?function(Domain, Range), ET, R, C) -> {RT2, RR2} = t_solve_remote(Range, ET, R, C), {?function(RT1, RT2), RR1 ++ RR2}; t_solve_remote(?list(Types, Term, Size), ET, R, C) -> - {RT, RR} = t_solve_remote(Types, ET, R, C), - {?list(RT, Term, Size), RR}; + {RT1, RR1} = t_solve_remote(Types, ET, R, C), + {RT2, RR2} = t_solve_remote(Term, ET, R, C), + {?list(RT1, RT2, Size), RR1 ++ RR2}; t_solve_remote(?product(Types), ET, R, C) -> {RL, RR} = list_solve_remote(Types, ET, R, C), {?product(RL), RR}; @@ -1349,8 +1350,8 @@ t_maybe_improper_list() -> t_maybe_improper_list(_Content, ?unit) -> ?none; t_maybe_improper_list(?unit, _Termination) -> ?none; t_maybe_improper_list(Content, Termination) -> - %% Safety check - true = t_is_subtype(t_nil(), Termination), + %% Safety check: would be nice to have but does not work with remote types + %% true = t_is_subtype(t_nil(), Termination), ?list(Content, Termination, ?unknown_qual). -spec t_is_maybe_improper_list(erl_type()) -> boolean(). @@ -1365,8 +1366,8 @@ t_is_maybe_improper_list(_) -> false. %% t_improper_list(?unit, _Termination) -> ?none; %% t_improper_list(_Content, ?unit) -> ?none; %% t_improper_list(Content, Termination) -> -%% %% Safety check -%% false = t_is_subtype(t_nil(), Termination), +%% %% Safety check: would be nice to have but does not work with remote types +%% %% false = t_is_subtype(t_nil(), Termination), %% ?list(Content, Termination, ?any). -spec lift_list_to_pos_empty(erl_type()) -> erl_type(). diff --git a/lib/ic/c_src/Makefile.in b/lib/ic/c_src/Makefile.in index 6e65f06114..ed860ab73b 100644 --- a/lib/ic/c_src/Makefile.in +++ b/lib/ic/c_src/Makefile.in @@ -132,10 +132,8 @@ docs: _create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) $(LIBRARY): $(OBJ_FILES) - $(ar_verbose) - -$(AR) $(AR_OUT) $@ $(OBJ_FILES) - $(ranlib_verbose) - -$(RANLIB) $@ + -$(V_AR) $(AR_OUT) $@ $(OBJ_FILES) + -$(V_RANLIB) $@ $(OBJDIR)/%.o: %.c $(V_CC) $(CC_FLAGS) -c -o $@ $(ALL_CFLAGS) $< diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index d9a27e7d1e..db68cc3116 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2004</year><year>2012</year> + <year>2004</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -440,7 +440,10 @@ apply(Module, Function, [ReplyInfo | Args]) <v>Profile = profile() | pid() (when started <c>stand_alone</c>)</v> </type> <desc> - <p>Cancels an asynchronous HTTP-request. </p> + <p>Cancels an asynchronous HTTP-request. Note this does not guarantee + that the request response will not be delivered, as it is asynchronous the + the request may already have been completed when the cancellation arrives. + </p> <marker id="set_options"></marker> </desc> diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 4d7023a8e9..da9bbdd1ec 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -208,16 +208,8 @@ cancel_request(RequestId) -> cancel_request(RequestId, Profile) when is_atom(Profile) orelse is_pid(Profile) -> ?hcrt("cancel request", [{request_id, RequestId}, {profile, Profile}]), - ok = httpc_manager:cancel_request(RequestId, profile_name(Profile)), - receive - %% If the request was already fulfilled throw away the - %% answer as the request has been canceled. - {http, {RequestId, _}} -> - ok - after 0 -> - ok - end. - + httpc_manager:cancel_request(RequestId, profile_name(Profile)). + %%-------------------------------------------------------------------------- %% set_options(Options) -> ok | {error, Reason} @@ -241,14 +233,7 @@ set_options(Options, Profile) when is_atom(Profile) orelse is_pid(Profile) -> ?hcrt("set options", [{options, Options}, {profile, Profile}]), case validate_options(Options) of {ok, Opts} -> - try - begin - httpc_manager:set_options(Opts, profile_name(Profile)) - end - catch - exit:{noproc, _} -> - {error, inets_not_started} - end; + httpc_manager:set_options(Opts, profile_name(Profile)); {error, Reason} -> {error, Reason} end. @@ -343,8 +328,6 @@ store_cookies(SetCookieHeaders, Url, Profile) ok end catch - exit:{noproc, _} -> - {error, {not_started, Profile}}; error:{badmatch, Bad} -> {error, {parse_failed, Bad}} end. diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 55794f57dc..80c8b2439e 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -32,7 +32,7 @@ start_link/4, %% connect_and_send/2, send/2, - cancel/3, + cancel/2, stream_next/1, info/1 ]). @@ -117,8 +117,8 @@ send(Request, Pid) -> %% Description: Cancels a request. Intended to be called by the httpc %% manager process. %%-------------------------------------------------------------------- -cancel(RequestId, Pid, From) -> - cast({cancel, RequestId, From}, Pid). +cancel(RequestId, Pid) -> + cast({cancel, RequestId}, Pid). %%-------------------------------------------------------------------- @@ -400,19 +400,17 @@ handle_call(info, _, State) -> %% handle_keep_alive_queue/2 on the other hand will just skip the %% request as if it was never issued as in this case the request will %% not have been sent. -handle_cast({cancel, RequestId, From}, +handle_cast({cancel, RequestId}, #state{request = #request{id = RequestId} = Request, profile_name = ProfileName, canceled = Canceled} = State) -> ?hcrv("cancel current request", [{request_id, RequestId}, {profile, ProfileName}, {canceled, Canceled}]), - httpc_manager:request_canceled(RequestId, ProfileName, From), - ?hcrv("canceled", []), {stop, normal, State#state{canceled = [RequestId | Canceled], request = Request#request{from = answer_sent}}}; -handle_cast({cancel, RequestId, From}, +handle_cast({cancel, RequestId}, #state{profile_name = ProfileName, request = #request{id = CurrId}, canceled = Canceled} = State) -> @@ -420,8 +418,6 @@ handle_cast({cancel, RequestId, From}, {curr_req_id, CurrId}, {profile, ProfileName}, {canceled, Canceled}]), - httpc_manager:request_canceled(RequestId, ProfileName, From), - ?hcrv("canceled", []), {noreply, State#state{canceled = [RequestId | Canceled]}}; handle_cast(stream_next, #state{session = Session} = State) -> @@ -521,19 +517,12 @@ handle_info({Proto, _Socket, Data}, activate_once(Session), {noreply, State#state{mfa = NewMFA}} catch - exit:_Exit -> - ?hcrd("data processing exit", [{exit, _Exit}]), + _:_Reason -> + ?hcrd("data processing exit", [{exit, _Reason}]), ClientReason = {could_not_parse_as_http, Data}, ClientErrMsg = httpc_response:error(Request, ClientReason), NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState}; - error:_Error -> - ?hcrd("data processing error", [{error, _Error}]), - ClientReason = {could_not_parse_as_http, Data}, - ClientErrMsg = httpc_response:error(Request, ClientReason), - NewState = answer_request(Request, ClientErrMsg, State), {stop, normal, NewState} - end, ?hcri("data processed", [{final_result, FinalResult}]), FinalResult; @@ -1165,7 +1154,7 @@ handle_http_body(Body, #state{headers = Headers, handle_response(#state{status = new} = State) -> ?hcrd("handle response - status = new", []), - handle_response(try_to_enable_pipeline_or_keep_alive(State)); + handle_response(check_persistent(State)); handle_response(#state{request = Request, status = Status, @@ -1440,39 +1429,22 @@ is_keep_alive_enabled_server(_,_) -> is_keep_alive_connection(Headers, #session{client_close = ClientClose}) -> (not ((ClientClose) orelse httpc_response:is_server_closing(Headers))). -try_to_enable_pipeline_or_keep_alive( - #state{session = Session, - request = #request{method = Method}, +check_persistent( + #state{session = #session{type = Type} = Session, status_line = {Version, _, _}, headers = Headers, - profile_name = ProfileName} = State) -> - ?hcrd("try to enable pipeline or keep-alive", - [{version, Version}, - {headers, Headers}, - {session, Session}]), + profile_name = ProfileName} = State) -> case is_keep_alive_enabled_server(Version, Headers) andalso - is_keep_alive_connection(Headers, Session) of + is_keep_alive_connection(Headers, Session) of true -> - case (is_pipeline_enabled_client(Session) andalso - httpc_request:is_idempotent(Method)) of - true -> - insert_session(Session, ProfileName), - State#state{status = pipeline}; - false -> - insert_session(Session, ProfileName), - %% Make sure type is keep_alive in session - %% as it in this case might be pipeline - NewSession = Session#session{type = keep_alive}, - State#state{status = keep_alive, - session = NewSession} - end; + mark_persistent(ProfileName, Session), + State#state{status = Type}; false -> State#state{status = close} end. answer_request(#request{id = RequestId, from = From} = Request, Msg, - #state{session = Session, - timers = Timers, + #state{timers = Timers, profile_name = ProfileName} = State) -> ?hcrt("answer request", [{request, Request}, {msg, Msg}]), httpc_response:send(From, Msg), @@ -1482,19 +1454,14 @@ answer_request(#request{id = RequestId, from = From} = Request, Msg, Timer = {RequestId, TimerRef}, cancel_timer(TimerRef, {timeout, Request#request.id}), httpc_manager:request_done(RequestId, ProfileName), - NewSession = maybe_make_session_available(ProfileName, Session), Timers2 = Timers#timers{request_timers = lists:delete(Timer, RequestTimers)}, State#state{request = Request#request{from = answer_sent}, - session = NewSession, timers = Timers2}. -maybe_make_session_available(ProfileName, - #session{available = false} = Session) -> - update_session(ProfileName, Session, #session.available, true), - Session#session{available = true}; -maybe_make_session_available(_ProfileName, Session) -> - Session. +mark_persistent(ProfileName, Session) -> + update_session(ProfileName, Session, #session.persistent, true), + Session#session{persistent = true}. cancel_timers(#timers{request_timers = ReqTmrs, queue_timer = QTmr}) -> cancel_timer(QTmr, timeout_queue), diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl index 30e2742e9d..d5b3dd2a2a 100644 --- a/lib/inets/src/http_client/httpc_internal.hrl +++ b/lib/inets/src/http_client/httpc_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-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 @@ -143,8 +143,8 @@ %% true | false %% This will be true, when a response has been received for - %% the first request. See type above. - available = false + %% the first request and the server has not closed the connection + persistent = false }). diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index c45dcab802..a3ed371e61 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. +%% Copyright Ericsson AB 2002-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 @@ -29,7 +29,6 @@ start_link/3, request/2, cancel_request/2, - request_canceled/3, request_done/2, retry_request/2, redirect_request/2, @@ -144,22 +143,7 @@ redirect_request(Request, ProfileName) -> %%-------------------------------------------------------------------- cancel_request(RequestId, ProfileName) -> - call(ProfileName, {cancel_request, RequestId}). - - -%%-------------------------------------------------------------------- -%% Function: request_canceled(RequestId, ProfileName) -> ok -%% RequestId - ref() -%% ProfileName = atom() -%% -%% Description: Confirms that a request has been canceld. Intended to -%% be called by the httpc handler process. -%%-------------------------------------------------------------------- - -request_canceled(RequestId, ProfileName, From) -> - gen_server:reply(From, ok), - cast(ProfileName, {request_canceled, RequestId}). - + cast(ProfileName, {cancel_request, RequestId}). %%-------------------------------------------------------------------- %% Function: request_done(RequestId, ProfileName) -> ok @@ -467,33 +451,13 @@ do_init(ProfileName, CookiesDir) -> %%-------------------------------------------------------------------- handle_call({request, Request}, _, State) -> ?hcri("request", [{request, Request}]), - case (catch handle_request(Request, State)) of + case (catch handle_request(Request, State, false)) of {reply, Msg, NewState} -> {reply, Msg, NewState}; Error -> {stop, Error, httpc_response:error(Request, Error), State} end; -handle_call({cancel_request, RequestId}, From, - #state{handler_db = HandlerDb} = State) -> - ?hcri("cancel_request", [{request_id, RequestId}]), - case ets:lookup(HandlerDb, RequestId) of - [] -> - %% The request has allready compleated make sure - %% it is deliverd to the client process queue so - %% it can be thrown away by httpc:cancel_request - %% This delay is hopfully a temporary workaround. - %% Note that it will not not delay the manager, - %% only the client that called httpc:cancel_request - timer:apply_after(?DELAY, gen_server, reply, [From, ok]), - {noreply, State}; - [{_, Pid, _}] -> - httpc_handler:cancel(RequestId, Pid, From), - {noreply, - State#state{cancel = - [{RequestId, Pid, From} | State#state.cancel]}} - end; - handle_call(reset_cookies, _, #state{cookie_db = CookieDb} = State) -> ?hcrv("reset cookies", []), httpc_cookie:reset_db(CookieDb), @@ -547,7 +511,7 @@ handle_cast({retry_or_redirect_request, {Time, Request}}, {noreply, State}; handle_cast({retry_or_redirect_request, Request}, State) -> - case (catch handle_request(Request, State)) of + case (catch handle_request(Request, State, true)) of {reply, {ok, _}, NewState} -> {noreply, NewState}; Error -> @@ -555,19 +519,19 @@ handle_cast({retry_or_redirect_request, Request}, State) -> {stop, Error, State} end; -handle_cast({request_canceled, RequestId}, State) -> - ?hcrv("request canceled", [{request_id, RequestId}]), - ets:delete(State#state.handler_db, RequestId), - case lists:keysearch(RequestId, 1, State#state.cancel) of - {value, Entry = {RequestId, _, From}} -> - ?hcrt("found in cancel", [{from, From}]), - {noreply, - State#state{cancel = lists:delete(Entry, State#state.cancel)}}; - Else -> - ?hcrt("not found in cancel", [{else, Else}]), - {noreply, State} +handle_cast({cancel_request, RequestId}, + #state{handler_db = HandlerDb} = State) -> + case ets:lookup(HandlerDb, RequestId) of + [] -> + %% Request already compleated nothing to + %% cancel + {noreply, State}; + [{_, Pid, _}] -> + httpc_handler:cancel(RequestId, Pid), + ets:delete(State#state.handler_db, RequestId), + {noreply, State} end; - + handle_cast({request_done, RequestId}, State) -> ?hcrv("request done", [{request_id, RequestId}]), ets:delete(State#state.handler_db, RequestId), @@ -629,22 +593,8 @@ handle_info({'EXIT', _, _}, State) -> %% Handled in DOWN {noreply, State}; handle_info({'DOWN', _, _, Pid, _}, State) -> - ets:match_delete(State#state.handler_db, {'_', Pid, '_'}), - - %% If there where any canceled request, handled by the - %% the process that now has terminated, the - %% cancelation can be viewed as sucessfull! - NewCanceldList = - lists:foldl(fun(Entry = {_, HandlerPid, From}, Acc) -> - case HandlerPid of - Pid -> - gen_server:reply(From, ok), - lists:delete(Entry, Acc); - _ -> - Acc - end - end, State#state.cancel, State#state.cancel), - {noreply, State#state{cancel = NewCanceldList}}; + ets:match_delete(State#state.handler_db, {'_', Pid, '_'}), + {noreply, State}; handle_info(Info, State) -> Report = io_lib:format("Unknown message in " "httpc_manager:handle_info ~p~n", [Info]), @@ -774,7 +724,7 @@ get_handler_info(Tab) -> handle_request(#request{settings = #http_options{version = "HTTP/0.9"}} = Request, - State) -> + State, _) -> %% Act as an HTTP/0.9 client that does not know anything %% about persistent connections @@ -787,7 +737,7 @@ handle_request(#request{settings = handle_request(#request{settings = #http_options{version = "HTTP/1.0"}} = Request, - State) -> + State, _) -> %% Act as an HTTP/1.0 client that does not %% use persistent connections @@ -798,13 +748,13 @@ handle_request(#request{settings = start_handler(NewRequest#request{headers = NewHeaders}, State), {reply, {ok, NewRequest#request.id}, State}; -handle_request(Request, State = #state{options = Options}) -> +handle_request(Request, State = #state{options = Options}, Retry) -> NewRequest = handle_cookies(generate_request_id(Request), State), SessionType = session_type(Options), case select_session(Request#request.method, Request#request.address, - Request#request.scheme, SessionType, State) of + Request#request.scheme, SessionType, State, Retry) of {ok, HandlerPid} -> pipeline_or_keep_alive(NewRequest, HandlerPid, State); no_connection -> @@ -828,6 +778,7 @@ start_handler(#request{id = Id, #state{profile_name = ProfileName, handler_db = HandlerDb, options = Options}) -> + ClientClose = httpc_request:is_client_closing(Request#request.headers), {ok, Pid} = case is_inets_manager() of true -> @@ -838,13 +789,18 @@ start_handler(#request{id = Id, end, HandlerInfo = {Id, Pid, From}, ets:insert(HandlerDb, HandlerInfo), + insert_session(#session{id = {Request#request.address, Pid}, + scheme = Request#request.scheme, + client_close = ClientClose, + type = session_type(Options) + }, ProfileName), erlang:monitor(process, Pid). select_session(Method, HostPort, Scheme, SessionType, #state{options = #options{max_pipeline_length = MaxPipe, max_keep_alive_length = MaxKeepAlive}, - session_db = SessionDb}) -> + session_db = SessionDb}, Retry) -> ?hcrd("select session", [{session_type, SessionType}, {max_pipeline_length, MaxPipe}, {max_keep_alive_length, MaxKeepAlive}]), @@ -857,19 +813,29 @@ select_session(Method, HostPort, Scheme, SessionType, %% client_close, scheme and type specified. %% The fields id (part of: HandlerPid) and queue_length %% specified. - Pattern = #session{id = {HostPort, '$1'}, - client_close = false, - scheme = Scheme, - queue_length = '$2', - type = SessionType, - available = true, - _ = '_'}, + Pattern = case (Retry andalso SessionType == pipeline) of + true -> + #session{id = {HostPort, '$1'}, + client_close = false, + scheme = Scheme, + queue_length = '$2', + type = SessionType, + persistent = true, + _ = '_'}; + false -> + #session{id = {HostPort, '$1'}, + client_close = false, + scheme = Scheme, + queue_length = '$2', + type = SessionType, + _ = '_'} + end, %% {'_', {HostPort, '$1'}, false, Scheme, '_', '$2', SessionTyp}, Candidates = ets:match(SessionDb, Pattern), ?hcrd("select session", [{host_port, HostPort}, {scheme, Scheme}, {type, SessionType}, - {candidates, Candidates}]), + {candidates, Candidates}]), select_session(Candidates, MaxKeepAlive, MaxPipe, SessionType); false -> no_connection diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index b3ca13e2fe..27446ca7fe 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -798,6 +798,8 @@ store({log_format, LogFormat}, _ConfigList) store({server_tokens, ServerTokens} = Entry, _ConfigList) -> Server = server(ServerTokens), {ok, [Entry, {server, Server}]}; +store({keep_alive_timeout, KeepAliveTimeout}, _ConfigList) -> + {ok, {keep_alive_timeout, KeepAliveTimeout * 1000}}; store(ConfigListEntry, _ConfigList) -> {ok, ConfigListEntry}. diff --git a/lib/inets/src/http_server/mod_cgi.erl b/lib/inets/src/http_server/mod_cgi.erl index f1b73810e6..d933b0a4ba 100644 --- a/lib/inets/src/http_server/mod_cgi.erl +++ b/lib/inets/src/http_server/mod_cgi.erl @@ -131,9 +131,9 @@ store({script_nocache, Value} = Conf, _) {ok, Conf}; store({script_nocache, Value}, _) -> {error, {wrong_type, {script_nocache, Value}}}; -store({script_timeout, Value} = Conf, _) +store({script_timeout, Value}, _) when is_integer(Value), Value >= 0 -> - {ok, Conf}; + {ok, {script_timeout, Value * 1000}}; store({script_timeout, Value}, _) -> {error, {wrong_type, {script_timeout, Value}}}. @@ -238,7 +238,7 @@ send_request_body_to_script(ModData, Port) -> end. deliver_webpage(#mod{config_db = Db} = ModData, Port) -> - Timeout = cgi_timeout(Db), + Timeout = script_timeout(Db), case receive_headers(Port, httpd_cgi, parse_headers, [<<>>, [], []], Timeout) of {Headers, Body} -> @@ -341,8 +341,8 @@ script_elements(#mod{method = "PUT", entity_body = Body}, _) -> script_elements(_, _) -> []. -cgi_timeout(Db) -> - httpd_util:lookup(Db, cgi_timeout, ?DEFAULT_CGI_TIMEOUT). +script_timeout(Db) -> + httpd_util:lookup(Db, script_timeout, ?DEFAULT_CGI_TIMEOUT). %% Convert error to printable string %% diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 0c35f284f7..818edc12ac 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -277,9 +277,6 @@ trace(Config) when is_list(Config) -> pipeline(Config) when is_list(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), []}, {ok, _} = httpc:request(get, Request, [], [], pipeline), - - %% Make sure pipeline session is registerd - test_server:sleep(4000), keep_alive_requests(Request, pipeline). %%-------------------------------------------------------------------- @@ -287,9 +284,6 @@ pipeline(Config) when is_list(Config) -> persistent_connection(Config) when is_list(Config) -> Request = {url(group_name(Config), "/dummy.html", Config), []}, {ok, _} = httpc:request(get, Request, [], [], persistent), - - %% Make sure pipeline session is registerd - test_server:sleep(4000), keep_alive_requests(Request, persistent). %%------------------------------------------------------------------------- @@ -311,13 +305,8 @@ async(Config) when is_list(Config) -> {ok, NewRequestId} = httpc:request(get, Request, [], [{sync, false}]), - ok = httpc:cancel_request(NewRequestId), - receive - {http, {NewRequestId, _}} -> - ct:fail(http_cancel_request_failed) - after 3000 -> - ok - end. + ok = httpc:cancel_request(NewRequestId). + %%------------------------------------------------------------------------- save_to_file() -> [{doc, "Test to save the http body to a file"}]. @@ -1149,7 +1138,7 @@ receive_replys([ID|IDs]) -> {http, {ID, {{_, 200, _}, [_|_], _}}} -> receive_replys(IDs); {http, {Other, {{_, 200, _}, [_|_], _}}} -> - ct:fail({recived_canceld_id, Other}) + ct:pal({recived_canceld_id, Other}) end. %% Perform a synchronous stop diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl index b1fe373cff..2d06f3e70c 100644 --- a/lib/inets/test/httpd_basic_SUITE.erl +++ b/lib/inets/test/httpd_basic_SUITE.erl @@ -38,7 +38,9 @@ all() -> erl_script_nocache_opt, script_nocache, escaped_url_in_error_body, - slowdose + script_timeout, + slowdose, + keep_alive_timeout ]. groups() -> @@ -80,16 +82,19 @@ DUMMY DummyFile = filename:join([PrivDir,"dummy.html"]), CgiDir = filename:join(PrivDir, "cgi-bin"), ok = file:make_dir(CgiDir), - Cgi = case test_server:os_type() of - {win32, _} -> - "printenv.bat"; - _ -> - "printenv.sh" - end, - inets_test_lib:copy_file(Cgi, DataDir, CgiDir), - AbsCgi = filename:join([CgiDir, Cgi]), - {ok, FileInfo} = file:read_file_info(AbsCgi), - ok = file:write_file_info(AbsCgi, FileInfo#file_info{mode = 8#00755}), + {CgiPrintEnv, CgiSleep} = case test_server:os_type() of + {win32, _} -> + {"printenv.bat", "cgi_sleep.exe"}; + _ -> + {"printenv.sh", "cgi_sleep"} + end, + lists:foreach( + fun(Cgi) -> + inets_test_lib:copy_file(Cgi, DataDir, CgiDir), + AbsCgi = filename:join([CgiDir, Cgi]), + {ok, FileInfo} = file:read_file_info(AbsCgi), + ok = file:write_file_info(AbsCgi, FileInfo#file_info{mode = 8#00755}) + end, [CgiPrintEnv, CgiSleep]), {ok, Fd} = file:open(DummyFile, [write]), ok = file:write(Fd, Dummy), ok = file:close(Fd), @@ -100,7 +105,8 @@ DUMMY {document_root, PrivDir}, {bind_address, "localhost"}], - [{httpd_conf, HttpdConf}, {cgi_dir, CgiDir}, {cgi_script, Cgi} | Config]. + [{httpd_conf, HttpdConf}, {cgi_dir, CgiDir}, + {cgi_printenv, CgiPrintEnv}, {cgi_sleep, CgiSleep} | Config]. %%-------------------------------------------------------------------- %% Function: end_per_suite(Config) -> _ @@ -235,7 +241,7 @@ script_nocache(Config) when is_list(Config) -> verify_script_nocache(Config, CgiNoCache, EsiNoCache, CgiOption, EsiOption) -> HttpdConf = ?config(httpd_conf, Config), - CgiScript = ?config(cgi_script, Config), + CgiScript = ?config(cgi_printenv, Config), CgiDir = ?config(cgi_dir, Config), {ok, Pid} = inets:start(httpd, [{port, 0}, {script_alias, @@ -363,6 +369,63 @@ escaped_url_in_error_body(Config) when is_list(Config) -> inets:stop(httpd, Pid), tsp("escaped_url_in_error_body -> done"), ok. + + +%%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- + +keep_alive_timeout(doc) -> + ["Test the keep_alive_timeout option"]; +keep_alive_timeout(suite) -> + []; +keep_alive_timeout(Config) when is_list(Config) -> + HttpdConf = ?config(httpd_conf, Config), + {ok, Pid} = inets:start(httpd, [{port, 0}, {keep_alive, true}, {keep_alive_timeout, 2} | HttpdConf]), + Info = httpd:info(Pid), + Port = proplists:get_value(port, Info), + _Address = proplists:get_value(bind_address, Info), + {ok, S} = gen_tcp:connect("localhost", Port, []), + receive + after 3000 -> + {error, closed} = gen_tcp:send(S, "hey") + end, + inets:stop(httpd, Pid). + +%%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- + +script_timeout(doc) -> + ["Test the httpd script_timeout option"]; +script_timeout(suite) -> + []; +script_timeout(Config) when is_list(Config) -> + verify_script_timeout(Config, 20, 200), + verify_script_timeout(Config, 5, 403), + ok. + +verify_script_timeout(Config, ScriptTimeout, StatusCode) -> + HttpdConf = ?config(httpd_conf, Config), + CgiScript = ?config(cgi_sleep, Config), + CgiDir = ?config(cgi_dir, Config), + {ok, Pid} = inets:start(httpd, [{port, 0}, + {script_alias, + {"/cgi-bin/", CgiDir ++ "/"}}, + {script_timeout, ScriptTimeout} + | HttpdConf]), + Info = httpd:info(Pid), + Port = proplists:get_value(port, Info), + Address = proplists:get_value(bind_address, Info), + ok = httpd_test_lib:verify_request(ip_comm, Address, Port, node(), + "GET /cgi-bin/" ++ CgiScript ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, StatusCode}, + {version, "HTTP/1.0"}]), + inets:stop(httpd, Pid). + + +%%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- + slowdose(doc) -> ["Testing minimum bytes per second option"]; slowdose(Config) when is_list(Config) -> diff --git a/lib/inets/test/httpd_basic_SUITE_data/Makefile.src b/lib/inets/test/httpd_basic_SUITE_data/Makefile.src new file mode 100644 index 0000000000..9da2ed583f --- /dev/null +++ b/lib/inets/test/httpd_basic_SUITE_data/Makefile.src @@ -0,0 +1,14 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = cgi_sleep@exe@ + +all: $(PROGS) + +cgi_sleep@exe@: cgi_sleep@obj@ + $(LD) $(CROSSLDFLAGS) -o cgi_sleep cgi_sleep@obj@ @LIBS@ + +cgi_sleep@obj@: cgi_sleep.c + $(CC) -c -o cgi_sleep@obj@ $(CFLAGS) cgi_sleep.c diff --git a/lib/inets/test/httpd_basic_SUITE_data/cgi_sleep.c b/lib/inets/test/httpd_basic_SUITE_data/cgi_sleep.c new file mode 100644 index 0000000000..126bb23987 --- /dev/null +++ b/lib/inets/test/httpd_basic_SUITE_data/cgi_sleep.c @@ -0,0 +1,26 @@ +#include <stdlib.h> +#include <stdio.h> + +#ifdef __WIN32__ +#include <windows.h> +#include <fcntl.h> +#include <io.h> +#else +#include <unistd.h> +#endif + +int main(void) +{ + unsigned int seconds = 10; + +#ifdef __WIN32__ + Sleep(seconds * 1000); + _setmode(_fileno(stdout), _O_BINARY); +#else + sleep(seconds); +#endif + + printf("Content-type: text/plain\r\n\r\n"); + printf("Slept for %u seconds.\r\n", seconds); + exit(EXIT_SUCCESS); +} 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/kernel/src/inet.erl b/lib/kernel/src/inet.erl index 27f085c3aa..d4c78505da 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -120,6 +120,17 @@ 'addr' | 'broadaddr' | 'dstaddr' | 'mtu' | 'netmask' | 'flags' |'hwaddr'. +-type if_getopt_result() :: + {'addr', ip_address()} | + {'broadaddr', ip_address()} | + {'dstaddr', ip_address()} | + {'mtu', non_neg_integer()} | + {'netmask', ip_address()} | + {'flags', ['up' | 'down' | 'broadcast' | 'no_broadcast' | + 'pointtopoint' | 'no_pointtopoint' | + 'running' | 'multicast' | 'loopback']} | + {'hwaddr', ether_address()}. + -type address_family() :: 'inet' | 'inet6'. -type socket_protocol() :: 'tcp' | 'udp' | 'sctp'. -type socket_type() :: 'stream' | 'dgram' | 'seqpacket'. @@ -266,13 +277,13 @@ getiflist() -> -spec ifget(Socket :: socket(), Name :: string() | atom(), Opts :: [if_getopt()]) -> - {'ok', [if_setopt()]} | {'error', posix()}. + {'ok', [if_getopt_result()]} | {'error', posix()}. ifget(Socket, Name, Opts) -> prim_inet:ifget(Socket, Name, Opts). -spec ifget(Name :: string() | atom(), Opts :: [if_getopt()]) -> - {'ok', [if_setopt()]} | {'error', posix()}. + {'ok', [if_getopt_result()]} | {'error', posix()}. ifget(Name, Opts) -> withsocket(fun(S) -> prim_inet:ifget(S, Name, Opts) end). diff --git a/lib/observer/doc/src/ttb.xml b/lib/observer/doc/src/ttb.xml index 4e63aecbf2..1453bbdf10 100644 --- a/lib/observer/doc/src/ttb.xml +++ b/lib/observer/doc/src/ttb.xml @@ -105,8 +105,9 @@ ttb:p(all, call)</code> <v>Nodes = atom() | [atom()] | all | existing | new</v> <v>Opts = Opt | [Opt]</v> <v>Opt = {file,Client} | {handler, FormatHandler} | {process_info,PI} | - shell | {shell, ShellSpec} | {timer, TimerSpec} | {overload, {MSec, Module, Function}} - | {flush, MSec} | resume | {resume, FetchTimeout}</v> + shell | {shell, ShellSpec} | {timer, TimerSpec} | + {overload_check, {MSec, Module, Function}} | + {flush, MSec} | resume | {resume, FetchTimeout}</v> <v>TimerSpec = MSec | {MSec, StopOpts}</v> <v>MSec = FetchTimeout = integer()</v> <v>Module = Function = atom() </v> @@ -158,7 +159,7 @@ ttb:p(all, call)</code> network communication are always present. The timer starts after <c>ttb:p/2</c> is issued, so you can set up your trace patterns before. </p> - <p>The <c>overload</c> option allows to enable overload + <p>The <c>overload_check</c> option allows to enable overload checking on the nodes under trace. <c>Module:Function(check)</c> is performed each <c>MSec</c> milliseconds. If the check returns <c>true</c>, the tracing is disabled on a given node.<br/> 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/public_key/doc/src/using_public_key.xml b/lib/public_key/doc/src/using_public_key.xml index 5d9f1536d9..450bd7e35f 100644 --- a/lib/public_key/doc/src/using_public_key.xml +++ b/lib/public_key/doc/src/using_public_key.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="iso-8859-1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> @@ -90,7 +90,7 @@ [{'RSAPrivateKey',<<224,108,117,203,152,40,15,77,128,126, 221,195,154,249,85,208,202,251,109, 119,120,57,29,89,19,9,...>>, - {"DES-EDE3-CBC",<<"k�e��p�L">>}}] + {"DES-EDE3-CBC",<<"kÙeø¼pµL">>}}] </code> @@ -350,7 +350,7 @@ ok</code> <p> or </p> - <code>1> PemBin = public_key:pem_entry_encode('SubjectPublicKeyInfo', RSAPubKey). + <code>1> PemEntry = public_key:pem_entry_encode('SubjectPublicKeyInfo', RSAPubKey). {'SubjectPublicKeyInfo', <<48,92...>>, not_encrypted} 2> PemBin = public_key:pem_encode([PemEntry]). diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 97e7a4db1d..d213b67052 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -75,8 +75,8 @@ <p>Add (atl) log conversion block option. </p> <p>It is now possible to request that the Audit Trail Log should be blocked during conversion (<c>log_to_txt</c> or <c>log_to_io</c>). - This could be usefull when coverting a large log (when there is - a chance it may otherwise wrap during conversion). </p> + This could be usefull when coverting an entire large log (when + there is a chance it may otherwise wrap during conversion). </p> <p>See agent <seealso marker="snmpa#log_to_txt">log_to_txt</seealso> and @@ -89,6 +89,17 @@ <p>Own Id: seq12433</p> </item> + <item> + <p>When converting an Audit Trail Log to text, a corrupt + log entry could cause the entire conversion to fail. </p> + <p>Also, for a log with sequence numbers, failing to + decode a log entry would cause the conversion to fail + (not because of the failed decode, but because of the + failure to write the error message). </p> + <p>Own Id: OTP-111453</p> + <p>Aux Id: Seq 12459</p> + </item> + </list> </section> diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index e1bf7692b3..fa4b72ab68 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -27,7 +27,6 @@ %% {load_module, snmp_pdus, soft_purge, soft_purge, []} %% {update, snmpa_local_db, soft, soft_purge, soft_purge, []} %% {add_module, snmpm_net_if_mt} - [ {"4.24.2", [{restart_application, snmp}]}, {"4.24.1", [{restart_application, snmp}]}, diff --git a/lib/snmp/src/misc/snmp_log.erl b/lib/snmp/src/misc/snmp_log.erl index de03c97281..862c1c7c0c 100644 --- a/lib/snmp/src/misc/snmp_log.erl +++ b/lib/snmp/src/misc/snmp_log.erl @@ -16,6 +16,7 @@ %% %% %CopyrightEnd% %% +%% -module(snmp_log). @@ -434,6 +435,8 @@ log_to_txt(Log, Block, FileName, Dir, Mibs, TextFile, Start, Stop) [Log, Block, FileName, Dir, Mibs, TextFile, Start, Stop]), File = filename:join(Dir, FileName), Converter = fun(L) -> + ?vtrace("log_to_txt:fun -> entry with" + "~n L: ~p", [L]), do_log_to_file(L, TextFile, Mibs, Start, Stop) end, log_convert(Log, Block, File, Converter). @@ -475,6 +478,8 @@ log_to_io(Log, Block, FileName, Dir, Mibs, Start, Stop) [Log, Block, FileName, Dir, Mibs, Start, Stop]), File = filename:join(Dir, FileName), Converter = fun(L) -> + ?vtrace("log_to_io:fun -> entry with" + "~n L: ~p", [L]), do_log_to_io(L, Mibs, Start, Stop) end, log_convert(Log, Block, File, Converter). @@ -504,15 +509,15 @@ do_log_convert(Log, Block, File, Converter) -> fun() -> put(sname, lc), put(verbosity, Verbosity), + ?vlog("begin converting", []), Result = do_log_convert2(Log, Block, File, Converter), + ?vlog("convert result: ~p", [Result]), exit(Result) end), receive {'DOWN', Ref, process, Pid, Result} -> %% ?vtrace("do_log_converter -> received result" - %% "~n Result: ~p" - %% "~n disk_log:info(Log): ~p", - %% [Result, disk_log:info(Log)]), + %% "~n Result: ~p", [Result]), Result end. @@ -529,6 +534,7 @@ do_log_convert2(Log, Block, File, Converter) -> %% log, because if we close an already open log we will cause %% a runtime error. + ?vtrace("do_log_convert2 -> entry - check if owner", []), case is_owner(Log) of true -> ?vtrace("do_log_converter2 -> convert an already owned log", []), @@ -541,19 +547,22 @@ do_log_convert2(Log, Block, File, Converter) -> ?vtrace("do_log_converter2 -> convert log", []), case log_open(Log, File) of {ok, _} -> - ?vtrace("do_log_converter2 -> " - "convert (the now opened) log", []), + ?vdebug("do_log_convert2 -> opened - now convert", []), maybe_block(Log, Block), Res = Converter(Log), maybe_unblock(Log, Block), disk_log:close(Log), + ?vdebug("do_log_convert2 -> converted - done: " + "~n Result: ~p", [Res]), Res; {error, {name_already_open, _}} -> - ?vtrace("do_log_converter2 -> " - "convert (an already opened) log", []), + ?vdebug("do_log_convert2 -> " + "already opened - now convert", []), maybe_block(Log, Block), Res = Converter(Log), maybe_unblock(Log, Block), + ?vdebug("do_log_convert2 -> converted - done: " + "~n Result: ~p", [Res]), Res; {error, Reason} -> ?vinfo("do_log_converter2 -> " @@ -601,50 +610,93 @@ maybe_unblock(Log, true = _Block) -> %% -- do_log_to_text --- do_log_to_file(Log, TextFile, Mibs, Start, Stop) -> + ?vtrace("do_log_to_txt -> entry with" + "~n Log: ~p" + "~n TextFile: ~p" + "~n Start: ~p" + "~n Stop: ~p", [Log, TextFile, Start, Stop]), case file:open(TextFile, [write]) of {ok, Fd} -> + ?vtrace("do_log_to_txt -> outfile created - create mini MIB", []), MiniMib = snmp_mini_mib:create(Mibs), + ?vtrace("do_log_to_txt -> mini-MIB created - begin conversion", []), Write = fun(X) -> + ?vtrace("do_log_to_txt:fun -> " + "entry - try format", []), case format_msg(X, MiniMib, Start, Stop) of {ok, S} -> + ?vtrace("do_log_to_txt:fun -> " + "formated - now write", []), io:format(Fd, "~s", [S]); _ -> + ?vdebug("do_log_to_txt:fun -> " + "format failed", []), ok end end, Res = (catch loop(disk_log:chunk(Log, start), Log, Write)), + ?vtrace("do_log_to_txt -> converted - now delete mini-MIB", []), snmp_mini_mib:delete(MiniMib), + ?vtrace("do_log_to_txt -> " + "mini-MIB closed - now close output file", []), file:close(Fd), + ?vtrace("do_log_to_txt -> done", []), Res; {error, Reason} -> + ?vinfo("failed opening output file: " + "~n TestFile: ~p" + "~n Reason: ~p", [TextFile, Reason]), {error, {TextFile, Reason}} end. do_log_to_io(Log, Mibs, Start, Stop) -> + ?vtrace("do_log_to_io -> entry with" + "~n Log: ~p" + "~n Mibs: ~p" + "~n Start: ~p" + "~n Stop: ~p", [Log, Mibs, Start, Stop]), MiniMib = snmp_mini_mib:create(Mibs), + ?vtrace("do_log_to_io -> mini-MIB created - begin conversion", []), Write = fun(X) -> + ?vtrace("do_log_to_io:fun -> entry", []), case format_msg(X, MiniMib, Start, Stop) of {ok, S} -> + ?vtrace("do_log_to_io:fun -> " + "formated - now write", []), io:format("~s", [S]); _ -> + ?vdebug("do_log_to_io:fun -> " + "format failed", []), ok end end, (catch loop(disk_log:chunk(Log, start), Log, Write)), + ?vtrace("do_log_to_io -> converted - now delete mini-MIB", []), snmp_mini_mib:delete(MiniMib), + ?vtrace("do_log_to_io -> done", []), ok. loop(eof, _Log, _Write) -> + ?vtrace("loop -> entry when eof", []), ok; -loop({error, _} = Error, _Log, _Write) -> +loop({error, _Reason} = Error, _Log, _Write) -> + ?vtrace("loop -> entry with error" + "~n Reason: ~p", [_Reason]), Error; loop({Cont, Terms}, Log, Write) -> - case (catch lists:foreach(Write, Terms)) of + ?vtrace("loop -> entry with terms" + "~n Cont: ~p" + "~n length(Terms): ~p", [Cont, length(Terms)]), + case (catch lists:foreach(Write, Terms)) of {'EXIT', Reason} -> + ?vtrace("loop -> failure while writing terms" + "~n Reason: ~p", [Reason]), {error, Reason}; - _ -> + _X -> + ?vtrace("loop -> terms written" + "~n X: ~p", [_X]), loop(disk_log:chunk(Log, Cont), Log, Write) end; loop({Cont, Terms, BadBytes}, Log, Write) -> @@ -657,6 +709,8 @@ loop({Cont, Terms, BadBytes}, Log, Write) -> loop(disk_log:chunk(Log, Cont), Log, Write) end; loop(Error, _Log, _Write) -> + ?vtrace("loop -> entry with unknown" + "~n Error: ~p", [Error]), Error. @@ -671,14 +725,17 @@ format_msg(Entry, Mib, Start, Stop) -> %% This is an old-style entry, that never had the sequence-number do_format_msg({Timestamp, Packet, {Addr, Port}}, Mib) -> + ?vdebug("do_format_msg -> old style log entry", []), do_format_msg(Timestamp, Packet, Addr, Port, Mib); %% This is the format without sequence-number do_format_msg({Timestamp, Packet, Addr, Port}, Mib) -> + ?vdebug("do_format_msg -> log entry without seqno", []), do_format_msg(Timestamp, Packet, Addr, Port, Mib); %% This is the format with sequence-number do_format_msg({Timestamp, SeqNo, Packet, Addr, Port}, Mib) -> + ?vdebug("do_format_msg -> log entry with seqno", []), do_format_msg(Timestamp, SeqNo, Packet, Addr, Port, Mib); %% This is crap... @@ -686,103 +743,165 @@ do_format_msg(_, _) -> format_tab("** unknown entry in log file\n\n", []). do_format_msg(TimeStamp, {V3Hdr, ScopedPdu}, Addr, Port, Mib) -> + ?vtrace("do_format_msg -> entry with" + "~n Timestamp: ~p" + "~n Addr: ~p" + "~n Port: ~p" + "~n => Try decode scoped pdu", + [TimeStamp, Addr, Port]), case (catch snmp_pdus:dec_scoped_pdu(ScopedPdu)) of ScopedPDU when is_record(ScopedPDU, scopedPdu) -> + ?vtrace("do_format_msg -> scoped pdu decoded" + "~n ScopedPDU: ~p", [ScopedPDU]), Msg = #message{version = 'version-3', vsn_hdr = V3Hdr, data = ScopedPDU}, f(ts2str(TimeStamp), "", Msg, Addr, Port, Mib); + {'EXIT', Reason} -> - format_tab("** error in log file at ~s from ~p:~w ~p\n\n", + ?vinfo("Failed decoding scoped pdu: " + "~n V3Hdr: ~w" + "~n ScopedPdu: ~w" + "~n Reason: ~p", [V3Hdr, ScopedPdu, Reason]), + format_tab("** error in log file at ~s from ~s:~w ~p\n\n", [ts2str(TimeStamp), ip(Addr), Port, Reason]) end; + do_format_msg(TimeStamp, Packet, Addr, Port, Mib) -> + ?vtrace("do_format_msg -> entry with" + "~n Timestamp: ~p" + "~n Addr: ~p" + "~n Port: ~p" + "~n => Try decode packet", + [TimeStamp, Addr, Port]), case (catch snmp_pdus:dec_message(binary_to_list(Packet))) of - Msg when is_record(Msg, message) -> + #message{data = Data} = Msg when (is_record(Data, scopedPdu) orelse + is_record(Data, pdu) orelse + is_record(Data, trappdu)) -> + ?vtrace("do_format_msg -> packet decoded" + "~n Msg: ~p", [Msg]), f(ts2str(TimeStamp), "", Msg, Addr, Port, Mib); + + #message{version = Vsn, + vsn_hdr = VsnHdr} = Msg -> + ?vinfo("Message not fully decoded: " + "~n Msg: ~p", [Msg]), + Reason = + lists:flatten( + io_lib:format("Message not fully decoded: " + "Vsn = ~p, VsnHdr = ~w", [Vsn, VsnHdr])), + format_tab("** error in log file ~s from ~s:~w => " + "\n ~s\n\n", + [ts2str(TimeStamp), ip(Addr), Port, Reason]); + {'EXIT', Reason} -> + ?vinfo("Failed decoding packet: " + "~n Packet: ~w" + "~n Reason: ~p", [Packet, Reason]), format_tab("** error in log file ~p\n\n", [Reason]) end. do_format_msg(TimeStamp, SeqNo, {V3Hdr, ScopedPdu}, Addr, Port, Mib) -> + ?vtrace("do_format_msg -> entry with" + "~n Timestamp: ~p" + "~n SeqNo: ~p" + "~n Addr: ~p" + "~n Port: ~p" + "~n => Try decode scoped pdu", + [TimeStamp, SeqNo, Addr, Port]), case (catch snmp_pdus:dec_scoped_pdu(ScopedPdu)) of ScopedPDU when is_record(ScopedPDU, scopedPdu) -> + ?vtrace("do_format_msg -> scoped pdu decoded" + "~n ScopedPDU: ~p", [ScopedPDU]), Msg = #message{version = 'version-3', vsn_hdr = V3Hdr, data = ScopedPDU}, f(ts2str(TimeStamp), sn2str(SeqNo), Msg, Addr, Port, Mib); + {'EXIT', Reason} -> - format_tab("** error in log file at ~s from ~p:~w ~p\n\n", + ?vinfo("Failed decoding scoped pdu: " + "~n V3Hdr: ~w" + "~n ScopedPdu: ~w" + "~n Reason: ~p", [V3Hdr, ScopedPdu, Reason]), + format_tab("** error in log file at ~s~s from ~s:~w ~p\n\n", [ts2str(TimeStamp), sn2str(SeqNo), ip(Addr), Port, Reason]) end; do_format_msg(TimeStamp, SeqNo, Packet, Addr, Port, Mib) -> + ?vtrace("do_format_msg -> entry with" + "~n Timestamp: ~p" + "~n SeqNo: ~p" + "~n Addr: ~p" + "~n Port: ~p" + "~n => Try decode message", + [TimeStamp, SeqNo, Addr, Port]), case (catch snmp_pdus:dec_message(binary_to_list(Packet))) of - Msg when is_record(Msg, message) -> + #message{data = Data} = Msg when (is_record(Data, scopedPdu) orelse + is_record(Data, pdu) orelse + is_record(Data, trappdu)) -> + ?vtrace("do_format_msg -> message decoded" + "~n Msg: ~p", [Msg]), f(ts2str(TimeStamp), sn2str(SeqNo), Msg, Addr, Port, Mib); + + #message{version = Vsn, + vsn_hdr = VsnHdr} = Msg -> + ?vinfo("Message not fully decoded: " + "~n Msg: ~p", [Msg]), + Reason = + lists:flatten( + io_lib:format("Message not fully decoded: " + "Vsn = ~p, VsnHdr = ~w", [Vsn, VsnHdr])), + format_tab("** error in log file ~s~s from ~s:~w => " + "\n ~s\n\n", + [ts2str(TimeStamp), sn2str(SeqNo), + ip(Addr), Port, Reason]); + {'EXIT', Reason} -> - format_tab("** error in log file ~s from ~p:~w ~p\n\n", + ?vinfo("Failed decoding packet: " + "~n Packet: ~w" + "~n Reason: ~p", [Packet, Reason]), + format_tab("** error in log file ~s (~s) from ~s:~w ~p\n\n", [ts2str(TimeStamp), sn2str(SeqNo), ip(Addr), Port, Reason]) end. -%% format_msg({TimeStamp, {V3Hdr, ScopedPdu}, {Addr, Port}}, -%% Mib, Start, Stop) -> -%% format_msg({TimeStamp, {V3Hdr, ScopedPdu}, Addr, Port}, -%% Mib, Start, Stop); -%% format_msg({TimeStamp, {V3Hdr, ScopedPdu}, Addr, Port}, -%% Mib, Start, Stop) -> -%% case timestamp_filter(TimeStamp, Start, Stop) of -%% true -> -%% case (catch snmp_pdus:dec_scoped_pdu(ScopedPdu)) of -%% ScopedPDU when record(ScopedPDU, scopedPdu) -> -%% Msg = #message{version = 'version-3', -%% vsn_hdr = V3Hdr, -%% data = ScopedPDU}, -%% f(ts2str(TimeStamp), Msg, Addr, Port, Mib); -%% {'EXIT', Reason} -> -%% format_tab("** error in log file at ~s from ~p:~w ~p\n\n", -%% [ts2str(TimeStamp), ip(Addr), Port, Reason]) -%% end; -%% false -> -%% ignore -%% end; -%% format_msg({TimeStamp, Packet, {Addr, Port}}, Mib, Start, Stop) -> -%% format_msg({TimeStamp, Packet, Addr, Port}, Mib, Start, Stop); -%% format_msg({TimeStamp, Packet, Addr, Port}, Mib, Start, Stop) -> -%% case timestamp_filter(TimeStamp, Start, Stop) of -%% true -> -%% case (catch snmp_pdus:dec_message(binary_to_list(Packet))) of -%% Msg when record(Msg, message) -> -%% f(ts2str(TimeStamp), Msg, Addr, Port, Mib); -%% {'EXIT', Reason} -> -%% format_tab("** error in log file ~p\n\n", [Reason]) -%% end; -%% false -> -%% ignore -%% end; -%% format_msg(_, _Mib, _Start, _Stop) -> -%% format_tab("** unknown entry in log file\n\n", []). - f(TimeStamp, SeqNo, #message{version = Vsn, vsn_hdr = VsnHdr, data = Data}, Addr, Port, Mib) -> - Str = format_pdu(Data, Mib), - HdrStr = format_header(Vsn, VsnHdr), - case get_type(Data) of - trappdu -> - f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - 'snmpv2-trap' -> - f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - 'inform-request' -> - f_inform(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - 'get-response' -> - f_response(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - report -> - f_report(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - _ -> - f_request(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) + try + begin + Str = format_pdu(Data, Mib), + HdrStr = format_header(Vsn, VsnHdr), + case get_type(Data) of + trappdu -> + f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); + 'snmpv2-trap' -> + f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); + 'inform-request' -> + f_inform(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); + 'get-response' -> + f_response(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); + report -> + f_report(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); + _ -> + f_request(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) + end + end + catch + T:E -> + ?vinfo("Failed formating log entry" + "~n TimeStamp: ~p" + "~n SeqNo: ~p" + "~n Data: ~p" + "~n Vsn: ~p" + "~n VsnHdr: ~p" + "~n Addr: ~p" + "~n Port: ~p" + "~n Error Type: ~w" + "~n Error: ~p", + [TimeStamp, SeqNo, Data, Vsn, VsnHdr, Addr, Port, T, E]), + format_tab("** error while formating log entry ~p\n\n", [{T, E}]) end. f_request(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> @@ -809,7 +928,7 @@ f_inform(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> %% Convert a timestamp 2-tupple to a printable string %% ts2str({Local,Universal}) -> - dat2str(Local) ++ " , " ++ dat2str(Universal); + lists:flatten(dat2str(Local) ++ " , " ++ dat2str(Universal)); ts2str(_) -> "". @@ -906,7 +1025,7 @@ get_type(#pdu{type = Type}) -> ip({A,B,C,D}) -> - io_lib:format("~w.~w.~w.~w", [A,B,C,D]). + lists:flatten(io_lib:format("~w.~w.~w.~w", [A,B,C,D])). diff --git a/lib/snmp/src/misc/snmp_verbosity.erl b/lib/snmp/src/misc/snmp_verbosity.erl index e5ff3daf91..7d063fd702 100644 --- a/lib/snmp/src/misc/snmp_verbosity.erl +++ b/lib/snmp/src/misc/snmp_verbosity.erl @@ -154,7 +154,17 @@ image_of_sname(mgr) -> "MGR"; image_of_sname(mgr_misc) -> "MGR_MISC"; image_of_sname(undefined) -> ""; -image_of_sname(V) -> lists:flatten(io_lib:format("~p",[V])). +image_of_sname(S) when is_list(S) -> + %% The assumption is that its a printable string, + %% but just in case it is some other list... + try lists:flatten(io_lib:format("~s", [S])) of + L -> + L + catch + _:_ -> + lists:flatten(io_lib:format("~p", [S])) + end; +image_of_sname(V) -> lists:flatten(io_lib:format("~p", [V])). validate(info) -> info; 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/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 6513042e98..e6ed0d8626 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -34,7 +34,7 @@ -export([security_parameters/2, security_parameters/3, suite_definition/1, decipher/5, cipher/5, - suite/1, suites/1, anonymous_suites/0, psk_suites/1, srp_suites/0, + suite/1, suites/1, ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]). diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 29a8996bd6..b18452a8f2 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -49,13 +49,13 @@ ]). %% Cipher suites handling --export([available_suites/2, available_suites/3, cipher_suites/2, - select_session/10]). +-export([available_suites/2, cipher_suites/2, + select_session/10, supported_ecc/1]). %% Extensions handling -export([client_hello_extensions/5, handle_client_hello_extensions/8, %% Returns server hello extensions - handle_server_hello_extensions/9 + handle_server_hello_extensions/9, select_curve/2 ]). %% MISC @@ -89,7 +89,7 @@ client_hello_extensions(Version, CipherSuites, SslOpts, ConnectionStates, Renego {EcPointFormats, EllipticCurves} = case advertises_ec_ciphers(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites)) of true -> - ecc_extensions(tls_v1, Version); + client_ecc_extensions(tls_v1, Version); false -> {undefined, undefined} end, @@ -861,22 +861,29 @@ available_suites(UserSuites, Version) -> UserSuites end. -available_suites(ServerCert, UserSuites, Version) -> - ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version)). +available_suites(ServerCert, UserSuites, Version, Curve) -> + ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version)) + -- unavailable_ecc_suites(Curve). + +unavailable_ecc_suites(no_curve) -> + ssl_cipher:ec_keyed_suites(); +unavailable_ecc_suites(_) -> + []. cipher_suites(Suites, false) -> [?TLS_EMPTY_RENEGOTIATION_INFO_SCSV | Suites]; cipher_suites(Suites, true) -> Suites. -select_session(SuggestedSessionId, CipherSuites, Compressions, Port, Session, Version, +select_session(SuggestedSessionId, CipherSuites, Compressions, Port, #session{ecc = ECCCurve} = + Session, Version, #ssl_options{ciphers = UserSuites} = SslOpts, Cache, CacheCb, Cert) -> {SessionId, Resumed} = ssl_session:server_id(Port, SuggestedSessionId, SslOpts, Cert, Cache, CacheCb), - Suites = ssl_handshake:available_suites(Cert, UserSuites, Version), case Resumed of undefined -> + Suites = available_suites(Cert, UserSuites, Version, ECCCurve), CipherSuite = select_cipher_suite(CipherSuites, Suites), Compression = select_compression(Compressions), {new, Session#session{session_id = SessionId, @@ -886,6 +893,13 @@ select_session(SuggestedSessionId, CipherSuites, Compressions, Port, Session, Ve {resumed, Resumed} end. +supported_ecc(Version) -> + case tls_v1:ecc_curves(Version) of + [] -> + undefined; + Curves -> + #elliptic_curves{elliptic_curve_list = Curves} + end. %%-------------certificate handling -------------------------------- certificate_types({KeyExchange, _, _, _}) @@ -926,9 +940,8 @@ certificate_authorities_from_db(CertDbHandle, CertDbRef) -> handle_client_hello_extensions(RecordCB, Random, #hello_extensions{renegotiation_info = Info, srp = SRP, - next_protocol_negotiation = NextProtocolNegotiation, - ec_point_formats = EcPointFormats0, - elliptic_curves = EllipticCurves0}, Version, + ec_point_formats = ECCFormat, + next_protocol_negotiation = NextProtocolNegotiation}, Version, #ssl_options{secure_renegotiate = SecureRenegotation} = Opts, #session{cipher_suite = CipherSuite, compression_method = Compression} = Session0, ConnectionStates0, Renegotiation) -> @@ -937,12 +950,11 @@ handle_client_hello_extensions(RecordCB, Random, Random, CipherSuite, Compression, ConnectionStates0, Renegotiation, SecureRenegotation), ProtocolsToAdvertise = handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, Opts), - {EcPointFormats, EllipticCurves} = handle_ecc_extensions(Version, EcPointFormats0, EllipticCurves0), + ServerHelloExtensions = #hello_extensions{ renegotiation_info = renegotiation_info(RecordCB, server, ConnectionStates, Renegotiation), - ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves, + ec_point_formats = server_ecc_extension(Version, ECCFormat), next_protocol_negotiation = encode_protocols_advertised_on_server(ProtocolsToAdvertise) }, @@ -1078,7 +1090,7 @@ srp_user(#ssl_options{srp_identity = {UserName, _}}) -> srp_user(_) -> undefined. -ecc_extensions(Module, Version) -> +client_ecc_extensions(Module, Version) -> CryptoSupport = proplists:get_value(public_keys, crypto:supports()), case proplists:get_bool(ecdh, CryptoSupport) of true -> @@ -1089,15 +1101,13 @@ ecc_extensions(Module, Version) -> {undefined, undefined} end. -handle_ecc_extensions(Version, EcPointFormats0, EllipticCurves0) -> +server_ecc_extension(_Version, EcPointFormats) -> CryptoSupport = proplists:get_value(public_keys, crypto:supports()), case proplists:get_bool(ecdh, CryptoSupport) of true -> - EcPointFormats1 = handle_ecc_point_fmt_extension(EcPointFormats0), - EllipticCurves1 = handle_ecc_curves_extension(Version, EllipticCurves0), - {EcPointFormats1, EllipticCurves1}; - _ -> - {undefined, undefined} + handle_ecc_point_fmt_extension(EcPointFormats); + false -> + undefined end. handle_ecc_point_fmt_extension(undefined) -> @@ -1105,11 +1115,6 @@ handle_ecc_point_fmt_extension(undefined) -> handle_ecc_point_fmt_extension(_) -> #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}. -handle_ecc_curves_extension(_Version, undefined) -> - undefined; -handle_ecc_curves_extension(Version, _) -> - #elliptic_curves{elliptic_curve_list = tls_v1:ecc_curves(Version)}. - advertises_ec_ciphers([]) -> false; advertises_ec_ciphers([{ecdh_ecdsa, _,_,_} | _]) -> @@ -1124,6 +1129,22 @@ advertises_ec_ciphers([{ecdh_anon, _,_,_} | _]) -> true; advertises_ec_ciphers([_| Rest]) -> advertises_ec_ciphers(Rest). +select_curve(#elliptic_curves{elliptic_curve_list = ClientCurves}, + #elliptic_curves{elliptic_curve_list = ServerCurves}) -> + select_curve(ClientCurves, ServerCurves); +select_curve(undefined, _) -> + %% Client did not send ECC extension use default curve if + %% ECC cipher is negotiated + {namedCurve, ?secp256k1}; +select_curve(_, []) -> + no_curve; +select_curve(Curves, [Curve| Rest]) -> + case lists:member(Curve, Curves) of + true -> + {namedCurve, Curve}; + false -> + select_curve(Curves, Rest) + end. %%-------------------------------------------------------------------- %%% Internal functions @@ -1648,3 +1669,4 @@ advertised_hash_signs({Major, Minor}) when Major >= 3 andalso Minor >= 3 -> ({Hash, _}) -> proplists:get_bool(Hash, Hashs) end, HashSigns)}; advertised_hash_signs(_) -> undefined. + diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index 3a3ad8cf35..f25b0df806 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -45,7 +45,8 @@ master_secret, srp_username, is_resumable, - time_stamp + time_stamp, + ecc }). -define(NUM_OF_SESSION_ID_BYTES, 32). % TSL 1.1 & SSL 3 diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 5618837506..39595b4f95 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -97,8 +97,7 @@ terminated = false, % allow_renegotiate = true, expecting_next_protocol_negotiation = false :: boolean(), - next_protocol = undefined :: undefined | binary(), - client_ecc % {Curves, PointFmt} + next_protocol = undefined :: undefined | binary() }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, @@ -405,26 +404,24 @@ hello(#server_hello{cipher_suite = CipherSuite, hello(Hello = #client_hello{client_version = ClientVersion, extensions = #hello_extensions{hash_signs = HashSigns}}, State = #state{connection_states = ConnectionStates0, - port = Port, session = #session{own_certificate = Cert} = Session0, + port = Port, + session = #session{own_certificate = Cert} = Session0, renegotiation = {Renegotiation, _}, session_cache = Cache, session_cache_cb = CacheCb, ssl_options = SslOpts}) -> HashSign = ssl_handshake:select_hashsign(HashSigns, Cert), case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, - ConnectionStates0, Cert}, Renegotiation) of + ConnectionStates0, Cert}, Renegotiation) of {Version, {Type, #session{cipher_suite = CipherSuite} = Session}, - ConnectionStates, - #hello_extensions{ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves} = ServerHelloExt} -> + ConnectionStates, ServerHelloExt} -> {KeyAlg, _, _, _} = ssl_cipher:suite_definition(CipherSuite), - NegotiatedHashSign = negotiated_hashsign(HashSign, KeyAlg, Version), - do_server_hello(Type, ServerHelloExt, + NegotiatedHashSign = negotiated_hashsign(HashSign, KeyAlg, Version), + do_server_hello(Type, ServerHelloExt, State#state{connection_states = ConnectionStates, negotiated_version = Version, session = Session, - hashsign_algorithm = NegotiatedHashSign, - client_ecc = {EllipticCurves, EcPointFormats}}); + hashsign_algorithm = NegotiatedHashSign}); #alert{} = Alert -> handle_own_alert(Alert, ClientVersion, hello, State) end; @@ -1647,12 +1644,13 @@ key_exchange(#state{role = server, key_algorithm = Algo, negotiated_version = Version, tls_handshake_history = Handshake0, socket = Socket, - transport_cb = Transport + transport_cb = Transport, + session = #session{ecc = Curve} } = State) when Algo == ecdhe_ecdsa; Algo == ecdhe_rsa; Algo == ecdh_anon -> - ECDHKeys = public_key:generate_key(select_curve(State)), + ECDHKeys = public_key:generate_key(Curve), ConnectionState = ssl_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, @@ -3086,12 +3084,7 @@ default_hashsign(_Version, KeyExchange) KeyExchange == rsa_psk; KeyExchange == srp_anon -> {null, anon}. - -select_curve(#state{client_ecc = {[Curve|_], _}}) -> - {namedCurve, Curve}; -select_curve(_) -> - {namedCurve, ?secp256k1}. - + is_anonymous(Algo) when Algo == dh_anon; Algo == ecdh_anon; Algo == psk; diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 02bfa69fc5..ecbca83e10 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -70,7 +70,7 @@ client_hello(Host, Port, ConnectionStates, }. %%-------------------------------------------------------------------- --spec server_hello(#session{}, tls_version(), #connection_states{}, +-spec server_hello(binary(), tls_version(), #connection_states{}, #hello_extensions{}) -> #server_hello{}. %% %% Description: Creates a server hello message. @@ -120,17 +120,16 @@ hello(#client_hello{client_version = ClientVersion, cipher_suites = CipherSuites, compression_methods = Compressions, random = Random, - extensions = HelloExt}, + extensions = #hello_extensions{elliptic_curves = Curves} = HelloExt}, #ssl_options{versions = Versions} = SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) -> Version = ssl_handshake:select_version(tls_record, ClientVersion, Versions), case tls_record:is_acceptable_version(Version, Versions) of true -> - %% TODO: need to take supported Curves into Account when selecting the CipherSuite.... - %% if whe have an ECDSA cert with an unsupported curve, we need to drop ECDSA ciphers + ECCCurve = ssl_handshake:select_curve(Curves, ssl_handshake:supported_ecc(Version)), {Type, #session{cipher_suite = CipherSuite} = Session1} = ssl_handshake:select_session(SugesstedId, CipherSuites, Compressions, - Port, Session0, Version, + Port, Session0#session{ecc = ECCCurve}, Version, SslOpts, Cache, CacheCb, Cert), case CipherSuite of no_suite -> 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/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index 4f8d45dc8d..4b42f64609 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -387,7 +387,7 @@ merge(F, D1, D2) -> update(K, fun (V1) -> F(K, V1, V2) end, V2, D) end, D1, D2). - + %% get_slot(Hashdb, Key) -> Slot. %% Get the slot. First hash on the new range, if we hit a bucket %% which has not been split use the unsplit buddy bucket. diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 73b8da335a..ca6a4b5c58 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -912,7 +912,7 @@ type_test(binary) -> is_binary; type_test(record) -> is_record; type_test(Test) -> Test. - + %% match(Pattern, Term, Bindings) -> %% {match,NewBindings} | nomatch %% or erlang:error({illegal_pattern, Pattern}). @@ -1051,7 +1051,7 @@ match_list([], [], Bs, _BBs) -> {match,Bs}; match_list(_, _, _Bs, _BBs) -> nomatch. - + %% new_bindings() %% bindings(Bindings) %% binding(Name, Bindings) diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index 4b654833ed..40ef6c8998 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -222,7 +222,7 @@ format_error(Atom) when is_atom(Atom) -> format_error(Term) -> lists:flatten(io_lib:format("~tp", [Term])). - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% Useful definitions (also start of implementation). @@ -412,7 +412,7 @@ split_filename([Comp|Rest], Prefix, Suffix, Len) -> split_filename([], Prefix, Suffix, _) -> {filename:join(Prefix),filename:join(Suffix)}. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% %%% Retrieving files from a tape archive. diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 9ef4954194..b8c0576e56 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -248,7 +248,7 @@ ensure_dir(F) -> end end. - + %%% %%% Pattern matching using a compiled wildcard. %%% @@ -360,7 +360,7 @@ do_alt([], _File) -> do_list_dir(Dir, Mod) -> eval_list_dir(Dir, Mod). - + %%% Compiling a wildcard. %% Only for debugging. diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 7f65131f67..df68a37c06 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -393,7 +393,7 @@ decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Hib) -> end. %%% --------------------------------------------------- -%%% Send/recive functions +%%% Send/receive functions %%% --------------------------------------------------- do_send(Dest, Msg) -> case catch erlang:send(Dest, Msg, [noconnect]) of diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 92a086b077..9e69601770 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -583,7 +583,7 @@ printable_unicode_list(_) -> false. %Everything else is false nl() -> "\n". - + %% %% Utilities for collecting characters in input files %% diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index b5577165f4..d6a9f4645d 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -630,7 +630,7 @@ flatlength([H|T], L) when is_list(H) -> flatlength([_|T], L) -> flatlength(T, L + 1); flatlength([], L) -> L. - + %% keymember(Key, Index, [Tuple]) Now a BIF! %% keyfind(Key, Index, [Tuple]) A BIF! %% keysearch(Key, Index, [Tuple]) Now a BIF! @@ -1163,7 +1163,7 @@ rumerge(T1, []) -> T1; rumerge(T1, [H2 | T2]) -> lists:reverse(rumerge2_1(T1, T2, [], H2), []). - + %% all(Predicate, List) %% any(Predicate, List) %% map(Function, List) diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl index 4ed27ff4eb..d0bd0cb26e 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -257,7 +257,7 @@ chars(C, N, Tail) when N > 0 -> chars(C, N-1, [C|Tail]); chars(C, 0, Tail) when is_integer(C) -> Tail. - + %% Torbjörn's bit. %%% COPIES %%% @@ -461,7 +461,7 @@ sub_string(String, Start) -> substr(String, Start). Stop :: pos_integer(). sub_string(String, Start, Stop) -> substr(String, Start, Stop - Start + 1). - + %% ISO/IEC 8859-1 (latin1) letters are converted, others are ignored %% diff --git a/lib/stdlib/test/slave_SUITE.erl b/lib/stdlib/test/slave_SUITE.erl index 37fc694083..1d6a3ac90d 100644 --- a/lib/stdlib/test/slave_SUITE.erl +++ b/lib/stdlib/test/slave_SUITE.erl @@ -230,7 +230,7 @@ rsh_test(ResultTo) -> link(ResultTo), ?line {error, no_rsh} = slave:start(super, slave3). - + %%% Utilities. diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index 8e71c69d35..189a71a8ce 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -622,7 +622,7 @@ run_test(File, Args, Options) -> run_test(File, Args, Options, Vars) -> ts_run:run(File, Args, Options, Vars). - + %% This module provides some convenient shortcuts to running %% the test server from within a started Erlang shell. %% (This are here for backwards compatibility.) 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-start.el b/lib/tools/emacs/erlang-start.el index e1dc86621e..76e0575e68 100644 --- a/lib/tools/emacs/erlang-start.el +++ b/lib/tools/emacs/erlang-start.el @@ -52,7 +52,7 @@ ;; ;; To set the variable you can use the following command: ;; M-x set-variable RET debug-on-error RET t RET - + ;;; Code: ;; diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 624042204c..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" @@ -1025,7 +1027,7 @@ behaviour.") (defvar erlang-mode-syntax-table nil "Syntax table in use in Erlang-mode buffers.") - + (defvar erlang-skel-file "erlang-skels" "The type of erlang-skeletons that should be used, default @@ -1272,7 +1274,7 @@ Unfortunately, XEmacs hasn't got support for a special Font Lock syntax table. The effect is that `apply' in the atom `foo_apply' will be highlighted as a bif.") - + ;;; Avoid errors while compiling this file. ;; `eval-when-compile' is not defined in Emacs 18. We define it as a @@ -1321,7 +1323,7 @@ Lock syntax table. The effect is that `apply' in the atom (require 'tempo) (require 'compile)))) - + (defun erlang-version () "Return the current version of Erlang mode." (interactive) @@ -1516,7 +1518,7 @@ Other commands: (set (make-local-variable 'outline-level) (lambda () 1)) (set (make-local-variable 'add-log-current-defun-function) 'erlang-current-defun)) - + (defun erlang-font-lock-init () "Initialize Font Lock for Erlang mode." (or erlang-font-lock-syntax-table @@ -1686,7 +1688,7 @@ plus variables, macros and records." (font-lock-mode 1) (funcall (symbol-function 'font-lock-fontify-buffer))) - + (defun erlang-menu-init () "Init menus for Erlang mode. @@ -1905,7 +1907,7 @@ Example: The new menu is returned. No guarantee is given that the original menu is left unchanged." (delq entry items)) - + ;; Man code: (defun erlang-man-init () @@ -2228,7 +2230,7 @@ For example: After installing the line, kill and restart Emacs, or restart Erlang mode with the command `M-x erlang-mode RET'."))) - + ;; Skeleton code: ;; This code is based on the package `tempo' which is part of modern @@ -2349,7 +2351,7 @@ The first character of DD is space if the value is less than 10." (erlang-string-to-int (substring date 8 10)) (substring date 4 7) (substring date -4)))) - + ;; Indentation code: (defun erlang-indent-command (&optional whole-exp) @@ -3132,7 +3134,7 @@ commands." (skip-chars-backward " \t") (max (if (bolp) 0 (1+ (current-column))) comment-column))))) - + ;;; Erlang movement commands ;; All commands below work as movement commands. I.e. if the point is @@ -3336,7 +3338,7 @@ With negative argument go towards the beginning of the buffer." (forward-sexp 1) (buffer-substring start (point))))) - + ;;; Miscellaneous (defun erlang-fill-paragraph (&optional justify) @@ -3445,7 +3447,7 @@ at the end." (error "Can't clone argument list")) (insert args) (set-mark p))) - + ;;; Information retrieval functions. (defun erlang-buffer-substring (beg end) @@ -3772,7 +3774,7 @@ exported function." (store-match-data old-match-data) (member (cons name arity) exports)))) - + ;;; Check module name ;; The function `write-file', bound to C-x C-w, calls @@ -3835,7 +3837,7 @@ This function is normally placed in the hook `local-write-file-hooks'." ;; Must return nil since it is added to `local-write-file-hook'. nil) - + ;;; Electric functions. (defun erlang-electric-semicolon (&optional arg) @@ -4229,7 +4231,7 @@ This function is designed to be a member of a criteria list." (erlang-skip-blank) (looking-at "end[^_a-zA-Z0-9]"))) - + ;; Erlang tags support which is aware of erlang modules. ;; ;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags @@ -4539,7 +4541,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (or default (error "There is no default tag")) spec))))) - + ;; Search tag functions which are aware of Erlang modules. The tactic ;; is to store new search functions into the local variables of the ;; TAGS buffers. The variables are restored directly after the @@ -4715,7 +4717,7 @@ for a tag on the form `module:tag'." (string= mod (erlang-get-module-from-file-name (file-of-tag))))))) - + ;;; Tags completion, Emacs 19 `etags' specific. ;;; ;;; The basic idea is to create a second completion table `erlang-tags- @@ -4834,7 +4836,7 @@ about Erlang modules." ;; Only the first one will be stored in the table. (intern (concat module ":") table)))))) table)) - + ;;; ;;; Prepare for other methods to run an Erlang slave process. ;;; @@ -4916,7 +4918,7 @@ future, a new shell on an already running host will be started." (call-interactively erlang-next-error-function)) - + ;;; ;;; Erlang Shell Mode -- Major mode used for Erlang shells. ;;; @@ -5052,7 +5054,7 @@ Selects Comint or Compilation mode command as appropriate." (define-key map "\M-\C-m" 'compile-goto-error) (unless inferior-erlang-use-cmm (define-key map "\C-x`" 'erlang-next-error))) - + ;;; ;;; Inferior Erlang -- Run an Erlang shell as a subprocess. ;;; 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/src/tags.erl b/lib/tools/src/tags.erl index 1c72ef8db5..e3cc51cdb2 100644 --- a/lib/tools/src/tags.erl +++ b/lib/tools/src/tags.erl @@ -292,7 +292,7 @@ word_char(C) when C >= $0, C =< $9 -> true; word_char($_) -> true; word_char(_) -> false. - + %%% Output routines %% Check the options `outfile' and `outdir'. @@ -323,7 +323,7 @@ genout(Os, Name, Entries) -> io:put_chars(Os, lists:reverse(Entries)). - + %%% help routines %% Flatten and reverse a nested list. 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/tools/test/eprof_SUITE_data/eed.erl b/lib/tools/test/eprof_SUITE_data/eed.erl index 520c5f3dd1..5f2a21aa60 100644 --- a/lib/tools/test/eprof_SUITE_data/eed.erl +++ b/lib/tools/test/eprof_SUITE_data/eed.erl @@ -146,7 +146,7 @@ format_error({'EXIT', {Code, {Mod, Func, Args}}}) -> [{Code, {Mod, Func, length(Args)}}])); format_error(A) -> atom_to_list(A). - + %%% Parsing commands. @@ -327,7 +327,7 @@ when 0 =< Num1, Num1 =< Num2, Num2 =< State#state.lines -> check_lines(_, _, _, _) -> error(bad_linenum). - + %%% Executing commands. %% ($)= - print line number @@ -657,7 +657,7 @@ undo_command(_, _, _) -> write_command(_Cmd, [_First, _Last], _St) -> error(not_implemented). - + %%% Primitive buffer operations. print_current(St) -> @@ -717,7 +717,7 @@ wrap_next_line(State) when State#state.dot == State#state.lines -> wrap_next_line(State) -> next_line(State). - + %%% Utilities. get_pattern(End, Cmd, State) -> 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_regexp.erl b/lib/xmerl/src/xmerl_regexp.erl index 0c53e6f34a..9303bdb125 100644 --- a/lib/xmerl/src/xmerl_regexp.erl +++ b/lib/xmerl/src/xmerl_regexp.erl @@ -593,7 +593,7 @@ sub_first_match(S, {regexp,RE}) -> nomatch -> nomatch end. - + %% This is the regular expression grammar used. It is equivalent to the %% one used in AWK, except that we allow ^ $ to be used anywhere and fail %% in the matching. @@ -961,7 +961,7 @@ re_apply_or(never_match, R2) -> R2; re_apply_or(R1, never_match) -> R1; re_apply_or(nomatch, R2) -> R2; re_apply_or(R1, nomatch) -> R1. - + %% Record definitions for the NFA, DFA and compiler. -record(nfa_state, {no,edges=[],accept=no}). @@ -1026,7 +1026,7 @@ parse_reas([{RegExp,A}|REAs], S) -> {error,E} -> {error,E} end; parse_reas([], Stack) -> {ok,reverse(Stack)}. - + %% build_combined_nfa(RegExpActionList) -> {NFA,StartState}. %% Build the combined NFA using Thompson's construction straight out %% of the book. Build the separate NFAs in the same order as the @@ -1147,7 +1147,7 @@ nfa_comp_class(Cc) -> comp_crs([{C1,C2}|Crs], Last) -> [{Last,C1-1}|comp_crs(Crs, C2+1)]; comp_crs([], Last) -> [{Last,maxchar}]. - + %% build_dfa(NFA, NfaStartState) -> {DFA,DfaStartState}. %% Build a DFA from an NFA using "subset construction". The major %% difference from the book is that we keep the marked and unmarked @@ -1282,7 +1282,7 @@ accept([St|Sts], NFA) -> #nfa_state{accept=no} -> accept(Sts, NFA) end; accept([], _NFA) -> no. - + %% minimise_dfa(DFA, StartState, FirstState) -> {DFA,StartState}. %% Minimise the DFA by removing equivalent states. We consider a %% state if both the transitions and the their accept state is the @@ -1331,7 +1331,7 @@ pack_dfa([D|DFA], NewN, Rs, PDFA) -> pack_dfa(DFA, NewN+1, [{D#dfa_state.no,NewN}|Rs], [D#dfa_state{no=NewN}|PDFA]); pack_dfa([], _NewN, Rs, PDFA) -> {PDFA,Rs}. - + %% comp_apply(String, StartPos, DFAReg) -> {match,RestPos,Rest} | nomatch. %% Apply the DFA of a regular expression to a string. If %% there is a match return the position of the remaining string and 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. |