diff options
Diffstat (limited to 'lib')
106 files changed, 4770 insertions, 2378 deletions
diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 3d66583745..8d9422144e 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -54,6 +54,7 @@ CT_MODULES= \ asn1ct_constructed_per \ asn1ct_constructed_ber_bin_v2 \ asn1ct_gen_ber_bin_v2 \ + asn1ct_imm \ asn1ct_value \ asn1ct_tok \ asn1ct_parser2 \ @@ -163,11 +164,32 @@ release_spec: opt release_docs_spec: +# +# Dependencies +# - - - - - - - +$(EBIN)/asn1_app.beam: asn1_app.erl +$(EBIN)/asn1_db.beam: asn1_db.erl +$(EBIN)/asn1ct.beam: asn1ct.erl asn1_records.hrl +$(EBIN)/asn1ct_check.beam: asn1ct_check.erl asn1_records.hrl +$(EBIN)/asn1ct_constructed_ber_bin_v2.beam: asn1ct_constructed_ber_bin_v2.erl \ + asn1_records.hrl +$(EBIN)/asn1ct_constructed_per.beam: asn1ct_constructed_per.erl asn1_records.hrl +$(EBIN)/asn1ct_gen.beam: asn1ct_gen.erl asn1_records.hrl +$(EBIN)/asn1ct_gen_ber_bin_v2.beam: asn1ct_gen_ber_bin_v2.erl asn1_records.hrl +$(EBIN)/asn1ct_gen_per.beam: asn1ct_gen_per.erl asn1_records.hrl +$(EBIN)/asn1ct_gen_per_rt2ct.beam: asn1ct_gen_per_rt2ct.erl asn1_records.hrl +$(EBIN)/asn1ct_imm.beam: asn1ct_imm.erl +$(EBIN)/asn1ct_name.beam: asn1ct_name.erl +$(EBIN)/asn1ct_parser2.beam: asn1ct_parser2.erl asn1_records.hrl +$(EBIN)/asn1ct_pretty_format.beam: asn1ct_pretty_format.erl +$(EBIN)/asn1ct_table.beam: asn1ct_table.erl +$(EBIN)/asn1ct_tok.beam: asn1ct_tok.erl +$(EBIN)/asn1ct_value.beam: asn1ct_value.erl asn1_records.hrl +$(EBIN)/asn1rt.beam: asn1rt.erl +$(EBIN)/asn1rt_ber_bin.beam: asn1rt_ber_bin.erl asn1_records.hrl +$(EBIN)/asn1rt_ber_bin_v2.beam: asn1rt_ber_bin_v2.erl +$(EBIN)/asn1rt_check.beam: asn1rt_check.erl +$(EBIN)/asn1rt_nif.beam: asn1rt_nif.erl +$(EBIN)/asn1rt_per_bin_rt2ct.beam: asn1rt_per_bin_rt2ct.erl asn1_records.hrl +$(EBIN)/asn1rt_uper_bin.beam: asn1rt_uper_bin.erl asn1_records.hrl diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index e4e0e064e8..b29a7b3048 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -76,9 +76,7 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> case {Optionals = optionals(to_textual_order(CompList)),CompList, is_optimized(Erule)} of {[],EmptyCL,_} when EmptyCL == {[],[],[]};EmptyCL == {[],[]};EmptyCL == [] -> - emit(["%%Variable setting just to eliminate ", - "compiler warning for unused vars!",nl, - "_Val = ",{curr,val},",",nl]); + ok; {[],_,_} -> emit([{next,val}," = ",{curr,val},",",nl]); {_,_,true} -> @@ -219,9 +217,74 @@ gen_decode_set(Erules,Typename,D) -> gen_decode_sequence(Erules,Typename,D) -> gen_decode_constructed(Erules,Typename,D). -gen_decode_constructed(Erules,Typename,D) when is_record(D,type) -> +gen_decode_constructed(Erule, Typename, #type{}=D) -> + Imm0 = gen_dec_constructed_imm(Erule, Typename, #type{}=D), + Imm = opt_imm(Imm0), asn1ct_name:start(), asn1ct_name:clear(), + emit_gen_dec_imm(Imm), + emit([".",nl,nl]). + +opt_imm(Imm0) -> + {Imm,_} = opt_imm_1(Imm0, unknown, []), + Imm. + +opt_imm_1([{imm,Imm0,F}|T], Al0, Acc) -> + {Imm,Al} = asn1ct_imm:optimize_alignment(Imm0, Al0), + opt_imm_1(T, Al, [{imm,Imm,F}|Acc]); +opt_imm_1([ignore|T], Al, Acc) -> + opt_imm_1(T, Al, Acc); +opt_imm_1([{ignore,_}=H|T], Al, Acc) -> + opt_imm_1(T, Al, [H|Acc]); +opt_imm_1([{safe,ignore}|T], Al, Acc) -> + opt_imm_1(T, Al, Acc); +opt_imm_1([{safe,_}=H|T], Al, Acc) -> + opt_imm_1(T, Al, [H|Acc]); +opt_imm_1([{group,G0}|T], Al0, Acc) -> + {G,Al} = opt_imm_1(G0, Al0, []), + opt_imm_1(T, Al, [{group,G}|Acc]); +opt_imm_1([Emit|T], _, Acc) when is_function(Emit, 1) -> + opt_imm_1(T, unknown, [Emit|Acc]); +opt_imm_1([], Al, Acc) -> + {lists:reverse(Acc),Al}. + +emit_gen_dec_imm(L) -> + emit_gen_dec_imm(L, "", []). + +emit_gen_dec_imm([{ignore,Fun}|T], Sep, St0) -> + St = Fun(St0), + emit_gen_dec_imm(T, Sep, St); +emit_gen_dec_imm([{group,L}|T], Sep, St0) -> + emit(Sep), + St = emit_gen_dec_imm_group(L, St0), + emit_gen_dec_imm(T, [com,nl], St); +emit_gen_dec_imm([{imm,Imm,Emit}|T], Sep, St0) -> + emit(Sep), + St = Emit(Imm, St0), + emit_gen_dec_imm(T, [com,nl], St); +emit_gen_dec_imm([{safe,Item}|T], Sep, St) -> + emit_gen_dec_imm([Item|T], Sep, St); +emit_gen_dec_imm([Emit|T], Sep, St0) -> + emit(Sep), + St = Emit(St0), + emit_gen_dec_imm(T, [com,nl], St); +emit_gen_dec_imm([], _, _) -> ok. + +emit_gen_dec_imm_group([H|T], St0) -> + St = emit_gen_dec_group_item(H, St0), + emit_gen_dec_imm_group(T, St); +emit_gen_dec_imm_group([], St) -> St. + +emit_gen_dec_group_item({ignore,Fun}, St) -> + Fun(St); +emit_gen_dec_group_item({imm,Imm,Fun}, St) -> + Fun(Imm, St); +emit_gen_dec_group_item({safe,Item}, St) -> + emit_gen_dec_group_item(Item, St); +emit_gen_dec_group_item(Emit, St) -> + Emit(St). + +gen_dec_constructed_imm(Erule, Typename, #type{}=D) -> {CompList,TableConsInfo} = case D#type.def of #'SEQUENCE'{tablecinf=TCI,components=CL} -> @@ -231,27 +294,19 @@ gen_decode_constructed(Erules,Typename,D) when is_record(D,type) -> {CL,TCI} % the textual order is already taken care of end, Ext = extensible_dec(CompList), - MaybeComma1 = case Ext of - {ext,_Pos,_NumExt} -> - gen_dec_extension_value("Bytes"), - {",",nl}; - _ -> - "" - end, + EmitExt = case Ext of + {ext,_Pos,_NumExt} -> + gen_dec_extension_value(); + _ -> ignore + end, Optionals = optionals(CompList), - MaybeComma2 = case Optionals of - [] -> MaybeComma1; - _ -> - Bcurr = asn1ct_name:curr(bytes), - Bnext = asn1ct_name:next(bytes), - emit(MaybeComma1), - GetoptCall = "} = ?RT_PER:getoptionals2(", - emit({"{Opt,",{var,Bnext},GetoptCall, - {var,Bcurr},",",{asis,length(Optionals)},")"}), - asn1ct_name:new(bytes), - ", " - end, - {DecObjInf,UniqueFName,ValueIndex} = + EmitOpt = case Optionals of + [] -> + ignore; + [_|_] -> + gen_dec_optionals(Optionals) + end, + ObjSetInfo = case TableConsInfo of %% {ObjectSet,AttrN,N,UniqueFieldName} ->%% N is index of attribute that determines constraint #simpletableattributes{objectsetname=ObjectSet, @@ -283,13 +338,19 @@ gen_decode_constructed(Erules,Typename,D) when is_record(D,type) -> {false,false,false} end end, -%% NewCompList = wrap_compList(CompList), - {AccTerm,AccBytes} = - gen_dec_components_call(Erules,Typename,CompList,MaybeComma2,DecObjInf,Ext,length(Optionals)), - case asn1ct_name:all(term) of - [] -> emit(MaybeComma2); % no components at all - _ -> emit({com,nl}) - end, + {DecObjInf,_,_} = ObjSetInfo, + EmitComp = gen_dec_components_call(Erule, Typename, CompList, + DecObjInf, Ext, length(Optionals)), + EmitRest = fun({AccTerm,AccBytes}) -> + gen_dec_constructed_imm_2(Typename, CompList, + ObjSetInfo, + AccTerm, AccBytes) + end, + [EmitExt,EmitOpt|EmitComp++[{safe,EmitRest}]]. + +gen_dec_constructed_imm_2(Typename, CompList, + ObjSetInfo, AccTerm, AccBytes) -> + {_,UniqueFName,ValueIndex} = ObjSetInfo, case {AccTerm,AccBytes} of {[],[]} -> ok; @@ -331,8 +392,7 @@ gen_decode_constructed(Erules,Typename,D) when is_record(D,type) -> mkvlist(textual_order(to_encoding_order(CompList),asn1ct_name:all(term))), emit("},") end, - emit({{curr,bytes},"}"}), - emit({".",nl,nl}). + emit({{curr,bytes},"}"}). textual_order([#'ComponentType'{textual_order=undefined}|_],TermList) -> TermList; @@ -514,10 +574,10 @@ gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> _ -> "" end, - gen_decode_length(SizeConstraint, - is_optimized(Erules)), - emit({"'dec_",asn1ct_gen:list2name(Typename), - "_components'(Num, Bytes1, telltype",ObjFun,", []).",nl}), + {Num,Buf} = gen_decode_length(SizeConstraint, Erules), + emit([",",nl, + "'dec_",asn1ct_gen:list2name(Typename), + "_components'(",Num,", ",Buf,ObjFun,", []).",nl,nl]), NewComponentType = case ComponentType#type.def of {'ENUMERATED',_,Component}-> @@ -526,40 +586,13 @@ gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> end, gen_decode_sof_components(Erules,Typename,SeqOrSetOf,NewComponentType). -%% Logic copied from asn1_per_bin_rt2ct:decode_constrained_number -gen_decode_length({Lb,Ub},true) when Ub =< 65535, Lb >= 0 -> - Range = Ub - Lb + 1, - Call = if - Range == 1 -> - "{0,Bytes}"; - Range == 2 -> - "?RT_PER:getbits(Bytes,1)"; - Range =< 4 -> - "?RT_PER:getbits(Bytes,2)"; - Range =< 8 -> - "?RT_PER:getbits(Bytes,3)"; - Range =< 16 -> - "?RT_PER:getbits(Bytes,4)"; - Range =< 32 -> - "?RT_PER:getbits(Bytes,5)"; - Range =< 64 -> - "?RT_PER:getbits(Bytes,6)"; - Range =< 128 -> - "?RT_PER:getbits(Bytes,7)"; - Range =< 255 -> - "?RT_PER:getbits(Bytes,8)"; - Range =< 256 -> - "?RT_PER:getoctets(Bytes,1)"; - Range =< 65536 -> - "?RT_PER:getoctets(Bytes,2)"; - true -> - ["exit({not_supported,{integer_range,",Range,"}}"] - end, - emit({nl,"{Val,Remain} = ",Call,",",nl}), - emit({nl,"{Num,Bytes1} = {Val+",Lb,",Remain},",nl}); -gen_decode_length(SizeConstraint,_) -> - emit({nl,"{Num,Bytes1} = ?RT_PER:decode_length(Bytes,", - {asis,SizeConstraint},"),",nl}). +is_aligned(per) -> true; +is_aligned(uper) -> false. + +gen_decode_length(Constraint, Erule) -> + emit(["%% Length with constraint ",{asis,Constraint},nl]), + Imm = asn1ct_imm:per_dec_length(Constraint, true, is_aligned(Erule)), + asn1ct_imm:dec_slim_cg(Imm, "Bytes"). gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> {ObjFun,ObjFun_Var} = @@ -611,10 +644,10 @@ gen_decode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> {"",""} end, emit({"'dec_",asn1ct_gen:list2name(Typename), - "_components'(0, Bytes, _",ObjFun_Var,", Acc) ->",nl, + "_components'(0, Bytes",ObjFun_Var,", Acc) ->",nl, indent(3),"{lists:reverse(Acc), Bytes};",nl}), emit({"'dec_",asn1ct_gen:list2name(Typename), - "_components'(Num, Bytes, _",ObjFun,", Acc) ->",nl}), + "_components'(Num, Bytes",ObjFun,", Acc) ->",nl}), emit({indent(3),"{Term,Remain} = "}), Constructed_Suffix = asn1ct_gen:constructed_suffix(SeqOrSetOf, Cont#type.def), @@ -643,7 +676,7 @@ gen_decode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> emit({"'dec_",Conttype,"'(Bytes,telltype),",nl}) end, emit({indent(3),"'dec_",asn1ct_gen:list2name(Typename), - "_components'(Num-1, Remain, telltype",ObjFun,", [Term|Acc]).",nl}). + "_components'(Num-1, Remain",ObjFun,", [Term|Acc]).",nl}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -714,10 +747,25 @@ extgrouppos([_|T],ActualPos,VirtualPos,Len,Acc) -> extgrouppos(T,ActualPos,VirtualPos,Len+1,Acc). - -gen_dec_extension_value(_) -> - emit({"{Ext,",{next,bytes},"} = ?RT_PER:getext(",{curr,bytes},")"}), - asn1ct_name:new(bytes). +gen_dec_extension_value() -> + Imm0 = {get_bits,1,[1]}, + E = fun(Imm, _) -> + emit(["{Ext,",{next,bytes},"} = "]), + BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), + asn1ct_imm:dec_code_gen(Imm, BytesVar), + asn1ct_name:new(bytes) + end, + {imm,Imm0,E}. + +gen_dec_optionals(Optionals) -> + Imm0 = {get_bits,length(Optionals),[1]}, + E = fun(Imm, _) -> + BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), + emit(["{Opt,",{next,bytes},"} = "]), + asn1ct_imm:dec_code_gen(Imm, BytesVar), + asn1ct_name:new(bytes) + end, + {imm,Imm0,E}. gen_fixoptionals([{Pos,Def}|R]) -> asn1ct_name:new(fixopt), @@ -1031,53 +1079,79 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> emit("))"); _ -> true end. -gen_dec_components_call(Erule,TopType,{Root,ExtList},MaybeComma, + +gen_dec_components_call(Erule, TopType, {Root,ExtList}, + DecInfObj, Ext, NumberOfOptionals) -> + gen_dec_components_call(Erule,TopType,{Root,ExtList,[]}, + DecInfObj,Ext,NumberOfOptionals); +gen_dec_components_call(Erule,TopType,CL={Root1,ExtList,Root2}, DecInfObj,Ext,NumberOfOptionals) -> - gen_dec_components_call(Erule,TopType,{Root,ExtList,[]},MaybeComma,DecInfObj,Ext,NumberOfOptionals); -gen_dec_components_call(Erule,TopType,CL={Root1,ExtList,Root2},MaybeComma,DecInfObj,Ext,NumberOfOptionals) -> %% The type has extensionmarker - OptTable = create_optionality_table(Root1++Root2), - {Rpos,AccTerm,AccBytes} = - gen_dec_components_call1(Erule,TopType, Root1++Root2, 1, OptTable, - MaybeComma,DecInfObj,noext,[],[], - NumberOfOptionals), - emit([",",nl,"{Extensions,",{next,bytes},"} = "]), - emit(["?RT_PER:getextension(Ext,",{curr,bytes},"),",nl]), - asn1ct_name:new(bytes), + Init = {ignore,fun(_) -> {[],[]} end}, + {EmitRoot,Tpos} = + gen_dec_comp_calls(Root1++Root2, Erule, TopType, OptTable, + DecInfObj, noext, NumberOfOptionals, + 1, []), + EmitGetExt = gen_dec_get_extension(Erule), {extgrouppos,ExtGroupPosLen} = extgroup_pos_and_length(CL), - NewExtList = wrap_extensionAdditionGroups(ExtList,ExtGroupPosLen), - {_Epos,AccTermE,AccBytesE} = - gen_dec_components_call1(Erule,TopType,NewExtList,Rpos, OptTable, - "",DecInfObj,Ext,[],[],NumberOfOptionals), - case ExtList of - [] -> true; - _ -> emit([",",nl]) - end, - emit([{next,bytes},"= ?RT_PER:skipextensions(",{curr,bytes},",", - length(ExtList)+1,",Extensions)",nl]), - asn1ct_name:new(bytes), - {AccTerm++AccTermE,AccBytes++AccBytesE}; - -gen_dec_components_call(Erule,TopType,CompList,MaybeComma,DecInfObj, - Ext,NumberOfOptionals) -> + NewExtList = wrap_extensionAdditionGroups(ExtList, ExtGroupPosLen), + {EmitExts,_} = gen_dec_comp_calls(NewExtList, Erule, TopType, OptTable, + DecInfObj, Ext, NumberOfOptionals, + Tpos, []), + Finish = + fun(St) -> + emit([{next,bytes},"= ?RT_PER:skipextensions(",{curr,bytes},",", + length(ExtList)+1,",Extensions)"]), + asn1ct_name:new(bytes), + St + end, + [Init] ++ EmitRoot ++ [EmitGetExt|EmitExts] ++ [Finish]; +gen_dec_components_call(Erule, TopType, CompList, DecInfObj, + Ext, NumberOfOptionals) -> %% The type has no extensionmarker OptTable = create_optionality_table(CompList), - {_,AccTerm,AccBytes} = - gen_dec_components_call1(Erule,TopType, CompList, 1, OptTable, - MaybeComma,DecInfObj,Ext,[],[], - NumberOfOptionals), - {AccTerm,AccBytes}. - - -gen_dec_components_call1(Erule,TopType, - [C=#'ComponentType'{name=Cname,typespec=Type,prop=Prop,textual_order=TextPos}|Rest], - Tpos,OptTable,MaybeComma,DecInfObj,Ext,AccTerm,AccBytes,NumberOfOptionals) -> + Init = {ignore,fun(_) -> {[],[]} end}, + {Cs,_} = gen_dec_comp_calls(CompList, Erule, TopType, OptTable, + DecInfObj, Ext, NumberOfOptionals, + 1, []), + [Init|Cs]. + +gen_dec_get_extension(Erule) -> + Imm0 = asn1ct_imm:per_dec_extension_map(is_aligned(Erule)), + E = fun(Imm, St) -> + emit([nl,"%% Extensions", + nl, + "{Extensions,",{next,bytes},"} = ", + "case Ext of",nl, + "0 -> {<<>>,",{curr,bytes},"};",nl, + "1 ->",nl]), + BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), + {Dst,DstBuf} = asn1ct_imm:dec_slim_cg(Imm, BytesVar), + emit([com,nl, + "{",Dst,",",DstBuf,"}",nl, + "end"]), + asn1ct_name:new(bytes), + St + end, + {imm,Imm0,E}. + +gen_dec_comp_calls([C|Cs], Erule, TopType, OptTable, DecInfObj, + Ext, NumberOfOptionals, Tpos, Acc) -> + L = gen_dec_comp_call(C, Erule, TopType, Tpos, OptTable, DecInfObj, + Ext, NumberOfOptionals), + gen_dec_comp_calls(Cs, Erule, TopType, OptTable, DecInfObj, + Ext, NumberOfOptionals, Tpos+1, [L|Acc]); +gen_dec_comp_calls([], _, _, _, _, _, _, Tpos, Acc) -> + {lists:append(lists:reverse(Acc)),Tpos}. + +gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, + Ext, NumberOfOptionals) -> + #'ComponentType'{typespec=Type,prop=Prop,textual_order=TextPos} = Comp, Pos = case Ext of noext -> Tpos; {ext,Epos,_Enum} -> Tpos - Epos + 1 end, - emit(MaybeComma), InnerType = case Type#type.def of #'ObjectClassFieldType'{type=InType} -> @@ -1086,109 +1160,128 @@ gen_dec_components_call1(Erule,TopType, asn1ct_gen:get_inner(Def) end, - case InnerType of - #'Externaltypereference'{type=T} -> - emit({nl,"%% attribute number ",TextPos," with type ", - T,nl}); - IT when is_tuple(IT) -> - emit({nl,"%% attribute number ",TextPos," with type ", - element(2,IT),nl}); - _ -> - emit({nl,"%% attribute number ",TextPos," with type ", - InnerType,nl}) - end, - - IsMandatoryAndPredefinedTableC = - fun(noext,mandatory,{"got objfun through args","ObjFun"}) -> - true; - (_,_,{"got objfun through args","ObjFun"}) -> - false; - (_,_,_) -> - true - end, - case {InnerType,IsMandatoryAndPredefinedTableC(Ext,Prop,DecInfObj)} of -%% {typefield,_} when Ext == noext, Prop == mandatory -> - {{typefield,_},true} -> - %% DecInfObj /= {"got objfun through args","ObjFun"} | - %% (DecInfObj == {"got objfun through args","ObjFun"} & - %% Ext == noext & Prop == mandatory) - asn1ct_name:new(term), - asn1ct_name:new(tmpterm), - emit({"{",{curr,tmpterm},", ",{next,bytes},"} = "}); + DispType = case InnerType of + #'Externaltypereference'{type=T} -> T; + IT when is_tuple(IT) -> element(2,IT); + _ -> InnerType + end, + Comment = fun(St) -> + emit([nl,"%% attribute number ",TextPos, + " with type ",DispType,nl]), + St + end, + + Preamble = + case {InnerType,is_mandatory_predef_tab_c(Ext, Prop, DecInfObj)} of + {{typefield,_},true} -> + %% DecInfObj /= {"got objfun through args","ObjFun"} | + %% (DecInfObj == {"got objfun through args","ObjFun"} & + %% Ext == noext & Prop == mandatory) + fun(St) -> + asn1ct_name:new(term), + asn1ct_name:new(tmpterm), + emit(["{",{curr,tmpterm},", ",{next,bytes},"} = "]), + St + end; %%{objectfield,_,_} when Ext == noext, Prop == mandatory -> - {{objectfield,_,_},true} -> - asn1ct_name:new(term), - asn1ct_name:new(tmpterm), - emit({"{",{curr,tmpterm},", ",{next,bytes},"} = "}); + {{objectfield,_,_},true} -> + fun(St) -> + asn1ct_name:new(term), + asn1ct_name:new(tmpterm), + emit(["{",{curr,tmpterm},", ",{next,bytes},"} = "]), + St + end; _ -> case Type of #type{def=#'SEQUENCE'{ extaddgroup=Number1, components=ExtGroupCompList1}} when is_integer(Number1)-> - emit({"{{_,"}), - emit_extaddgroupTerms(term,ExtGroupCompList1), - emit({"}"}); - _ -> - asn1ct_name:new(term), - emit({"{",{curr,term}}) - end, - emit({",",{next,bytes},"} = "}) - end, - - case {Ext,Prop,is_optimized(Erule)} of - {noext,mandatory,_} -> ok; % generate nothing - {noext,_,_} -> %% OPTIONAL or DEFAULT - OptPos = get_optionality_pos(TextPos,OptTable), - Element = io_lib:format("Opt band (1 bsl ~w)",[NumberOfOptionals - OptPos]), - emit(["case ",Element," of",nl]), - emit([" _Opt",TextPos," when _Opt",TextPos," > 0 ->"]); - {_,_,false} -> %% extension element, not bitstring - emit(["case Extensions of",nl]), - emit([" _ when size(Extensions) >= ",Pos,",element(",Pos,",Extensions) == 1 ->",nl]); - _ -> - emit(["case Extensions of",nl]), - emit([" <<_:",Pos-1,",1:1,_/bitstring>> when bit_size(Extensions) >= ",Pos," ->",nl]) - end, - put(component_type,{true,C}), - {TermVar,BytesVar} = gen_dec_line(Erule,TopType,Cname,Type,Tpos,DecInfObj,Ext,Prop), - erase(component_type), - case {Ext,Prop} of - {noext,mandatory} -> true; % generate nothing - {noext,_} -> - emit([";",nl,"0 ->"]), - emit(["{"]), - gen_dec_component_no_val(Ext,Prop), - emit({",",{curr,bytes},"}",nl}), - emit([nl,"end"]); - _ -> - emit([";",nl,"_ ->",nl]), - emit(["{"]), - case Type of - #type{def=#'SEQUENCE'{ - extaddgroup=Number2, - components=ExtGroupCompList2}} when is_integer(Number2)-> - emit({"{extAddGroup,"}), - gen_dec_extaddGroup_no_val(Ext,ExtGroupCompList2), - emit({"}"}); + fun(St) -> + emit(["{{_,"]), + emit_extaddgroupTerms(term,ExtGroupCompList1), + emit(["}"]), + emit([",",{next,bytes},"} = "]), + St + end; _ -> - gen_dec_component_no_val(Ext,Prop) - end, - emit({",",{curr,bytes},"}",nl}), - emit([nl,"end"]) - end, - asn1ct_name:new(bytes), - case Rest of - [] -> - {Tpos+1,AccTerm++TermVar,AccBytes++BytesVar}; - _ -> - emit({com,nl}), - gen_dec_components_call1(Erule,TopType,Rest,Tpos+1,OptTable, - "",DecInfObj,Ext, AccTerm++TermVar, - AccBytes++BytesVar,NumberOfOptionals) - end; + fun(St) -> + asn1ct_name:new(term), + emit(["{",{curr,term}]), + emit([",",{next,bytes},"} = "]), + St + end + end + end, -gen_dec_components_call1(_,_TopType,[],Pos,_OptTable,_,_,_,AccTerm,AccBytes,_NumberOfOptionals) -> - {Pos,AccTerm,AccBytes}. + OptOrDef = + case {Ext,Prop} of + {noext,mandatory} -> + ignore; + {noext,_} -> %% OPTIONAL or DEFAULT + OptPos = get_optionality_pos(TextPos, OptTable), + Element = io_lib:format("Opt band (1 bsl ~w)", + [NumberOfOptionals - OptPos]), + fun(St) -> + emit(["case ",Element," of",nl]), + emit([" _Opt",TextPos," when _Opt",TextPos," > 0 ->"]), + St + end; + {{ext,_,_},_} -> %Extension + fun(St) -> + emit(["case Extensions of",nl, + " <<_:",Pos-1,",1:1,_/bitstring>> ->",nl]), + St + end + end, + Lines = gen_dec_line_imm(Erule, TopType, Comp, Tpos, DecInfObj, Ext), + Postamble = + case {Ext,Prop} of + {noext,mandatory} -> + ignore; + {noext,_} -> + fun(St) -> + emit([";",nl,"0 ->"]), + emit(["{"]), + gen_dec_component_no_val(Ext,Prop), + emit({",",{curr,bytes},"}",nl}), + emit([nl,"end"]), + St + end; + _ -> + fun(St) -> + emit([";",nl,"_ ->",nl]), + emit(["{"]), + case Type of + #type{def=#'SEQUENCE'{ + extaddgroup=Number2, + components=ExtGroupCompList2}} + when is_integer(Number2)-> + emit({"{extAddGroup,"}), + gen_dec_extaddGroup_no_val(Ext,ExtGroupCompList2), + emit({"}"}); + _ -> + gen_dec_component_no_val(Ext, Prop) + end, + emit({",",{curr,bytes},"}",nl}), + emit([nl,"end"]), + St + end + end, + AdvBuffer = {ignore,fun(St) -> + asn1ct_name:new(bytes), + St + end}, + [{group,[{safe,Comment},{safe,Preamble}, + {safe,OptOrDef}|Lines]++ + [{safe,Postamble},{safe,AdvBuffer}]}]. + +is_mandatory_predef_tab_c(noext, mandatory, + {"got objfun through args","ObjFun"}) -> + true; +is_mandatory_predef_tab_c(_, _, {"got objfun through args","ObjFun"}) -> + false; +is_mandatory_predef_tab_c(_,_,_) -> + true. gen_dec_extaddGroup_no_val(Ext,[#'ComponentType'{prop=Prop}])-> gen_dec_component_no_val(Ext,Prop), @@ -1208,8 +1301,14 @@ gen_dec_component_no_val({ext,_,_},mandatory) -> emit({"asn1_NOVALUE"}). -gen_dec_line(Erule,TopType,Cname,Type,Pos,DecInfObj,Ext,Prop) -> - Ctgenmod = asn1ct_gen:ct_gen_module(Erule), +gen_dec_line(Erule, TopType, Comp, Pos, DecInfObj, Ext) -> + Imm0 = gen_dec_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext), + Init = {ignore,fun(_) -> {[],[]} end}, + Imm = [{group,[Init|Imm0]}], + emit_gen_dec_imm(Imm). + +gen_dec_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext) -> + #'ComponentType'{name=Cname,typespec=Type} = Comp, Atype = case Type of #type{def=#'ObjectClassFieldType'{type=InnerType}} -> @@ -1218,175 +1317,235 @@ gen_dec_line(Erule,TopType,Cname,Type,Pos,DecInfObj,Ext,Prop) -> asn1ct_gen:get_inner(Type#type.def) end, - BytesVar0 = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), - BytesVar = case Ext of - {ext,Ep,_} when Pos >= Ep -> - emit(["begin",nl,"{TmpVal",Pos,",Trem",Pos, - "}=?RT_PER:decode_open_type(", - {curr,bytes},",[]),",nl, - "{TmpValx",Pos,",_}="]), - io_lib:format("TmpVal~p",[Pos]); - _ -> BytesVar0 - end, - SaveBytes = - case Atype of - {typefield,_} -> + Pre = gen_dec_line_open_type(Erule, Ext, Pos), + Decode = gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj, Ext), + Post = + fun({SaveBytes,Finish}) -> + {AccTerm,AccBytes} = Finish(), + #'ComponentType'{name=Cname} = Comp, case DecInfObj of - false -> % This is in a choice with typefield components - {Name,RestFieldNames} = - (Type#type.def)#'ObjectClassFieldType'.fieldname, - - asn1ct_name:new(tmpterm), - asn1ct_name:new(reason), - emit([indent(2),"{",{curr,tmpterm},", ",{next,bytes}, - "} = ?RT_PER:decode_open_type(",{curr,bytes}, - ", []),",nl]), - emit([indent(2),"case (catch ObjFun(", - {asis,Name},",",{curr,tmpterm},",telltype,", - {asis,RestFieldNames},")) of", nl]), - emit([indent(4),"{'EXIT',",{curr,reason},"} ->",nl]), - emit([indent(6),"exit({'Type not ", - "compatible with table constraint', ", - {curr,reason},"});",nl]), - asn1ct_name:new(tmpterm), - emit([indent(4),"{",{curr,tmpterm},", _} ->",nl]), - emit([indent(6),"{",{asis,Cname},", {",{curr,tmpterm},", ", - {next,bytes},"}}",nl]), - emit([indent(2),"end"]), - []; - {"got objfun through args","ObjFun"} -> - %% this is when the generated code gots the - %% objfun though arguments on function - %% invocation. - if - Ext == noext andalso Prop == mandatory -> - ok; - true -> - asn1ct_name:new(tmpterm), - asn1ct_name:new(tmpbytes), - emit([nl," {",{curr,tmpterm},", ",{curr,tmpbytes},"} ="]) - end, - {Name,RestFieldNames} = - (Type#type.def)#'ObjectClassFieldType'.fieldname, - emit(["?RT_PER:decode_open_type(",{curr,bytes}, - ", []),",nl]), - if - Ext == noext andalso Prop == mandatory -> - emit([{curr,term}," =",nl," "]); - true -> - emit([" {"]) - end, - emit(["case (catch ObjFun(",{asis,Name},",", - {curr,tmpterm},",telltype,", - {asis,RestFieldNames},")) of", nl]), - emit([" {'EXIT',",{curr,reason},"} ->",nl]), - emit([indent(6),"exit({'Type not ", - "compatible with table constraint', ", - {curr,reason},"});",nl]), - asn1ct_name:new(tmpterm), - emit([indent(4),"{",{curr,tmpterm},", _} ->",nl]), - emit([indent(6),{curr,tmpterm},nl]), - emit([indent(2),"end"]), - if - Ext == noext andalso Prop == mandatory -> - ok; - true -> - emit([",",nl,{curr,tmpbytes},"}"]) - end, - []; - _ -> - emit(["?RT_PER:decode_open_type(",{curr,bytes}, - ", [])"]), - RefedFieldName = - (Type#type.def)#'ObjectClassFieldType'.fieldname, - - [{Cname,RefedFieldName, - asn1ct_gen:mk_var(asn1ct_name:curr(term)), - asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)), - get_components_prop()}] - end; - {objectfield,PrimFieldName1,PFNList} -> - emit(["?RT_PER:decode_open_type(",{curr,bytes},", [])"]), - [{Cname,{PrimFieldName1,PFNList}, - asn1ct_gen:mk_var(asn1ct_name:curr(term)), - asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)), - get_components_prop()}]; - _ -> - CurrMod = get(currmod), - case asn1ct_gen:type(Atype) of - #'Externaltypereference'{module=CurrMod,type=EType} -> - emit({"'dec_",EType,"'(",BytesVar,",telltype)"}); - #'Externaltypereference'{module=Mod,type=EType} -> - emit({"'",Mod,"':'dec_",EType,"'(",BytesVar, - ",telltype)"}); - {primitive,bif} -> - case Atype of - {fixedtypevaluefield,_,Btype} -> - Ctgenmod:gen_dec_prim(Erule,Btype, - BytesVar); - _ -> - Ctgenmod:gen_dec_prim(Erule,Type, - BytesVar) - end; - 'ASN1_OPEN_TYPE' -> - case Type#type.def of - #'ObjectClassFieldType'{type=OpenType} -> - Ctgenmod:gen_dec_prim(Erule,#type{def=OpenType}, - BytesVar); - _ -> - Ctgenmod:gen_dec_prim(Erule,Type, - BytesVar) - end; - #typereference{val=Dname} -> - emit({"'dec_",Dname,"'(",BytesVar,",telltype)"}); - {notype,_} -> - emit({"'dec_",Atype,"'(",BytesVar,",telltype)"}); - {constructed,bif} -> - NewTypename = [Cname|TopType], - case Type#type.tablecinf of - [{objfun,_}|_R] -> - emit({"'dec_",asn1ct_gen:list2name(NewTypename), - "'(",BytesVar,", telltype, ObjFun)"}); - _ -> - emit({"'dec_",asn1ct_gen:list2name(NewTypename), - "'(",BytesVar,", telltype)"}) - end - end, - case DecInfObj of - {Cname,{_,OSet,UniqueFName,ValIndex}} -> - Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), - ValueMatch = value_match(ValIndex,Term), - {ObjSetMod,ObjSetName} = - case OSet of - {M,O} -> {{asis,M},O}; - _ -> {"?MODULE",OSet} + {Cname,ObjSet} -> + ObjSetRef = + case ObjSet of + {deep,OSName,_,_} -> + OSName; + _ -> ObjSet end, - emit({",",nl,"ObjFun = ",ObjSetMod, - ":'getdec_",ObjSetName,"'(", - {asis,UniqueFName},", ",ValueMatch,")"}); + {AccTerm++[{ObjSetRef,Cname, + asn1ct_gen:mk_var(asn1ct_name:curr(term))}], + AccBytes++SaveBytes}; _ -> - ok - end, - [] + {AccTerm,AccBytes++SaveBytes} + end end, - case Ext of - {ext,Ep2,_} when Pos >= Ep2 -> - emit([", {TmpValx",Pos,",Trem",Pos,"}",nl,"end"]); - _ -> true - end, - %% Prepare return value + [Pre,Decode,{safe,Post}]. + +gen_dec_line_open_type(Erule, {ext,Ep,_}, Pos) when Pos >= Ep -> + Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)), + {safe,fun(St) -> + emit(["begin",nl]), + BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), + {Dst,DstBuf} = asn1ct_imm:dec_slim_cg(Imm, BytesVar), + emit([",",nl,"{TmpValx",Pos,",_} = "]), + {Dst, + fun() -> + emit([",",nl, + "{TmpValx",Pos,",",DstBuf,"}",nl, + "end"]), + St + end} + end}; +gen_dec_line_open_type(_, _, _) -> + {safe,fun(St) -> + {asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), + fun() -> St end} + end}. + +gen_dec_line_special(_, {typefield,_}, _TopType, Comp, + DecInfObj, Ext) -> + #'ComponentType'{name=Cname,typespec=Type,prop=Prop} = Comp, + fun({_BytesVar,PrevSt}) -> + case DecInfObj of + false -> % This is in a choice with typefield components + {Name,RestFieldNames} = + (Type#type.def)#'ObjectClassFieldType'.fieldname, + + asn1ct_name:new(tmpterm), + asn1ct_name:new(reason), + emit([indent(2),"{",{curr,tmpterm},", ",{next,bytes}, + "} = ?RT_PER:decode_open_type(",{curr,bytes}, + ", []),",nl]), + emit([indent(2),"case (catch ObjFun(", + {asis,Name},",",{curr,tmpterm},",telltype,", + {asis,RestFieldNames},")) of", nl]), + emit([indent(4),"{'EXIT',",{curr,reason},"} ->",nl]), + emit([indent(6),"exit({'Type not ", + "compatible with table constraint', ", + {curr,reason},"});",nl]), + asn1ct_name:new(tmpterm), + emit([indent(4),"{",{curr,tmpterm},", _} ->",nl]), + emit([indent(6),"{",{asis,Cname},", {",{curr,tmpterm},", ", + {next,bytes},"}}",nl]), + emit([indent(2),"end"]), + {[],PrevSt}; + {"got objfun through args","ObjFun"} -> + %% this is when the generated code gots the + %% objfun though arguments on function + %% invocation. + if + Ext == noext andalso Prop == mandatory -> + ok; + true -> + asn1ct_name:new(tmpterm), + asn1ct_name:new(tmpbytes), + emit([nl," {",{curr,tmpterm},", ",{curr,tmpbytes},"} ="]) + end, + {Name,RestFieldNames} = + (Type#type.def)#'ObjectClassFieldType'.fieldname, + emit(["?RT_PER:decode_open_type(",{curr,bytes}, + ", []),",nl]), + if + Ext == noext andalso Prop == mandatory -> + emit([{curr,term}," =",nl," "]); + true -> + emit([" {"]) + end, + emit(["case (catch ObjFun(",{asis,Name},",", + {curr,tmpterm},",telltype,", + {asis,RestFieldNames},")) of", nl]), + emit([" {'EXIT',",{curr,reason},"} ->",nl]), + emit([indent(6),"exit({'Type not ", + "compatible with table constraint', ", + {curr,reason},"});",nl]), + asn1ct_name:new(tmpterm), + emit([indent(4),"{",{curr,tmpterm},", _} ->",nl]), + emit([indent(6),{curr,tmpterm},nl]), + emit([indent(2),"end"]), + if + Ext == noext andalso Prop == mandatory -> + ok; + true -> + emit([",",nl,{curr,tmpbytes},"}"]) + end, + {[],PrevSt}; + _ -> + emit(["?RT_PER:decode_open_type(",{curr,bytes}, + ", [])"]), + RefedFieldName = + (Type#type.def)#'ObjectClassFieldType'.fieldname, + + {[{Cname,RefedFieldName, + asn1ct_gen:mk_var(asn1ct_name:curr(term)), + asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)), + Prop}],PrevSt} + end + end; +gen_dec_line_special(_, {objectfield,PrimFieldName1,PFNList}, _TopType, + Comp, _DecInfObj, _Ext) -> + fun({_BytesVar,PrevSt}) -> + emit(["?RT_PER:decode_open_type(",{curr,bytes},", [])"]), + #'ComponentType'{name=Cname,prop=Prop} = Comp, + SaveBytes = [{Cname,{PrimFieldName1,PFNList}, + asn1ct_gen:mk_var(asn1ct_name:curr(term)), + asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)), + Prop}], + {SaveBytes,PrevSt} + end; +gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj, _Ext) -> + case gen_dec_line_other(Erule, Atype, TopType, Comp) of + Fun when is_function(Fun, 1) -> + fun({BytesVar,PrevSt}) -> + Fun(BytesVar), + gen_dec_line_dec_inf(Comp, DecInfObj), + {[],PrevSt} + end; + Imm0 -> + {imm,Imm0, + fun(Imm, {BytesVar,PrevSt}) -> + asn1ct_imm:dec_code_gen(Imm, BytesVar), + gen_dec_line_dec_inf(Comp, DecInfObj), + {[],PrevSt} + end} + end. + +gen_dec_line_dec_inf(Comp, DecInfObj) -> + #'ComponentType'{name=Cname} = Comp, case DecInfObj of - {Cname,ObjSet} -> - ObjSetRef = - case ObjSet of - {deep,OSName,_,_} -> - OSName; - _ -> ObjSet + {Cname,{_,OSet,UniqueFName,ValIndex}} -> + Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), + ValueMatch = value_match(ValIndex,Term), + {ObjSetMod,ObjSetName} = + case OSet of + {M,O} -> {{asis,M},O}; + _ -> {"?MODULE",OSet} end, - {[{ObjSetRef,Cname,asn1ct_gen:mk_var(asn1ct_name:curr(term))}], - SaveBytes}; + emit({",",nl,"ObjFun = ",ObjSetMod, + ":'getdec_",ObjSetName,"'(", + {asis,UniqueFName},", ",ValueMatch,")"}); _ -> - {[],SaveBytes} + ok + end. + +gen_dec_line_other(Erule, Atype, TopType, Comp) -> + #'ComponentType'{name=Cname,typespec=Type} = Comp, + CurrMod = get(currmod), + Ctgenmod = asn1ct_gen:ct_gen_module(Erule), + case asn1ct_gen:type(Atype) of + #'Externaltypereference'{module=CurrMod,type=EType} -> + fun(BytesVar) -> + emit({"'dec_",EType,"'(",BytesVar,",telltype)"}) + end; + #'Externaltypereference'{module=Mod,type=EType} -> + fun(BytesVar) -> + emit({"'",Mod,"':'dec_",EType,"'(",BytesVar, + ",telltype)"}) + end; + {primitive,bif} -> + case Atype of + {fixedtypevaluefield,_,Btype} -> + gen_dec_prim(Ctgenmod, Erule, Btype); + _ -> + gen_dec_prim(Ctgenmod, Erule, Type) + end; + 'ASN1_OPEN_TYPE' -> + case Type#type.def of + #'ObjectClassFieldType'{type=OpenType} -> + gen_dec_prim(Ctgenmod, Erule, #type{def=OpenType}); + _ -> + gen_dec_prim(Ctgenmod, Erule, Type) + end; + #typereference{val=Dname} -> + fun(BytesVar) -> + emit({"'dec_",Dname,"'(",BytesVar,",telltype)"}) + end; + {notype,_} -> + fun(BytesVar) -> + emit({"'dec_",Atype,"'(",BytesVar,",telltype)"}) + end; + {constructed,bif} -> + NewTypename = [Cname|TopType], + case Type#type.tablecinf of + [{objfun,_}|_R] -> + fun(BytesVar) -> + emit({"'dec_",asn1ct_gen:list2name(NewTypename), + "'(",BytesVar,", telltype, ObjFun)"}) + end; + _ -> + fun(BytesVar) -> + emit({"'dec_",asn1ct_gen:list2name(NewTypename), + "'(",BytesVar,", telltype)"}) + end + end + end. + +gen_dec_prim(Ctgenmod, Erule, Type) -> + case asn1ct_gen_per:gen_dec_imm(Erule, Type) of + no -> + fun(BytesVar) -> + Ctgenmod:gen_dec_prim(Erule, Type, BytesVar) + end; + Imm -> + Imm end. gen_enc_choice(Erule,TopType,CompList,Ext) -> @@ -1640,18 +1799,12 @@ wrap_extensionAdditionGroups([],_,Acc,_,_) -> lists:reverse(Acc). -wrap_gen_dec_line(Erule,C,TopType,Cname,Type,Pos,DIO,Ext) -> +wrap_gen_dec_line(Erule,C,TopType,_Cname,_Type,Pos,DIO,Ext) -> put(component_type,{true,C}), - gen_dec_line(Erule,TopType,Cname,Type,Pos,DIO,Ext,mandatory), + gen_dec_line(Erule, TopType, C#'ComponentType'{prop=mandatory}, + Pos, DIO, Ext), erase(component_type). -get_components_prop() -> - case get(component_type) of - undefined -> - mandatory; - {true,#'ComponentType'{prop=Prop}} -> Prop - end. - value_match(Index,Value) when is_atom(Value) -> value_match(Index,atom_to_list(Value)); diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index b0990e92cf..57b12ce186 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -1405,7 +1405,7 @@ gen_head(Erules,Mod,Hrl) -> emit({"%% Purpose: encoder and decoder to the types in mod ",Mod,nl,nl}), emit({"-module('",Mod,"').",nl}), put(currmod,Mod), - %emit({"-compile(export_all).",nl}), + emit({"-compile(nowarn_unused_vars).",nl}), case {Hrl,lists:member(inline,get(encoding_options))} of {0,_} -> true; {_,true} -> true; diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 3e100fc833..eb4cfdccc6 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -25,6 +25,7 @@ -include("asn1_records.hrl"). %-compile(export_all). +-export([gen_dec_imm/2]). -export([pgen/4,gen_dec_prim/3,gen_encode_prim/4]). -export([gen_obj_code/3,gen_objectset_code/2]). -export([gen_decode/2, gen_decode/3]). @@ -146,10 +147,12 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> case D#type.def of 'INTEGER' -> emit({"?RT_PER:encode_integer(", %fel - {asis,effective_constraint(integer,Constraint)},",",Value,")"}); + {asis,asn1ct_imm:effective_constraint(integer,Constraint)}, + ",",Value,")"}); {'INTEGER',NamedNumberList} -> emit({"?RT_PER:encode_integer(", - {asis,effective_constraint(integer,Constraint)},",",Value,",", + {asis,asn1ct_imm:effective_constraint(integer,Constraint)}, + ",",Value,",", {asis,NamedNumberList},")"}); {'ENUMERATED',{Nlist1,Nlist2}} -> NewList = lists:concat([[{0,X}||{X,_} <- Nlist1],['EXT_MARK'],[{1,X}||{X,_} <- Nlist2]]), @@ -184,7 +187,7 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> {asis,Constraint},",",Value,",", {asis,NamedNumberList},")"}); 'NULL' -> - emit({"?RT_PER:encode_null(",Value,")"}); + emit("[]"); 'OBJECT IDENTIFIER' -> emit({"?RT_PER:encode_object_identifier(",Value,")"}); 'RELATIVE-OID' -> @@ -295,107 +298,16 @@ emit_enc_enumerated_case(_Per,C, {0,EnumName}, Count) -> emit_enc_enumerated_case(_Erule, C, EnumName, Count) -> emit(["'",EnumName,"' -> ?RT_PER:encode_integer(",{asis,C},", ",Count,")"]). -%% effective_constraint(Type,C) -%% Type = atom() -%% C = [C1,...] -%% C1 = {'SingleValue',SV} | {'ValueRange',VR} | {atom(),term()} -%% SV = integer() | [integer(),...] -%% VR = {Lb,Ub} -%% Lb = 'MIN' | integer() -%% Ub = 'MAX' | integer() -%% Returns a single value if C only has a single value constraint, and no -%% value range constraints, that constrains to a single value, otherwise -%% returns a value range that has the lower bound set to the lowest value -%% of all single values and lower bound values in C and the upper bound to -%% the greatest value. -effective_constraint(integer,[C={{_,_},_}|_Rest]) -> % extension - [C]; %% [C|effective_constraint(integer,Rest)]; XXX what is possible ??? -effective_constraint(integer,C) -> - SVs = get_constraints(C,'SingleValue'), - SV = effective_constr('SingleValue',SVs), - VRs = get_constraints(C,'ValueRange'), - VR = effective_constr('ValueRange',VRs), - greatest_common_range(SV,VR). - -effective_constr(_,[]) -> - []; -effective_constr('SingleValue',List) -> - SVList = lists:flatten(lists:map(fun(X)->element(2,X)end,List)), - %% Sort and remove duplicates before generating SingleValue or ValueRange - %% In case of ValueRange, also check for 'MIN and 'MAX' - case lists:usort(SVList) of - [N] -> - [{'SingleValue',N}]; - L when is_list(L) -> - [{'ValueRange',{least_Lb(L),greatest_Ub(L)}}] - end; -effective_constr('ValueRange',List) -> - LBs = lists:map(fun({_,{Lb,_}})-> Lb end,List), - UBs = lists:map(fun({_,{_,Ub}})-> Ub end,List), - Lb = least_Lb(LBs), - [{'ValueRange',{Lb,lists:max(UBs)}}]. - -greatest_common_range([],VR) -> - VR; -greatest_common_range(SV,[]) -> - SV; -greatest_common_range(SV,VR) -> - greatest_common_range2(mk_vr(SV),mk_vr(VR)). -greatest_common_range2({_,Int},{'MIN',Ub}) when is_integer(Int), - Int > Ub -> - [{'ValueRange',{'MIN',Int}}]; -greatest_common_range2({_,Int},{Lb,Ub}) when is_integer(Int), - Int < Lb -> - [{'ValueRange',{Int,Ub}}]; -greatest_common_range2({_,Int},VR={_Lb,_Ub}) when is_integer(Int) -> - [{'ValueRange',VR}]; -greatest_common_range2({_,L},{Lb,Ub}) when is_list(L) -> - Min = least_Lb([Lb|L]), - Max = greatest_Ub([Ub|L]), - [{'ValueRange',{Min,Max}}]; -greatest_common_range2({Lb1,Ub1},{Lb2,Ub2}) -> - Min = least_Lb([Lb1,Lb2]), - Max = greatest_Ub([Ub1,Ub2]), - [{'ValueRange',{Min,Max}}]. - -mk_vr([{Type,I}]) when is_atom(Type), is_integer(I) -> - {I,I}; -mk_vr([{Type,{Lb,Ub}}]) when is_atom(Type) -> - {Lb,Ub}; -mk_vr(Other) -> - Other. - -least_Lb(L) -> - case lists:member('MIN',L) of - true -> 'MIN'; - _ -> lists:min(L) - end. - -greatest_Ub(L) -> - case lists:member('MAX',L) of - true -> 'MAX'; - _ -> lists:max(L) - end. - - -get_constraints(L=[{Key,_}],Key) -> - L; -get_constraints([],_) -> - []; -get_constraints(C,Key) -> - {value,L} = keysearch_allwithkey(Key,1,C,[]), - L. - -keysearch_allwithkey(Key,Ix,C,Acc) -> - case lists:keysearch(Key,Ix,C) of - false -> - {value,Acc}; - {value,T} -> - RestC = lists:delete(T,C), - keysearch_allwithkey(Key,Ix,RestC,[T|Acc]) +get_constraint([{Key,V}], Key) -> + V; +get_constraint([], _) -> + no; +get_constraint(C, Key) -> + case lists:keyfind(Key, 1, C) of + false -> no; + {Key,V} -> V end. - %% Object code generating for encoding and decoding %% ------------------------------------------------ @@ -1228,19 +1140,43 @@ gen_decode_user(Erules,D) when is_record(D,typedef) -> exit({error,{asn1,{unknown,Other}}}) end. +gen_dec_imm(Erule, #type{def=Name,constraint=C}) -> + Aligned = case Erule of + uper -> false; + per -> true + end, + gen_dec_imm_1(Name, C, Aligned). + +gen_dec_imm_1('BOOLEAN', _Constr, _Aligned) -> + asn1ct_imm:per_dec_boolean(); +gen_dec_imm_1({'ENUMERATED',{Base,Ext}}, _Constr, Aligned) -> + asn1ct_imm:per_dec_enumerated(Base, Ext, Aligned); +gen_dec_imm_1({'ENUMERATED',NamedNumberList}, _Constr, Aligned) -> + asn1ct_imm:per_dec_enumerated(NamedNumberList, Aligned); +gen_dec_imm_1('INTEGER', Constr, Aligned) -> + asn1ct_imm:per_dec_integer(Constr, Aligned); +gen_dec_imm_1({'INTEGER',NamedNumberList}, Constraint, Aligned) -> + asn1ct_imm:per_dec_named_integer(Constraint, + NamedNumberList, + Aligned); +gen_dec_imm_1('OCTET STRING', Constraint, Aligned) -> + SzConstr = get_constraint(Constraint, 'SizeConstraint'), + Imm = asn1ct_imm:per_dec_octet_string(SzConstr, Aligned), + {convert,binary_to_list,Imm}; +gen_dec_imm_1(_, _, _) -> no. + +gen_dec_prim(Erule, Type, BytesVar) -> + case gen_dec_imm(Erule, Type) of + no -> + gen_dec_prim_1(Erule, Type, BytesVar); + Imm -> + asn1ct_imm:dec_code_gen(Imm, BytesVar) + end. -gen_dec_prim(Erules,Att,BytesVar) -> - Typename = Att#type.def, - Constraint = Att#type.constraint, +gen_dec_prim_1(Erule, + #type{def=Typename,constraint=Constraint}=Att, + BytesVar) -> case Typename of - 'INTEGER' -> - emit({"?RT_PER:decode_integer(",BytesVar,",", - {asis,effective_constraint(integer,Constraint)},")"}); - {'INTEGER',NamedNumberList} -> - emit({"?RT_PER:decode_integer(",BytesVar,",", - {asis,effective_constraint(integer,Constraint)},",", - {asis,NamedNumberList},")"}); - 'REAL' -> emit({"?RT_PER:decode_real(",BytesVar,")"}); @@ -1256,8 +1192,7 @@ gen_dec_prim(Erules,Att,BytesVar) -> {asis,NamedNumberList},")"}) end; 'NULL' -> - emit({"?RT_PER:decode_null(", - BytesVar,")"}); + emit({"{'NULL',",BytesVar,"}"}); 'OBJECT IDENTIFIER' -> emit({"?RT_PER:decode_object_identifier(", BytesVar,")"}); @@ -1267,24 +1202,6 @@ gen_dec_prim(Erules,Att,BytesVar) -> 'ObjectDescriptor' -> emit({"?RT_PER:decode_ObjectDescriptor(", BytesVar,")"}); - {'ENUMERATED',{NamedNumberList1,NamedNumberList2}} -> - NewTup = {list_to_tuple([X||{X,_} <- NamedNumberList1]), - list_to_tuple([X||{X,_} <- NamedNumberList2])}, - NewC = [{'ValueRange',{0,size(element(1,NewTup))-1}}], - emit({"?RT_PER:decode_enumerated(",BytesVar,",", - {asis,NewC},",", - {asis,NewTup},")"}); - {'ENUMERATED',NamedNumberList} -> - NewTup = list_to_tuple([X||{X,_} <- NamedNumberList]), - NewC = [{'ValueRange',{0,size(NewTup)-1}}], - emit({"?RT_PER:decode_enumerated(",BytesVar,",", - {asis,NewC},",", - {asis,NewTup},")"}); - 'BOOLEAN'-> - emit({"?RT_PER:decode_boolean(",BytesVar,")"}); - 'OCTET STRING' -> - emit({"?RT_PER:decode_octet_string(",BytesVar,",", - {asis,Constraint},")"}); 'NumericString' -> emit({"?RT_PER:decode_NumericString(",BytesVar,",", {asis,Constraint},")"}); @@ -1323,7 +1240,7 @@ gen_dec_prim(Erules,Att,BytesVar) -> 'UTF8String' -> emit({"?RT_PER:decode_UTF8String(",BytesVar,")"}); 'ANY' -> - case Erules of + case Erule of per -> emit(["fun() -> {XTerm,YTermXBytes} = ?RT_PER:decode_open_type(",BytesVar,",",{asis,Constraint}, "), {binary_to_list(XTerm),XBytes} end ()"]); _ -> @@ -1345,7 +1262,7 @@ gen_dec_prim(Erules,Att,BytesVar) -> emit([" {YTerm,_} = dec_",Tname,"(XTerm,mandatory),",nl]), emit([" {YTerm,XBytes} end(",BytesVar,")"]); _ -> - case Erules of + case Erule of per -> emit(["fun() -> {XTerm,XBytes} = ?RT_PER:decode_open_type(",BytesVar,", []), {binary_to_list(XTerm),XBytes} end()"]); _ -> @@ -1353,11 +1270,11 @@ gen_dec_prim(Erules,Att,BytesVar) -> end end; #'ObjectClassFieldType'{} -> - case asn1ct_gen:get_inner(Att#type.def) of + case asn1ct_gen:get_inner(Typename) of {fixedtypevaluefield,_,InnerType} -> - gen_dec_prim(Erules,InnerType,BytesVar); + gen_dec_prim(Erule, InnerType, BytesVar); T -> - gen_dec_prim(Erules,Att#type{def=T},BytesVar) + gen_dec_prim(Erule, Att#type{def=T}, BytesVar) end; Other -> exit({'cant decode' ,Other}) diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index 16eec92847..ecd212c3e3 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -176,7 +176,7 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> {asis,NamedNumberList},")"}) end; 'NULL' -> - emit({"?RT_PER:encode_null(",Value,")"}); + emit("[]"); 'OBJECT IDENTIFIER' -> emit({"?RT_PER:encode_object_identifier(",Value,")"}); 'RELATIVE-OID' -> @@ -450,17 +450,6 @@ emit_enc_octet_string(_Erules,Constraint,Value) -> emit({" ?RT_PER:encode_octet_string(",{asis,C},",false,",Value,")",nl}) end. -emit_dec_octet_string(Constraint,BytesVar) -> - case get_constraint(Constraint,'SizeConstraint') of - 0 -> - emit({" {[],",BytesVar,"}",nl}); - {_,0} -> - emit({" {[],",BytesVar,"}",nl}); - C -> - emit({" ?RT_PER:decode_octet_string(",BytesVar,",", - {asis,C},",false)",nl}) - end. - emit_enc_integer_case(Value) -> case get(component_type) of {true,#'ComponentType'{prop=Prop}} -> @@ -624,23 +613,6 @@ get_constraint(C,Key) -> V end. -get_constraints(L=[{Key,_}],Key) -> - L; -get_constraints([],_) -> - []; -get_constraints(C,Key) -> - {value,L} = keysearch_allwithkey(Key,1,C,[]), - L. - -keysearch_allwithkey(Key,Ix,C,Acc) -> - case lists:keysearch(Key,Ix,C) of - false -> - {value,Acc}; - {value,T} -> - RestC = lists:delete(T,C), - keysearch_allwithkey(Key,Ix,RestC,[T|Acc]) - end. - %% effective_constraint(Type,C) %% Type = atom() %% C = [C1,...] @@ -657,69 +629,9 @@ keysearch_allwithkey(Key,Ix,C,Acc) -> effective_constraint(integer,[C={{_,_},_}|_Rest]) -> % extension [C]; %% [C|effective_constraint(integer,Rest)]; XXX what is possible ??? effective_constraint(integer,C) -> - SVs = get_constraints(C,'SingleValue'), - SV = effective_constr('SingleValue',SVs), - VRs = get_constraints(C,'ValueRange'), - VR = effective_constr('ValueRange',VRs), - CRange = greatest_common_range(SV,VR), - pre_encode(integer,CRange); + pre_encode(integer, asn1ct_imm:effective_constraint(integer, C)); effective_constraint(bitstring,C) -> - get_constraint(C,'SizeConstraint'). - -effective_constr(_,[]) -> - []; -effective_constr('SingleValue',List) -> - SVList = lists:flatten(lists:map(fun(X)->element(2,X)end,List)), - %% Sort and remove duplicates before generating SingleValue or ValueRange - %% In case of ValueRange, also check for 'MIN and 'MAX' - case lists:usort(SVList) of - [N] -> - [{'SingleValue',N}]; - L when is_list(L) -> - [{'ValueRange',{least_Lb(L),greatest_Ub(L)}}] - end; -effective_constr('ValueRange',List) -> - LBs = lists:map(fun({_,{Lb,_}})-> Lb end,List), - UBs = lists:map(fun({_,{_,Ub}})-> Ub end,List), - Lb = least_Lb(LBs), - [{'ValueRange',{Lb,lists:max(UBs)}}]. - -greatest_common_range([],VR) -> - VR; -greatest_common_range(SV,[]) -> - SV; -greatest_common_range([{_,Int}],[{_,{'MIN',Ub}}]) when is_integer(Int), - Int > Ub -> - [{'ValueRange',{'MIN',Int}}]; -greatest_common_range([{_,Int}],[{_,{Lb,Ub}}]) when is_integer(Int), - Int < Lb -> - [{'ValueRange',{Int,Ub}}]; -greatest_common_range([{_,Int}],VR=[{_,{_Lb,_Ub}}]) when is_integer(Int) -> - VR; -greatest_common_range([{_,L}],[{_,{Lb,Ub}}]) when is_list(L) -> - Min = least_Lb([Lb|L]), - Max = greatest_Ub([Ub|L]), - [{'ValueRange',{Min,Max}}]; -greatest_common_range([{_,{Lb1,Ub1}}],[{_,{Lb2,Ub2}}]) -> - Min = least_Lb([Lb1,Lb2]), - Max = greatest_Ub([Ub1,Ub2]), - [{'ValueRange',{Min,Max}}]. - - -least_Lb(L) -> - case lists:member('MIN',L) of - true -> 'MIN'; - _ -> lists:min(L) - end. - -greatest_Ub(L) -> - case lists:member('MAX',L) of - true -> 'MAX'; - _ -> lists:max(L) - end. - - - + asn1ct_imm:effective_constraint(bitstring, C). pre_encode(integer,[]) -> []; @@ -1586,17 +1498,9 @@ gen_dec_prim(Erules,Att,BytesVar) -> Constraint = Att#type.constraint, case Typename of 'INTEGER' -> - EffectiveConstr = effective_constraint(integer,Constraint), - emit_dec_integer(EffectiveConstr,BytesVar); -% emit({"?RT_PER:decode_integer(",BytesVar,",", -% {asis,EffectiveConstr},")"}); - {'INTEGER',NamedNumberList} -> - EffectiveConstr = effective_constraint(integer,Constraint), - emit_dec_integer(EffectiveConstr,BytesVar,NamedNumberList); -% emit({"?RT_PER:decode_integer(",BytesVar,",", -% {asis,EffectiveConstr},",", -% {asis,NamedNumberList},")"}); - + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); + {'INTEGER',_NamedNumberList} -> + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'REAL' -> emit(["?RT_PER:decode_real(",BytesVar,")"]); @@ -1612,8 +1516,7 @@ gen_dec_prim(Erules,Att,BytesVar) -> {asis,NamedNumberList},")"}) end; 'NULL' -> - emit({"?RT_PER:decode_null(", - BytesVar,")"}); + emit({"{'NULL',",BytesVar,"}"}); 'OBJECT IDENTIFIER' -> emit({"?RT_PER:decode_object_identifier(", BytesVar,")"}); @@ -1623,23 +1526,13 @@ gen_dec_prim(Erules,Att,BytesVar) -> 'ObjectDescriptor' -> emit({"?RT_PER:decode_ObjectDescriptor(", BytesVar,")"}); - {'ENUMERATED',{NamedNumberList1,NamedNumberList2}} -> - NewTup = {list_to_tuple([X||{X,_} <- NamedNumberList1]), - list_to_tuple([X||{X,_} <- NamedNumberList2])}, - NewC = [{'ValueRange',{0,size(element(1,NewTup))-1}}], - emit({"?RT_PER:decode_enumerated(",BytesVar,",", - {asis,NewC},",", - {asis,NewTup},")"}); - {'ENUMERATED',NamedNumberList} -> - NewNNL = [X||{X,_} <- NamedNumberList], - NewC = effective_constraint(integer, - [{'ValueRange',{0,length(NewNNL)-1}}]), - emit_dec_enumerated(BytesVar,NewC,NewNNL); + {'ENUMERATED',_} -> + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'BOOLEAN'-> - emit({"?RT_PER:decode_boolean(",BytesVar,")"}); + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'OCTET STRING' -> - emit_dec_octet_string(Constraint,BytesVar); + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'NumericString' -> emit_dec_known_multiplier_string('NumericString', @@ -1716,88 +1609,6 @@ gen_dec_prim(Erules,Att,BytesVar) -> exit({'cant decode' ,Other}) end. - -emit_dec_integer(C,BytesVar,NNL) -> - asn1ct_name:new(tmpterm), - asn1ct_name:new(buffer), - Tmpterm = asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)), - Buffer = asn1ct_gen:mk_var(asn1ct_name:curr(buffer)), - emit({" begin {",{curr,tmpterm},",",{curr,buffer},"} = ",nl}), - emit_dec_integer(C,BytesVar), - emit({",",nl," case ",Tmpterm," of",nl}), - lists:map(fun({Name,Int})->emit({" ",Int," -> {",{asis,Name},",", - Buffer,"};",nl}); - (_)-> exit({error,{asn1,{"error in named number list",NNL}}}) - end, - NNL), - emit({" _ -> {",Tmpterm,",",Buffer,"}",nl}), - emit({" end",nl}), % end of case - emit(" end"). % end of begin - -emit_dec_integer([{'SingleValue',Int}],BytesVar) when is_integer(Int) -> - emit(["{",Int,",",BytesVar,"}"]); -emit_dec_integer([{_,{Lb,_Ub},_Range,{BitsOrOctets,N}}],BytesVar) -> - GetBorO = - case BitsOrOctets of - bits -> "getbits"; - _ -> "getoctets" - end, - asn1ct_name:new(tmpterm), - asn1ct_name:new(tmpremain), - emit({" begin",nl," {",{curr,tmpterm},",",{curr,tmpremain},"}=", - "?RT_PER:",GetBorO,"(",BytesVar,",",N,"),",nl}), - emit({" {",{curr,tmpterm},"+",Lb,",",{curr,tmpremain},"}",nl, - " end"}); -emit_dec_integer([{_,{'MIN',_}}],BytesVar) -> - emit({"?RT_PER:decode_unconstrained_number(",BytesVar,")"}); -emit_dec_integer([{_,{Lb,'MAX'}}],BytesVar) -> - emit({"?RT_PER:decode_semi_constrained_number(",BytesVar,",",Lb,")"}); -emit_dec_integer([{'ValueRange',VR={Lb,Ub}}],BytesVar) -> - Range = Ub-Lb+1, - emit({"?RT_PER:decode_constrained_number(",BytesVar,",", - {asis,VR},",",Range,")"}); -emit_dec_integer(C=[{Rc,_}],BytesVar) when is_tuple(Rc) -> - emit({"?RT_PER:decode_integer(",BytesVar,",",{asis,C},")"}); -emit_dec_integer(_,BytesVar) -> - emit({"?RT_PER:decode_unconstrained_number(",BytesVar,")"}). - - -emit_dec_enumerated(BytesVar,C,NamedNumberList) -> - emit_dec_enumerated_begin(),% emits a begin if component - asn1ct_name:new(tmpterm), - Tmpterm = asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)), - asn1ct_name:new(tmpremain), - Tmpremain = asn1ct_gen:mk_var(asn1ct_name:curr(tmpremain)), - emit({" {",{curr,tmpterm},",",{curr,tmpremain},"} =",nl}), - emit_dec_integer(C,BytesVar), - emit({",",nl," case ",Tmpterm," of "}), - - Cases=lists:flatten(dec_enumerated_cases(NamedNumberList,Tmpremain,0)), - emit({Cases++"_->exit({error,{asn1,{decode_enumerated,{",Tmpterm, - ",",{asis,NamedNumberList},"}}}}) end",nl}), - emit_dec_enumerated_end(). - -emit_dec_enumerated_begin() -> - case get(component_type) of - {true,_} -> - emit({" begin",nl}); - _ -> ok - end. - -emit_dec_enumerated_end() -> - case get(component_type) of - {true,_} -> - emit(" end"); - _ -> ok - end. - - -dec_enumerated_cases([Name|Rest],Tmpremain,No) -> - io_lib:format("~w->{~w,~s};",[No,Name,Tmpremain])++ - dec_enumerated_cases(Rest,Tmpremain,No+1); -dec_enumerated_cases([],_,_) -> - "". - %% For PER the ExtensionAdditionGroup notation has significance for the encoding and decoding %% the components within the ExtensionAdditionGroup is treated in a similar way as if they %% have been specified within a SEQUENCE, therefore we construct a fake sequence type here diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl new file mode 100644 index 0000000000..34bb0b8714 --- /dev/null +++ b/lib/asn1/src/asn1ct_imm.erl @@ -0,0 +1,626 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_imm). +-export([per_dec_boolean/0,per_dec_enumerated/2,per_dec_enumerated/3, + per_dec_extension_map/1, + per_dec_integer/2,per_dec_length/3,per_dec_named_integer/3, + per_dec_octet_string/2,per_dec_open_type/1]). +-export([optimize_alignment/1,optimize_alignment/2, + dec_slim_cg/2,dec_code_gen/2]). +-export([effective_constraint/2]). +-import(asn1ct_gen, [emit/1]). + +-record(st, {var, + base}). + +dec_slim_cg(Imm0, BytesVar) -> + {Imm,_} = optimize_alignment(Imm0), + asn1ct_name:new(v), + [H|T] = atom_to_list(asn1ct_name:curr(v)) ++ "@", + VarBase = [H-($a-$A)|T], + St0 = #st{var=0,base=VarBase}, + {Res,Pre,_} = flatten(Imm, BytesVar, St0), + dcg_list_outside(Pre), + Res. + +dec_code_gen(Imm, BytesVar) -> + emit(["begin",nl]), + {Dst,DstBuf} = dec_slim_cg(Imm, BytesVar), + emit([",",nl, + "{",Dst,",",DstBuf,"}",nl, + "end"]), + ok. + +optimize_alignment(Imm) -> + opt_al(Imm, unknown). + +optimize_alignment(Imm, Al) -> + opt_al(Imm, Al). + + +per_dec_boolean() -> + {map,{get_bits,1,[1]},[{0,false},{1,true}]}. + +per_dec_enumerated(NamedList0, Aligned) -> + Constraint = [{'ValueRange',{0,length(NamedList0)-1}}], + NamedList = per_dec_enumerated_fix_list(NamedList0, [enum_error], 0), + Int = per_dec_integer(Constraint, Aligned), + {map,Int,NamedList}. + +per_dec_enumerated(BaseNamedList, NamedListExt0, Aligned) -> + Base = per_dec_enumerated(BaseNamedList, Aligned), + NamedListExt = per_dec_enumerated_fix_list(NamedListExt0, + [enum_default], 0), + Ext = {map,per_dec_normally_small_number(Aligned),NamedListExt}, + bit_case(Base, Ext). + +per_dec_extension_map(Aligned) -> + Len = {add,per_dec_normally_small_number(Aligned),1}, + {get_bits,Len,[1,bitstring]}. + +per_dec_integer(Constraint0, Aligned) -> + Constraint = effective_constraint(integer, Constraint0), + per_dec_integer_1(Constraint, Aligned). + +per_dec_length(SingleValue, _, _Aligned) when is_integer(SingleValue) -> + {value,SingleValue}; +per_dec_length({S,S}, _, _Aligned) when is_integer(S) -> + {value,S}; +per_dec_length({{_,_}=Constr,_}, AllowZero, Aligned) -> + bit_case(per_dec_length(Constr, AllowZero, Aligned), + per_dec_length(undefined, AllowZero, Aligned)); +per_dec_length({Lb,Ub}, _AllowZero, Aligned) when is_integer(Lb), + is_integer(Lb), + Ub =< 65535 -> + per_dec_constrained(Lb, Ub, Aligned); +per_dec_length({_,_}, AllowZero, Aligned) -> + decode_unconstrained_length(AllowZero, Aligned); +per_dec_length(undefined, AllowZero, Aligned) -> + decode_unconstrained_length(AllowZero, Aligned). + +per_dec_named_integer(Constraint, NamedList0, Aligned) -> + Int = per_dec_integer(Constraint, Aligned), + NamedList = [{K,V} || {V,K} <- NamedList0] ++ [integer_default], + {map,Int,NamedList}. + +per_dec_octet_string(Constraint, Aligned) -> + dec_string(Constraint, 8, Aligned). + +per_dec_open_type(Aligned) -> + {get_bits,decode_unconstrained_length(true, Aligned), + [8,binary,{align,Aligned}]}. + + +%%% +%%% Local functions. +%%% + +dec_string(Sv, U, _Aligned) when is_integer(Sv), U*Sv =< 16 -> + {get_bits,Sv,[U,binary]}; +dec_string(Sv, U, Aligned) when is_integer(Sv), Sv < 16#10000 -> + {get_bits,Sv,[U,binary,{align,Aligned}]}; +dec_string(C, U, Aligned) when is_list(C) -> + dec_string({hd(C),lists:max(C)}, U, Aligned); +dec_string({Sv,Sv}, U, Aligned) -> + dec_string(Sv, U, Aligned); +dec_string({{_,_}=C,_}, U, Aligned) -> + bit_case(dec_string(C, U, Aligned), + dec_string(no, U, Aligned)); +dec_string({Lb,Ub}, U, Aligned) when Ub < 16#10000 -> + Len = per_dec_constrained(Lb, Ub, Aligned), + {get_bits,Len,[U,binary,{align,Aligned}]}; +dec_string(_, U, Aligned) -> + Al = [{align,Aligned}], + DecRest = fun(V, Buf) -> + emit(["?RT_PER:decode_fragmented(",V,", ", + Buf,", ",U,")"]) + end, + {'case',[{test,{get_bits,1,[1|Al]},0, + {value,{get_bits, + {get_bits,7,[1]}, + [U,binary]}}}, + {test,{get_bits,1,[1|Al]},1, + {test,{get_bits,1,[1]},0, + {value,{get_bits, + {get_bits,14,[1]}, + [U,binary]}}}}, + {test,{get_bits,1,[1|Al]},1, + {test,{get_bits,1,[1]},1, + {value,{call,DecRest,{get_bits,6,[1]}}}}}]}. + +per_dec_enumerated_fix_list([{V,_}|T], Tail, N) -> + [{N,V}|per_dec_enumerated_fix_list(T, Tail, N+1)]; +per_dec_enumerated_fix_list([], Tail, _) -> Tail. + +per_dec_integer_1([{'SingleValue',Value}], _Aligned) -> + {value,Value}; +per_dec_integer_1([{'ValueRange',{Lb,'MAX'}}], Aligned) when is_integer(Lb) -> + per_dec_unconstrained(Aligned); +per_dec_integer_1([{'ValueRange',{Lb,Ub}}], Aligned) when is_integer(Lb), + is_integer(Ub) -> + per_dec_constrained(Lb, Ub, Aligned); +per_dec_integer_1([{{_,_}=Constr0,_}], Aligned) -> + Constr = effective_constraint(integer, [Constr0]), + bit_case(per_dec_integer(Constr, Aligned), + per_dec_unconstrained(Aligned)); +per_dec_integer_1([], Aligned) -> + per_dec_unconstrained(Aligned). + +per_dec_unconstrained(Aligned) -> + {get_bits,decode_unconstrained_length(false, Aligned),[8,signed]}. + +per_dec_constrained(Lb, Ub, false) -> + Range = Ub - Lb + 1, + Get = {get_bits,uper_num_bits(Range),[1]}, + add_lb(Lb, Get); +per_dec_constrained(Lb, Ub, true) -> + Range = Ub - Lb + 1, + Get = if + Range =< 255 -> + {get_bits,per_num_bits(Range),[1,unsigned]}; + Range == 256 -> + {get_bits,1,[8,unsigned,{align,true}]}; + Range =< 65536 -> + {get_bits,2,[8,unsigned,{align,true}]}; + true -> + RangeOctLen = byte_size(binary:encode_unsigned(Range - 1)), + {get_bits,per_dec_length({1,RangeOctLen}, false, true), + [8,unsigned,{align,true}]} + end, + add_lb(Lb, Get). + +add_lb(0, Get) -> Get; +add_lb(Lb, Get) -> {add,Get,Lb}. + +per_dec_normally_small_number(Aligned) -> + Small = {get_bits,6,[1]}, + Unlimited = per_decode_semi_constrained(0, Aligned), + bit_case(Small, Unlimited). + +per_decode_semi_constrained(Lb, Aligned) -> + add_lb(Lb, {get_bits,decode_unconstrained_length(false, Aligned),[8]}). + +bit_case(Base, Ext) -> + {'case',[{test,{get_bits,1,[1]},0,Base}, + {test,{get_bits,1,[1]},1,Ext}]}. + +decode_unconstrained_length(AllowZero, Aligned) -> + Al = [{align,Aligned}], + Zero = case AllowZero of + false -> [non_zero]; + true -> [] + end, + {'case',[{test,{get_bits,1,[1|Al]},0, + {value,{get_bits,7,[1|Zero]}}}, + {test,{get_bits,1,[1|Al]},1, + {test,{get_bits,1,[1]},0, + {value,{get_bits,14,[1|Zero]}}}}]}. + +uper_num_bits(N) -> + uper_num_bits(N, 1, 0). + +uper_num_bits(N, T, B) when N =< T -> B; +uper_num_bits(N, T, B) -> uper_num_bits(N, T bsl 1, B+1). + +per_num_bits(2) -> 1; +per_num_bits(N) when N =< 4 -> 2; +per_num_bits(N) when N =< 8 -> 3; +per_num_bits(N) when N =< 16 -> 4; +per_num_bits(N) when N =< 32 -> 5; +per_num_bits(N) when N =< 64 -> 6; +per_num_bits(N) when N =< 128 -> 7; +per_num_bits(N) when N =< 255 -> 8. + +%%% +%%% Remove unnecessary aligning to octet boundaries. +%%% + +opt_al({get_bits,E0,Opts0}, A0) -> + {E,A1} = opt_al(E0, A0), + Opts = opt_al_1(A1, Opts0), + A = update_al(A1, E, Opts), + {{get_bits,E,Opts},A}; +opt_al({call,Fun,E0}, A0) -> + {E,A} = opt_al(E0, A0), + {{call,Fun,E},A}; +opt_al({convert,Op,E0}, A0) -> + {E,A} = opt_al(E0, A0), + {{convert,Op,E},A}; +opt_al({value,E0}, A0) -> + {E,A} = opt_al(E0, A0), + {{value,E},A}; +opt_al({add,E0,I}, A0) when is_integer(I) -> + {E,A} = opt_al(E0, A0), + {{add,E,I},A}; +opt_al({test,E0,V,B0}, A0) -> + {E,A1} = opt_al(E0, A0), + {B,A2} = opt_al(B0, A1), + {{test,E,V,B},A2}; +opt_al({'case',Cs0}, A0) -> + {Cs,A} = opt_al_cs(Cs0, A0), + {{'case',Cs},A}; +opt_al({map,E0,Cs}, A0) -> + {E,A} = opt_al(E0, A0), + {{map,E,Cs},A}; +opt_al(I, A) when is_integer(I) -> + {I,A}. + +opt_al_cs([C0|Cs0], A0) -> + {C,A1} = opt_al(C0, A0), + {Cs,A2} = opt_al_cs(Cs0, A0), + {[C|Cs],merge_al(A1, A2)}; +opt_al_cs([], _) -> {[],none}. + +merge_al(unknown, _) -> unknown; +merge_al(Other, none) -> Other; +merge_al(_, unknown) -> unknown; +merge_al(I0, I1) -> + case {I0 rem 8,I1 rem 8} of + {I,I} -> I; + {_,_} -> unknown + end. + +opt_al_1(unknown, Opts) -> + Opts; +opt_al_1(A, Opts0) -> + case alignment(Opts0) of + none -> + Opts0; + full -> + case A rem 8 of + 0 -> + %% Already in alignment. + proplists:delete(align, Opts0); + Bits -> + %% Cheaper alignment with a constant padding. + Opts1 = proplists:delete(align, Opts0), + [{align,8-Bits }|Opts1] + end; + A -> %Assertion. + Opts0 + end. + +update_al(A0, E, Opts) -> + A = case alignment(Opts) of + none -> A0; + full -> 0; + Bits when is_integer(A0) -> + 0 = (A0 + Bits) rem 8; %Assertion. + _ -> + 0 + end, + [U] = [U || U <- Opts, is_integer(U)], + if + U rem 8 =:= 0 -> A; + is_integer(A), is_integer(E) -> A + U*E; + true -> unknown + end. + +%%% +%%% Flatten the intermediate format and assign temporaries. +%%% + +flatten({get_bits,I,U}, Buf0, St0) when is_integer(I) -> + {Dst,St} = new_var_pair(St0), + Gb = {get_bits,{I,Buf0},U,Dst}, + flatten_align(Gb, [], St); +flatten({get_bits,E0,U}, Buf0, St0) -> + {E,Pre,St1} = flatten(E0, Buf0, St0), + {Dst,St2} = new_var_pair(St1), + Gb = {get_bits,E,U,Dst}, + flatten_align(Gb, Pre, St2); +flatten({test,{get_bits,I,U},V,E0}, Buf0, St0) when is_integer(I) -> + {DstBuf0,St1} = new_var("Buf", St0), + Gb = {get_bits,{I,Buf0},U,{V,DstBuf0}}, + {{_Dst,DstBuf},Pre0,St2} = flatten_align(Gb, [], St1), + {E,Pre1,St3} = flatten(E0, DstBuf, St2), + {E,Pre0++Pre1,St3}; +flatten({add,E0,I}, Buf0, St0) -> + {{Src,Buf},Pre,St1} = flatten(E0, Buf0, St0), + {Dst,St} = new_var("Add", St1), + {{Dst,Buf},Pre++[{add,Src,I,Dst}],St}; +flatten({'case',Cs0}, Buf0, St0) -> + {Dst,St1} = new_var_pair(St0), + {Cs1,St} = flatten_cs(Cs0, Buf0, St1), + {Al,Cs2} = flatten_hoist_align(Cs1), + {Dst,Al++[{'case',Buf0,Cs2,Dst}],St}; +flatten({map,E0,Cs0}, Buf0, St0) -> + {{E,DstBuf},Pre,St1} = flatten(E0, Buf0, St0), + {Dst,St2} = new_var("Int", St1), + Cs = flatten_map_cs(Cs0, E), + {{Dst,DstBuf},Pre++[{'map',E,Cs,{Dst,DstBuf}}],St2}; +flatten({value,V0}, Buf0, St0) when is_integer(V0) -> + {{V0,Buf0},[],St0}; +flatten({value,V0}, Buf0, St0) -> + flatten(V0, Buf0, St0); +flatten({convert,Op,E0}, Buf0, St0) -> + {{E,Buf},Pre,St1} = flatten(E0, Buf0, St0), + {Dst,St2} = new_var("Conv", St1), + {{Dst,Buf},Pre++[{convert,Op,E,Dst}],St2}; +flatten({call,Fun,E0}, Buf0, St0) -> + {Src,Pre,St1} = flatten(E0, Buf0, St0), + {Dst,St2} = new_var_pair(St1), + {Dst,Pre++[{call,Fun,Src,Dst}],St2}. + +flatten_cs([C0|Cs0], Buf, St0) -> + {C,Pre,St1} = flatten(C0, Buf, St0), + {Cs,St2} = flatten_cs(Cs0, Buf, St0), + St3 = St2#st{var=max(St1#st.var, St2#st.var)}, + {[Pre++[{return,C}]|Cs],St3}; +flatten_cs([], _, St) -> {[],St}. + +flatten_map_cs(Cs, Var) -> + flatten_map_cs_1(Cs, {Var,Cs}). + +flatten_map_cs_1([{K,V}|Cs], DefData) -> + [{{asis,K},{asis,V}}|flatten_map_cs_1(Cs, DefData)]; +flatten_map_cs_1([integer_default], {Int,_}) -> + [{'_',Int}]; +flatten_map_cs_1([enum_default], {Int,_}) -> + [{'_',["{asn1_enum,",Int,"}"]}]; +flatten_map_cs_1([enum_error], {Var,Cs}) -> + Vs = [V || {_,V} <- Cs], + [{'_',["exit({error,{asn1,{decode_enumerated,{",Var,",", + {asis,Vs},"}}}})"]}]; +flatten_map_cs_1([], _) -> []. + +flatten_hoist_align([[{align_bits,_,_}=Ab|T]|Cs]) -> + flatten_hoist_align_1(Cs, Ab, [T]); +flatten_hoist_align(Cs) -> {[],Cs}. + +flatten_hoist_align_1([[Ab|T]|Cs], Ab, Acc) -> + flatten_hoist_align_1(Cs, Ab, [T|Acc]); +flatten_hoist_align_1([], Ab, Acc) -> + {[Ab],lists:reverse(Acc)}. + +flatten_align({get_bits,{SrcBits,SrcBuf},U,Dst}=Gb0, Pre, St0) -> + case alignment(U) of + none -> + flatten_align_1(U, Dst, Pre++[Gb0], St0); + full -> + {PadBits,St1} = new_var("Pad", St0), + {DstBuf,St2} = new_var("Buf", St1), + Ab = {align_bits,SrcBuf,PadBits}, + Agb = {get_bits,{PadBits,SrcBuf},[1],{'_',DstBuf}}, + Gb = {get_bits,{SrcBits,DstBuf},U,Dst}, + flatten_align_1(U, Dst, Pre++[Ab,Agb,Gb], St2); + PadBits when is_integer(PadBits), PadBits > 0 -> + {DstBuf,St1} = new_var("Buf", St0), + Agb = {get_bits,{PadBits,SrcBuf},[1],{'_',DstBuf}}, + Gb = {get_bits,{SrcBits,DstBuf},U,Dst}, + flatten_align_1(U, Dst, Pre++[Agb,Gb], St1) + end. + +flatten_align_1(U, {D,_}=Dst, Pre, St) -> + case is_non_zero(U) of + false -> + {Dst,Pre,St}; + true -> + {Dst,Pre++[{non_zero,D}],St} + end. + +new_var_pair(St0) -> + {Var,St1} = new_var("V", St0), + {Buf,St2} = new_var("Buf", St1), + {{Var,Buf},St2}. + +new_var(Tag, #st{base=VarBase,var=N}=St) -> + {VarBase++Tag++integer_to_list(N),St#st{var=N+1}}. + +alignment([{align,false}|_]) -> none; +alignment([{align,true}|_]) -> full; +alignment([{align,Bits}|_]) -> Bits; +alignment([_|T]) -> alignment(T); +alignment([]) -> none. + +is_non_zero(Fl) -> + lists:member(non_zero, Fl). + +%%% +%%% Generate Erlang code from the flattened intermediate format. +%%% + +dcg_list_outside([{align_bits,Buf,SzVar}|T]) -> + emit([SzVar," = bit_size(",Buf,") band 7"]), + iter_dcg_list_outside(T); +dcg_list_outside([{'case',Buf,Cs,Dst}|T]) -> + dcg_case(Buf, Cs, Dst), + iter_dcg_list_outside(T); +dcg_list_outside([{'map',Val,Cs,Dst}|T]) -> + dcg_map(Val, Cs, Dst), + iter_dcg_list_outside(T); +dcg_list_outside([{add,S1,S2,Dst}|T]) -> + emit([Dst," = ",S1," + ",S2]), + iter_dcg_list_outside(T); +dcg_list_outside([{return,{V,Buf}}|T]) -> + emit(["{",V,",",Buf,"}"]), + iter_dcg_list_outside(T); +dcg_list_outside([{call,Fun,{V,Buf},{Dst,DstBuf}}|T]) -> + emit(["{",Dst,",",DstBuf,"} = "]), + Fun(V, Buf), + iter_dcg_list_outside(T); +dcg_list_outside([{convert,Op,V,Dst}|T]) -> + emit([Dst," = ",Op,"(",V,")"]), + iter_dcg_list_outside(T); +dcg_list_outside([{get_bits,{_,Buf0},_,_}|_]=L0) -> + emit("<<"), + {L,Buf} = dcg_list_inside(L0, buf), + emit([Buf,"/bitstring>> = ",Buf0]), + iter_dcg_list_outside(L); +dcg_list_outside([]) -> + emit("ignore"), + ok. + +iter_dcg_list_outside([_|_]=T) -> + emit([",",nl]), + dcg_list_outside(T); +iter_dcg_list_outside([]) -> ok. + +dcg_case(Buf, Cs, {Dst,DstBuf}) -> + emit(["{",Dst,",",DstBuf,"} = case ",Buf," of",nl]), + dcg_case_cs(Cs), + emit("end"). + +dcg_case_cs([C|Cs]) -> + emit("<<"), + {T0,DstBuf} = dcg_list_inside(C, buf), + emit([DstBuf,"/bitstring>>"]), + T1 = dcg_guard(T0), + dcg_list_outside(T1), + case Cs of + [] -> emit([nl]); + [_|_] -> emit([";",nl]) + end, + dcg_case_cs(Cs); +dcg_case_cs([]) -> ok. + +dcg_guard([{non_zero,Src}|T]) -> + emit([" when ",Src," =/= 0 ->",nl]), + T; +dcg_guard(T) -> + emit([" ->",nl]), + T. + +dcg_map(Val, Cs, {Dst,_}) -> + emit([Dst," = case ",Val," of",nl]), + dcg_map_cs(Cs), + emit("end"). + +dcg_map_cs([{K,V}]) -> + emit([K," -> ",V,nl]); +dcg_map_cs([{K,V}|Cs]) -> + emit([K," -> ",V,";",nl]), + dcg_map_cs(Cs). + +dcg_list_inside([{get_bits,{Sz,_},Fl0,{Dst,DstBuf}}|T], _) -> + Fl = bit_flags(Fl0, []), + emit([mk_dest(Dst),":",Sz,Fl,","]), + dcg_list_inside(T, DstBuf); +dcg_list_inside(L, Dst) -> {L,Dst}. + +bit_flags([1|T], Acc) -> + bit_flags(T, Acc); +bit_flags([{align,_}|T], Acc) -> + bit_flags(T, Acc); +bit_flags([non_zero|T], Acc) -> + bit_flags(T, Acc); +bit_flags([U|T], Acc) when is_integer(U) -> + bit_flags(T, ["unit:"++integer_to_list(U)|Acc]); +bit_flags([H|T], Acc) -> + bit_flags(T, [atom_to_list(H)|Acc]); +bit_flags([], []) -> + ""; +bit_flags([], Acc) -> + "/" ++ bit_flags_1(Acc, ""). + +bit_flags_1([H|T], Sep) -> + Sep ++ H ++ bit_flags_1(T, "-"); +bit_flags_1([], _) -> []. + +mk_dest(I) when is_integer(I) -> + integer_to_list(I); +mk_dest(S) -> S. + +%% effective_constraint(Type,C) +%% Type = atom() +%% C = [C1,...] +%% C1 = {'SingleValue',SV} | {'ValueRange',VR} | {atom(),term()} +%% SV = integer() | [integer(),...] +%% VR = {Lb,Ub} +%% Lb = 'MIN' | integer() +%% Ub = 'MAX' | integer() +%% Returns a single value if C only has a single value constraint, and no +%% value range constraints, that constrains to a single value, otherwise +%% returns a value range that has the lower bound set to the lowest value +%% of all single values and lower bound values in C and the upper bound to +%% the greatest value. +effective_constraint(integer,[C={{_,_},_}|_Rest]) -> % extension + [C]; +effective_constraint(integer, C) -> + SVs = get_constraints(C, 'SingleValue'), + SV = effective_constr('SingleValue', SVs), + VRs = get_constraints(C, 'ValueRange'), + VR = effective_constr('ValueRange', VRs), + greatest_common_range(SV, VR); +effective_constraint(bitstring, C) -> + get_constraint(C, 'SizeConstraint'). + +effective_constr(_, []) -> []; +effective_constr('SingleValue', List) -> + SVList = lists:flatten(lists:map(fun(X) -> element(2, X) end, List)), + %% Sort and remove duplicates before generating SingleValue or ValueRange + %% In case of ValueRange, also check for 'MIN and 'MAX' + case lists:usort(SVList) of + [N] -> + [{'SingleValue',N}]; + [_|_]=L -> + [{'ValueRange',{least_Lb(L),greatest_Ub(L)}}] + end; +effective_constr('ValueRange', List) -> + LBs = lists:map(fun({_,{Lb,_}}) -> Lb end, List), + UBs = lists:map(fun({_,{_,Ub}}) -> Ub end, List), + Lb = least_Lb(LBs), + [{'ValueRange',{Lb,lists:max(UBs)}}]. + +greatest_common_range([], VR) -> + VR; +greatest_common_range(SV, []) -> + SV; +greatest_common_range([{_,Int}], [{_,{'MIN',Ub}}]) + when is_integer(Int), Int > Ub -> + [{'ValueRange',{'MIN',Int}}]; +greatest_common_range([{_,Int}],[{_,{Lb,Ub}}]) + when is_integer(Int), Int < Lb -> + [{'ValueRange',{Int,Ub}}]; +greatest_common_range([{_,Int}],VR=[{_,{_Lb,_Ub}}]) when is_integer(Int) -> + VR; +greatest_common_range([{_,L}],[{_,{Lb,Ub}}]) when is_list(L) -> + Min = least_Lb([Lb|L]), + Max = greatest_Ub([Ub|L]), + [{'ValueRange',{Min,Max}}]; +greatest_common_range([{_,{Lb1,Ub1}}], [{_,{Lb2,Ub2}}]) -> + Min = least_Lb([Lb1,Lb2]), + Max = greatest_Ub([Ub1,Ub2]), + [{'ValueRange',{Min,Max}}]. + + +least_Lb(L) -> + case lists:member('MIN', L) of + true -> 'MIN'; + false -> lists:min(L) + end. + +greatest_Ub(L) -> + case lists:member('MAX', L) of + true -> 'MAX'; + false -> lists:max(L) + end. + +get_constraint(C, Key) -> + case lists:keyfind(Key, 1, C) of + false -> no; + {_,V} -> V + end. + +get_constraints([{Key,_}=Pair|T], Key) -> + [Pair|get_constraints(T, Key)]; +get_constraints([_|T], Key) -> + get_constraints(T, Key); +get_constraints([], _) -> []. diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 6057e27b63..389642c446 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -436,11 +436,8 @@ get_encoding_rule(M) -> open_type_value(ber) -> <<4,9,111,112,101,110,95,116,121,112,101>>; -open_type_value(per) -> - <<"\n\topen_type">>; %octet string value "open_type" -% <<10,9,111,112,101,110,95,116,121,112,101>>; open_type_value(_) -> - [4,9,111,112,101,110,95,116,121,112,101]. + <<"\n\topen_type">>. %octet string value "open_type" to_textual_order({Root,Ext}) -> {to_textual_order(Root),Ext}; diff --git a/lib/asn1/src/asn1rt_per_bin_rt2ct.erl b/lib/asn1/src/asn1rt_per_bin_rt2ct.erl index 01e1cb23d7..5997232f13 100644 --- a/lib/asn1/src/asn1rt_per_bin_rt2ct.erl +++ b/lib/asn1/src/asn1rt_per_bin_rt2ct.erl @@ -22,25 +22,21 @@ -include("asn1_records.hrl"). --export([dec_fixup/3]). +-export([decode_fragmented/3]). -export([setchoiceext/1, setext/1, fixoptionals/3, fixextensions/2, - getext/1, getextension/2, skipextensions/3, getbit/1, getchoice/3 ]). --export([getoptionals/2, getoptionals2/2, - set_choice/3, encode_integer/2, encode_integer/3 ]). --export([decode_integer/2, decode_integer/3, encode_small_number/1, - decode_boolean/1, encode_length/2, decode_length/1, decode_length/2, - encode_small_length/1, decode_small_length/1, + skipextensions/3, getbit/1, getchoice/3 ]). +-export([set_choice/3, encode_integer/2, encode_integer/3 ]). +-export([encode_small_number/1, + encode_length/2, + encode_small_length/1, decode_compact_bit_string/3]). --export([decode_enumerated/3, - encode_bit_string/3, decode_bit_string/3 ]). --export([encode_octet_string/2, decode_octet_string/2, - encode_null/1, decode_null/1, +-export([encode_bit_string/3, decode_bit_string/3 ]). +-export([encode_octet_string/2, encode_object_identifier/1, decode_object_identifier/1, encode_real/1, decode_real/1, encode_relative_oid/1, decode_relative_oid/1, complete/1]). - -export([encode_open_type/2, decode_open_type/2]). -export([encode_GeneralString/2, decode_GeneralString/2, @@ -51,19 +47,10 @@ encode_UTF8String/1,decode_UTF8String/1 ]). --export([decode_constrained_number/2, - decode_constrained_number/3, - decode_unconstrained_number/1, - decode_semi_constrained_number/2, - encode_unconstrained_number/1, - decode_constrained_number/4, +-export([encode_unconstrained_number/1, encode_octet_string/3, - decode_octet_string/3, encode_known_multiplier_string/5, - decode_known_multiplier_string/5, - getoctets/2, getbits/2 -% start_drv/1,start_drv2/1,init_drv/1 - ]). + decode_known_multiplier_string/5]). -export([eint_positive/1]). @@ -73,20 +60,6 @@ -define('32K',32768). -define('64K',65536). -%%-define(nodriver,true). - -dec_fixup(Terms,Cnames,RemBytes) -> - dec_fixup(Terms,Cnames,RemBytes,[]). - -dec_fixup([novalue|T],[_Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,Acc); -dec_fixup([{_Name,novalue}|T],[_Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,Acc); -dec_fixup([H|T],[Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,[{Hc,H}|Acc]); -dec_fixup([],_Cnames,RemBytes,Acc) -> - {lists:reverse(Acc),RemBytes}. - %%-------------------------------------------------------- %% setchoiceext(InRootSet) -> [{bit,X}] %% X is set to 1 when InRootSet==false @@ -131,15 +104,6 @@ fixoptionals([Pos|Ot],Val,Acc) -> end. -getext(Bytes) when is_bitstring(Bytes) -> - getbit(Bytes). - -getextension(0, Bytes) -> - {<<>>,Bytes}; -getextension(1, Bytes) -> - {Len,Bytes2} = decode_small_length(Bytes), - getbits_as_binary(Len,Bytes2).% {Bin,Bytes3}. - fixextensions({ext,ExtPos,ExtNum},Val) -> case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of 0 -> []; @@ -182,14 +146,6 @@ getchoice(Bytes,_,1) -> getchoice(Bytes,NumChoices,0) -> decode_constrained_number(Bytes,{0,NumChoices-1}). -%% old version kept for backward compatibility with generates from R7B01 -getoptionals(Bytes,NumOpt) -> - getbits_as_binary(NumOpt,Bytes). - -%% new version used in generates from r8b_patch/3 and later -getoptionals2(Bytes,NumOpt) -> - {_,_} = getbits(Bytes,NumOpt). - %% getbits_as_binary(Num,Bytes) -> {Bin,Rest} %% Num = integer(), @@ -332,32 +288,6 @@ decode_fragmented_bits(<<0:1,Len:7,Bin/binary>>,C,Acc) -> exit({error,{asn1,{illegal_value,C,BinBits}}}) end. - -decode_fragmented_octets(Bin,C) -> - decode_fragmented_octets(Bin,C,[]). - -decode_fragmented_octets(<<3:2,Len:6,Bin/binary>>,C,Acc) -> - {Value,Bin2} = split_binary(Bin,Len * ?'16K'), - decode_fragmented_octets(Bin2,C,[Value|Acc]); -decode_fragmented_octets(<<0:1,0:7,Bin/binary>>,C,Acc) -> - Octets = list_to_binary(lists:reverse(Acc)), - case C of - Int when is_integer(Int), C == size(Octets) -> - {Octets,Bin}; - Int when is_integer(Int) -> - exit({error,{asn1,{illegal_value,C,Octets}}}) - end; -decode_fragmented_octets(<<0:1,Len:7,Bin/binary>>,C,Acc) -> - <<Value:Len/binary-unit:8,Bin2/binary>> = Bin, - BinOctets = list_to_binary(lists:reverse([Value|Acc])), - case C of - Int when is_integer(Int),size(BinOctets) == Int -> - {BinOctets,Bin2}; - Int when is_integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinOctets}}}) - end. - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% encode_open_type(Constraint, Value) -> CompleteList @@ -442,40 +372,6 @@ encode_integer(_,Val) -> exit({error,{asn1,{illegal_value,Val}}}). - -decode_integer(Buffer,Range,NamedNumberList) -> - {Val,Buffer2} = decode_integer(Buffer,Range), - case lists:keysearch(Val,2,NamedNumberList) of - {value,{NewVal,_}} -> {NewVal,Buffer2}; - _ -> {Val,Buffer2} - end. - -decode_integer(Buffer,[{Rc,_Ec}]) when is_tuple(Rc) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> decode_integer(Buffer2,[Rc]); - 1 -> decode_unconstrained_number(Buffer2) - end; -decode_integer(Buffer,undefined) -> - decode_unconstrained_number(Buffer); -decode_integer(Buffer,C) -> - case get_constraint(C,'SingleValue') of - V when is_integer(V) -> - {V,Buffer}; - _ -> - decode_integer1(Buffer,C) - end. - -decode_integer1(Buffer,C) -> - case VR = get_constraint(C,'ValueRange') of - no -> - decode_unconstrained_number(Buffer); - {Lb, 'MAX'} -> - decode_semi_constrained_number(Buffer,Lb); - {_Lb,_Ub} -> - decode_constrained_number(Buffer,VR) - end. - %% X.691:10.6 Encoding of a normally small non-negative whole number %% Use this for encoding of CHOICE index if there is an extension marker in %% the CHOICE @@ -495,7 +391,7 @@ decode_small_number(Bytes) -> 0 -> getbits(Bytes2,6); 1 -> - decode_semi_constrained_number(Bytes2,0) + decode_semi_constrained_number(Bytes2) end. %% X.691:10.7 Encoding of a semi-constrained whole number @@ -518,12 +414,10 @@ encode_semi_constrained_number(Lb,Val) -> [encode_length(undefined,Len),[21,<<Len:16>>,Oct]] end. -decode_semi_constrained_number(Bytes,{Lb,_}) -> - decode_semi_constrained_number(Bytes,Lb); -decode_semi_constrained_number(Bytes,Lb) -> +decode_semi_constrained_number(Bytes) -> {Len,Bytes2} = decode_length(Bytes,undefined), {V,Bytes3} = getoctets(Bytes2,Len), - {V+Lb,Bytes3}. + {V,Bytes3}. encode_constrained_number({Lb,_Ub},_Range,{bits,N},Val) -> Val2 = Val-Lb, @@ -609,13 +503,6 @@ decode_constrained_number(Buffer,VR={Lb,Ub}) -> Range = Ub - Lb + 1, decode_constrained_number(Buffer,VR,Range). -decode_constrained_number(Buffer,{Lb,_Ub},_Range,{bits,N}) -> - {Val,Remain} = getbits(Buffer,N), - {Val+Lb,Remain}; -decode_constrained_number(Buffer,{Lb,_Ub},_Range,{octets,N}) -> - {Val,Remain} = getoctets(Buffer,N), - {Val+Lb,Remain}. - decode_constrained_number(Buffer,{Lb,_Ub},Range) -> % Val2 = Val - Lb, {Val,Remain} = @@ -716,23 +603,6 @@ enint(-1, [B1|T]) when B1 > 127 -> enint(N, Acc) -> enint(N bsr 8, [N band 16#ff|Acc]). -decode_unconstrained_number(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Ints,Bytes3} = getoctets_as_bin(Bytes2,Len), - {dec_integer(Ints),Bytes3}. - -dec_integer(Bin = <<0:1,_:7,_/binary>>) -> - decpint(Bin); -dec_integer(<<_:1,B:7,BitStr/bitstring>>) -> - Size = bit_size(BitStr), - <<I:Size>> = BitStr, - (-128 + B) bsl bit_size(BitStr) bor I. - -decpint(Bin) -> - Size = bit_size(Bin), - <<Int:Size>> = Bin, - Int. - %% X.691:10.9 Encoding of a length determinant %%encode_small_length(undefined,Len) -> % null means no UpperBound %% encode_small_number(Len). @@ -777,18 +647,6 @@ encode_small_length(Len) -> [1,encode_length(undefined,Len)]. -decode_small_length(Buffer) -> - case getbit(Buffer) of - {0,Remain} -> - {Bits,Remain2} = getbits(Remain,6), - {Bits+1,Remain2}; - {1,Remain} -> - decode_length(Remain,undefined) - end. - -decode_length(Buffer) -> - decode_length(Buffer,undefined). - decode_length(Buffer,undefined) -> % un-constrained case align(Buffer) of <<0:1,Oct:7,Rest/binary>> -> @@ -831,38 +689,6 @@ decode_length(Buffer,SingleValue) when is_integer(SingleValue) -> {SingleValue,Buffer}. - % X.691:11 -decode_boolean(Buffer) -> %when record(Buffer,buffer) - case getbit(Buffer) of - {1,Remain} -> {true,Remain}; - {0,Remain} -> {false,Remain} - end. - - -%% ENUMERATED with extension marker -decode_enumerated(Buffer,C,{Ntup1,Ntup2}) when is_tuple(Ntup1), is_tuple(Ntup2) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> % not an extension value - {Val,Buffer3} = decode_integer(Buffer2,C), - case catch (element(Val+1,Ntup1)) of - NewVal when is_atom(NewVal) -> {NewVal,Buffer3}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,[Ntup1,Ntup2]}}}}) - end; - 1 -> % this an extension value - {Val,Buffer3} = decode_small_number(Buffer2), - case catch (element(Val+1,Ntup2)) of - NewVal when is_atom(NewVal) -> {NewVal,Buffer3}; - _ -> {{asn1_enum,Val},Buffer3} - end - end; - -decode_enumerated(Buffer,C,NamedNumberTup) when is_tuple(NamedNumberTup) -> - {Val,Buffer2} = decode_integer(Buffer,C), - case catch (element(Val+1,NamedNumberTup)) of - NewVal when is_atom(NewVal) -> {NewVal,Buffer2}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,NamedNumberTup}}}}) - end. %%=============================================================================== %%=============================================================================== @@ -1313,49 +1139,74 @@ encode_octet_string(SZ={_,_},false,Val) -> % [encode_length(SZ,length(Val)),align, % {octets,Val}]; Len = length(Val), - [encode_length(SZ,Len),2, - octets_to_complete(Len,Val)]; + try + [encode_length(SZ,Len),2, + octets_to_complete(Len,Val)] + catch + exit:{error,{asn1,{encode_length,_}}} -> + encode_fragmented_octet_string(Val) + end; encode_octet_string(SZ,false,Val) when is_list(SZ) -> Len = length(Val), - [encode_length({hd(SZ),lists:max(SZ)},Len),2, - octets_to_complete(Len,Val)]; + try + [encode_length({hd(SZ),lists:max(SZ)},Len),2, + octets_to_complete(Len,Val)] + catch + exit:{error,{asn1,{encode_length,_}}} -> + encode_fragmented_octet_string(Val) + end; +encode_octet_string(Sv,false,Val) when is_integer(Sv) -> + encode_fragmented_octet_string(Val); encode_octet_string(no,false,Val) -> Len = length(Val), - [encode_length(undefined,Len),2, - octets_to_complete(Len,Val)]; + try + [encode_length(undefined,Len),2, + octets_to_complete(Len,Val)] + catch + exit:{error,{asn1,{encode_length,_}}} -> + encode_fragmented_octet_string(Val) + end; encode_octet_string(C,_,_) -> exit({error,{not_implemented,C}}). - -decode_octet_string(Bytes,Range) -> - decode_octet_string(Bytes,Range,false). - -decode_octet_string(<<B1,Bytes/bitstring>>,1,false) -> -%% {B1,Bytes2} = getbits(Bytes,8), - {[B1],Bytes}; -decode_octet_string(<<B1,B2,Bytes/bitstring>>,2,false) -> -%% {Bs,Bytes2}= getbits(Bytes,16), -%% {binary_to_list(<<Bs:16>>),Bytes2}; - {[B1,B2],Bytes}; -decode_octet_string(Bytes,Sv,false) when is_integer(Sv),Sv=<65535 -> - %% Bytes2 = align(Bytes), - %% getoctets_as_list aligns buffer before it picks octets - getoctets_as_list(Bytes,Sv); -decode_octet_string(Bytes,Sv,false) when is_integer(Sv) -> - Bytes2 = align(Bytes), - decode_fragmented_octets(Bytes2,Sv); -decode_octet_string(Bytes,{Lb,Ub},false) -> - {Len,Bytes2} = decode_length(Bytes,{Lb,Ub}), -%% Bytes3 = align(Bytes2), - getoctets_as_list(Bytes2,Len); -decode_octet_string(Bytes,Sv,false) when is_list(Sv) -> - {Len,Bytes2} = decode_length(Bytes,{hd(Sv),lists:max(Sv)}), -%% Bytes3 = align(Bytes2), - getoctets_as_list(Bytes2,Len); -decode_octet_string(Bytes,no,false) -> - {Len,Bytes2} = decode_length(Bytes,undefined), -%% Bytes3 = align(Bytes2), - getoctets_as_list(Bytes2,Len). +encode_fragmented_octet_string(Val) -> + Bin = iolist_to_binary(Val), + efos_1(Bin). + +efos_1(<<B1:16#C000/binary,B2:16#4000/binary,T/binary>>) -> + [20,1,<<3:2,4:6>>, + octets_to_complete(16#C000, B1), + octets_to_complete(16#4000, B2)|efos_1(T)]; +efos_1(<<B:16#C000/binary,T/binary>>) -> + [20,1,<<3:2,3:6>>,octets_to_complete(16#C000, B)|efos_1(T)]; +efos_1(<<B:16#8000/binary,T/binary>>) -> + [20,1,<<3:2,2:6>>,octets_to_complete(16#8000, B)|efos_1(T)]; +efos_1(<<B:16#4000/binary,T/binary>>) -> + [20,1,<<3:2,1:6>>,octets_to_complete(16#4000, B)|efos_1(T)]; +efos_1(<<>>) -> + [20,1,0]; +efos_1(<<B/bitstring>>) -> + Len = byte_size(B), + [encode_length(undefined, Len),octets_to_complete(Len, B)]. + +decode_fragmented(SegSz0, Buf0, Unit) -> + SegSz = SegSz0 * Unit * ?'16K', + <<Res:SegSz/bitstring,Buf/bitstring>> = Buf0, + decode_fragmented_1(Buf, Unit, Res). + +decode_fragmented_1(<<0:1,N:7,Buf0/bitstring>>, Unit, Res) -> + Sz = N*Unit, + <<S:Sz/bitstring,Buf/bitstring>> = Buf0, + {<<Res/bitstring,S/bitstring>>,Buf}; +decode_fragmented_1(<<1:1,0:1,N:14,Buf0/bitstring>>, Unit, Res) -> + Sz = N*Unit, + <<S:Sz/bitstring,Buf/bitstring>> = Buf0, + {<<Res/bitstring,S/bitstring>>,Buf}; +decode_fragmented_1(<<1:1,1:1,SegSz0:6,Buf0/bitstring>>, Unit, Res0) -> + SegSz = SegSz0 * Unit * ?'16K', + <<Frag:SegSz/bitstring,Buf/bitstring>> = Buf0, + Res = <<Res0/bitstring,Frag/bitstring>>, + decode_fragmented_1(Buf, Unit, Res). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1543,16 +1394,6 @@ chars_decode2(Bytes,{Min,Max,CharInTab},NumBits,Len,Acc) -> chars_decode2(Bytes2,{Min,Max,CharInTab},NumBits,Len -1,[element(Char+1,CharInTab)|Acc]). - % X.691:17 -encode_null(_Val) -> []. % encodes to nothing -%encode_null({Name,Val}) when is_atom(Name) -> -% encode_null(Val). - -decode_null(Bytes) -> - {'NULL',Bytes}. - - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% encode_UTF8String(Val) -> CompleteList %% Val -> <<utf8encoded binary>> diff --git a/lib/asn1/src/asn1rt_uper_bin.erl b/lib/asn1/src/asn1rt_uper_bin.erl index e1f96416a9..9410c3ef90 100644 --- a/lib/asn1/src/asn1rt_uper_bin.erl +++ b/lib/asn1/src/asn1rt_uper_bin.erl @@ -25,21 +25,20 @@ %%-compile(export_all). - -export([setext/1, fixoptionals/3, +-export([decode_fragmented/3]). +-export([setext/1, fixoptionals/3, fixextensions/2, - getext/1, getextension/2, skipextensions/3, getbit/1, getchoice/3 ]). - -export([getoptionals2/2, set_choice/3, encode_integer/2, encode_integer/3 ]). - -export([decode_integer/2, decode_integer/3, encode_small_number/1, encode_boolean/1, - decode_boolean/1, encode_length/2, decode_length/1, decode_length/2, - encode_small_length/1, decode_small_length/1, + skipextensions/3, getbit/1, getchoice/3 ]). +-export([set_choice/3, encode_integer/2, encode_integer/3]). +-export([encode_small_number/1, encode_boolean/1, + encode_length/2, + encode_small_length/1, decode_compact_bit_string/3]). - -export([decode_enumerated/3, - encode_bit_string/3, decode_bit_string/3 ]). - -export([encode_octet_string/2, decode_octet_string/2, - encode_null/1, decode_null/1, - encode_relative_oid/1, decode_relative_oid/1, +-export([encode_bit_string/3, decode_bit_string/3 ]). +-export([encode_octet_string/2, + encode_relative_oid/1, decode_relative_oid/1, encode_object_identifier/1, decode_object_identifier/1, - encode_real/1, decode_real/1, + encode_real/1, decode_real/1, complete/1, complete_NFP/1]). @@ -99,16 +98,6 @@ fixoptionals([Pos|Ot],Val,Acc) -> end. -getext(Bytes) when is_bitstring(Bytes) -> - getbit(Bytes). - -getextension(0, Bytes) -> - {{},Bytes}; -getextension(1, Bytes) -> - {Len,Bytes2} = decode_small_length(Bytes), - {Blist, Bytes3} = getbits_as_list(Len,Bytes2), - {list_to_tuple(Blist),Bytes3}. - fixextensions({ext,ExtPos,ExtNum},Val) -> case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of 0 -> []; @@ -151,11 +140,6 @@ getchoice(Bytes,NumChoices,0) -> decode_constrained_number(Bytes,{0,NumChoices-1}). -%%%%%%%%%%%%%%% -getoptionals2(Bytes,NumOpt) -> - getbits(Bytes,NumOpt). - - %% getbits_as_binary(Num,Bytes) -> {{Unused,BinBits},RestBytes}, %% Num = integer(), %% Bytes = list() | tuple(), @@ -275,33 +259,6 @@ decode_fragmented_bits(<<0:1,Len:7,BitStr/bitstring>>,C,Acc) -> exit({error,{asn1,{illegal_value,C,ResBitStr}}}) end. - -decode_fragmented_octets({0,Bin},C) -> - decode_fragmented_octets(Bin,C,[]). - -decode_fragmented_octets(<<3:2,Len:6,BitStr/bitstring>>,C,Acc) -> - FragLen = Len * ?'16K', - <<Value:FragLen/binary,Rest/bitstring>> = BitStr, - decode_fragmented_octets(Rest,C,[Value|Acc]); -decode_fragmented_octets(<<0:1,0:7,Bin/bitstring>>,C,Acc) -> - Octets = list_to_binary(lists:reverse(Acc)), - case C of - Int when is_integer(Int), C == size(Octets) -> - {Octets,Bin}; - Int when is_integer(Int) -> - exit({error,{asn1,{illegal_value,C,Octets}}}) - end; -decode_fragmented_octets(<<0:1,Len:7,BitStr/bitstring>>,C,Acc) -> - <<Value:Len/binary-unit:8,BitStr2/binary>> = BitStr, - BinOctets = list_to_binary(lists:reverse([Value|Acc])), - case C of - Int when is_integer(Int),size(BinOctets) == Int -> - {BinOctets,BitStr2}; - Int when is_integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinOctets}}}) - end. - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% encode_open_type(Constraint, Value) -> CompleteList @@ -384,47 +341,6 @@ encode_integer1(C, Val) -> exit({error,{asn1,{illegal_value,VR,Val}}}) end. -decode_integer(Buffer,Range,NamedNumberList) -> - {Val,Buffer2} = decode_integer(Buffer,Range), - case lists:keysearch(Val,2,NamedNumberList) of - {value,{NewVal,_}} -> {NewVal,Buffer2}; - _ -> {Val,Buffer2} - end. - -decode_integer(Buffer,[{Rc,_Ec}]) when is_tuple(Rc) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> decode_integer(Buffer2,[Rc]); %% Value in root of constraint - 1 -> decode_unconstrained_number(Buffer2) - end; -decode_integer(Buffer,undefined) -> - decode_unconstrained_number(Buffer); -decode_integer(Buffer,C) -> - case get_constraint(C,'SingleValue') of - V when is_integer(V) -> - {V,Buffer}; - V when is_list(V) -> - {Val,Buffer2} = decode_integer1(Buffer,C), - case lists:member(Val,V) of - true -> - {Val,Buffer2}; - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end; - _ -> - decode_integer1(Buffer,C) - end. - -decode_integer1(Buffer,C) -> - case VR = get_constraint(C,'ValueRange') of - no -> - decode_unconstrained_number(Buffer); - {Lb, 'MAX'} -> - decode_semi_constrained_number(Buffer,Lb); - {_,_} -> - decode_constrained_number(Buffer,VR) - end. - %% X.691:10.6 Encoding of a normally small non-negative whole number %% Use this for encoding of CHOICE index if there is an extension marker in %% the CHOICE @@ -441,7 +357,7 @@ decode_small_number(Bytes) -> 0 -> getbits(Bytes2,6); 1 -> - decode_semi_constrained_number(Bytes2,0) + decode_semi_constrained_number(Bytes2) end. %% X.691:10.7 Encoding of a semi-constrained whole number @@ -465,12 +381,10 @@ encode_semi_constrained_number(Lb,Val) -> [encode_length(undefined,Size),Bin] end. -decode_semi_constrained_number(Bytes,{Lb,_}) -> - decode_semi_constrained_number(Bytes,Lb); -decode_semi_constrained_number(Bytes,Lb) -> +decode_semi_constrained_number(Bytes) -> {Len,Bytes2} = decode_length(Bytes,undefined), {V,Bytes3} = getoctets(Bytes2,Len), - {V+Lb,Bytes3}. + {V,Bytes3}. encode_constrained_number(Range,{Name,Val}) when is_atom(Name) -> encode_constrained_number(Range,Val); @@ -552,23 +466,6 @@ enint(-1, [B1|T]) when B1 > 127 -> enint(N, Acc) -> enint(N bsr 8, [N band 16#ff|Acc]). -decode_unconstrained_number(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Ints,Bytes3} = getoctets_as_bin(Bytes2,Len), - {dec_integer(Ints),Bytes3}. - -dec_integer(Bin = <<0:1,_:7,_/bitstring>>) -> - decpint(Bin); -dec_integer(<<_:1,B:7,BitStr/bitstring>>) -> - Size = bit_size(BitStr), - <<I:Size>> = BitStr, - (-128 + B) bsl bit_size(BitStr) bor I. - -decpint(Bin) -> - Size = bit_size(Bin), - <<Int:Size>> = Bin, - Int. - %% X.691:10.9 Encoding of a length determinant %%encode_small_length(undefined,Len) -> % null means no UpperBound @@ -583,7 +480,7 @@ encode_length(undefined,Len) -> % un-constrained Len < 16384 -> <<2:2,Len:14>>; true -> % should be able to endode length >= 16384 - exit({error,{asn1,{encode_length,{nyi,above_16k}}}}) + error({error,{asn1,{encode_length,{nyi,above_16k}}}}) end; encode_length({0,'MAX'},Len) -> @@ -609,18 +506,6 @@ encode_small_length(Len) -> [<<1:1>>,encode_length(undefined,Len)]. -decode_small_length(Buffer) -> - case getbit(Buffer) of - {0,Remain} -> - {Bits,Remain2} = getbits(Remain,6), - {Bits+1,Remain2}; - {1,Remain} -> - decode_length(Remain,undefined) - end. - -decode_length(Buffer) -> - decode_length(Buffer,undefined). - %% un-constrained decode_length(<<0:1,Oct:7,Rest/bitstring>>,undefined) -> {Oct,Rest}; @@ -663,38 +548,6 @@ encode_boolean({Name,Val}) when is_atom(Name) -> encode_boolean(Val) -> exit({error,{asn1,{encode_boolean,Val}}}). -decode_boolean(Buffer) -> %when record(Buffer,buffer) - case getbit(Buffer) of - {1,Remain} -> {true,Remain}; - {0,Remain} -> {false,Remain} - end. - - -%% ENUMERATED with extension marker -decode_enumerated(Buffer,C,{Ntup1,Ntup2}) when is_tuple(Ntup1), is_tuple(Ntup2) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> % not an extension value - {Val,Buffer3} = decode_integer(Buffer2,C), - case catch (element(Val+1,Ntup1)) of - NewVal when is_atom(NewVal) -> {NewVal,Buffer3}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,[Ntup1,Ntup2]}}}}) - end; - 1 -> % this an extension value - {Val,Buffer3} = decode_small_number(Buffer2), - case catch (element(Val+1,Ntup2)) of - NewVal when is_atom(NewVal) -> {NewVal,Buffer3}; - _ -> {{asn1_enum,Val},Buffer3} - end - end; - -decode_enumerated(Buffer,C,NamedNumberTup) when is_tuple(NamedNumberTup) -> - {Val,Buffer2} = decode_integer(Buffer,C), - case catch (element(Val+1,NamedNumberTup)) of - NewVal when is_atom(NewVal) -> {NewVal,Buffer2}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,NamedNumberTup}}}}) - end. - %%============================================================================ %%============================================================================ @@ -1053,36 +906,71 @@ encode_octet_string(C,Val) -> list_to_binary(Val); 2 -> list_to_binary(Val); - Sv when Sv =<65535, Sv == length(Val) -> % fixed length - list_to_binary(Val); - VR = {_,_} -> - [encode_length(VR,length(Val)),list_to_binary(Val)]; + {_,_}=VR -> + try + [encode_length(VR, length(Val)),list_to_binary(Val)] + catch + error:{error,{asn1,{encode_length,_}}} -> + encode_fragmented_octet_string(Val) + end; + Sv when is_integer(Sv), Sv =:= length(Val) -> % fixed length + if + Sv =< 65535 -> + list_to_binary(Val); + true -> + encode_fragmented_octet_string(Val) + end; Sv when is_list(Sv) -> - [encode_length({hd(Sv),lists:max(Sv)},length(Val)),list_to_binary(Val)]; + try + [encode_length({hd(Sv),lists:max(Sv)}, + length(Val)),list_to_binary(Val)] + catch + error:{error,{asn1,{encode_length,_}}} -> + encode_fragmented_octet_string(Val) + end; no -> - [encode_length(undefined,length(Val)),list_to_binary(Val)] + try + [encode_length(undefined, length(Val)),list_to_binary(Val)] + catch + error:{error,{asn1,{encode_length,_}}} -> + encode_fragmented_octet_string(Val) + end end. -decode_octet_string(Bytes,C) -> - decode_octet_string1(Bytes,get_constraint(C,'SizeConstraint')). -decode_octet_string1(<<B1,Bytes/bitstring>>,1) -> - {[B1],Bytes}; -decode_octet_string1(<<B1,B2,Bytes/bitstring>>,2) -> - {[B1,B2],Bytes}; -decode_octet_string1(Bytes,Sv) when is_integer(Sv),Sv=<65535 -> - getoctets_as_list(Bytes,Sv); -decode_octet_string1(Bytes,Sv) when is_integer(Sv) -> - decode_fragmented_octets(Bytes,Sv); -decode_octet_string1(Bytes,{Lb,Ub}) -> - {Len,Bytes2} = decode_length(Bytes,{Lb,Ub}), - getoctets_as_list(Bytes2,Len); -decode_octet_string1(Bytes,Sv) when is_list(Sv) -> - {Len,Bytes2} = decode_length(Bytes,{hd(Sv),lists:max(Sv)}), - getoctets_as_list(Bytes2,Len); -decode_octet_string1(Bytes,no) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_list(Bytes2,Len). - +encode_fragmented_octet_string(Val) -> + Bin = list_to_binary(Val), + efos_1(Bin). + +efos_1(<<B:16#10000/binary,T/binary>>) -> + [<<3:2,4:6>>,B|efos_1(T)]; +efos_1(<<B:16#C000/binary,T/binary>>) -> + [<<3:2,3:6>>,B|efos_1(T)]; +efos_1(<<B:16#8000/binary,T/binary>>) -> + [<<3:2,2:6>>,B|efos_1(T)]; +efos_1(<<B:16#4000/binary,T/binary>>) -> + [<<3:2,1:6>>,B|efos_1(T)]; +efos_1(<<B/bitstring>>) -> + Len = byte_size(B), + [encode_length(undefined, Len),B]. + +decode_fragmented(SegSz0, Buf0, Unit) -> + SegSz = SegSz0 * Unit * ?'16K', + <<Res:SegSz/bitstring,Buf/bitstring>> = Buf0, + decode_fragmented_1(Buf, Unit, Res). + +decode_fragmented_1(<<0:1,N:7,Buf0/bitstring>>, Unit, Res) -> + Sz = N*Unit, + <<S:Sz/bitstring,Buf/bitstring>> = Buf0, + {<<Res/bitstring,S/bitstring>>,Buf}; +decode_fragmented_1(<<1:1,0:1,N:14,Buf0/bitstring>>, Unit, Res) -> + Sz = N*Unit, + <<S:Sz/bitstring,Buf/bitstring>> = Buf0, + {<<Res/bitstring,S/bitstring>>,Buf}; +decode_fragmented_1(<<1:1,1:1,SegSz0:6,Buf0/bitstring>>, Unit, Res0) -> + SegSz = SegSz0 * Unit * ?'16K', + <<Frag:SegSz/bitstring,Buf/bitstring>> = Buf0, + Res = <<Res0/bitstring,Frag/bitstring>>, + decode_fragmented_1(Buf, Unit, Res). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1427,12 +1315,6 @@ decode_UTF8String(Bytes) -> getoctets_as_bin(Bytes2,Len). - % X.691:17 -encode_null(_) -> []. % encodes to nothing - -decode_null(Bytes) -> - {'NULL',Bytes}. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% encode_object_identifier(Val) -> CompleteList %% encode_object_identifier({Name,Val}) -> CompleteList diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index fd5ea15323..38ec72c473 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -631,7 +631,7 @@ parse(Config) -> [asn1_test_lib:compile(M, Config, [abs]) || M <- test_modules()]. per(Config) -> - test(Config, fun per/3, [per]). + test(Config, fun per/3, [per,uper]). per(Config, Rule, Opts) -> [module_test(M, Config, Rule, Opts) || M <- per_modules()]. diff --git a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 index d287840f30..7cb47e9792 100644 --- a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 @@ -55,6 +55,19 @@ BS1024 ::= BIT STRING (SIZE (1024)) OsExpCon ::= [60] EXPLICIT OCTET STRING OsExpPri ::= [PRIVATE 61] EXPLICIT OCTET STRING OsExpApp ::= [APPLICATION 62] EXPLICIT OCTET STRING + OsFrag ::= OCTET STRING (SIZE (0..100000)) + FixedOs65536 ::= OCTET STRING (SIZE (65536)) + FixedOs65537 ::= OCTET STRING (SIZE (65537)) + + OsAlignment ::= SEQUENCE { + b1 BOOLEAN, + s1 Os, + b2 BOOLEAN, + s2 OsFrag, + b3 BOOLEAN, + s3 FixedOs65536, + i INTEGER (0..63) + } Ns ::= NumericString NsCon ::= [70] NumericString diff --git a/lib/asn1/test/asn1_app_test.erl b/lib/asn1/test/asn1_app_test.erl index 2c31c3259d..9dbe1b50e0 100644 --- a/lib/asn1/test/asn1_app_test.erl +++ b/lib/asn1/test/asn1_app_test.erl @@ -138,7 +138,8 @@ check_asn1ct_modules(Extra) -> asn1ct_name,asn1ct_constructed_per,asn1ct_constructed_ber, asn1ct_gen_ber,asn1ct_constructed_ber_bin_v2, asn1ct_gen_ber_bin_v2,asn1ct_value, - asn1ct_tok,asn1ct_parser2,asn1ct_table], + asn1ct_tok,asn1ct_parser2,asn1ct_table, + asn1ct_imm], case Extra -- ASN1CTMods of [] -> ok; diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index b1c5172b95..9a640a2cb1 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -338,69 +338,24 @@ octet_string(Rules) -> ok end, + roundtrip('Os', [47,23,99,255,1]), + roundtrip('OsCon', [47,23,99,255,1]), + roundtrip('OsPri', [47,23,99,255,1]), + roundtrip('OsApp', [47,23,99,255,1]), - - ?line {ok,Bytes4} = - asn1_wrapper:encode('PrimStrings','Os',[47,23,99,255,1]), - ?line {ok,[47,23,99,255,1]} = asn1_wrapper:decode('PrimStrings','Os',lists:flatten(Bytes4)), - - ?line {ok,Bytes5} = - asn1_wrapper:encode('PrimStrings','OsCon',[47,23,99,255,1]), - ?line {ok,[47,23,99,255,1]} = asn1_wrapper:decode('PrimStrings','OsCon',lists:flatten(Bytes5)), - - ?line {ok,Bytes6} = - asn1_wrapper:encode('PrimStrings','OsPri',[47,23,99,255,1]), - ?line {ok,[47,23,99,255,1]} = asn1_wrapper:decode('PrimStrings','OsPri',lists:flatten(Bytes6)), - - ?line {ok,Bytes7} = - asn1_wrapper:encode('PrimStrings','OsApp',[47,23,99,255,1]), - ?line {ok,[47,23,99,255,1]} = asn1_wrapper:decode('PrimStrings','OsApp',lists:flatten(Bytes7)), - - ?line {ok,Bytes8} = - asn1_wrapper:encode('PrimStrings','OsExpCon',[47,23,99,255,1]), - ?line {ok,[47,23,99,255,1]} = asn1_wrapper:decode('PrimStrings','OsExpCon',lists:flatten(Bytes8)), - - ?line {ok,Bytes9} = - asn1_wrapper:encode('PrimStrings','OsExpPri',[47,23,99,255,1]), - ?line {ok,[47,23,99,255,1]} = asn1_wrapper:decode('PrimStrings','OsExpPri',lists:flatten(Bytes9)), - - ?line {ok,Bytes10} = - asn1_wrapper:encode('PrimStrings','OsExpApp',[47,23,99,255,1]), - ?line {ok,[47,23,99,255,1]} = asn1_wrapper:decode('PrimStrings','OsExpApp',lists:flatten(Bytes10)), - - ?line {ok,Bytes11} = - asn1_wrapper:encode('PrimStrings','Os',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','Os',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = - asn1_wrapper:encode('PrimStrings','OsApp',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','OsApp',lists:flatten(Bytes12)), - - ?line {ok,Bytes13} = - asn1_wrapper:encode('PrimStrings','OsExpApp',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','OsExpApp',lists:flatten(Bytes13)), - - - - - + roundtrip('OsExpCon', [47,23,99,255,1]), + roundtrip('OsExpPri', [47,23,99,255,1]), + roundtrip('OsExpApp', [47,23,99,255,1]), + roundtrip('Os', []), + roundtrip('OsApp', []), + roundtrip('OsExpApp',[]), OsR = "12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890", - ?line {ok,Bytes21} = - asn1_wrapper:encode('PrimStrings','Os',OsR), - ?line {ok,Os1} = asn1_wrapper:decode('PrimStrings','Os',lists:flatten(Bytes21)), - ?line Os1 = OsR, - ?line {ok,Bytes22} = - asn1_wrapper:encode('PrimStrings','OsCon',OsR), - ?line {ok,Os2} = asn1_wrapper:decode('PrimStrings','OsCon',lists:flatten(Bytes22)), - ?line Os2 = OsR, - ?line {ok,Bytes23} = - asn1_wrapper:encode('PrimStrings','OsExpApp',OsR), - ?line {ok,Os3} = asn1_wrapper:decode('PrimStrings','OsExpApp',lists:flatten(Bytes23)), - ?line Os3 = OsR, - + roundtrip('Os', OsR), + roundtrip('OsCon', OsR), + roundtrip('OsExpApp', OsR), ?line case asn1_wrapper:erule(Rules) of @@ -416,21 +371,85 @@ octet_string(Rules) -> ok end, - + fragmented_octet_string(Rules), ok. +fragmented_octet_string(Erules) -> + K16 = 1 bsl 14, + K32 = K16 + K16, + K48 = K32 + K16, + K64 = K48 + K16, + Lens = [0,1,14,15,16,17,127,128, + K16-1,K16,K16+1,K16+(1 bsl 7)-1,K16+(1 bsl 7),K16+(1 bsl 7)+1, + K32-1,K32,K32+1,K32+(1 bsl 7)-1,K32+(1 bsl 7),K32+(1 bsl 7)+1, + K48-1,K48,K48+1,K48+(1 bsl 7)-1,K48+(1 bsl 7),K48+(1 bsl 7)+1, + 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], + Types = ['Os','OsFrag'], + [fragmented_octet_string(Erules, Types, L) || L <- Lens], + fragmented_octet_string(Erules, ['FixedOs65536'], 65536), + fragmented_octet_string(Erules, ['FixedOs65537'], 65537), + + %% Make sure that octet alignment works. + roundtrip('OsAlignment', + {'OsAlignment',false,make_value(70000),true,make_value(66666), + false,make_value(65536),42}), + roundtrip('OsAlignment', + {'OsAlignment',false,make_value(0),true,make_value(0), + false,make_value(65536),42}), + ok. + +fragmented_octet_string(Erules, Types, L) -> + Value = make_value(L), + [begin + Encoded = enc_frag(Erules, Type, Value), + {ok,Value} = 'PrimStrings':decode(Type, Encoded) + end || Type <- Types], + ok. +enc_frag(Erules, Type, Value) -> + {ok,Encoded} = 'PrimStrings':encode(Type, Value), + case Erules of + ber -> + Encoded; + _ -> + %% Validate encoding with our own encoder. + Encoded = enc_frag_1(<<>>, list_to_binary(Value)) + end. + +enc_frag_1(Res, Bin0) -> + K16 = 1 bsl 14, + Sz = byte_size(Bin0), + if + Sz >= K16 -> + F = min(Sz div K16, 4), + FragSize = F * K16, + <<Frag:FragSize/binary-unit:8,Bin/binary>> = Bin0, + enc_frag_1(<<Res/binary,3:2,F:6,Frag/binary>>, Bin); + Sz >= 128 -> + <<Res/binary,1:1,0:1,Sz:14,Bin0/binary>>; + true -> + <<Res/binary,0:1,Sz:7,Bin0/binary>> + end. + +make_value(L) -> + make_value(L, 0, []). + +make_value(0, _, Acc) -> + Acc; +make_value(N, Byte, Acc) when Byte =< 255 -> + make_value(N-1, Byte+7, [Byte|Acc]); +make_value(N, Byte, Acc) -> + make_value(N, Byte band 16#FF, Acc). - numeric_string(Rules) -> %%========================================================== %% Ns ::= NumericString %%========================================================== - ?line {ok,BytesNs2} = asn1_wrapper:encode('PrimStrings','Ns',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','Ns',lists:flatten(BytesNs2)), + roundtrip('Ns', []), ?line case asn1_wrapper:erule(Rules) of ber -> @@ -455,10 +474,7 @@ numeric_string(Rules) -> %% NsCon ::= [70] NumericString %%========================================================== - ?line {ok,BytesNs12} = asn1_wrapper:encode('PrimStrings','NsCon',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','NsCon',lists:flatten(BytesNs12)), - - + roundtrip('NsCon', []), ?line case asn1_wrapper:erule(Rules) of ber -> @@ -482,10 +498,7 @@ numeric_string(Rules) -> %% NsExpCon ::= [71] EXPLICIT NumericString %%========================================================== - ?line {ok,BytesNs22} = asn1_wrapper:encode('PrimStrings','NsExpCon',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','NsExpCon',lists:flatten(BytesNs22)), - - + roundtrip('NsExpCon', []), ?line case asn1_wrapper:erule(Rules) of ber -> @@ -507,9 +520,6 @@ numeric_string(Rules) -> ok. - - - other_strings(_Rules) -> @@ -517,49 +527,27 @@ other_strings(_Rules) -> %% Ps ::= PrintableString %%========================================================== - ?line {ok,BytesPs1} = asn1_wrapper:encode('PrimStrings','Ps',[47,23,99,75,47]), - ?line {ok,[47,23,99,75,47]} = - asn1_wrapper:decode('PrimStrings','Ps',lists:flatten(BytesPs1)), - - ?line {ok,BytesPs2} = asn1_wrapper:encode('PrimStrings','Ps',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','Ps',lists:flatten(BytesPs2)), - + roundtrip('Ps', [47,23,99,75,47]), + roundtrip('Ps', []), %%========================================================== %% Vis ::= VisibleString %%========================================================== - ?line {ok,BytesVis1} = asn1_wrapper:encode('PrimStrings','Vis',[47,23,99,75,47]), - ?line {ok,[47,23,99,75,47]} = - asn1_wrapper:decode('PrimStrings','Vis',lists:flatten(BytesVis1)), - - ?line {ok,BytesVis2} = asn1_wrapper:encode('PrimStrings','Vis',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','Vis',lists:flatten(BytesVis2)), - + roundtrip('Vis', [47,23,99,75,47]), + roundtrip('Vis', []), %%========================================================== %% IA5 ::= IA5String %%========================================================== - ?line {ok,BytesIA51} = asn1_wrapper:encode('PrimStrings','IA5',[47,23,99,75,47]), - ?line {ok,[47,23,99,75,47]} = - asn1_wrapper:decode('PrimStrings','IA5',lists:flatten(BytesIA51)), - - ?line {ok,BytesIA52} = asn1_wrapper:encode('PrimStrings','IA5',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','IA5',lists:flatten(BytesIA52)), + roundtrip('IA5', [47,23,99,75,47]), + roundtrip('IA5', []), - IA5_1 = "12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890", - - ?line {ok,BytesIA53} = asn1_wrapper:encode('PrimStrings','IA5',IA5_1), - ?line {ok,IA5_1r} = asn1_wrapper:decode('PrimStrings','IA5',lists:flatten(BytesIA53)), - ?line IA5_1 = IA5_1r, - - - - + roundtrip('IA5', IA5_1), ok. @@ -568,94 +556,60 @@ more_strings(_Rules) -> %% Ts ::= TeletexString %%========================================================== - ?line {ok,BytesTs1} = asn1_wrapper:encode('PrimStrings','Ts',[47,23,99,75,47]), - ?line {ok,[47,23,99,75,47]} = - asn1_wrapper:decode('PrimStrings','Ts',lists:flatten(BytesTs1)), - - ?line {ok,BytesTs2} = asn1_wrapper:encode('PrimStrings','Ts',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','Ts',lists:flatten(BytesTs2)), - + roundtrip('Ts', [47,23,99,75,47]), + roundtrip('Ts', []), %%========================================================== %% Vxs ::= VideotexString %%========================================================== - ?line {ok,BytesVxs1} = asn1_wrapper:encode('PrimStrings','Vxs',[47,23,99,75,47]), - ?line {ok,[47,23,99,75,47]} = - asn1_wrapper:decode('PrimStrings','Vxs',lists:flatten(BytesVxs1)), - - ?line {ok,BytesVxs2} = asn1_wrapper:encode('PrimStrings','Vxs',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','Vxs',lists:flatten(BytesVxs2)), - + roundtrip('Vxs', [47,23,99,75,47]), + roundtrip('Vxs', []), %%========================================================== %% Grs ::= GraphicString %%========================================================== - ?line {ok,BytesGrs1} = asn1_wrapper:encode('PrimStrings','Grs',[47,23,99,75,47]), - ?line {ok,[47,23,99,75,47]} = - asn1_wrapper:decode('PrimStrings','Grs',lists:flatten(BytesGrs1)), - - ?line {ok,BytesGrs2} = asn1_wrapper:encode('PrimStrings','Grs',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','Grs',lists:flatten(BytesGrs2)), + roundtrip('Grs',[47,23,99,75,47]), + roundtrip('Grs', []), %%========================================================== %% ODesc ::= ObjectDescriptor, test case for OTP-4161 %%========================================================== - ?line {ok,BytesODesc1} = asn1_wrapper:encode('PrimStrings','ODesc',[79,98,106,101,99,116,68,101,115,99,114,105,112,116,111,114]), - ?line {ok,[79,98,106,101,99,116,68,101,115,99,114,105,112,116,111,114]} = - asn1_wrapper:decode('PrimStrings','ODesc',lists:flatten(BytesODesc1)), - - ?line {ok,BytesODesc2} = asn1_wrapper:encode('PrimStrings','ODesc',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','ODesc',lists:flatten(BytesODesc2)), + roundtrip('ODesc', [79,98,106,101,99,116,68,101,115,99,114, + 105,112,116,111,114]), + roundtrip('ODesc', []), %%========================================================== %% Ges ::= GeneralString %%========================================================== - ?line {ok,BytesGes1} = asn1_wrapper:encode('PrimStrings','Ges',[47,23,99,75,47]), - ?line {ok,[47,23,99,75,47]} = - asn1_wrapper:decode('PrimStrings','Ges',lists:flatten(BytesGes1)), - - ?line {ok,BytesGes2} = asn1_wrapper:encode('PrimStrings','Ges',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','Ges',lists:flatten(BytesGes2)), - - ok. + roundtrip('Ges', [47,23,99,75,47]), + roundtrip('Ges', []), + ok. universal_string(Rules) -> - %%========================================================== %% Us ::= UniversalString %%========================================================== - ?line {ok,Bytes1} = - asn1_wrapper:encode('PrimStrings','Us',[{47,23,99,47},{0,0,55,66}]), - ?line {ok,[{47,23,99,47},{0,0,55,66}]} = - asn1_wrapper:decode('PrimStrings','Us',lists:flatten(Bytes1)), + roundtrip('Us', [{47,23,99,47},{0,0,55,66}]), ?line {ok,Bytes2} = asn1_wrapper:encode('PrimStrings','Us',[{47,23,99,255},{0,0,0,201}]), ?line {ok,[{47,23,99,255},201]} = asn1_wrapper:decode('PrimStrings','Us',lists:flatten(Bytes2)), - ?line {ok,Bytes3} = asn1_wrapper:encode('PrimStrings','Us',"Universal String"), - ?line {ok,"Universal String"} = - asn1_wrapper:decode('PrimStrings','Us',lists:flatten(Bytes3)), - - ?line {ok,Bytes4} = asn1_wrapper:encode('PrimStrings','Us',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','Us',lists:flatten(Bytes4)), - - ?line {ok,Bytes5} = asn1_wrapper:encode('PrimStrings','Us',[{47,23,99,47}]), - ?line {ok,[{47,23,99,47}]} = - asn1_wrapper:decode('PrimStrings','Us',lists:flatten(Bytes5)), - + roundtrip('Us', "Universal String"), + roundtrip('Us', []), + roundtrip('Us', [{47,23,99,47}]), ?line case asn1_wrapper:erule(Rules) of ber -> @@ -670,32 +624,22 @@ universal_string(Rules) -> Us1 = "12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890", - ?line {ok,Bytes15} = asn1_wrapper:encode('PrimStrings','IA5',Us1), - ?line {ok,Us1r} = asn1_wrapper:decode('PrimStrings','IA5',lists:flatten(Bytes15)), - ?line Us1 = Us1r, - + roundtrip('IA5', Us1), %%========================================================== %% UsCon ::= [70] UniversalString %%========================================================== - ?line {ok,Bytes11} = - asn1_wrapper:encode('PrimStrings','UsCon',[{47,23,99,255},{0,0,2,201}]), - ?line {ok,[{47,23,99,255},{0,0,2,201}]} = - asn1_wrapper:decode('PrimStrings','UsCon',lists:flatten(Bytes11)), + roundtrip('UsCon', [{47,23,99,255},{0,0,2,201}]), ?line {ok,Bytes12} = asn1_wrapper:encode('PrimStrings','UsCon',[{47,23,99,255},{0,0,0,201}]), ?line {ok,[{47,23,99,255},201]} = asn1_wrapper:decode('PrimStrings','UsCon',lists:flatten(Bytes12)), - ?line {ok,Bytes13} = asn1_wrapper:encode('PrimStrings','UsCon',"Universal String"), - ?line {ok,"Universal String"} = - asn1_wrapper:decode('PrimStrings','UsCon',lists:flatten(Bytes13)), - - ?line {ok,Bytes14} = asn1_wrapper:encode('PrimStrings','UsCon',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','UsCon',lists:flatten(Bytes14)), + roundtrip('UsCon', "Universal String"), + roundtrip('UsCon', []), ?line case asn1_wrapper:erule(Rules) of ber -> @@ -712,25 +656,15 @@ universal_string(Rules) -> %% UsExpCon ::= [71] EXPLICIT UniversalString %%========================================================== - ?line {ok,Bytes21} = - asn1_wrapper:encode('PrimStrings','UsExpCon',[{47,23,99,255},{0,0,2,201}]), - ?line {ok,[{47,23,99,255},{0,0,2,201}]} = - asn1_wrapper:decode('PrimStrings','UsExpCon',lists:flatten(Bytes21)), + roundtrip('UsExpCon', [{47,23,99,255},{0,0,2,201}]), ?line {ok,Bytes22} = asn1_wrapper:encode('PrimStrings','UsExpCon',[{47,23,99,255},{0,0,0,201}]), ?line {ok,[{47,23,99,255},201]} = asn1_wrapper:decode('PrimStrings','UsExpCon',lists:flatten(Bytes22)), - ?line {ok,Bytes23} = - asn1_wrapper:encode('PrimStrings','UsExpCon',"Universal String"), - ?line {ok,"Universal String"} = - asn1_wrapper:decode('PrimStrings','UsExpCon',lists:flatten(Bytes23)), - - ?line {ok,Bytes24} = - asn1_wrapper:encode('PrimStrings','UsExpCon',[]), - ?line {ok,[]} = - asn1_wrapper:decode('PrimStrings','UsExpCon',lists:flatten(Bytes24)), + roundtrip('UsExpCon', "Universal String"), + roundtrip('UsExpCon', []), ?line case asn1_wrapper:erule(Rules) of ber -> @@ -740,12 +674,8 @@ universal_string(Rules) -> asn1_wrapper:decode('PrimStrings','UsExpCon',lists:flatten([16#BF,16#47,16,60,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0])); _ -> ok end, - - -ok. - - + ok. bmp_string(_Rules) -> @@ -754,29 +684,18 @@ bmp_string(_Rules) -> %% BMP ::= BMPString %%========================================================== - ?line {ok,Bytes1} = - asn1_wrapper:encode('PrimStrings','BMP',[{0,0,99,48},{0,0,2,201}]), - ?line {ok,[{0,0,99,48},{0,0,2,201}]} = - asn1_wrapper:decode('PrimStrings','BMP',lists:flatten(Bytes1)), + roundtrip('BMP', [{0,0,99,48},{0,0,2,201}]), ?line {ok,Bytes2} = asn1_wrapper:encode('PrimStrings','BMP',[{0,0,0,48},{0,0,2,201}]), ?line {ok,[48,{0,0,2,201}]} = asn1_wrapper:decode('PrimStrings','BMP',lists:flatten(Bytes2)), - - ?line {ok,Bytes3} = asn1_wrapper:encode('PrimStrings','BMP',"BMP String"), - ?line {ok,"BMP String"} = - asn1_wrapper:decode('PrimStrings','BMP',lists:flatten(Bytes3)), - - ?line {ok,Bytes4} = asn1_wrapper:encode('PrimStrings','BMP',[]), - ?line {ok,[]} = asn1_wrapper:decode('PrimStrings','BMP',lists:flatten(Bytes4)), + roundtrip('BMP', "BMP String"), + roundtrip('BMP', []), BMP1 = "12345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890", - ?line {ok,Bytes5} = asn1_wrapper:encode('PrimStrings','BMP',BMP1), - ?line {ok,BMP1r} = asn1_wrapper:decode('PrimStrings','BMP',lists:flatten(Bytes5)), - ?line BMP1 = BMP1r, - + roundtrip('BMP', BMP1), ok. @@ -790,35 +709,17 @@ times(_Rules) -> %% Gt ::= GeneralizedTime %%========================================================== - ?line {ok,Bytes1} = asn1_wrapper:encode('PrimStrings','Gt',"19970923110723.2"), - ?line {ok,"19970923110723.2"} = - asn1_wrapper:decode('PrimStrings','Gt',lists:flatten(Bytes1)), + roundtrip('Gt', "19970923110723.2"), + roundtrip('Gt', "19970923110723.2Z"), + roundtrip('Gt', "19970923110723.2-0500"), - ?line {ok,Bytes2} = asn1_wrapper:encode('PrimStrings','Gt',"19970923110723.2Z"), - ?line {ok,"19970923110723.2Z"} = - asn1_wrapper:decode('PrimStrings','Gt',lists:flatten(Bytes2)), - - ?line {ok,Bytes3} = asn1_wrapper:encode('PrimStrings','Gt',"19970923110723.2-0500"), - ?line {ok,"19970923110723.2-0500"} = - asn1_wrapper:decode('PrimStrings','Gt',lists:flatten(Bytes3)), - - - - - - %%========================================================== %% UTC ::= UTCTime %%========================================================== - ?line {ok,Bytes11} = asn1_wrapper:encode('PrimStrings','UTC',"9709211107Z"), - ?line {ok,"9709211107Z"} = - asn1_wrapper:decode('PrimStrings','UTC',lists:flatten(Bytes11)), - - ?line {ok,Bytes12} = asn1_wrapper:encode('PrimStrings','UTC',"9709211107-0500"), - ?line {ok,"9709211107-0500"} = - asn1_wrapper:decode('PrimStrings','UTC',lists:flatten(Bytes12)), + roundtrip('UTC', "9709211107Z"), + roundtrip('UTC', "9709211107-0500"), ok. @@ -917,3 +818,8 @@ wrapper_utf8_binary_to_list(L) when is_list(L) -> asn1rt:utf8_binary_to_list(list_to_binary(L)); wrapper_utf8_binary_to_list(B) -> asn1rt:utf8_binary_to_list(B). + +roundtrip(Type, Value) -> + {ok,Encoded} = 'PrimStrings':encode(Type, Value), + {ok,Value} = 'PrimStrings':decode(Type, Encoded), + ok. diff --git a/lib/common_test/doc/src/ct_hooks_chapter.xml b/lib/common_test/doc/src/ct_hooks_chapter.xml index 86237f5fc1..27d56fd47d 100644 --- a/lib/common_test/doc/src/ct_hooks_chapter.xml +++ b/lib/common_test/doc/src/ct_hooks_chapter.xml @@ -457,12 +457,26 @@ terminate(State) -> <row> <cell>cth_surefire</cell> <cell>no</cell> - <cell>Captures all test results and outputs them as surefire XML into - a file. The file which is created is by default called junit_report.xml. - The name can be by setting the path option for this hook. e.g. + <cell><p>Captures all test results and outputs them as surefire + XML into a file. The file which is created is by default + called junit_report.xml. The file name can be changed by + setting the <c>path</c> option for this hook, e.g.</p> + <code>-ct_hooks cth_surefire [{path,"/tmp/report.xml"}]</code> - Surefire XML can forinstance be used by Jenkins to display test - results.</cell> + + <p>If the <c>url_base</c> option is set, an additional + attribute named <c>url</c> will be added to each + <c>testsuite</c> and <c>testcase</c> XML element. The value will + be a constructed from the <c>url_base</c> and a relative path + to the test suite or test case log respectively, e.g.</p> + + <code>-ct_hooks cth_surefire [{url_base,"http://myserver.com/"}]</code> + <p>will give a url attribute value similar to</p> + + <code>"http://myserver.com/[email protected]_11.19.39/x86_64-unknown-linux-gnu.my_test.logs/run.2012-12-12_11.19.39/suite.log.html"</code> + + <p>Surefire XML can for instance be used by Jenkins to display test + results.</p></cell> </row> </table> diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index 7e33b71de1..8c3b13951d 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -32,6 +32,56 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.6.3.1</title> + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + The following corrections/changes are done in the + cth_surefire hook:</p> + <p> + <list> <item> Earlier there would always be a + 'properties' element under the 'testsuites' element. This + would exist even if there were no 'property' element + inside it. This has been changed so if there are no + 'property' elements to display, then there will not be a + 'properties' element either. </item> <item> The XML file + will now (unless other is specified) be stored in the top + log directory. Earlier, the default directory would be + the current working directory for the erlang node, which + would mostly, but not always, be the top log directory. + </item> <item> The 'hostname' attribute in the + 'testsuite' element would earlier never have the correct + value. This has been corrected. </item> <item> The + 'errors' attribute in the 'testsuite' element would + earlier display the number of failed testcases. This has + been changed and will now always have the value 0, while + the 'failures' attribute will show the number of failed + testcases. </item> <item> A new attribute 'skipped' is + added to the 'testsuite' element. This will display the + number of skipped testcases. These would earlier be + included in the number of failed test cases. </item> + <item> The total number of tests displayed by the 'tests' + attribute in the 'testsuite' element would earlier + include init/end_per_suite and init/end_per_group. This + is no longer the case. The 'tests' attribute will now + only count "real" test cases. </item> <item> Earlier, + auto skipped test cases would have no value in the 'log' + attribute. This is now corrected. </item> <item> A new + attributes 'log' is added to the 'testsuite' element. + </item> <item> A new option named 'url_base' is added for + this hook. If this option is used, a new attribute named + 'url' will be added to the 'testcase' and 'testsuite' + elements. </item> </list></p> + <p> + Own Id: OTP-10589</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.6.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index 294b82bff6..11c8235040 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -307,7 +307,7 @@ -type option() :: {ssh,host()} | {port,inet:port_number()} | {user,string()} | {password,string()} | {user_dir,string()} | {timeout,timeout()}. --type host() :: inet:host_name() | inet:ip_address(). +-type host() :: inet:hostname() | inet:ip_address(). -type notification() :: {notification, xml_attributes(), notification_content()}. -type notification_content() :: [event_time()|simple_xml()]. diff --git a/lib/common_test/src/cth_conn_log.erl b/lib/common_test/src/cth_conn_log.erl index 3af89db3a5..255f3ec78a 100644 --- a/lib/common_test/src/cth_conn_log.erl +++ b/lib/common_test/src/cth_conn_log.erl @@ -58,7 +58,7 @@ -spec init(Id, HookOpts) -> Result when Id :: term(), - HookOpts :: ct:hook_options(), + HookOpts :: ct_netconfc:hook_options(), Result :: {ok,[{ct_netconfc:conn_mod(), {ct_netconfc:log_type(),[ct_netconfc:key_or_name()]}}]}. init(_Id, HookOpts) -> diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index 76b0f0b5ea..e6eaad8d48 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -1,3 +1,22 @@ +%%-------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%%-------------------------------------------------------------------- + %%% @doc Common Test Framework functions handling test specifications. %%% %%% <p>This module creates a junit report of the test run if plugged in @@ -27,18 +46,28 @@ -export([terminate/1]). -record(state, { filepath, axis, properties, package, hostname, - curr_suite, curr_suite_ts, curr_group = [], curr_tc, - curr_log_dir, timer, tc_log, + curr_suite, curr_suite_ts, curr_group = [], + curr_log_dir, timer, tc_log, url_base, test_cases = [], test_suites = [] }). --record(testcase, { log, group, classname, name, time, failure, timestamp }). --record(testsuite, { errors, failures, hostname, name, tests, +-record(testcase, { log, url, group, classname, name, time, result, timestamp }). +-record(testsuite, { errors, failures, skipped, hostname, name, tests, time, timestamp, id, package, - properties, testcases }). + properties, testcases, log, url }). + +-define(default_report,"junit_report.xml"). +-define(suite_log,"suite.log.html"). + +%% Number of dirs from log root to testcase log file. +%% ct_run.<node>.<timestamp>/<test_name>/run.<timestamp>/<tc_log>.html +-define(log_depth,3). id(Opts) -> - filename:absname(proplists:get_value(path, Opts, "junit_report.xml")). + case proplists:get_value(path, Opts) of + undefined -> ?default_report; + Path -> filename:absname(Path) + end. init(Path, Opts) -> {ok, Host} = inet:gethostname(), @@ -47,10 +76,24 @@ init(Path, Opts) -> package = proplists:get_value(package,Opts), axis = proplists:get_value(axis,Opts,[]), properties = proplists:get_value(properties,Opts,[]), + url_base = proplists:get_value(url_base,Opts), timer = now() }. pre_init_per_suite(Suite,Config,#state{ test_cases = [] } = State) -> - {Config, init_tc(State#state{ curr_suite = Suite, curr_suite_ts = now() }, + TcLog = proplists:get_value(tc_logfile,Config), + CurrLogDir = filename:dirname(TcLog), + Path = + case State#state.filepath of + ?default_report -> + RootDir = get_test_root(TcLog), + filename:join(RootDir,?default_report); + P -> + P + end, + {Config, init_tc(State#state{ filepath = Path, + curr_suite = Suite, + curr_suite_ts = now(), + curr_log_dir = CurrLogDir}, Config) }; pre_init_per_suite(Suite,Config,State) -> %% Have to close the previous suite @@ -59,7 +102,8 @@ pre_init_per_suite(Suite,Config,State) -> post_init_per_suite(_Suite,Config, Result, State) -> {Result, end_tc(init_per_suite,Config,Result,State)}. -pre_end_per_suite(_Suite,Config,State) -> {Config, init_tc(State, Config)}. +pre_end_per_suite(_Suite,Config,State) -> + {Config, init_tc(State, Config)}. post_end_per_suite(_Suite,Config,Result,State) -> {Result, end_tc(end_per_suite,Config,Result,State)}. @@ -71,13 +115,15 @@ pre_init_per_group(Group,Config,State) -> post_init_per_group(_Group,Config,Result,State) -> {Result, end_tc(init_per_group,Config,Result,State)}. -pre_end_per_group(_Group,Config,State) -> {Config, init_tc(State, Config)}. +pre_end_per_group(_Group,Config,State) -> + {Config, init_tc(State, Config)}. post_end_per_group(_Group,Config,Result,State) -> NewState = end_tc(end_per_group, Config, Result, State), {Result, NewState#state{ curr_group = tl(NewState#state.curr_group)}}. -pre_init_per_testcase(_TC,Config,State) -> {Config, init_tc(State, Config)}. +pre_init_per_testcase(_TC,Config,State) -> + {Config, init_tc(State, Config)}. post_end_per_testcase(TC,Config,Result,State) -> {Result, end_tc(TC,Config, Result,State)}. @@ -88,11 +134,19 @@ on_tc_fail(_TC, Res, State) -> TCs = State#state.test_cases, TC = hd(TCs), NewTC = TC#testcase{ - failure = + result = {fail,lists:flatten(io_lib:format("~p",[Res]))} }, State#state{ test_cases = [NewTC | tl(TCs)]}. -on_tc_skip(Tc,{Type,_Reason} = Res, State) when Type == tc_auto_skip -> +on_tc_skip(Tc,{Type,_Reason} = Res, State0) when Type == tc_auto_skip -> + TcStr = atom_to_list(Tc), + State = + case State0#state.test_cases of + [#testcase{name=TcStr}|TCs] -> + State0#state{test_cases=TCs}; + _ -> + State0 + end, do_tc_skip(Res, end_tc(Tc,[],Res,init_tc(State,[]))); on_tc_skip(_Tc, _Res, State = #state{test_cases = []}) -> State; @@ -103,7 +157,7 @@ do_tc_skip(Res, State) -> TCs = State#state.test_cases, TC = hd(TCs), NewTC = TC#testcase{ - failure = + result = {skipped,lists:flatten(io_lib:format("~p",[Res]))} }, State#state{ test_cases = [NewTC | tl(TCs)]}. @@ -117,33 +171,52 @@ end_tc(Func, Config, Res, State) when is_atom(Func) -> end_tc(atom_to_list(Func), Config, Res, State); end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite, curr_group = Groups, - timer = TS, tc_log = Log } ) -> + curr_log_dir = CurrLogDir, + timer = TS, + tc_log = Log0, + url_base = UrlBase } ) -> + Log = + case Log0 of + "" -> + LowerSuiteName = string:to_lower(atom_to_list(Suite)), + filename:join(CurrLogDir,LowerSuiteName++"."++Name++".html"); + _ -> + Log0 + end, + Url = make_url(UrlBase,Log), ClassName = atom_to_list(Suite), PGroup = string:join([ atom_to_list(Group)|| Group <- lists:reverse(Groups)],"."), TimeTakes = io_lib:format("~f",[timer:now_diff(now(),TS) / 1000000]), State#state{ test_cases = [#testcase{ log = Log, + url = Url, timestamp = now_to_string(TS), classname = ClassName, group = PGroup, name = Name, time = TimeTakes, - failure = passed }| State#state.test_cases]}. + result = passed }| + State#state.test_cases], + tc_log = ""}. % so old tc_log is not set if next is on_tc_skip close_suite(#state{ test_cases = [] } = State) -> State; -close_suite(#state{ test_cases = TCs } = State) -> - Total = length(TCs), - Succ = length(lists:filter(fun(#testcase{ failure = F }) -> - F == passed - end,TCs)), - Fail = Total - Succ, +close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) -> + {Total,Fail,Skip} = count_tcs(TCs,0,0,0), TimeTaken = timer:now_diff(now(),State#state.curr_suite_ts) / 1000000, + SuiteLog = filename:join(State#state.curr_log_dir,?suite_log), + SuiteUrl = make_url(UrlBase,SuiteLog), Suite = #testsuite{ name = atom_to_list(State#state.curr_suite), package = State#state.package, + hostname = State#state.hostname, time = io_lib:format("~f",[TimeTaken]), timestamp = now_to_string(State#state.curr_suite_ts), - errors = Fail, tests = Total, - testcases = lists:reverse(TCs) }, + errors = 0, + failures = Fail, + skipped = Skip, + tests = Total, + testcases = lists:reverse(TCs), + log = SuiteLog, + url = SuiteUrl}, State#state{ test_cases = [], test_suites = [Suite | State#state.test_suites]}. @@ -159,14 +232,15 @@ terminate(State) -> -to_xml(#testcase{ group = Group, classname = CL, log = L, name = N, time = T, timestamp = TS, failure = F}) -> +to_xml(#testcase{ group = Group, classname = CL, log = L, url = U, name = N, time = T, timestamp = TS, result = R}) -> ["<testcase ", - [["group=\"",Group,"\""]||Group /= ""]," " + [["group=\"",Group,"\" "]||Group /= ""], "name=\"",N,"\" " "time=\"",T,"\" " - "timestamp=\"",TS,"\" " + "timestamp=\"",TS,"\" ", + [["url=\"",U,"\" "]||U /= undefined], "log=\"",L,"\">", - case F of + case R of passed -> []; {skipped,Reason} -> @@ -176,22 +250,29 @@ to_xml(#testcase{ group = Group, classname = CL, log = L, name = N, time = T, ti ["<failure message=\"Test ",N," in ",CL," failed!\" type=\"crash\">", sanitize(Reason),"</failure>"] end,"</testcase>"]; -to_xml(#testsuite{ package = P, hostname = H, errors = E, time = Time, - timestamp = TS, tests = T, name = N, testcases = Cases }) -> +to_xml(#testsuite{ package = P, hostname = H, errors = E, failures = F, + skipped = S, time = Time, timestamp = TS, tests = T, name = N, + testcases = Cases, log = Log, url = Url }) -> ["<testsuite ", [["package=\"",P,"\" "]||P /= undefined], - [["hostname=\"",P,"\" "]||H /= undefined], - [["name=\"",N,"\" "]||N /= undefined], - [["time=\"",Time,"\" "]||Time /= undefined], - [["timestamp=\"",TS,"\" "]||TS /= undefined], + "hostname=\"",H,"\" " + "name=\"",N,"\" " + "time=\"",Time,"\" " + "timestamp=\"",TS,"\" " "errors=\"",integer_to_list(E),"\" " - "tests=\"",integer_to_list(T),"\">", + "failures=\"",integer_to_list(F),"\" " + "skipped=\"",integer_to_list(S),"\" " + "tests=\"",integer_to_list(T),"\" ", + [["url=\"",Url,"\" "]||Url /= undefined], + "log=\"",Log,"\">", [to_xml(Case) || Case <- Cases], "</testsuite>"]; to_xml(#state{ test_suites = TestSuites, axis = Axis, properties = Props }) -> ["<testsuites>",properties_to_xml(Axis,Props), [to_xml(TestSuite) || TestSuite <- TestSuites],"</testsuites>"]. +properties_to_xml([],[]) -> + []; properties_to_xml(Axis,Props) -> ["<properties>", [["<property name=\"",Name,"\" axis=\"yes\" value=\"",Value,"\" />"] || {Name,Value} <- Axis], @@ -217,3 +298,37 @@ sanitize([]) -> now_to_string(Now) -> {{YY,MM,DD},{HH,Mi,SS}} = calendar:now_to_local_time(Now), io_lib:format("~p-~2..0B-~2..0BT~2..0B:~2..0B:~2..0B",[YY,MM,DD,HH,Mi,SS]). + +make_url(undefined,_) -> + undefined; +make_url(_,[]) -> + undefined; +make_url(UrlBase0,Log) -> + UrlBase = string:strip(UrlBase0,right,$/), + RelativeLog = get_relative_log_url(Log), + string:join([UrlBase,RelativeLog],"/"). + +get_test_root(Log) -> + LogParts = filename:split(Log), + filename:join(lists:sublist(LogParts,1,length(LogParts)-?log_depth)). + +get_relative_log_url(Log) -> + LogParts = filename:split(Log), + Start = length(LogParts)-?log_depth, + Length = ?log_depth+1, + string:join(lists:sublist(LogParts,Start,Length),"/"). + +count_tcs([#testcase{name=ConfCase}|TCs],Ok,F,S) + when ConfCase=="init_per_suite"; + ConfCase=="end_per_suite"; + ConfCase=="init_per_group"; + ConfCase=="end_per_group" -> + count_tcs(TCs,Ok,F,S); +count_tcs([#testcase{result=passed}|TCs],Ok,F,S) -> + count_tcs(TCs,Ok+1,F,S); +count_tcs([#testcase{result={fail,_}}|TCs],Ok,F,S) -> + count_tcs(TCs,Ok,F+1,S); +count_tcs([#testcase{result={skipped,_}}|TCs],Ok,F,S) -> + count_tcs(TCs,Ok,F,S+1); +count_tcs([],Ok,F,S) -> + {Ok+F+S,F,S}. diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index df816f9a61..d469d03e04 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -56,7 +56,8 @@ MODULES= \ ct_snmp_SUITE \ ct_group_leader_SUITE \ ct_cover_SUITE \ - ct_groups_search_SUITE + ct_groups_search_SUITE \ + ct_surefire_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/common_test/test/ct_surefire_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE.erl new file mode 100644 index 0000000000..69e98cef48 --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE.erl @@ -0,0 +1,351 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File: ct_surefire_SUITE +%%% +%%% Description: +%%% Test cth_surefire hook +%%% +%%%------------------------------------------------------------------- +-module(ct_surefire_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +-include_lib("xmerl/include/xmerl.hrl"). + +-define(eh, ct_test_support_eh). + +-define(url_base,"http://my.host.com/"). + +%%-------------------------------------------------------------------- +%% TEST SERVER CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% Description: Since Common Test starts another Test Server +%% instance, the tests need to be performed on a separate node (or +%% there will be clashes with logging processes etc). +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + Config1 = ct_test_support:init_per_suite(Config), + Config1. + +end_per_suite(Config) -> + ct_test_support:end_per_suite(Config). + +init_per_testcase(TestCase, Config) -> + ct_test_support:init_per_testcase(TestCase, Config). + +end_per_testcase(TestCase, Config) -> + ct_test_support:end_per_testcase(TestCase, Config). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + default, + absolute_path, + relative_path, + url, + logdir + ]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +%%%----------------------------------------------------------------- +%%% +default(Config) when is_list(Config) -> + run(default,[cth_surefire],Config), + PrivDir = ?config(priv_dir,Config), + XmlRe = filename:join([PrivDir,"*","junit_report.xml"]), + check_xml(default,XmlRe). + +absolute_path(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir,Config), + Path = filename:join(PrivDir,"abspath.xml"), + run(absolute_path,[{cth_surefire,[{path,Path}]}],Config), + check_xml(absolute_path,Path). + +relative_path(Config) when is_list(Config) -> + Path = "relpath.xml", + run(relative_path,[{cth_surefire,[{path,Path}]}],Config), + PrivDir = ?config(priv_dir,Config), + XmlRe = filename:join([PrivDir,"*",Path]), + check_xml(relative_path,XmlRe). + +url(Config) when is_list(Config) -> + Path = "url.xml", + run(url,[{cth_surefire,[{url_base,?url_base}, + {path,Path}]}],Config), + PrivDir = ?config(priv_dir,Config), + XmlRe = filename:join([PrivDir,"*",Path]), + check_xml(url,XmlRe). + +logdir(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir,Config), + LogDir = filename:join(PrivDir,"specific_logdir"), + file:make_dir(LogDir), + Path = "logdir.xml", + run(logdir,[{cth_surefire,[{path,Path}]}],Config,[{logdir,LogDir}]), + PrivDir = ?config(priv_dir,Config), + XmlRe = filename:join([LogDir,"*",Path]), + check_xml(logdir,XmlRe). + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- +run(Case,CTHs,Config) -> + run(Case,CTHs,Config,[]). +run(Case,CTHs,Config,ExtraOpts) -> + DataDir = ?config(data_dir, Config), + Suite = filename:join(DataDir, "surefire_SUITE"), + {Opts,ERPid} = setup([{suite,Suite},{ct_hooks,CTHs},{label,Case}|ExtraOpts], + Config), + ok = execute(Case, Opts, ERPid, Config). + +setup(Test, Config) -> + Opts0 = ct_test_support:get_opts(Config), + Opts1 = + case lists:keymember(logdir,1,Test) of + true -> lists:keydelete(logdir,1,Opts0); + false -> Opts0 + end, + Level = ?config(trace_level, Config), + EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], + Opts = Opts1 ++ [{event_handler,{?eh,EvHArgs}}|Test], + ERPid = ct_test_support:start_event_receiver(Config), + {Opts,ERPid}. + +execute(Name, Opts, ERPid, Config) -> + ok = ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + + ct_test_support:log_events(Name, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + + TestEvents = events_to_check(Name), + ct_test_support:verify_events(TestEvents, Events, Config). + +reformat(Events, EH) -> + ct_test_support:reformat(Events, EH). + +%%%----------------------------------------------------------------- +%%% TEST EVENTS +%%%----------------------------------------------------------------- +events_to_check(Test) -> + %% 2 tests (ct:run_test + script_start) is default + events_to_check(Test, 2). + +events_to_check(_, 0) -> + []; +events_to_check(Test, N) -> + test_events(Test) ++ events_to_check(Test, N-1). + +test_events(_) -> + [{?eh,start_logging,'_'}, + {?eh,start_info,{1,1,9}}, + {?eh,tc_start,{surefire_SUITE,init_per_suite}}, + {?eh,tc_done,{surefire_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{surefire_SUITE,tc_ok}}, + {?eh,tc_done,{surefire_SUITE,tc_ok,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{surefire_SUITE,tc_fail}}, + {?eh,tc_done,{surefire_SUITE,tc_fail, + {failed,{error,{test_case_failed,"this test should fail"}}}}}, + {?eh,test_stats,{1,1,{0,0}}}, + {?eh,tc_start,{surefire_SUITE,tc_skip}}, + {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}}, + {?eh,test_stats,{1,1,{1,0}}}, + {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}}, + {?eh,tc_done,{surefire_SUITE,tc_autoskip_require, + {skipped,{require_failed,'_'}}}}, + {?eh,test_stats,{1,1,{1,1}}}, + [{?eh,tc_start,{surefire_SUITE,{init_per_group,g,[]}}}, + {?eh,tc_done,{surefire_SUITE,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{surefire_SUITE,tc_ok}}, + {?eh,tc_done,{surefire_SUITE,tc_ok,ok}}, + {?eh,test_stats,{2,1,{1,1}}}, + {?eh,tc_start,{surefire_SUITE,tc_fail}}, + {?eh,tc_done,{surefire_SUITE,tc_fail, + {failed,{error,{test_case_failed,"this test should fail"}}}}}, + {?eh,test_stats,{2,2,{1,1}}}, + {?eh,tc_start,{surefire_SUITE,tc_skip}}, + {?eh,tc_done,{surefire_SUITE,tc_skip,{skipped,"this test is skipped"}}}, + {?eh,test_stats,{2,2,{2,1}}}, + {?eh,tc_start,{surefire_SUITE,tc_autoskip_require}}, + {?eh,tc_done,{surefire_SUITE,tc_autoskip_require, + {skipped,{require_failed,'_'}}}}, + {?eh,test_stats,{2,2,{2,2}}}, + {?eh,tc_start,{surefire_SUITE,{end_per_group,g,[]}}}, + {?eh,tc_done,{surefire_SUITE,{end_per_group,g,[]},ok}}], + [{?eh,tc_start,{surefire_SUITE,{init_per_group,g_fail,[]}}}, + {?eh,tc_done,{surefire_SUITE,{init_per_group,g_fail,[]}, + {failed,{error,all_cases_should_be_skipped}}}}, + {?eh,tc_auto_skip,{surefire_SUITE,tc_ok, + {failed, + {surefire_SUITE,init_per_group, + {'EXIT',all_cases_should_be_skipped}}}}}, + {?eh,test_stats,{2,2,{2,3}}}, + {?eh,tc_auto_skip,{surefire_SUITE,end_per_group, + {failed, + {surefire_SUITE,init_per_group, + {'EXIT',all_cases_should_be_skipped}}}}}], + {?eh,tc_start,{surefire_SUITE,end_per_suite}}, + {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}, + {?eh,stop_logging,[]}]. + + +%%%----------------------------------------------------------------- +%%% Check generated xml log files +check_xml(Case,XmlRe) -> + case filelib:wildcard(XmlRe) of + [] -> + ct:fail("No xml files found with regexp ~p~n", [XmlRe]); + [_] = Xmls when Case==absolute_path -> + do_check_xml(Case,Xmls); + [_,_] = Xmls -> + do_check_xml(Case,Xmls) + end. + +%% Allowed structure: +%% <testsuites> +%% <testsuite> +%% <properties> +%% <property/> +%% ... +%% </properties> +%% <testcase> +%% [<failure/> | <error/> | <skipped/> ] +%% </testcase> +%% ... +%% </testsuite> +%% ... +%% </testsuites> +do_check_xml(Case,[Xml|Xmls]) -> + ct:log("Checking <a href=~p>~s</a>~n",[Xml,Xml]), + {E,_} = xmerl_scan:file(Xml), + Expected = events_to_result(lists:flatten(test_events(Case))), + ParseResult = testsuites(Case,E), + ct:log("Expecting: ~p~n",[[Expected]]), + ct:log("Actual : ~p~n",[ParseResult]), + [Expected] = ParseResult, + do_check_xml(Case,Xmls); +do_check_xml(_,[]) -> + ok. + +%% Scanning the XML to get the same type of result as events_to_result/1 +testsuites(Case,#xmlElement{name=testsuites,content=TS}) -> + %% OTP-10589 - move properties element to <testsuite> + false = lists:keytake(properties,#xmlElement.name,TS), + testsuite(Case,TS). + +testsuite(Case,[#xmlElement{name=testsuite,content=TC,attributes=A}|TS]) -> + {ET,EF,ES} = events_to_numbers(lists:flatten(test_events(Case))), + {T,E,F,S} = get_numbers_from_attrs(A,false,false,false,false), + ct:log("Expecting total:~p, error:~p, failure:~p, skipped:~p~n",[ET,0,EF,ES]), + ct:log("Actual total:~p, error:~p, failure:~p, skipped:~p~n",[T,E,F,S]), + {ET,0,EF,ES} = {T,E,F,S}, + + %% properties should only be there if given a options to hook + false = lists:keytake(properties,#xmlElement.name,TC), + %% system-out and system-err is not used by common_test + false = lists:keytake('system-out',#xmlElement.name,TC), + false = lists:keytake('system-err',#xmlElement.name,TC), + R=testcase(Case,TC), + [R|testsuite(Case,TS)]; +testsuite(_Case,[]) -> + []. + +testcase(url=Case,[#xmlElement{name=testcase,attributes=A,content=C}|TC]) -> + R = failed_or_skipped(C), + case R of + [s] -> + case lists:keyfind(url,#xmlAttribute.name,A) of + false -> ok; + #xmlAttribute{value=UrlAttr} -> + lists:keyfind(url,#xmlAttribute.name,A), + true = lists:prefix(?url_base,UrlAttr) + end; + _ -> + #xmlAttribute{value=UrlAttr} = + lists:keyfind(url,#xmlAttribute.name,A), + true = lists:prefix(?url_base,UrlAttr) + end, + [R|testcase(Case,TC)]; +testcase(Case,[#xmlElement{name=testcase,attributes=A,content=C}|TC]) -> + false = lists:keyfind(url,#xmlAttribute.name,A), + R = failed_or_skipped(C), + [R|testcase(Case,TC)]; +testcase(_Case,[]) -> + []. + +failed_or_skipped([#xmlElement{name=failure}|E]) -> + [f|failed_or_skipped(E)]; +failed_or_skipped([#xmlElement{name=error}|E]) -> + [e|failed_or_skipped(E)]; +failed_or_skipped([#xmlElement{name=skipped}|E]) -> + [s|failed_or_skipped(E)]; +failed_or_skipped([]) -> + []. + +%% Using the expected events to produce the expected result of the XML scanning. +%% The result is a list of test suites: +%% Testsuites = [Testsuite] +%% Testsuite = [Testcase] +%% Testcase = [] | [f] | [s], indicating ok, failed and skipped respectively +events_to_result([{?eh,tc_done,{_Suite,_Case,R}}|E]) -> + [result(R)|events_to_result(E)]; +events_to_result([{?eh,tc_auto_skip,_}|E]) -> + [[s]|events_to_result(E)]; +events_to_result([_|E]) -> + events_to_result(E); +events_to_result([]) -> + []. + +result(ok) ->[]; +result({skipped,_}) -> [s]; +result({failed,_}) -> [f]. + +%% Using the expected events' last test_stats element to produce the +%% expected number of totla, errors, failed and skipped testcases. +events_to_numbers(E) -> + RevE = lists:reverse(E), + {?eh,test_stats,{Ok,F,{US,AS}}} = lists:keyfind(test_stats,2,RevE), + {Ok+F+US+AS,F,US+AS}. + +get_numbers_from_attrs([#xmlAttribute{name=tests,value=X}|A],false,E,F,S) -> + get_numbers_from_attrs(A,list_to_integer(X),E,F,S); +get_numbers_from_attrs([#xmlAttribute{name=errors,value=X}|A],T,false,F,S) -> + get_numbers_from_attrs(A,T,list_to_integer(X),F,S); +get_numbers_from_attrs([#xmlAttribute{name=failures,value=X}|A],T,E,false,S) -> + get_numbers_from_attrs(A,T,E,list_to_integer(X),S); +get_numbers_from_attrs([#xmlAttribute{name=skipped,value=X}|A],T,E,F,false) -> + get_numbers_from_attrs(A,T,E,F,list_to_integer(X)); +get_numbers_from_attrs([_|A],T,E,F,S) -> + get_numbers_from_attrs(A,T,E,F,S); +get_numbers_from_attrs([],T,E,F,S) -> + {T,E,F,S}. diff --git a/lib/common_test/test/ct_surefire_SUITE_data/surefire_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE_data/surefire_SUITE.erl new file mode 100644 index 0000000000..677aee46c5 --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE_data/surefire_SUITE.erl @@ -0,0 +1,92 @@ +%%-------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%---------------------------------------------------------------------- +%% File: surefire_SUITE.erl +%% +%% Description: +%% This file contains the test cases for cth_surefire. +%% +%% @author Support +%% @doc Test of surefire support in common_test +%% @end +%%---------------------------------------------------------------------- +%%---------------------------------------------------------------------- +-module(surefire_SUITE). +-include_lib("common_test/include/ct.hrl"). + +-compile(export_all). + +%% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(1)). + +all() -> + testcases() ++ [{group,g},{group,g_fail}]. + +groups() -> + [{g,testcases()}, + {g_fail,[tc_ok]}]. + +testcases() -> + [tc_ok, + tc_fail, + tc_skip, + tc_autoskip_require]. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + Config. + +init_per_group(g_fail, _Config) -> + exit(all_cases_should_be_skipped); +init_per_group(_, Config) -> + Config. + +end_per_group(_Group, Config) -> + Config. + +init_per_testcase(_Case, Config) -> + Dog = test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. + +end_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +%%%----------------------------------------------------------------- +%%% Test cases +break(_Config) -> + test_server:break(""), + ok. + +tc_ok(_Config) -> + ok. + +tc_fail(_Config) -> + ct:fail("this test should fail"). + +tc_skip(_Config) -> + {skip,"this test is skipped"}. + +tc_autoskip_require() -> + [{require,whatever}]. +tc_autoskip_require(Config) -> + ct:fail("this test should never be executed - it should be autoskipped"). diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 37053e1cc4..02794a8e18 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -241,21 +241,45 @@ btb_reaches_match_2([{bif,_,{f,F},Ss,Dst}=I|Is], Regs0, D0) -> Regs = btb_kill([Dst], Regs0), D = btb_follow_branch(F, Regs, D0), btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{test,bs_start_match2,_,_,[Ctx,_],Ctx}|Is], Regs, D) -> - case btb_context_regs(Regs) of - [Ctx] -> - D; - CtxRegs -> - case member(Ctx, CtxRegs) of - false -> btb_reaches_match_2(Is, Regs, D); - true -> btb_error(unsuitable_bs_start_match) +btb_reaches_match_2([{test,bs_start_match2,{f,F},Live,[Ctx,_],Ctx}=I|Is], + Regs0, D0) -> + CtxRegs = btb_context_regs(Regs0), + case member(Ctx, CtxRegs) of + false -> + %% This bs_start_match2 instruction does not use "our" + %% match state. Therefore we can continue the search + %% for another bs_start_match2 instruction. + D = btb_follow_branch(F, Regs0, D0), + Regs = btb_kill_not_live(Live, Regs0), + btb_reaches_match_2(Is, Regs, D); + true -> + %% OK. This instruction will use "our" match state, + %% but we must make sure that all other copies of the + %% match state are killed in the code that follows + %% the instruction. (We know that the fail branch cannot + %% be taken in this case.) + OtherCtxRegs = CtxRegs -- [Ctx], + case btb_are_all_unused(OtherCtxRegs, Is, D0) of + false -> btb_error({OtherCtxRegs,not_all_unused_after,I}); + true -> D0 end end; -btb_reaches_match_2([{test,bs_start_match2,_,_,[Bin,_],Ctx}|Is], Regs, D) -> - CtxRegs = btb_context_regs(Regs), +btb_reaches_match_2([{test,bs_start_match2,{f,F},Live,[Bin,_],Ctx}|Is], + Regs0, D0) -> + CtxRegs = btb_context_regs(Regs0), case member(Bin, CtxRegs) orelse member(Ctx, CtxRegs) of - false -> btb_reaches_match_2(Is, Regs, D); - true -> btb_error(unsuitable_bs_start_match) + false -> + %% This bs_start_match2 does not reference any copy of the + %% match state. Therefore it can safely be passed on the + %% way to another (perhaps more suitable) bs_start_match2 + %% instruction. + D = btb_follow_branch(F, Regs0, D0), + Regs = btb_kill_not_live(Live, Regs0), + btb_reaches_match_2(Is, Regs, D); + true -> + %% This variant of the bs_start_match2 instruction does + %% not accept a match state as source. + btb_error(unsuitable_bs_start_match) end; btb_reaches_match_2([{test,_,{f,F},Ss}=I|Is], Regs, D0) -> btb_ensure_not_used(Ss, I, Regs), @@ -287,11 +311,11 @@ btb_reaches_match_2([{bs_restore2,Src,_}=I|Is], Regs0, D) -> btb_reaches_match_1(Is, Regs0, D); true -> %% Check that all other copies of the context registers - %% are killed by the following instructions. + %% are unused by the following instructions. Regs = btb_kill([Src], Regs0), CtxRegs = btb_context_regs(Regs), - case btb_are_all_killed(CtxRegs, Is, D) of - false -> btb_error({CtxRegs,not_all_killed_after,I}); + case btb_are_all_unused(CtxRegs, Is, D) of + false -> btb_error({CtxRegs,not_all_unused_after,I}); true -> D#btb{must_not_save=true} end end; @@ -301,11 +325,11 @@ btb_reaches_match_2([{bs_context_to_binary,Src}=I|Is], Regs0, D) -> btb_reaches_match_1(Is, Regs0, D); true -> %% Check that all other copies of the context registers - %% are killed by the following instructions. + %% are unused by the following instructions. Regs = btb_kill([Src], Regs0), CtxRegs = btb_context_regs(Regs), - case btb_are_all_killed(CtxRegs, Is, D) of - false -> btb_error({CtxRegs,not_all_killed_after,I}); + case btb_are_all_unused(CtxRegs, Is, D) of + false -> btb_error({CtxRegs,not_all_unused_after,I}); true -> D#btb{must_not_save=true} end end; @@ -343,7 +367,7 @@ btb_call(Arity, Lbl, Regs0, Is, D0) -> %% tucked away in a y register. RegList = btb_context_regs(Regs), YRegs = [R || {y,_}=R <- RegList], - case btb_are_all_killed(YRegs, Is, D) of + case btb_are_all_unused(YRegs, Is, D) of true -> D; false -> btb_error({multiple_uses,RegList}) end; @@ -426,11 +450,11 @@ btb_reaches_match_block([], Regs) -> Regs. %% btb_are_all_killed([Register], [Instruction], D) -> true|false -%% Test whether all of the register are killed in the instruction stream. +%% Test whether all of the register are unused in the instruction stream. -btb_are_all_killed(RegList, Is, #btb{index=Li}) -> +btb_are_all_unused(RegList, Is, #btb{index=Li}) -> all(fun(R) -> - beam_utils:is_killed(R, Is, Li) + beam_utils:is_not_used(R, Is, Li) end, RegList). %% btp_regs_from_list([Register]) -> RegisterSet. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index b05d01b2a1..636c299e47 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -220,6 +220,8 @@ extract_seq([{line,_}=Line|Is], Acc) -> extract_seq(Is, [Line|Acc]); extract_seq([{block,_}=Bl|Is], Acc) -> extract_seq_1(Is, [Bl|Acc]); +extract_seq([{bs_context_to_binary,_}=I|Is], Acc) -> + extract_seq_1(Is, [I|Acc]); extract_seq([{label,_}|_]=Is, Acc) -> extract_seq_1(Is, Acc); extract_seq(_, _) -> no. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 8b661e6901..8af0447f63 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -263,19 +263,11 @@ check_liveness(R, [{test,_,{f,Fail},As}|Is], St0) -> {_,_}=Other -> Other end end; -check_liveness(R, [{test,_,{f,Fail},Live,Ss,_}|Is], St0) -> - case R of - {x,X} -> - case X < Live orelse member(R, Ss) of - true -> {used,St0}; - false -> check_liveness_at(R, Fail, St0) - end; - {y,_} -> - case check_liveness_at(R, Fail, St0) of - {killed,St} -> check_liveness(R, Is, St); - {_,_}=Other -> Other - end - end; +check_liveness(R, [{test,Op,Fail,Live,Ss,Dst}|Is], St) -> + %% Check this instruction as a block to get a less conservative + %% result if the caller is is_not_used/3. + Block = [{set,[Dst],Ss,{alloc,Live,{bif,Op,Fail}}}], + check_liveness(R, [{block,Block}|Is], St); check_liveness(R, [{select,_,R,_,_}|_], St) -> {used,St}; check_liveness(R, [{select,_,_,Fail,Branches}|_], St) -> diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index e8f5c55c1a..d63d2235d7 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -33,7 +33,7 @@ matching_meets_construction/1,simon/1,matching_and_andalso/1, otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1, match_string/1,zero_width/1,bad_size/1,haystack/1, - cover_beam_bool/1,matched_out_size/1]). + cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -57,7 +57,7 @@ groups() -> matching_meets_construction,simon, matching_and_andalso,otp_7188,otp_7233,otp_7240, otp_7498,match_string,zero_width,bad_size,haystack, - cover_beam_bool,matched_out_size]}]. + cover_beam_bool,matched_out_size,follow_fail_branch]}]. init_per_suite(Config) -> @@ -1108,6 +1108,32 @@ mos_bin(<<L,Bin:L/binary,"abcdefghij">>) -> L = byte_size(Bin), Bin. +follow_fail_branch(_) -> + 42 = ffb_1(<<0,1>>, <<0>>), + 8 = ffb_1(<<0,1>>, [a]), + 42 = ffb_2(<<0,1>>, <<0>>, 17), + 8 = ffb_2(<<0,1>>, [a], 0), + ok. + +ffb_1(<<_,T/bitstring>>, List) -> + case List of + <<_>> -> + 42; + [_|_] -> + %% The fail branch of the bs_start_match2 instruction + %% pointing to here would be ignored, making the compiler + %% incorrectly assume that the delayed sub-binary + %% optimization was safe. + bit_size(T) + end. + +ffb_2(<<_,T/bitstring>>, List, A) -> + case List of + <<_>> when A =:= 17 -> 42; + [_|_] -> bit_size(T) + end. + + check(F, R) -> R = F(). diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 5dc088dcff..72c9e5b8e8 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -69,6 +69,9 @@ #if OPENSSL_VERSION_NUMBER >= 0x00908000L && !defined(OPENSSL_NO_SHA512) && defined(NID_sha512) # define HAVE_SHA512 #endif +#if OPENSSL_VERSION_NUMBER >= 0x0090705FL +# define HAVE_DES_ede3_cfb_encrypt +#endif #ifdef VALGRIND # include <valgrind/memcheck.h> @@ -173,7 +176,7 @@ static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -281,7 +284,7 @@ static ErlNifFunc nif_funcs[] = { {"des_cfb_crypt", 4, des_cfb_crypt}, {"des_ecb_crypt", 3, des_ecb_crypt}, {"des_ede3_cbc_crypt", 6, des_ede3_cbc_crypt}, - {"des_ede3_cfb_crypt", 6, des_ede3_cfb_crypt}, + {"des_ede3_cfb_crypt_nif", 6, des_ede3_cfb_crypt_nif}, {"aes_cfb_128_crypt", 4, aes_cfb_128_crypt}, {"aes_ctr_encrypt", 3, aes_ctr_encrypt}, {"aes_ctr_decrypt", 3, aes_ctr_encrypt}, @@ -533,12 +536,21 @@ static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] const char* ver = SSLeay_version(SSLEAY_VERSION); unsigned ver_sz = strlen(ver); ERL_NIF_TERM name_term, ver_term; + int ver_num = OPENSSL_VERSION_NUMBER; + /* R16: + * Ignore library version number from SSLeay() and instead show header + * version. Otherwise user might try to call a function that is implemented + * by a newer library but not supported by the headers used at compile time. + * Example: DES_ede3_cfb_encrypt in 0.9.7i but not in 0.9.7d. + * + * Version string is still from library though. + */ memcpy(enif_make_new_binary(env, name_sz, &name_term), libname, name_sz); memcpy(enif_make_new_binary(env, ver_sz, &ver_term), ver, ver_sz); return enif_make_list1(env, enif_make_tuple3(env, name_term, - enif_make_int(env, SSLeay()), + enif_make_int(env, ver_num), ver_term)); } @@ -1218,8 +1230,9 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T return ret; } -static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key1, Key2, Key3, IVec, Text/Cipher, IsEncrypt) */ +#ifdef HAVE_DES_ede3_cfb_encrypt ErlNifBinary key1, key2, key3, ivec, text; DES_key_schedule schedule1, schedule2, schedule3; DES_cblock ivec_clone; /* writable copy */ @@ -1241,6 +1254,9 @@ static ERL_NIF_TERM des_ede3_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T 8, text.size, &schedule1, &schedule2, &schedule3, &ivec_clone, (argv[5] == atom_true)); return ret; +#else + return atom_notsup; +#endif } static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 4dcd6fc4ea..3e533158c8 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -115,6 +115,12 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> > <input>info_lib().</input> [{<<"OpenSSL">>,9469983,<<"OpenSSL 0.9.8a 11 Oct 2005">>}] </pre> + <note><p> + From OTP R16 the <em>numeric version</em> represents the version of the OpenSSL + <em>header files</em> (<c>openssl/opensslv.h</c>) used when crypto was compiled. + The text variant represents the OpenSSL library used at runtime. + In earlier OTP versions both numeric and text was taken from the library. + </p></note> </desc> </func> <func> @@ -265,6 +271,8 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </type> <desc> <p>Computes a message digest of type <c>Type</c> from <c>Data</c>.</p> + <p>May throw exception <c>notsup</c> in case the chosen <c>Type</c> + is not supported by the underlying OpenSSL implementation.</p> </desc> </func> <func> @@ -277,6 +285,8 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> <p>Initializes the context for streaming hash operations. <c>Type</c> determines which digest to use. The returned context should be used as argument to <seealso marker="#hash_update/2">hash_update</seealso>.</p> + <p>May throw exception <c>notsup</c> in case the chosen <c>Type</c> + is not supported by the underlying OpenSSL implementation.</p> </desc> </func> <func> @@ -548,6 +558,8 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> keys, and <c>IVec</c> is an arbitrary initializing vector. The lengths of each of <c>Key1</c>, <c>Key2</c>, <c>Key3</c> and <c>IVec</c> must be 64 bits (8 bytes).</p> + <p>May throw exception <c>notsup</c> for old OpenSSL + versions (0.9.7) that does not support this encryption mode.</p> </desc> </func> <func> @@ -565,6 +577,8 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> and <c>IVec</c> must have the same values as those used when encrypting. The lengths of <c>Key1</c>, <c>Key2</c>, <c>Key3</c>, and <c>IVec</c> must be 64 bits (8 bytes).</p> + <p>May throw exception <c>notsup</c> for old OpenSSL + versions (0.9.7) that does not support this encryption mode.</p> </desc> </func> diff --git a/lib/crypto/doc/src/crypto_app.xml b/lib/crypto/doc/src/crypto_app.xml index 1c01e3f099..6573a56f4c 100644 --- a/lib/crypto/doc/src/crypto_app.xml +++ b/lib/crypto/doc/src/crypto_app.xml @@ -62,7 +62,7 @@ <section> <title>OpenSSL libraries</title> <p>The current implementation of the Erlang Crypto application is - based on the <em>OpenSSL</em> package version 0.9.7 or higher. + based on the <em>OpenSSL</em> package version 0.9.8 or higher. There are source and binary releases on the web. </p> <p>Source releases of OpenSSL can be downloaded from the <url href="http://www.openssl.org">OpenSSL</url> project home page, diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 21f507f153..461558a79e 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -78,12 +78,11 @@ md5_mac, md5_mac_96, sha_mac, sha_mac_96, sha224_mac, sha256_mac, sha384_mac, sha512_mac, - sha_mac_init, sha_mac_update, sha_mac_final, des_cbc_encrypt, des_cbc_decrypt, des_cfb_encrypt, des_cfb_decrypt, des_ecb_encrypt, des_ecb_decrypt, - des_ede3_cbc_encrypt, des_ede3_cbc_decrypt, - des_ede3_cfb_encrypt, des_ede3_cfb_decrypt, + des3_cbc_encrypt, des3_cbc_decrypt, + des3_cfb_encrypt, des3_cfb_decrypt, aes_cfb_128_encrypt, aes_cfb_128_decrypt, rand_bytes, strong_rand_bytes, @@ -103,6 +102,13 @@ aes_cbc_256_encrypt, aes_cbc_256_decrypt, aes_ctr_encrypt, aes_ctr_decrypt, aes_ctr_stream_init, aes_ctr_stream_encrypt, aes_ctr_stream_decrypt, + aes_cbc_ivec, blowfish_cbc_encrypt, blowfish_cbc_decrypt, + blowfish_cfb64_encrypt, blowfish_cfb64_decrypt, + blowfish_ecb_encrypt, blowfish_ecb_decrypt, blowfish_ofb64_encrypt, + des_cbc_ivec, des_cfb_ivec, erlint, mpint, + hash, hash_init, hash_update, hash_final, + hmac_init, hmac_update, hmac_final, hmac_final_n, info, + rc2_cbc_encrypt, rc2_cbc_decrypt, info_lib]). -type rsa_digest_type() :: 'md5' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'. @@ -597,12 +603,12 @@ des_ecb_crypt(_Key, _Data, _IsEncrypt) -> ?nif_stub. binary(). des3_cbc_encrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cbc_encrypt(Key1, Key2, Key3, IVec, Data). + des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, true). des_ede3_cbc_encrypt(Key1, Key2, Key3, IVec, Data) -> des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, true). des3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data). + des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, false). des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> des_ede3_cbc_crypt(Key1, Key2, Key3, IVec, Data, false). @@ -617,16 +623,18 @@ des_ede3_cbc_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. binary(). des3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cfb_encrypt(Key1, Key2, Key3, IVec, Data). -des_ede3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) -> des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, true). des3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) -> - des_ede3_cfb_decrypt(Key1, Key2, Key3, IVec, Data). -des_ede3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) -> des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, false). -des_ede3_cfb_crypt(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. +des_ede3_cfb_crypt(Key1, Key2, Key3, IVec, Data, IsEncrypt) -> + case des_ede3_cfb_crypt_nif(Key1,Key2,Key3,IVec,Data,IsEncrypt) of + notsup -> erlang:error(notsup); + Bin -> Bin + end. + +des_ede3_cfb_crypt_nif(_Key1, _Key2, _Key3, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% %% Blowfish diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 7ac693f371..8965ab6b94 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -87,10 +87,12 @@ groups() -> {rest, [], [md5, md5_update, md4, md4_update, md5_mac, md5_mac_io, sha, sha_update, + sha256, sha256_update, sha512, sha512_update, hmac_update_sha, hmac_update_sha_n, hmac_update_sha256, hmac_update_sha512, hmac_update_md5_n, hmac_update_md5_io, hmac_update_md5, hmac_rfc4231, des_cbc, aes_cfb, aes_cbc, + des_cfb, des_cfb_iter, des3_cbc, des3_cfb, rc2_cbc, aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_ecb, rand_uniform_test, strong_rand_test, rsa_verify_test, dsa_verify_test, rsa_sign_test, @@ -192,7 +194,16 @@ info(Config) when is_list(Config) -> {skip,"Missing crypto application"}; {_,_} -> ?line crypto:start(), - ?line crypto:info(), + ?line Info = crypto:info(), + ?line Exports = lists:usort([F || {F,_} <- crypto:module_info(exports)]), + ?line [] = Info -- Exports, + ?line NotInInfo = Exports -- Info, + io:format("NotInInfo = ~p\n", [NotInInfo]), + BlackList = lists:sort([des_ede3_cbc_decrypt, des_ede3_cbc_encrypt, + dh_check, dh_generate_parameters, + module_info, start, stop, version]), + ?line BlackList = NotInInfo, + ?line InfoLib = crypto:info_lib(), ?line [_|_] = InfoLib, F = fun([{Name,VerN,VerS}|T],Me) -> @@ -349,12 +360,8 @@ hmac_update_sha256(doc) -> hmac_update_sha256(suite) -> []; hmac_update_sha256(Config) when is_list(Config) -> - case openssl_version() of - V when V < 16#908000 -> - {skipped,"OpenSSL version too old"}; - _ -> - hmac_update_sha256_do() - end. + if_098(fun() -> hmac_update_sha256_do() end). + hmac_update_sha256_do() -> ?line Key = hexstr2bin("00010203101112132021222330313233" @@ -376,12 +383,7 @@ hmac_update_sha512(doc) -> hmac_update_sha512(suite) -> []; hmac_update_sha512(Config) when is_list(Config) -> - case openssl_version() of - V when V < 16#908000 -> - {skipped,"OpenSSL version too old"}; - _ -> - hmac_update_sha512_do() - end. + if_098(fun() -> hmac_update_sha512_do() end). hmac_update_sha512_do() -> ?line Key = hexstr2bin("00010203101112132021222330313233" @@ -422,12 +424,7 @@ hmac_rfc4231(doc) -> hmac_rfc4231(suite) -> []; hmac_rfc4231(Config) when is_list(Config) -> - case openssl_version() of - V when V < 16#908000 -> - {skipped,"OpenSSL version too old"}; - _ -> - hmac_rfc4231_do() - end. + if_098(fun() -> hmac_rfc4231_do() end). hmac_rfc4231_do() -> %% Test Case 1 @@ -746,6 +743,9 @@ sha256(doc) -> sha256(suite) -> []; sha256(Config) when is_list(Config) -> + if_098(fun() -> sha256_do() end). + +sha256_do() -> ?line m(crypto:sha256("abc"), hexstr2bin("BA7816BF8F01CFEA4141" "40DE5DAE2223B00361A396177A9CB410FF61F20015AD")), @@ -762,6 +762,9 @@ sha256_update(doc) -> sha256_update(suite) -> []; sha256_update(Config) when is_list(Config) -> + if_098(fun() -> sha256_update_do() end). + +sha256_update_do() -> ?line Ctx = crypto:sha256_init(), ?line Ctx1 = crypto:sha256_update(Ctx, "abcdbcdecdefdefgefghfghighi"), ?line Ctx2 = crypto:sha256_update(Ctx1, "jhijkijkljklmklmnlmnomnopnopq"), @@ -778,6 +781,9 @@ sha512(doc) -> sha512(suite) -> []; sha512(Config) when is_list(Config) -> + if_098(fun() -> sha512_do() end). + +sha512_do() -> ?line m(crypto:sha512("abc"), hexstr2bin("DDAF35A193617ABACC417349AE20413112E6FA4E89A97EA2" "0A9EEEE64B55D39A2192992A274FC1A836BA3C23A3FEEBBD" @@ -796,6 +802,9 @@ sha512_update(doc) -> sha512_update(suite) -> []; sha512_update(Config) when is_list(Config) -> + if_098(fun() -> sha512_update_do() end). + +sha512_update_do() -> ?line Ctx = crypto:sha512_init(), ?line Ctx1 = crypto:sha512_update(Ctx, "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn"), ?line Ctx2 = crypto:sha512_update(Ctx1, "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"), @@ -996,6 +1005,12 @@ des3_cfb(doc) -> des3_cfb(suite) -> []; des3_cfb(Config) when is_list(Config) -> + case openssl_version() of + V when V < 16#90705F -> {skipped,"OpenSSL version too old"}; + _ -> des3_cfb_do() + end. + +des3_cfb_do() -> ?line Key1 = hexstr2bin("0123456789abcdef"), ?line Key2 = hexstr2bin("fedcba9876543210"), ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), @@ -1959,3 +1974,10 @@ openssl_version() -> undefined end. +if_098(Fun) -> + case openssl_version() of + V when V < 16#908000 -> + {skipped,"OpenSSL version too old"}; + _ -> + Fun() + end. diff --git a/lib/debugger/src/dbg_wx_settings.erl b/lib/debugger/src/dbg_wx_settings.erl index 3be93c495c..94ecc5781d 100644 --- a/lib/debugger/src/dbg_wx_settings.erl +++ b/lib/debugger/src/dbg_wx_settings.erl @@ -49,31 +49,35 @@ save(Win, Pos, SFile) -> open_win(Win, Pos, SFile, Str, What) -> {SDir, SFileName} = - if - %% If settings are saved for the first time, and to - %% the default directory HOME/erlang.tools/debugger, - %% make sure the directory exists, or create it if - %% desired and possible - SFile==default -> {default_settings_dir(Win), "NoName.state"}; - true -> {filename:dirname(SFile), filename:basename(SFile)} - end, - + if + %% If settings are saved for the first time, and to + %% the default directory HOME/erlang.tools/debugger, + %% make sure the directory exists, or create it if + %% desired and possible + SFile==default -> {default_settings_dir(Win), "NoName.state"}; + true -> {filename:dirname(SFile), filename:basename(SFile)} + end, + FD = wxFileDialog:new(Win, [{message,Str},{pos, Pos}, - {defaultDir,SDir}, - {defaultFile,SFileName}, - {wildCard, "*.state"}, - {style,What}]), + {defaultDir,SDir}, + {defaultFile,SFileName}, + {wildCard, "*.state"}, + {style,What}]), case wxFileDialog:showModal(FD) of - ?wxID_OK -> - File = wxFileDialog:getFilename(FD), - Dir = wxFileDialog:getDirectory(FD), - wxFileDialog:destroy(FD), - {ok, filename:join(Dir,File)}; - _ -> - wxFileDialog:destroy(FD), - cancel + ?wxID_OK -> + case wxFileDialog:getPaths(FD) of + [NewFile] -> + wxFileDialog:destroy(FD), + {ok, NewFile}; + _ -> + wxFileDialog:destroy(FD), + cancel + end; + _ -> + wxFileDialog:destroy(FD), + cancel end. - + default_settings_dir(Win) -> {ok, [[Home]]} = init:get_argument(home), DefDir = filename:join([Home, ".erlang_tools", "debugger"]), diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index a4a0b80348..91384b8b91 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -1703,16 +1703,20 @@ send(Pid, Pkt) -> %% retransmit/4 retransmit({TPid, Caps, #diameter_app{alias = Alias} = App} = T, - #request{app = Alias, packet = Pkt} + #request{app = Alias, packet = Pkt0} = Req, SvcName, Timeout) -> - have_request(Pkt, TPid) %% Don't failover to a peer we've + have_request(Pkt0, TPid) %% Don't failover to a peer we've andalso ?THROW(timeout), %% already sent to. + #diameter_packet{header = Hdr0} = Pkt0, + Hdr = Hdr0#diameter_header{is_retransmitted = true}, + Pkt = Pkt0#diameter_packet{header = Hdr}, + resend_req(cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]), T, - Req, + Req#request{packet = Pkt}, Timeout, []). diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl index ed31670031..bb820a8bf2 100644 --- a/lib/diameter/test/diameter_failover_SUITE.erl +++ b/lib/diameter/test/diameter_failover_SUITE.erl @@ -18,19 +18,19 @@ %% %% -%% Tests of traffic between six Diameter nodes in three realms, +%% Tests of traffic between seven Diameter nodes in four realms, %% connected as follows. %% -%% ----- SERVER1.REALM2 -%% / -%% / ----- SERVER2.REALM2 -%% | / -%% CLIENT.REALM1 ------ SERVER3.REALM2 -%% | \ -%% | \ -%% \ ---- SERVER1.REALM3 -%% \ -%% ----- SERVER2.REALM3 +%% ----- SERVER1.REALM2 ----- +%% / \ +%% / ----- SERVER2.REALM2 ----- \ +%% | / \ | +%% CLIENT.REALM1 ------ SERVER3.REALM2 ------ CLIENT.REALM4 +%% | \ / | +%% | \ / | +%% \ ---- SERVER1.REALM3 ----- / +%% \ / +%% ----- SERVER2.REALM3 ----- %% -module(diameter_failover_SUITE). @@ -44,12 +44,16 @@ connect/1, send_ok/1, send_nok/1, + send_discard_1/1, + send_discard_2/1, stop_services/1, stop/1]). %% diameter callbacks -export([pick_peer/4, prepare_request/3, + prepare_retransmit/3, + handle_error/4, handle_answer/4, handle_request/3]). @@ -62,14 +66,18 @@ -define(ADDR, {127,0,0,1}). --define(CLIENT, "CLIENT.REALM1"). +-define(CLIENT1, "CLIENT.REALM1"). +-define(CLIENT2, "CLIENT.REALM4"). -define(SERVER1, "SERVER1.REALM2"). -define(SERVER2, "SERVER2.REALM2"). -define(SERVER3, "SERVER3.REALM2"). -define(SERVER4, "SERVER1.REALM3"). -define(SERVER5, "SERVER2.REALM3"). --define(SERVICES, [?CLIENT, ?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4, ?SERVER5]). +-define(IS_CLIENT(Svc), Svc == ?CLIENT1; Svc == ?CLIENT2). + +-define(CLIENTS, [?CLIENT1, ?CLIENT2]). +-define(SERVERS, [?SERVER1, ?SERVER2, ?SERVER3, ?SERVER4, ?SERVER5]). -define(DICT_COMMON, ?DIAMETER_DICT_COMMON). @@ -77,26 +85,27 @@ -define(APP_ID, ?DICT_COMMON:id()). %% Config for diameter:start_service/2. --define(SERVICE(Host, Dict), +-define(SERVICE(Host), [{'Origin-Host', Host}, {'Origin-Realm', realm(Host)}, {'Host-IP-Address', [?ADDR]}, {'Vendor-Id', 12345}, {'Product-Name', "OTP/diameter"}, - {'Acct-Application-Id', [Dict:id()]}, + {'Acct-Application-Id', [?APP_ID]}, {application, [{alias, ?APP_ALIAS}, - {dictionary, Dict}, + {dictionary, ?DICT_COMMON}, {module, #diameter_callback {peer_up = false, peer_down = false, - handle_error = false, - prepare_retransmit = false, default = ?MODULE}}, {answer_errors, callback}]}]). -define(SUCCESS, 2001). --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). +%% Value of Termination-Cause determines client/server behaviour. +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). +-define(MOVED, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_USER_MOVED'). +-define(TIMEOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_SESSION_TIMEOUT'). %% =========================================================================== @@ -109,6 +118,8 @@ all() -> connect, send_ok, send_nok, + send_discard_1, + send_discard_2, stop_services, stop]. @@ -119,19 +130,20 @@ start(_Config) -> ok = diameter:start(). start_services(_Config) -> - S = [server(N, ?DICT_COMMON) || N <- tl(?SERVICES)], - - ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, ?DICT_COMMON)), + Servers = [server(N) || N <- ?SERVERS], + [] = [T || C <- ?CLIENTS, + T <- [diameter:start_service(C, ?SERVICE(C))], + T /= ok], - {save_config, [{?CLIENT, S}]}. + {save_config, Servers}. connect(Config) -> - {_, Conns} = proplists:get_value(saved_config, Config), + {start_services, Servers} = proplists:get_value(saved_config, Config), - lists:foreach(fun({CN,Ss}) -> connect(CN, Ss) end, Conns). + lists:foreach(fun(C) -> connect(C, Servers) end, ?CLIENTS). stop_services(_Config) -> - [] = [{H,T} || H <- ?SERVICES, + [] = [{H,T} || H <- ?CLIENTS ++ ?SERVERS, T <- [diameter:stop_service(H)], T /= ok]. @@ -140,8 +152,8 @@ stop(_Config) -> %% ---------------------------------------- -server(Name, Dict) -> - ok = diameter:start_service(Name, ?SERVICE(Name, Dict)), +server(Name) -> + ok = diameter:start_service(Name, ?SERVICE(Name)), {Name, ?util:listen(Name, tcp)}. connect(Name, Refs) -> @@ -153,30 +165,39 @@ connect(Name, Refs) -> %% Send an STR and expect success after SERVER3 answers after a couple %% of failovers. send_ok(_Config) -> - Req = ['STR', {'Destination-Realm', realm(?SERVER1)}, - {'Termination-Cause', ?LOGOUT}, - {'Auth-Application-Id', ?APP_ID}], + Req = #diameter_base_STR{'Destination-Realm' = realm(?SERVER1), + 'Termination-Cause' = ?LOGOUT, + 'Auth-Application-Id' = ?APP_ID}, #diameter_base_STA{'Result-Code' = ?SUCCESS, 'Origin-Host' = ?SERVER3} - = call(Req, [{filter, realm}]). + = call(?CLIENT1, Req). %% Send an STR and expect failure when both servers fail. send_nok(_Config) -> - Req = ['STR', {'Destination-Realm', realm(?SERVER4)}, - {'Termination-Cause', ?LOGOUT}, - {'Auth-Application-Id', ?APP_ID}], - {error, failover} = call(Req, [{filter, realm}]). + Req = #diameter_base_STR{'Destination-Realm' = realm(?SERVER4), + 'Termination-Cause' = ?LOGOUT, + 'Auth-Application-Id' = ?APP_ID}, + {failover, ?LOGOUT} = call(?CLIENT1, Req). + +%% Send an STR and have prepare_retransmit discard it. +send_discard_1(_Config) -> + Req = #diameter_base_STR{'Destination-Realm' = realm(?SERVER1), + 'Termination-Cause' = ?TIMEOUT, + 'Auth-Application-Id' = ?APP_ID}, + {rejected, ?TIMEOUT} = call(?CLIENT2, Req). +send_discard_2(_Config) -> + Req = #diameter_base_STR{'Destination-Realm' = realm(?SERVER4), + 'Termination-Cause' = ?MOVED, + 'Auth-Application-Id' = ?APP_ID}, + {discarded, ?MOVED} = call(?CLIENT2, Req). %% =========================================================================== realm(Host) -> tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). -call(Req, Opts) -> - diameter:call(?CLIENT, ?APP_ALIAS, Req, Opts). - -set([H|T], Vs) -> - [H | Vs ++ T]. +call(Svc, Req) -> + diameter:call(Svc, ?APP_ALIAS, Req, [{filter, realm}]). %% =========================================================================== %% diameter callbacks @@ -184,7 +205,8 @@ set([H|T], Vs) -> %% pick_peer/4 %% Choose a server other than SERVER3 or SERVER5 if possible. -pick_peer(Peers, _, ?CLIENT, _State) -> +pick_peer(Peers, _, Svc, _State) + when ?IS_CLIENT(Svc) -> case lists:partition(fun({_, #diameter_caps{origin_host = {_, OH}}}) -> OH /= ?SERVER3 andalso OH /= ?SERVER5 end, @@ -198,20 +220,41 @@ pick_peer(Peers, _, ?CLIENT, _State) -> %% prepare_request/3 -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}) -> +prepare_request(Pkt, Svc, {_Ref, Caps}) + when ?IS_CLIENT(Svc) -> {send, prepare(Pkt, Caps)}. prepare(#diameter_packet{msg = Req}, Caps) -> #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, _}} = Caps, - set(Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}]). + Req#diameter_base_STR{'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Session-Id' = diameter:session_id(OH)}. + +%% prepare_retransmit/3 + +prepare_retransmit(#diameter_packet{header = H} = P, Svc, {_,_}) + when ?IS_CLIENT(Svc) -> + #diameter_header{is_retransmitted = true} = H, %% assert + prepare(P). + +prepare(#diameter_packet{msg = M} = P) -> + case M#diameter_base_STR.'Termination-Cause' of + ?LOGOUT -> {send, P}; + ?MOVED -> discard; + ?TIMEOUT -> {discard, rejected} + end. + +%% handle_error/4 + +handle_error(Reason, Req, _, _) -> + {Reason, Req#diameter_base_STR.'Termination-Cause'}. %% handle_answer/4 -handle_answer(Pkt, _Req, ?CLIENT, _Peer) -> +handle_answer(Pkt, _Req, Svc, _Peer) + when ?IS_CLIENT(Svc) -> #diameter_packet{msg = Rec, errors = []} = Pkt, Rec. @@ -219,8 +262,8 @@ handle_answer(Pkt, _Req, ?CLIENT, _Peer) -> %% Only SERVER3 actually answers. handle_request(Pkt, ?SERVER3, {_, Caps}) -> - #diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId, - 'Origin-Host' = ?CLIENT}} + #diameter_packet{header = #diameter_header{is_retransmitted = true}, + msg = #diameter_base_STR{'Session-Id' = SId}} = Pkt, #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, _}} diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 699dfc8791..b3249d4f56 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -700,20 +700,22 @@ recv_response(S, Data) -> Error -> throw(Error) end; {error,Reason} -> - throw({gen_tcp_error, Reason}); - Error -> - throw(Error) + throw({gen_tcp_error, Reason}) end. %%% Sanity check of received packet check_tag(Data) -> - case asn1rt_ber_bin:decode_tag(l2b(Data)) of - {_Tag, Data1, _Rb} -> - case asn1rt_ber_bin:decode_length(l2b(Data1)) of - {{_Len, _Data2}, _Rb2} -> ok; - _ -> throw({error,decoded_tag_length}) - end; - _ -> throw({error,decoded_tag}) + try + {_Tag, Data1, _Rb} = asn1rt_ber_bin:decode_tag(l2b(Data)), + try + {{_Len, _Data2}, _Rb2} = asn1rt_ber_bin:decode_length(l2b(Data1)), + ok + catch + _ -> throw({error,decoded_tag_length}) + end + catch + _ -> + throw({error, decoded_tag}) end. %%% Check for expected kind of reply diff --git a/lib/eldap/vsn.mk b/lib/eldap/vsn.mk index c9d6e4e324..4d05d3d1e3 100644 --- a/lib/eldap/vsn.mk +++ b/lib/eldap/vsn.mk @@ -1 +1 @@ -ELDAP_VSN = 1.0 +ELDAP_VSN = 1.0.1 diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 776e336aea..98d65abba1 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -766,37 +766,6 @@ type(erlang, node, 0, _) -> t_node(); type(erlang, node, 1, Xs) -> strict(arg_types(erlang, node, 1), Xs, fun (_) -> t_node() end); type(erlang, nodes, 0, _) -> t_list(t_node()); -type(erlang, port_call, Arity, Xs) when Arity =:= 2; Arity =:= 3 -> - strict(arg_types(erlang, port_call, Arity), Xs, fun (_) -> t_any() end); -type(erlang, port_info, 1, Xs) -> - strict(arg_types(erlang, port_info, 1), Xs, - fun (_) -> t_sup(t_atom('undefined'), t_list()) end); -type(erlang, port_info, 2, Xs) -> - strict(arg_types(erlang, port_info, 2), Xs, - fun ([_Port, Item]) -> - t_sup(t_atom('undefined'), - case t_atom_vals(Item) of - ['connected'] -> t_tuple([Item, t_pid()]); - ['id'] -> t_tuple([Item, t_integer()]); - ['input'] -> t_tuple([Item, t_integer()]); - ['links'] -> t_tuple([Item, t_list(t_pid())]); - ['name'] -> t_tuple([Item, t_string()]); - ['output'] -> t_tuple([Item, t_integer()]); - ['os_pid'] -> t_tuple([Item, t_sup(t_non_neg_integer(),t_atom('undefined'))]); - ['registered_name'] -> t_tuple([Item, t_atom()]); - List when is_list(List) -> - t_tuple([t_sup([t_atom(A) || A <- List]), - t_sup([t_atom(), t_integer(), - t_pid(), t_list(t_pid()), - t_string()])]); - unknown -> - [_, PosItem] = arg_types(erlang, port_info, 2), - t_tuple([PosItem, - t_sup([t_atom(), t_integer(), - t_pid(), t_list(t_pid()), - t_string()])]) - end) - end); %% Guard bif, needs to be here. type(erlang, round, 1, Xs) -> strict(arg_types(erlang, round, 1), Xs, fun (_) -> t_integer() end); @@ -922,6 +891,14 @@ type(erlang, system_info, 1, Xs) -> t_non_neg_fixnum(), t_non_neg_fixnum()]), t_string()); + ['otp_release'] -> + t_string(); + ['port_parallelism'] -> + t_boolean(); + ['port_count'] -> + t_non_neg_fixnum(); + ['port_limit'] -> + t_non_neg_fixnum(); ['process_count'] -> t_non_neg_fixnum(); ['process_limit'] -> @@ -2275,16 +2252,6 @@ arg_types(erlang, node, 1) -> [t_identifier()]; arg_types(erlang, nodes, 0) -> []; -arg_types(erlang, port_call, 2) -> - [t_sup(t_port(), t_atom()), t_any()]; -arg_types(erlang, port_call, 3) -> - [t_sup(t_port(), t_atom()), t_integer(), t_any()]; -arg_types(erlang, port_info, 1) -> - [t_sup(t_port(), t_atom())]; -arg_types(erlang, port_info, 2) -> - [t_sup(t_port(), t_atom()), - t_atoms(['registered_name', 'id', 'connected', - 'links', 'name', 'input', 'output', 'os_pid'])]; %% Guard bif, needs to be here. arg_types(erlang, round, 1) -> [t_number()]; diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index f498a88c5e..a1590c2dce 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -371,7 +371,51 @@ fe80::204:acff:fe17:bf38 </taglist> </desc> </func> - + <func> + <name name="parse_ipv4_address" arity="1" /> + <fsummary>Parse an IPv4 address</fsummary> + <desc> + <p>Parses an IPv4 address string and returns an <a href="#type-ip4_address">ip4_address()</a>. + Accepts a shortened IPv4 shortened address string.</p> + </desc> + </func> + <func> + <name name="parse_ipv4strict_address" arity="1" /> + <fsummary>Parse an IPv4 address strict.</fsummary> + <desc> + <p>Parses an IPv4 address string containing four fields, i.e <b>not</b> shortened, and returns an <a href="#type-ip4_adress">ip4_address()</a>.</p> + </desc> + </func> + <func> + <name name="parse_ipv6_address" arity="1" /> + <fsummary>Parse an IPv6 address</fsummary> + <desc> + <p>Parses an IPv6 address string and returns an <a href="#type-ip6_address">ip6_address()</a>. + If an IPv4 address string is passed, an IPv4-mapped IPv6 address is returned.</p> + </desc> + </func> + <func> + <name name="parse_ipv6strict_address" arity="1" /> + <fsummary>Parse an IPv6 address strict.</fsummary> + <desc> + <p>Parses an IPv6 address string and returns an <a href="#type-ip6_address">ip6_address()</a>. + Does <b>not</b> accept IPv4 adresses.</p> + </desc> + </func> + <func> + <name name="parse_address" arity="1" /> + <fsummary>Parse an IPv4 or IPv6 address.</fsummary> + <desc> + <p>Parses an IPv4 or IPv6 address string and returns an <a href="#type-ip4_address">ip4_address()</a> or <a href="#type-ip6_address">ip6_address()</a>. Accepts a shortened IPv4 address string.</p> + </desc> + </func> + <func> + <name name="parse_strict_address" arity="1" /> + <fsummary>Parse an IPv4 or IPv6 address strict.</fsummary> + <desc> + <p>Parses an IPv4 or IPv6 address string and returns an <a href="#type-ip4_address">ip4_address()</a> or <a href="#type-ip6_adress">ip6_address()</a>. Does <b>not</b> accept a shortened IPv4 address string.</p> + </desc> + </func> <func> <name name="peername" arity="1"/> <fsummary>Return the address and port for the other end of a connection</fsummary> @@ -512,13 +556,37 @@ fe80::204:acff:fe17:bf38 <c>[Byte1,Byte2|Binary]</c>.</p> </item> - <tag><c>{high_watermark, Size}</c></tag> - <item> <p> - Sender is forced busy if sent and enqueued data - reaches the highwater mark. - <br /> Default: 8192 kB. - </p> - </item> + <tag><c>{high_msgq_watermark, Size}</c> (TCP/IP sockets)</tag> + <item> + <p>The socket message queue will be set into a busy + state when the amount of data queued on the message + queue reaches this limit. Note that this limit only + concerns data that have not yet reached the ERTS internal + socket implementation. Default value used is 8 kB.</p> + <p>Senders of data to the socket will be suspended if + either the socket message queue is busy, or the socket + itself is busy.</p> + <p>For more information see the <c>low_msgq_watermark</c>, + <c>high_watermark</c>, and <c>low_watermark</c> options.</p> + <p>Note that distribution sockets will disable the use of + <c>high_msgq_watermark</c> and <c>low_msgq_watermark</c>, + and will instead use the + <seealso marker="erts:erlang#system_info_dist_buf_busy_limit">distribution + buffer busy limit</seealso> which is a similar feature.</p> + </item> + + <tag><c>{high_watermark, Size}</c> (TCP/IP sockets)</tag> + <item> + <p>The socket will be set into a busy state when the amount + of data queued internally by the ERTS socket implementation + reaches this limit. Default value used is 8 kB.</p> + <p>Senders of data to the socket will be suspended if + either the socket message queue is busy, or the socket + itself is busy.</p> + <p>For more information see the <c>low_watermark</c>, + <c>high_msgq_watermark</c>, and <c>low_msqg_watermark</c> + options.</p> + </item> <tag><c>{ipv6_v6only, Boolean}</c></tag> <item> @@ -603,14 +671,41 @@ fe80::204:acff:fe17:bf38 the flushing time-out in seconds.</p> </item> - <tag><c>{low_watermark, Size}</c></tag> - <item> <p> - If the port has reached its <c>high_watermark</c> it will - force busy onto senders. When the port data queue reaches the - <c>low_watermark</c> callers are no longer forced busy. - <br /> Default: 4096 kB. - </p> - </item> + <tag><c>{low_msgq_watermark, Size}</c> (TCP/IP sockets)</tag> + <item> + <p>If the socket message queue is in a busy state, the + socket message queue will be set in a not busy state when + the amount of data queued in the message queue falls + below this limit. Note that this limit only concerns data + that have not yet reached the ERTS internal socket + implementation. Default value used is 4 kB.</p> + <p>Senders that have been suspended due to either a + busy message queue or a busy socket, will be resumed + when neither the socket message queue, nor the socket + are busy.</p> + <p>For more information see the <c>high_msgq_watermark</c>, + <c>high_watermark</c>, and <c>low_watermark</c> options.</p> + <p>Note that distribution sockets will disable the use of + <c>high_msgq_watermark</c> and <c>low_msgq_watermark</c>, + and will instead use the + <seealso marker="erts:erlang#system_info_dist_buf_busy_limit">distribution + buffer busy limit</seealso> which is a similar feature.</p> + </item> + + <tag><c>{low_watermark, Size}</c> (TCP/IP sockets)</tag> + <item> + <p>If the socket is in a busy state, the socket will + be set in a not busy state when the amount of data + queued internally by the ERTS socket implementation + falls below this limit. Default value used is 4 kB.</p> + <p>Senders that have been suspended due to either a + busy message queue or a busy socket, will be resumed + when neither the socket message queue, nor the socket + are busy.</p> + <p>For more information see the <c>high_watermark</c>, + <c>high_msgq_watermark</c>, and <c>low_msgq_watermark</c> + options.</p> + </item> <tag><c>{mode, Mode :: binary | list}</c></tag> <item> diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index 68cd26ec10..75ce852001 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -1960,5 +1960,5 @@ to_string(Term) -> true -> Term; false -> - lists:flatten(io_lib:write(Term)) + lists:flatten(io_lib:format("~134217728p", [Term])) end. diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index 22e6aa5bc8..ec13ab6d2e 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -37,9 +37,11 @@ {dontroute, boolean()} | {exit_on_close, boolean()} | {header, non_neg_integer()} | + {high_msgq_watermark, pos_integer()} | {high_watermark, non_neg_integer()} | {keepalive, boolean()} | {linger, {boolean(), non_neg_integer()}} | + {low_msgq_watermark, pos_integer()} | {low_watermark, non_neg_integer()} | {mode, list | binary} | list | binary | {nodelay, boolean()} | @@ -67,9 +69,11 @@ dontroute | exit_on_close | header | + high_msgq_watermark | high_watermark | keepalive | linger | + low_msgq_watermark | low_watermark | mode | nodelay | diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index 92c1802a86..9670271b2e 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -30,7 +30,9 @@ ifget/3, ifget/2, ifset/3, ifset/2, getstat/1, getstat/2, ip/1, stats/0, options/0, - pushf/3, popf/1, close/1, gethostname/0, gethostname/1]). + pushf/3, popf/1, close/1, gethostname/0, gethostname/1, + parse_ipv4_address/1, parse_ipv6_address/1, parse_ipv4strict_address/1, + parse_ipv6strict_address/1, parse_address/1, parse_strict_address/1]). -export([connect_options/2, listen_options/2, udp_options/2, sctp_options/2]). @@ -527,6 +529,48 @@ getservbyname(Name, Protocol) when is_atom(Name) -> Error -> Error end. +-spec parse_ipv4_address(Address) -> + {ok, IPv4Address} | {error, einval} when + Address :: string(), + IPv4Address :: ip_address(). +parse_ipv4_address(Addr) -> + inet_parse:ipv4_address(Addr). + +-spec parse_ipv6_address(Address) -> + {ok, IPv6Address} | {error, einval} when + Address :: string(), + IPv6Address :: ip_address(). +parse_ipv6_address(Addr) -> + inet_parse:ipv6_address(Addr). + +-spec parse_ipv4strict_address(Address) -> + {ok, IPv4Address} | {error, einval} when + Address :: string(), + IPv4Address :: ip_address(). +parse_ipv4strict_address(Addr) -> + inet_parse:ipv4strict_address(Addr). + +-spec parse_ipv6strict_address(Address) -> + {ok, IPv6Address} | {error, einval} when + Address :: string(), + IPv6Address :: ip_address(). +parse_ipv6strict_address(Addr) -> + inet_parse:ipv6strict_address(Addr). + +-spec parse_address(Address) -> + {ok, IPAddress} | {error, einval} when + Address :: string(), + IPAddress :: ip_address(). +parse_address(Addr) -> + inet_parse:address(Addr). + +-spec parse_strict_address(Address) -> + {ok, IPAddress} | {error, einval} when + Address :: string(), + IPAddress :: ip_address(). +parse_strict_address(Addr) -> + inet_parse:strict_address(Addr). + %% Return a list of available options options() -> [ @@ -535,6 +579,7 @@ options() -> buffer, header, active, packet, deliver, mode, multicast_if, multicast_ttl, multicast_loop, exit_on_close, high_watermark, low_watermark, + high_msgq_watermark, low_msgq_watermark, send_timeout, send_timeout_close ]. @@ -552,8 +597,8 @@ stats() -> connect_options() -> [tos, priority, reuseaddr, keepalive, linger, sndbuf, recbuf, nodelay, header, active, packet, packet_size, buffer, mode, deliver, - exit_on_close, high_watermark, low_watermark, send_timeout, - send_timeout_close, delay_send,raw]. + exit_on_close, high_watermark, low_watermark, high_msgq_watermark, + low_msgq_watermark, send_timeout, send_timeout_close, delay_send, raw]. connect_options(Opts, Family) -> BaseOpts = @@ -608,8 +653,9 @@ con_add(Name, Val, R, Opts, AllOpts) -> listen_options() -> [tos, priority, reuseaddr, keepalive, linger, sndbuf, recbuf, nodelay, header, active, packet, buffer, mode, deliver, backlog, ipv6_v6only, - exit_on_close, high_watermark, low_watermark, send_timeout, - send_timeout_close, delay_send, packet_size,raw]. + exit_on_close, high_watermark, low_watermark, high_msgq_watermark, + low_msgq_watermark, send_timeout, send_timeout_close, delay_send, + packet_size, raw]. listen_options(Opts, Family) -> BaseOpts = diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl index 6d808b54cd..000119bc74 100644 --- a/lib/kernel/src/inet_int.hrl +++ b/lib/kernel/src/inet_int.hrl @@ -141,6 +141,8 @@ -define(INET_LOPT_READ_PACKETS, 33). -define(INET_OPT_RAW, 34). -define(INET_LOPT_TCP_SEND_TIMEOUT_CLOSE, 35). +-define(INET_LOPT_TCP_MSGQ_HIWTRMRK, 36). +-define(INET_LOPT_TCP_MSGQ_LOWTRMRK, 37). % Specific SCTP options: separate range: -define(SCTP_OPT_RTOINFO, 100). -define(SCTP_OPT_ASSOCINFO, 101). diff --git a/lib/kernel/src/inet_parse.erl b/lib/kernel/src/inet_parse.erl index ba62a59068..3551e701b6 100644 --- a/lib/kernel/src/inet_parse.erl +++ b/lib/kernel/src/inet_parse.erl @@ -36,7 +36,7 @@ -export([ipv4_address/1, ipv6_address/1]). -export([ipv4strict_address/1, ipv6strict_address/1]). --export([address/1]). +-export([address/1, strict_address/1]). -export([visible_string/1, domain/1]). -export([ntoa/1, dots/1]). -export([split_line/1]). @@ -456,6 +456,17 @@ address(Cs) when is_list(Cs) -> address(_) -> {error, einval}. +%%Parse ipv4 strict address or ipv6 strict address +strict_address(Cs) when is_list(Cs) -> + case ipv4strict_address(Cs) of + {ok,IP} -> + {ok,IP}; + _ -> + ipv6strict_address(Cs) + end; +strict_address(Cs) -> + {error, einval}. + %% %% Parse IPv4 address: %% d1.d2.d3.d4 diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl index 1cc3eb7c79..b40c50f79f 100644 --- a/lib/kernel/test/global_SUITE.erl +++ b/lib/kernel/test/global_SUITE.erl @@ -3821,7 +3821,7 @@ start_node_rel(Name0, Rel, Config) -> Name = node_name(Name0, Config), {Release, Compat} = case Rel of this -> - {[this], "+R8"}; + {[this], ""}; Rel when is_atom(Rel) -> {[{release, atom_to_list(Rel)}], ""}; RelList -> diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index ce138b6804..e5e1794514 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -37,7 +37,8 @@ gethostnative_soft_restart/0, gethostnative_soft_restart/1, gethostnative_debug_level/0, gethostnative_debug_level/1, getif/1, - getif_ifr_name_overflow/1,getservbyname_overflow/1, getifaddrs/1]). + getif_ifr_name_overflow/1,getservbyname_overflow/1, getifaddrs/1, + parse_strict_address/1]). -export([get_hosts/1, get_ipv6_hosts/1, parse_hosts/1, parse_address/1, kill_gethost/0, parallell_gethost/0]). @@ -52,7 +53,7 @@ all() -> t_gethostnative, gethostnative_parallell, cname_loop, gethostnative_debug_level, gethostnative_soft_restart, getif, getif_ifr_name_overflow, getservbyname_overflow, - getifaddrs]. + getifaddrs, parse_strict_address]. groups() -> [{parse, [], [parse_hosts, parse_address]}]. @@ -582,16 +583,16 @@ parse_address(Config) when is_list(Config) -> "fe80::198.168.0.", "fec0::fFfF:127.0.0.1."], t_parse_address - (ipv6_address, + (parse_ipv6_address, V6Strict++V6Sloppy++V6Err++V4Err), t_parse_address - (ipv6strict_address, + (parse_ipv6strict_address, V6Strict++V6Err++V4Err++[S || {_,S} <- V6Sloppy]), t_parse_address - (ipv4_address, + (parse_ipv4_address, V4Strict++V4Sloppy++V4Err++V6Err++[S || {_,S} <- V6Strict]), t_parse_address - (ipv4strict_address, + (parse_ipv4strict_address, V4Strict++V4Err++V6Err++[S || {_,S} <- V4Sloppy++V6Strict]). t_parse_address(Func, []) -> @@ -599,14 +600,16 @@ t_parse_address(Func, []) -> ok; t_parse_address(Func, [{Addr,String}|L]) -> io:format("~p = ~p.~n", [Addr,String]), - {ok,Addr} = inet_parse:Func(String), + {ok,Addr} = inet:Func(String), t_parse_address(Func, L); t_parse_address(Func, [String|L]) -> io:format("~p.~n", [String]), - {error,einval} = inet_parse:Func(String), + {error,einval} = inet:Func(String), t_parse_address(Func, L). - +parse_strict_address(Config) when is_list(Config) -> + {ok, Ipv4} = inet:parse_strict_address("127.0.0.1"), + {ok, Ipv6} = inet:parse_strict_address("c11:0c22:5c33:c440:55c0:c66c:77:0088"). t_gethostnative(suite) ->[]; t_gethostnative(doc) ->[]; diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index d488a33d67..ec67d9ec12 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -593,6 +593,12 @@ multicall(Nodes, Msg) -> {PatchedGood, Bad}. %% Make the replies look like rpc:multicalls.. %% rpc:multicall(Nodes, ?MODULE, call, [Msg]). +next_async_dump_log() -> + Interval = mnesia_monitor:get_env(dump_log_time_threshold), + Msg = {next_async_dump_log, time_threshold}, + Ref = erlang:send_after(Interval, self(), Msg), + Ref. + %%%---------------------------------------------------------------------- %%% Callback functions from gen_server %%%---------------------------------------------------------------------- @@ -614,9 +620,7 @@ init([Parent]) -> mnesia_lib:unset(original_nodes), mnesia_recover:connect_nodes(Diff), - Interval = mnesia_monitor:get_env(dump_log_time_threshold), - Msg = {async_dump_log, time_threshold}, - {ok, Ref} = timer:send_interval(Interval, Msg), + Ref = next_async_dump_log(), mnesia_dumper:start_regulator(), Empty = gb_trees:empty(), @@ -1121,6 +1125,11 @@ handle_sync_tabs([], _From) -> %% {stop, Reason, State} (terminate/2 is called) %%---------------------------------------------------------------------- +handle_info({next_async_dump_log, InitBy}, State) -> + async_dump_log(InitBy), + Ref = next_async_dump_log(), + noreply(State#state{dump_log_timer_ref=Ref}); + handle_info({async_dump_log, InitBy}, State) -> Worker = #dump_log{initiated_by = InitBy}, State2 = add_worker(Worker, State), diff --git a/lib/mnesia/src/mnesia_event.erl b/lib/mnesia/src/mnesia_event.erl index 8085155fd5..9fd0342d31 100644 --- a/lib/mnesia/src/mnesia_event.erl +++ b/lib/mnesia/src/mnesia_event.erl @@ -153,7 +153,7 @@ handle_system_event({mnesia_down, Node}, State) -> end; handle_system_event({mnesia_overload, Details}, State) -> - report_warning("Mnesia is overloaded: ~p~n", [Details]), + report_warning("Mnesia is overloaded: ~w~n", [Details]), {ok, State}; handle_system_event({mnesia_info, Format, Args}, State) -> diff --git a/lib/mnesia/src/mnesia_recover.erl b/lib/mnesia/src/mnesia_recover.erl index 4750291a10..b64f428f15 100644 --- a/lib/mnesia/src/mnesia_recover.erl +++ b/lib/mnesia/src/mnesia_recover.erl @@ -45,7 +45,8 @@ note_log_decision/2, outcome/2, start/0, - start_garb/0, + next_garb/0, + next_check_overload/0, still_pending/1, sync_trans_tid_serial/1, sync/0, @@ -91,10 +92,38 @@ start() -> init() -> call(init). -start_garb() -> +next_garb() -> Pid = whereis(mnesia_recover), - {ok, _} = timer:send_interval(timer:minutes(2), Pid, garb_decisions), - {ok, _} = timer:send_interval(timer:seconds(10), Pid, check_overload). + erlang:send_after(timer:minutes(2), Pid, garb_decisions). + +next_check_overload() -> + Pid = whereis(mnesia_recover), + erlang:send_after(timer:seconds(10), Pid, check_overload). + + +do_check_overload(S) -> + %% Time to check if mnesia_tm is overloaded + case whereis(mnesia_tm) of + Pid when is_pid(Pid) -> + Threshold = 100, + Prev = S#state.tm_queue_len, + {message_queue_len, Len} = + process_info(Pid, message_queue_len), + if + Len > Threshold, Prev > Threshold -> + What = {mnesia_tm, message_queue_len, [Prev, Len]}, + mnesia_lib:report_system_event({mnesia_overload, What}), + mnesia_lib:overload_set(mnesia_tm, true), + S#state{tm_queue_len = 0}; + Len > Threshold -> + S#state{tm_queue_len = Len}; + true -> + mnesia_lib:overload_set(mnesia_tm, false), + S#state{tm_queue_len = 0} + end; + undefined -> + S + end. allow_garb() -> cast(allow_garb). @@ -853,34 +882,13 @@ handle_info({connect_nodes, Ns, From}, State) -> handle_call({connect_nodes,Ns},From,State); handle_info(check_overload, S) -> - %% Time to check if mnesia_tm is overloaded - case whereis(mnesia_tm) of - Pid when is_pid(Pid) -> - - Threshold = 100, - Prev = S#state.tm_queue_len, - {message_queue_len, Len} = - process_info(Pid, message_queue_len), - if - Len > Threshold, Prev > Threshold -> - What = {mnesia_tm, message_queue_len, [Prev, Len]}, - mnesia_lib:report_system_event({mnesia_overload, What}), - mnesia_lib:overload_set(mnesia_tm, true), - {noreply, S#state{tm_queue_len = 0}}; - - Len > Threshold -> - {noreply, S#state{tm_queue_len = Len}}; - - true -> - mnesia_lib:overload_set(mnesia_tm, false), - {noreply, S#state{tm_queue_len = 0}} - end; - undefined -> - {noreply, S} - end; + State2 = do_check_overload(S), + next_check_overload(), + {noreply, State2}; handle_info(garb_decisions, State) -> do_garb_decisions(), + next_garb(), {noreply, State}; handle_info({force_decision, Tid}, State) -> diff --git a/lib/mnesia/src/mnesia_tm.erl b/lib/mnesia/src/mnesia_tm.erl index 0af7f55c06..b5b14ac05b 100644 --- a/lib/mnesia/src/mnesia_tm.erl +++ b/lib/mnesia/src/mnesia_tm.erl @@ -103,7 +103,8 @@ init(Parent) -> end, mnesia_schema:purge_tmp_files(), - mnesia_recover:start_garb(), + mnesia_recover:next_garb(), + mnesia_recover:next_check_overload(), ?eval_debug_fun({?MODULE, init}, [{nodes, AllOthers}]), diff --git a/lib/odbc/c_src/odbcserver.c b/lib/odbc/c_src/odbcserver.c index fe81d1dd3a..4a7a5224e5 100644 --- a/lib/odbc/c_src/odbcserver.c +++ b/lib/odbc/c_src/odbcserver.c @@ -153,7 +153,7 @@ static db_result_msg db_describe_table(byte *sql, db_state *state); /* ------------- Encode/decode functions -------- ------------------------*/ static db_result_msg encode_empty_message(void); -static db_result_msg encode_error_message(char *reason); +static db_result_msg encode_error_message(char *reason, char *errCode, SQLINTEGER nativeError); static db_result_msg encode_atom_message(char *atom); static db_result_msg encode_result(db_state *state); static db_result_msg encode_result_set(SQLSMALLINT num_of_columns, @@ -230,7 +230,7 @@ static void init_param_statement(int cols, static void map_dec_num_2_c_column(col_type *type, int precision, int scale); -static db_result_msg map_sql_2_c_column(db_column* column); +static db_result_msg map_sql_2_c_column(db_column* column, db_state *state); static param_array * bind_parameter_arrays(byte *buffer, int *index, @@ -246,7 +246,7 @@ static db_result_msg retrive_scrollable_cursor_support_info(db_state static int num_out_params(int num_of_params, param_array* params); /* ------------- Error handling functions --------------------------------*/ -static diagnos get_diagnos(SQLSMALLINT handleType, SQLHANDLE handle); +static diagnos get_diagnos(SQLSMALLINT handleType, SQLHANDLE handle, Boolean extendedErrors); /* ------------- Boolean functions ---------------------------------------*/ @@ -349,7 +349,7 @@ DWORD WINAPI database_handler(const char *port) byte *request_buffer = NULL; db_state state = {NULL, NULL, NULL, NULL, 0, {NULL, 0, 0}, - FALSE, FALSE, FALSE, FALSE, FALSE, FALSE}; + FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE}; byte request_id; #ifdef WIN32 SOCKET socket; @@ -438,14 +438,16 @@ static db_result_msg db_connect(byte *args, db_state *state) diagnos diagnos; byte *connStrIn; int erl_auto_commit_mode, erl_trace_driver, - use_srollable_cursors, tuple_row_state, binary_strings; + use_srollable_cursors, tuple_row_state, binary_strings, + extended_errors; erl_auto_commit_mode = args[0]; erl_trace_driver = args[1]; use_srollable_cursors = args[2]; tuple_row_state = args[3]; binary_strings = args[4]; - connStrIn = args + 5 * sizeof(byte); + extended_errors = args[5]; + connStrIn = args + 6 * sizeof(byte); if(tuple_row_state == ON) { tuple_row(state) = TRUE; @@ -465,6 +467,12 @@ static db_result_msg db_connect(byte *args, db_state *state) use_srollable_cursors(state) = FALSE; } + if(extended_errors == ON) { + extended_errors(state) = TRUE; + } else { + extended_errors(state) = FALSE; + } + init_driver(erl_auto_commit_mode, erl_trace_driver, state); connlen = (SQLSMALLINT)strlen((const char*)connStrIn); @@ -475,10 +483,10 @@ static db_result_msg db_connect(byte *args, db_state *state) &stringlength2ptr, SQL_DRIVER_NOPROMPT); if (!sql_success(result)) { - diagnos = get_diagnos(SQL_HANDLE_DBC, connection_handle(state)); + diagnos = get_diagnos(SQL_HANDLE_DBC, connection_handle(state), extended_errors(state)); strcat((char *)diagnos.error_msg, " Connection to database failed."); - msg = encode_error_message(diagnos.error_msg); + msg = encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError ); if(!sql_success(SQLFreeHandle(SQL_HANDLE_DBC, connection_handle(state)))) @@ -509,8 +517,8 @@ static db_result_msg db_close_connection(db_state *state) result = SQLDisconnect(connection_handle(state)); if (!sql_success(result)) { - diagnos = get_diagnos(SQL_HANDLE_DBC, connection_handle(state)); - return encode_error_message(diagnos.error_msg); + diagnos = get_diagnos(SQL_HANDLE_DBC, connection_handle(state), extended_errors(state)); + return encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); } if(!sql_success(SQLFreeHandle(SQL_HANDLE_DBC, @@ -536,8 +544,8 @@ static db_result_msg db_end_tran(byte compleationtype, db_state *state) (SQLSMALLINT)compleationtype); if (!sql_success(result)) { - diagnos = get_diagnos(SQL_HANDLE_DBC, connection_handle(state)); - return encode_error_message(diagnos.error_msg); + diagnos = get_diagnos(SQL_HANDLE_DBC, connection_handle(state), extended_errors(state)); + return encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); } else { return encode_atom_message("ok"); } @@ -572,7 +580,7 @@ static db_result_msg db_query(byte *sql, db_state *state) /* SQL_SUCCESS_WITH_INFO at this point may indicate an error in user input. */ if (result != SQL_SUCCESS && result != SQL_NO_DATA_FOUND) { - diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state)); + diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); if(strcmp((char *)diagnos.sqlState, INFO) == 0) { is_error[0] = 0; strncat((char *)is_error, (char *)diagnos.error_msg, @@ -583,12 +591,12 @@ static db_result_msg db_query(byte *sql, db_state *state) it as we want a nice and clean Erlang API */ if((strcmp((char *)is_error, "error") == 0)) { - msg = encode_error_message((char *)diagnos.error_msg); + msg = encode_error_message((char *)diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); clean_state(state); return msg; } } else { - msg = encode_error_message((char *)diagnos.error_msg); + msg = encode_error_message((char *)diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); clean_state(state); return msg; } @@ -661,9 +669,9 @@ static db_result_msg db_select_count(byte *sql, db_state *state) } if(!sql_success(SQLExecDirect(statement_handle(state), sql, SQL_NTS))) { - diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state)); + diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); clean_state(state); - return encode_error_message(diagnos.error_msg); + return encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); } if(!sql_success(SQLNumResultCols(statement_handle(state), @@ -803,13 +811,13 @@ static db_result_msg db_param_query(byte *buffer, db_state *state) result = SQLExecDirect(statement_handle(state), sql, SQL_NTS); if (!sql_success(result) || result == SQL_NO_DATA) { - diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state)); + diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); } /* SQL_NO_DATA and SQLSTATE 00000 indicate success for updates/deletes that affect no rows */ if(!sql_success(result) && !(result == SQL_NO_DATA && !strcmp((char *)diagnos.sqlState, INFO))) { - msg = encode_error_message(diagnos.error_msg); + msg = encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); } else { for (i = 0; i < param_status.params_processed; i++) { switch (param_status.param_status_array[i]) { @@ -823,8 +831,8 @@ static db_result_msg db_param_query(byte *buffer, db_state *state) break; default: diagnos = - get_diagnos(SQL_HANDLE_STMT, statement_handle(state)); - msg = encode_error_message(diagnos.error_msg); + get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); + msg = encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); i = param_status.params_processed; break; } @@ -893,16 +901,16 @@ static db_result_msg db_describe_table(byte *sql, db_state *state) DO_EXIT(EXIT_ALLOC); if (!sql_success(SQLPrepare(statement_handle(state), sql, SQL_NTS))){ - diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state)); - msg = encode_error_message(diagnos.error_msg); + diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); + msg = encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); clean_state(state); return msg; } if(!sql_success(SQLNumResultCols(statement_handle(state), &num_of_columns))) { - diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state)); - msg = encode_error_message(diagnos.error_msg); + diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); + msg = encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); clean_state(state); return msg; } @@ -951,7 +959,7 @@ static db_result_msg encode_empty_message(void) } /* Description: Encode an error-message to send back to erlang*/ -static db_result_msg encode_error_message(char *reason) +static db_result_msg encode_error_message(char *reason, char *errCode, SQLINTEGER nativeError ) { int index; db_result_msg msg; @@ -960,6 +968,12 @@ static db_result_msg encode_error_message(char *reason) ei_encode_version(NULL, &index); ei_encode_tuple_header(NULL, &index, 2); ei_encode_atom(NULL, &index, "error"); + if (errCode) + { + ei_encode_tuple_header(NULL, &index, 3); + ei_encode_string(NULL, &index, errCode); + ei_encode_long(NULL, &index, nativeError); + } ei_encode_string(NULL, &index, reason); msg.length = index; @@ -970,6 +984,12 @@ static db_result_msg encode_error_message(char *reason) ei_encode_version((char *)msg.buffer, &index); ei_encode_tuple_header((char *)msg.buffer, &index, 2); ei_encode_atom((char *)msg.buffer, &index, "error"); + if (errCode) + { + ei_encode_tuple_header((char *)msg.buffer, &index, 3); + ei_encode_string((char *)msg.buffer, &index, errCode); + ei_encode_long((char *)msg.buffer, &index, nativeError); + } ei_encode_string((char *)msg.buffer, &index, reason); return msg; @@ -1013,8 +1033,8 @@ static db_result_msg encode_result(db_state *state) if(!sql_success(SQLNumResultCols(statement_handle(state), &num_of_columns))) { - diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state)); - msg = encode_error_message(diagnos.error_msg); + diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); + msg = encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); clean_state(state); return msg; } @@ -1030,8 +1050,8 @@ static db_result_msg encode_result(db_state *state) } if(!sql_success(SQLRowCount(statement_handle(state), &RowCountPtr))) { - diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state)); - msg = encode_error_message(diagnos.error_msg); + diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); + msg = encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); clean_state(state); return msg; } @@ -1239,7 +1259,7 @@ static db_result_msg encode_column_name_list(SQLSMALLINT num_of_columns, (columns(state)[i]).type.sql = sql_type; (columns(state)[i]).type.col_size = size; - msg = map_sql_2_c_column(&columns(state)[i]); + msg = map_sql_2_c_column(&columns(state)[i], state); if (msg.length > 0) { return msg; /* An error has occurred */ } else { @@ -2346,7 +2366,7 @@ static void map_dec_num_2_c_column(col_type *type, int precision, int scale) /* Description: Transform SQL columntype to C columntype. Returns a dummy db_result_msg with length 0 on success and an errormessage otherwise.*/ -static db_result_msg map_sql_2_c_column(db_column* column) +static db_result_msg map_sql_2_c_column(db_column* column, db_state *state) { db_result_msg msg; @@ -2415,10 +2435,10 @@ static db_result_msg map_sql_2_c_column(db_column* column) column -> type.strlen_or_indptr = (SQLLEN)NULL; break; case SQL_UNKNOWN_TYPE: - msg = encode_error_message("Unknown column type"); + msg = encode_error_message("Unknown column type", extended_error(state, ""), 0); break; default: - msg = encode_error_message("Column type not supported"); + msg = encode_error_message("Column type not supported", extended_error(state, ""), 0); break; } return msg; @@ -2527,7 +2547,7 @@ static db_column retrive_binary_data(db_column column, int column_nr, while (result == SQL_SUCCESS_WITH_INFO) { - diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state)); + diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); if(strcmp((char *)diagnos.sqlState, TRUNCATED) == 0) { outputlen = column.type.len - 1; @@ -2614,10 +2634,10 @@ static db_result_msg more_result_sets(db_state *state) /* As we found an error we do not care about any potential more result sets */ exists_more_result_sets(state) = FALSE; - diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state)); + diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); strcat((char *)diagnos.error_msg, "Failed to create on of the result sets"); - msg = encode_error_message(diagnos.error_msg); + msg = encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); return msg; } } @@ -2634,7 +2654,7 @@ static Boolean sql_success(SQLRETURN result) diagnostic records scaning for error messages and the sqlstate. If this function is called when no error has ocurred only the sqlState field may be referenced.*/ -static diagnos get_diagnos(SQLSMALLINT handleType, SQLHANDLE handle) +static diagnos get_diagnos(SQLSMALLINT handleType, SQLHANDLE handle, Boolean extendedErrors) { diagnos diagnos; SQLINTEGER nativeError; @@ -2658,17 +2678,16 @@ static diagnos get_diagnos(SQLSMALLINT handleType, SQLHANDLE handle) result = SQLGetDiagRec(handleType, handle, record_nr, current_sql_state, &nativeError, current_errmsg_pos, (SQLSMALLINT)errmsg_buffer_size, &errmsg_size); - if(result != SQL_SUCCESS && result != SQL_NO_DATA) { - - - break; - } else { + if(result == SQL_SUCCESS) { /* update the sqlstate in the diagnos record, because the SQLGetDiagRec call succeeded */ memcpy(diagnos.sqlState, current_sql_state, SQL_STATE_SIZE); + diagnos.nativeError = nativeError; errmsg_buffer_size = errmsg_buffer_size - errmsg_size; acc_errmsg_size = acc_errmsg_size + errmsg_size; current_errmsg_pos = current_errmsg_pos + errmsg_size; + } else { + break; } } @@ -2676,7 +2695,7 @@ static diagnos get_diagnos(SQLSMALLINT handleType, SQLHANDLE handle) strcat((char *)diagnos.error_msg, "No SQL-driver information available."); } - else { + else if (!extendedErrors){ strcat(strcat((char *)diagnos.error_msg, " SQLSTATE IS: "), (char *)diagnos.sqlState); } diff --git a/lib/odbc/c_src/odbcserver.h b/lib/odbc/c_src/odbcserver.h index a76cedf1af..71760189e7 100644 --- a/lib/odbc/c_src/odbcserver.h +++ b/lib/odbc/c_src/odbcserver.h @@ -145,6 +145,7 @@ typedef struct { typedef struct { SQLCHAR sqlState[SQL_STATE_SIZE]; + SQLINTEGER nativeError; byte error_msg[MAX_ERR_MSG]; } diagnos; @@ -179,6 +180,7 @@ typedef struct { Boolean exists_more_result_sets; Boolean param_query; Boolean out_params; + Boolean extended_errors; } db_state; typedef enum { @@ -198,3 +200,5 @@ typedef enum { #define exists_more_result_sets(db_state) (db_state -> exists_more_result_sets) #define param_query(db_state) (db_state -> param_query) #define out_params(db_state) (db_state -> out_params) +#define extended_errors(db_state) (db_state -> extended_errors) +#define extended_error(db_state, errorcode) ( extended_errors(state) ? errorcode : NULL ) diff --git a/lib/odbc/doc/src/odbc.xml b/lib/odbc/doc/src/odbc.xml index 8a58dc2848..0e3386b11f 100644 --- a/lib/odbc/doc/src/odbc.xml +++ b/lib/odbc/doc/src/odbc.xml @@ -74,8 +74,12 @@ <code type="none"> milliseconds() = integer() >= 0 </code> <code type="none"> - common_reason() = connection_closed | term() - some kind of - explanation of what went wrong </code> + common_reason() = connection_closed | extended_error() | term() - some kind of + explanation of what went wrong </code> + <code type="none"> + extended_error() = {string(), integer(), Reason} - extended error type with ODBC + and native database error codes, as well as the base reason that would have been + returned had extended_errors not been enabled. </code> <code type="none"> string() = list of ASCII characters </code> <code type="none"> @@ -143,7 +147,7 @@ <d>All options has default values. </d> <v>option() = {auto_commit, on | off} | {timeout, milliseconds()} | {binary_strings, on | off} | {tuple_row, on | off} | {scrollable_cursors, on | off} | - {trace_driver, on | off} </v> + {trace_driver, on | off} | {extended_errors, on | off} </v> <v>Ref = connection_reference() - should be used to access the connection. </v> <v>Reason = port_program_executable_not_found | common_reason()</v> </type> @@ -196,6 +200,19 @@ <p>For more information about the <c>ConnectStr</c> see description of the function SQLDriverConnect in [1].</p> </note> + + <p>The <c>extended_errors</c> option enables extended ODBC error + information when an operation fails. Rather than returning <c>{error, Reason}</c>, + the failing function will reutrn <c>{error, {ODBCErrorCode, NativeErrorCode, Reason}}</c>. + Note that this information is probably of little use when writing database-independent code, + but can be of assistance in providing more sophisticated error handling when dealing with + a known underlying database. + <list type="bulleted"> + <item><c>ODBCErrorCode</c> is the ODBC error string returned by the ODBC driver.</item> + <item><c>NativeErrorCode</c> is the numberic error code returned by the underlying database. The possible values + and their meanings are dependent on the database being used.</item> + <item><c>Reason</c> is as per the <c>Reason</c> field when extended errors are not enabled.</item> + </list></p> </desc> </func> <func> @@ -203,7 +220,7 @@ <fsummary>Closes a connection to a database. </fsummary> <type> <v>Ref = connection_reference()</v> - <v>Reason = process_not_owner_of_odbc_connection</v> + <v>Reason = process_not_owner_of_odbc_connection | extended_error()</v> </type> <desc> <p>Closes a connection to a database. This will also diff --git a/lib/odbc/src/odbc.erl b/lib/odbc/src/odbc.erl index 16fdb4aabd..3eabec9ec3 100644 --- a/lib/odbc/src/odbc.erl +++ b/lib/odbc/src/odbc.erl @@ -810,10 +810,11 @@ connect(ConnectionReferense, ConnectionStr, Options) -> {C_TupleRow, _} = connection_config(tuple_row, Options), {BinaryStrings, _} = connection_config(binary_strings, Options), + {ExtendedErrors, _} = connection_config(extended_errors, Options), ODBCCmd = [?OPEN_CONNECTION, C_AutoCommitMode, C_TraceDriver, - C_SrollableCursors, C_TupleRow, BinaryStrings, ConnectionStr], + C_SrollableCursors, C_TupleRow, BinaryStrings, ExtendedErrors, ConnectionStr], %% Send request, to open a database connection, to the control process. case call(ConnectionReferense, @@ -860,6 +861,8 @@ connection_default(trace_driver) -> connection_default(scrollable_cursors) -> {?ON, on}; connection_default(binary_strings) -> + {?OFF, off}; +connection_default(extended_errors) -> {?OFF, off}. %%------------------------------------------------------------------------- diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index a076c4dfff..7d732f20f7 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -51,7 +51,7 @@ all() -> {group, client_dies}, connect_timeout, timeout, many_timeouts, timeout_reset, disconnect_on_timeout, connection_closed, disable_scrollable_cursors, - return_rows_as_lists, api_missuse]; + return_rows_as_lists, api_missuse, extended_errors]; Other -> {skip, Other} end. @@ -838,3 +838,33 @@ transaction_support_str(mysql) -> "ENGINE = InnoDB"; transaction_support_str(_) -> "". + + +%%------------------------------------------------------------------------- +extended_errors(doc)-> + ["Test the extended errors connection option: When off; the old behaviour of just an error " + "string is returned on error. When on, the error string is replaced by a 3 element tuple " + "that also exposes underlying ODBC provider error codes."]; +extended_errors(suite) -> []; +extended_errors(Config) when is_list(Config)-> + Table = ?config(tableName, Config), + {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), + {updated, _} = odbc:sql_query(Ref, "create table " ++ Table ++" ( id integer, data varchar(10))"), + + % Error case WITHOUT extended errors on... + case odbc:sql_query(Ref, "create table " ++ Table ++" ( id integer, data varchar(10))") of + {error, ErrorString} when is_list(ErrorString) -> ok + end, + + % Now the test case with extended errors on - This should return a tuple, not a list/string now. + % The first element is a string that is the ODBC error string; the 2nd element is a native integer error + % code passed from the underlying provider driver. The last is the familiar old error string. + % We can't check the actual error code; as each different underlying provider will return + % a different value - So we just check the return types at least. + {ok, RefExtended} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options() ++ [{extended_errors, on}]), + case odbc:sql_query(RefExtended, "create table " ++ Table ++" ( id integer, data varchar(10))") of + {error, {ODBCCodeString, NativeCodeNum, ShortErrorString}} when is_list(ODBCCodeString), is_number(NativeCodeNum), is_list(ShortErrorString) -> ok + end, + + ok = odbc:disconnect(Ref), + ok = odbc:disconnect(RefExtended). diff --git a/lib/odbc/vsn.mk b/lib/odbc/vsn.mk index 3bb2fe5bce..585b92b2d2 100644 --- a/lib/odbc/vsn.mk +++ b/lib/odbc/vsn.mk @@ -1 +1 @@ -ODBC_VSN = 2.10.13 +ODBC_VSN = 2.10.14 diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index 01e99f3f5e..9498412505 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -83,7 +83,7 @@ get_table2(Parent, Table, Type) -> ets -> ets:info(Table, size); mnesia -> mnesia:table_info(Table, size) end, - case Size > 0 of + case Size =/= undefined andalso Size > 0 of false -> Parent ! {self(), '$end_of_table'}, normal; diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index e8b28998c1..29c4a0d168 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -1485,7 +1485,8 @@ mandatory_modules() -> preloaded() -> %% Sorted - [erl_prim_loader,erlang,init,otp_ring0,prim_file,prim_inet, prim_zip,zlib]. + [erl_prim_loader,erlang,erts_internal,init,otp_ring0,prim_file,prim_inet, + prim_zip,zlib]. %%______________________________________________________________________ %% Kernel processes; processes that are specially treated by the init diff --git a/lib/snmp/doc/src/snmpm.xml b/lib/snmp/doc/src/snmpm.xml index 8ab3be8e18..e6e188d5d5 100644 --- a/lib/snmp/doc/src/snmpm.xml +++ b/lib/snmp/doc/src/snmpm.xml @@ -367,7 +367,7 @@ sec_level = noAuthNoPriv | authNoPriv | authPriv <p>Update agent config. The function <c>update_agent_info/3</c> should be used when several values needs to be updated atomically. </p> <p>See function - <seealso marker="#register_agent">register_agent</seealso>) + <seealso marker="#register_agent">register_agent</seealso> for more info about what kind of items are allowed. </p> <marker id="which_agents"></marker> diff --git a/lib/ssh/doc/html/SSH_protocols.png b/lib/ssh/doc/html/SSH_protocols.png Binary files differnew file mode 100644 index 0000000000..145c96c4cd --- /dev/null +++ b/lib/ssh/doc/html/SSH_protocols.png diff --git a/lib/ssh/doc/man6/.gitignore b/lib/ssh/doc/man6/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/ssh/doc/man6/.gitignore diff --git a/lib/ssh/doc/src/Makefile b/lib/ssh/doc/src/Makefile index da99c4ea0f..0e79d9979f 100644 --- a/lib/ssh/doc/src/Makefile +++ b/lib/ssh/doc/src/Makefile @@ -37,21 +37,30 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = \ - ssh.xml \ +XML_REF3_FILES = ssh.xml \ ssh_channel.xml \ - ssh_connection.xml\ + ssh_connection.xml \ + ssh_client_key_api.xml \ + ssh_server_key_api.xml \ ssh_sftp.xml \ ssh_sftpd.xml \ -XML_PART_FILES = part_notes.xml -XML_CHAPTER_FILES = notes.xml +XML_REF6_FILES = ssh_app.xml + +XML_PART_FILES = part_notes.xml \ + usersguide.xml +XML_CHAPTER_FILES = notes.xml \ + introduction.xml \ + ssh_protocol.xml \ + using_ssh.xml BOOK_FILES = book.xml -XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ +XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES)\ $(XML_PART_FILES) $(XML_CHAPTER_FILES) +IMAGE_FILES = SSH_protocols.png + # ---------------------------------------------------- HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -62,10 +71,12 @@ EXTRA_FILES = \ $(DEFAULT_GIF_FILES) \ $(DEFAULT_HTML_FILES) \ $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ + $(XML_REF6_FILES:%.xml=$(HTMLDIR)/%.html) \ $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) +MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) HTML_REF_MAN_FILE = $(HTMLDIR)/index.html @@ -80,16 +91,19 @@ DVIPS_FLAGS += # ---------------------------------------------------- # Targets # ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif +$(HTMLDIR)/%.png: %.png $(INSTALL_DATA) $< $@ docs: pdf html man $(TOP_PDF_FILE): $(XML_FILES) +images: $(IMAGE_FILES:%=$(HTMLDIR)/%) + pdf: $(TOP_PDF_FILE) -html: $(HTML_REF_MAN_FILE) +html: images $(HTML_REF_MAN_FILE) + clean clean_docs: rm -rf $(HTMLDIR)/* @@ -97,7 +111,7 @@ clean clean_docs: rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ -man: $(MAN3_FILES) +man: $(MAN3_FILES) $(MAN6_FILES) debug opt: @@ -117,5 +131,8 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" + $(INSTALL_DIR) "$(RELEASE_PATH)/man/man6" + $(INSTALL_DATA) $(MAN6_FILES) "$(RELEASE_PATH)/man/man6" + release_spec: diff --git a/lib/ssh/doc/src/SSH_protocols.png b/lib/ssh/doc/src/SSH_protocols.png Binary files differnew file mode 100644 index 0000000000..145c96c4cd --- /dev/null +++ b/lib/ssh/doc/src/SSH_protocols.png diff --git a/lib/ssh/doc/src/book.xml b/lib/ssh/doc/src/book.xml index fcec1d6f70..3c2375f96d 100644 --- a/lib/ssh/doc/src/book.xml +++ b/lib/ssh/doc/src/book.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE book SYSTEM "book.dtd"> <book xmlns:xi="http://www.w3.org/2001/XInclude"> <header titlestyle="normal"> <copyright> - <year>2005</year><year>2010</year> + <year>2005</year><year>2012</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -34,6 +34,9 @@ <preamble> <contents level="2"></contents> </preamble> + <parts lift="yes"> + <xi:include href="usersguide.xml"/> + </parts> <applications> <xi:include href="ref_man.xml"/> </applications> diff --git a/lib/ssh/doc/src/fascicules.xml b/lib/ssh/doc/src/fascicules.xml index 43090b4aed..069d9002e0 100644 --- a/lib/ssh/doc/src/fascicules.xml +++ b/lib/ssh/doc/src/fascicules.xml @@ -1,7 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE fascicules SYSTEM "fascicules.dtd"> <fascicules> + <fascicule file="usersguide" href="usersguide_frame.html" entry="no"> + User's Guide + </fascicule> <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> Reference Manual </fascicule> diff --git a/lib/ssh/doc/src/introduction.xml b/lib/ssh/doc/src/introduction.xml new file mode 100644 index 0000000000..aac8de0f76 --- /dev/null +++ b/lib/ssh/doc/src/introduction.xml @@ -0,0 +1,54 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2012</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + 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. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + + <title>Introduction</title> + <prepared>OTP team</prepared> + <file>introduction.xml</file> + </header> + + <section> + <title>Purpose</title> + + <p>Secure Shell (SSH) is a protocol for secure remote login and + other secure network services over an insecure network. SSH + provides a single, full-duplex, byte-oriented connection between + client and server. The protocol also provides privacy, integrity, + server authentication and man-in-the-middle protection.</p> + + <p>The Erlang SSH application is an implementation of the SSH + protocol in Erlang which offers API functions to write customized + SSH clients and servers as well as making the Erlang shell + available via SSH. Also included in the SSH application are an + SFTP (SSH File Transfer Protocol) client <seealso + marker="ssh_sftp">ssh_sftp</seealso> and server <seealso + marker="ssh_sftp">ssh_sftpd</seealso>.</p> + </section> + + <section> + <title>Prerequisites</title> + <p>It is assumed that the reader is familiar with the concepts of <seealso marker="doc/design_principals:users_guide">OTP</seealso> + and has a basic understanding of <url href="http://en.wikipedia.org/wiki/Public-key_cryptography">public keys</url>.</p> + </section> + +</chapter> diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index d4acb2ef1a..e58d4e2c36 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> @@ -780,7 +780,7 @@ <list> <item> <p> - Ssh timeouts will now behave as expected e.i. defaults to + Ssh timeouts will now behave as expected i.e. defaults to infinity only the user of the ssh application can know of a reasonable timeout value for their application.</p> <p> @@ -833,7 +833,7 @@ caused the ssh daemon to close the connections to all currently logged in users if one user logged out. Another problem related to the supervision tree caused the closing - down of clients to leak processes e.i. all processes was + down of clients to leak processes i.e. all processes was not shutdown correctly.</p> <p> Own Id: OTP-7676</p> @@ -925,7 +925,7 @@ slightly changes the options to the API function ssh:daemon/[1,2,3] deprecating all no longer documented options. Note that the new API enforces the "logical way" - of using the old API e.i. making the subsystem process + of using the old API i.e. making the subsystem process part of the ssh applications supervisor tree, so missuses of the old API are not compatible with the new API.</p> <p> diff --git a/lib/ssh/doc/src/ref_man.xml b/lib/ssh/doc/src/ref_man.xml index 9ab56b28ec..88203b5034 100644 --- a/lib/ssh/doc/src/ref_man.xml +++ b/lib/ssh/doc/src/ref_man.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE application SYSTEM "application.dtd"> <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>2004</year><year>2010</year> + <year>2004</year><year>2012</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -22,19 +22,22 @@ </legalnotice> <title>SSH Reference Manual</title> - <prepared>Jakob Cederlund</prepared> - <docno></docno> + <prepared>OTP</prepared> <date>2007-10-06</date> <rev>%VSN%</rev> - <file>application.sgml</file> + <file>ref_man.xml</file> </header> <description> <p>The SSH application is an erlang implementation of the - secure shell protocol.</p> + secure shell protocol (SSH) as defined by RFC 4250 - 4254</p> + </description> + <xi:include href="ssh_app.xml"/> <xi:include href="ssh.xml"/> <xi:include href="ssh_channel.xml"/> <xi:include href="ssh_connection.xml"/> + <xi:include href="ssh_client_key_api.xml"/> + <xi:include href="ssh_server_key_api.xml"/> <xi:include href="ssh_sftp.xml"/> <xi:include href="ssh_sftpd.xml"/> </application> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index fb68a13648..a0afb5056e 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -22,13 +22,7 @@ </legalnotice> <title>ssh</title> - <prepared>Ingela Anderton Andin</prepared> - <responsible>Håkan Mattsson</responsible> - <docno></docno> - <approved>Håkan Mattsson</approved> - <checked></checked> <date>2007-10-06</date> - <rev>PA1</rev> </header> <module>ssh</module> <modulesummary>Main API of the SSH application</modulesummary> @@ -40,80 +34,85 @@ <title>SSH</title> <list type="bulleted"> - <item>ssh requires the crypto and public_key applications.</item> - <item>Supported SSH-version is 2.0 </item> - <item>Currently supports only a minimum of mac and encryption algorithms i.e. - hmac-sha1, and aes128-cb and 3des-cbc.</item> + <item>SSH requires the crypto and public_key applications.</item> + <item>Supported SSH version is 2.0 </item> + <item>Supported MAC algorithms: hmac-sha1</item> + <item>Supported encryption algorithms: aes128-cb and 3des-cbc</item> </list> </section> <section> - <title>COMMON DATA TYPES </title> + <title>DATA TYPES </title> <p>Type definitions that are used more than once in - this module:</p> + this module and/or abstractions to indicate the intended use of the data + type:</p> <p><c>boolean() = true | false </c></p> - <p><c>string() = list of ASCII characters</c></p> + <p><c>string() = [byte()]</c></p> <p><c>ssh_daemon_ref() - opaque to the user returned by ssh:daemon/[1,2,3]</c></p> <p><c>ssh_connection_ref() - opaque to the user returned by ssh:connect/3</c></p> <p><c>ip_address() - {N1,N2,N3,N4} % IPv4 | {K1,K2,K3,K4,K5,K6,K7,K8} % IPv6</c></p> - <p><c>subsystem_spec() = {subsystem_name(), {channel_callback(), channel_init_args()}} </c></p> + <p><c>subsystem_spec() = {subsystem_name(), + {channel_callback(), channel_init_args()}} </c></p> <p><c>subsystem_name() = string() </c></p> <p><c>channel_callback() = atom() - Name of the erlang module implementing the subsystem using the ssh_channel behavior see</c> <seealso marker="ssh_channel">ssh_channel(3)</seealso></p> <p><c>channel_init_args() = list()</c></p> </section> - + <funcs> <func> <name>close(ConnectionRef) -> ok </name> - <fsummary>Closes a ssh connection</fsummary> + <fsummary>Closes an SSH connection</fsummary> <type> <v>ConnectionRef = ssh_connection_ref()</v> </type> - <desc><p>Closes a ssh connection.</p> + <desc><p>Closes an SSH connection.</p> </desc> </func> <func> <name>connect(Host, Port, Options) -> </name> - <name>connect(Host, Port, Options, Timeout) -> {ok, ssh_connection_ref()} - | {error, Reason}</name> + <name>connect(Host, Port, Options, Timeout) -> {ok, + ssh_connection_ref()} | {error, Reason}</name> <fsummary>Connect to an ssh server.</fsummary> <type> <v>Host = string()</v> <v>Port = integer()</v> - <d>The default is <c><![CDATA[22]]></c>, the registered port for SSH.</d> + <d>The default is <c><![CDATA[22]]></c>, the assigned well known port + number for SSH.</d> <v>Options = [{Option, Value}]</v> <v>Timeout = infinity | integer(milliseconds)</v> </type> <desc> - <p>Connects to an SSH server. No channel is started this is done + <p>Connects to an SSH server. No channel is started. This is done by calling ssh_connect:session_channel/2.</p> <p>Options are:</p> <taglist> <tag><c><![CDATA[{user_dir, string()}]]></c></tag> <item> - <p>Sets the user directory e.i. the directory containing + <p>Sets the user directory i.e. the directory containing ssh configuration files for the user such as - <c><![CDATA[known_hosts]]></c>, <c><![CDATA[id_rsa, id_dsa]]></c> and - <c><![CDATA[authorized_key]]></c>. Defaults to the directory normally - referred to as <c><![CDATA[~/.ssh]]></c> </p> + <c><![CDATA[known_hosts]]></c>, <c><![CDATA[id_rsa, + id_dsa]]></c> and + <c><![CDATA[authorized_key]]></c>. Defaults to the + directory normally referred to as + <c><![CDATA[~/.ssh]]></c> </p> </item> <tag><c><![CDATA[{dsa_pass_phrase, string()}]]></c></tag> <item> - <p>If the user dsa key is protected by a pass phrase it can be + <p>If the user dsa key is protected by a passphrase it can be supplied with this option. </p> </item> <tag><c><![CDATA[{rsa_pass_phrase, string()}]]></c></tag> <item> - <p>If the user rsa key is protected by a pass phrase it can be + <p>If the user rsa key is protected by a passphrase it can be supplied with this option. </p> </item> @@ -135,25 +134,26 @@ password. Do note that it may not always be desirable to use those options from a security point of view.</p> </item> - <tag><c><![CDATA[{public_key_alg, ssh_rsa | ssh_dsa}]]></c></tag> + <tag><c><![CDATA[{public_key_alg, 'ssh-rsa' | 'ssh-dss'}]]></c></tag> <item> <p>Sets the preferred public key algorithm to use for user - authentication. If the the preferred algorithm fails of + 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> </item> <tag><c><![CDATA[{pref_public_key_algs, list()}]]></c></tag> <item> - <p>List of public key algorithms to try to use, ssh_rsa and ssh_dsa available. - Will override <c><![CDATA[{public_key_alg, ssh_rsa | ssh_dsa}]]></c></p> + <p>List of public key algorithms to try to use, 'ssh-rsa' and 'ssh-dss' available. + Will override <c><![CDATA[{public_key_alg, 'ssh-rsa' | 'ssh-dss'}]]></c></p> </item> <tag><c><![CDATA[{connect_timeout, timeout()}]]></c></tag> <item> - <p>Sets a timeout on the transport layer connection. Defaults to infinity.</p> + <p>Sets a timeout on the transport layer + connection. Defaults to <c>infinity</c>.</p> </item> - <tag><c><![CDATA[{user, String}]]></c></tag> + <tag><c><![CDATA[{user, string()}]]></c></tag> <item> - <p>Provide a user name. If this option is not given, ssh + <p>Provides a user name. If this option is not given, ssh reads from the environment (<c><![CDATA[LOGNAME]]></c> or <c><![CDATA[USER]]></c> on unix, <c><![CDATA[USERNAME]]></c> on Windows).</p> @@ -165,23 +165,11 @@ password if the password authentication method is attempted.</p> </item> - <tag><c><![CDATA[{user_auth, Fun/3}]]></c></tag> - <item> - <p>Provide a fun for password authentication. The fun - will be called as <c><![CDATA[fun(User, Password, Opts)]]></c> and - should return <c><![CDATA[true]]></c> or <c><![CDATA[false]]></c>.</p> - </item> - <tag><c><![CDATA[{key_cb, atom() = KeyCallbackModule}]]></c></tag> + <tag><c><![CDATA[{key_cb, atom()}]]></c></tag> <item> - <p>Provide a special call-back module for key handling. - The call-back module should be modeled after the - <c><![CDATA[ssh_file]]></c> module. The functions that must - be exported are: - <c><![CDATA[private_host_rsa_key/2]]></c>, - <c><![CDATA[private_host_dsa_key/2]]></c>, - <c><![CDATA[lookup_host_key/3]]></c> and - <c><![CDATA[add_host_key/3]]></c>. This is considered - somewhat experimental and will be better documented later on.</p> + <p>Module implementing the behaviour <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso>. + Can be used to customize the handling of public keys. + </p> </item> <tag><c><![CDATA[{quiet_mode, atom() = boolean()}]]></c></tag> <item> @@ -189,9 +177,9 @@ </item> <tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag> <item> - <p>Allow an existing file-descriptor to be used + <p>Allow an existing file descriptor to be used (simply passed on to the transport protocol).</p></item> - <tag><c><![CDATA[{ip_v6_disabled, boolean()}]]></c></tag> + <tag><c><![CDATA[{ipv6_disabled, boolean()}]]></c></tag> <item> <p>Determines if SSH shall use IPv6 or not.</p> </item> @@ -205,7 +193,8 @@ </func> <func> - <name>connection_info(ConnectionRef, [Option]) ->[{Option, Value}] </name> + <name>connection_info(ConnectionRef, [Option]) ->[{Option, + Value}] </name> <fsummary> Retrieves information about a connection. </fsummary> <type> <v>Option = client_version | server_version | peer</v> @@ -220,7 +209,8 @@ <func> <name>daemon(Port) -> </name> <name>daemon(Port, Options) -> </name> - <name>daemon(HostAddress, Port, Options) -> ssh_daemon_ref()</name> + <name>daemon(HostAddress, Port, Options) -> {ok, + ssh_daemon_ref()} | {error, atom()}</name> <fsummary>Starts a server listening for SSH connections on the given port.</fsummary> <type> @@ -231,30 +221,32 @@ <v>Value = term()</v> </type> <desc> - <p>Starts a server listening for SSH connections on the given port.</p> - - <p>Options are:</p> + <p>Starts a server listening for SSH connections on the given + port.</p> + <p>Options are:</p> <taglist> <tag><c><![CDATA[{subsystems, [subsystem_spec()]]]></c></tag> <item> - Provides specifications for handling of subsystems. The - "sftp" subsystem-spec can be retrieved by calling - ssh_sftpd:subsystem_spec/1. If the subsystems option in not present - the value of <c>[ssh_sftpd:subsystem_spec([])]</c> will be used. - It is of course possible to set the option to the empty list - if you do not want the daemon to run any subsystems at all. + Provides specifications for handling of subsystems. The + "sftp" subsystem spec can be retrieved by calling + ssh_sftpd:subsystem_spec/1. If the subsystems option in + not present the value of + <c>[ssh_sftpd:subsystem_spec([])]</c> will be used. It is + of course possible to set the option to the empty list if + you do not want the daemon to run any subsystems at all. </item> - <tag><c><![CDATA[{shell, {Module, Function, Args} | fun(string() = User) - > pid() | - fun(string() = User, ip_address() = PeerAddr) -> pid()}]]></c></tag> + <tag><c><![CDATA[{shell, {Module, Function, Args} | + fun(string() = User) - > pid() | fun(string() = User, + ip_address() = PeerAddr) -> pid()}]]></c></tag> <item> - Defines the read-eval-print loop used when a shell is requested - by the client. Example use the - erlang shell: <c><![CDATA[{shell, start, []}]]></c> which is - the default behavior. + Defines the read-eval-print loop used when a shell is + requested by the client. Default is to use the erlang shell: + <c><![CDATA[{shell, start, []}]]></c> </item> - <tag><c><![CDATA[{ssh_cli,{channel_callback(), channel_init_args()}}]]></c></tag> + <tag><c><![CDATA[{ssh_cli,{channel_callback(), + channel_init_args()}}]]></c></tag> <item> - Provide your own cli implementation, e.i. a channel callback + Provides your own cli implementation, i.e. a channel callback module that implements a shell and command execution. Note that you may customize the shell read-eval-print loop using the option <c>shell</c> which is much less work than implementing @@ -262,27 +254,30 @@ </item> <tag><c><![CDATA[{user_dir, String}]]></c></tag> <item> - <p>Sets the user directory e.i. the directory containing + <p>Sets the user directory i.e. the directory containing ssh configuration files for the user such as - <c><![CDATA[known_hosts]]></c>, <c><![CDATA[id_rsa, id_dsa]]></c> and - <c><![CDATA[authorized_key]]></c>. Defaults to the directory normally - referred to as <c><![CDATA[~/.ssh]]></c> </p> + <c><![CDATA[known_hosts]]></c>, <c><![CDATA[id_rsa, + id_dsa]]></c> and + <c><![CDATA[authorized_key]]></c>. Defaults to the + directory normally referred to as + <c><![CDATA[~/.ssh]]></c> </p> </item> <tag><c><![CDATA[{system_dir, string()}]]></c></tag> <item> - <p>Sets the system directory, containing the host files - that identifies the host for ssh. The default is - <c><![CDATA[/etc/ssh]]></c>, note that SSH normally - requires the host files there to be readable only by - root.</p> + <p>Sets the system directory, containing the host key files + that identifies the host keys for ssh. The default is + <c><![CDATA[/etc/ssh]]></c>, note that for security reasons + this directory is normally only accessible by the root user.</p> </item> <tag><c><![CDATA[{auth_methods, string()}]]></c></tag> <item> - <p>Comma separated string that determines which authentication methodes that the server - should support and in what order they will be tried. Defaults to + <p>Comma separated string that determines which + authentication methodes that the server should support and + in what order they will be tried. Defaults to <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p> </item> - <tag><c><![CDATA[{user_passwords, [{string() = User, string() = Password}]}]]></c></tag> + <tag><c><![CDATA[{user_passwords, [{string() = User, + string() = Password}]}]]></c></tag> <item> <p>Provide passwords for password authentication.They will be used when someone tries to connect to the server and @@ -296,13 +291,19 @@ user. From a security perspective this option makes the server very vulnerable.</p> </item> - <tag><c><![CDATA[{pwdfun, fun/2}]]></c></tag> + <tag><c><![CDATA[{pwdfun, fun(User::string(), password::string() -> boolean()}]]></c></tag> <item> <p>Provide a function for password validation. This is called with user and password as strings, and should return <c><![CDATA[true]]></c> if the password is valid and <c><![CDATA[false]]></c> otherwise.</p> </item> + <tag><c><![CDATA[{key_cb, atom()}]]></c></tag> + <item> + <p>Module implementing the behaviour <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. + Can be used to customize the handling of public keys. + </p> + </item> <tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag> <item> <p>Allow an existing file-descriptor to be used @@ -311,6 +312,18 @@ <item> <p>Determines if SSH shall use IPv6 or not (only used when HostAddress is set to any).</p></item> + <tag><c><![CDATA[{failfun, fun()}]]></c></tag> + <item> + <p>Provide a fun() to implement your own logging when a user fails to authenticate.</p> + </item> + <tag><c><![CDATA[{connectfun, fun()}]]></c></tag> + <item> + <p>Provide a fun() to implement your own logging when a user authenticates to the server.</p> + </item> + <tag><c><![CDATA[{disconnectfun, fun()}]]></c></tag> + <item> + <p>Provide a fun() to implement your own logging when a user disconnects from the server.</p> + </item> </taglist> </desc> </func> @@ -326,9 +339,9 @@ <v> Options - see ssh:connect/3</v> </type> <desc> - <p>Starts an interactive shell to an SSH server on the + <p>Starts an interactive shell via an SSH server on the given <c>Host</c>. The function waits for user input, - and will not return until the remote shell is ended (e.g. on + and will not return until the remote shell is ended (i.e. exit from the shell). </p> </desc> @@ -337,25 +350,24 @@ <func> <name>start() -> </name> <name>start(Type) -> ok | {error, Reason}</name> - <fsummary>Starts the Ssh application. </fsummary> + <fsummary>Starts the SSH application. </fsummary> <type> <v>Type = permanent | transient | temporary</v> <v>Reason = term() </v> </type> <desc> - <p>Starts the Ssh application. Default type - is temporary. See also - <seealso marker="kernel:application">application(3)</seealso> - Requires that the crypto application has been started. + <p>Utility function that starts crypto, public_key and the SSH + application. Defult type is temporary. + See also <seealso marker="kernel:application">application(3)</seealso> </p> </desc> </func> <func> <name>stop() -> ok </name> - <fsummary>Stops the Ssh application.</fsummary> + <fsummary>Stops the SSH application.</fsummary> <desc> - <p>Stops the Ssh application. See also + <p>Stops the SSH application. See also <seealso marker="kernel:application">application(3)</seealso></p> </desc> </func> diff --git a/lib/ssh/doc/src/ssh_app.xml b/lib/ssh/doc/src/ssh_app.xml new file mode 100644 index 0000000000..c01f44936a --- /dev/null +++ b/lib/ssh/doc/src/ssh_app.xml @@ -0,0 +1,100 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE appref SYSTEM "appref.dtd"> + +<appref> + <header> + <copyright> + <year>2012</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>SSH</title> + <file>ssh_app.xml</file> + </header> + <app>SSH</app> + <appsummary>The ssh application implements the SSH (Secure Shell) protocol and + provides an SFTP (SSH File Transfer Protocol) client and server. </appsummary> + + <section> + <title>DEPENDENCIES</title> + <p>The ssh application uses the Erlang applications public_key and + crypto to handle public keys and encryption, hence these + applications needs to be loaded for the ssh application to work. In + an embedded environment that means they need to be started with + application:start/[1,2] before the ssh application is started. + </p> + </section> + + <section> + <title>CONFIGURATION</title> + + <p>The ssh application does not currently have an application + specific configuration file as described in application(3), + however it will by default use the following configuration files + from openssh: known_hosts, authorized_keys, authorized_keys2, + id_dsa and id_rsa, ssh_host_dsa_key and ssh_host_rsa_key. By + default Erlang SSH will look for id_dsa, id_rsa, known_hosts + and authorized_keys in ~/.ssh, and the host key files in /etc/ssh + . These locations may be changed by the options user_dir and + system_dir. Public key handling may also be customized by + providing a callback module implementing the behaviors + <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> and + <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. + </p> + + <section> + <title>PUBLIC KEYS</title> + <p> + id_dsa and id_rsa are the users private key files, note that + the public key is part of the private key so the ssh + application will not use the id_<*>.pub files. These are + for the users convenience when he/she needs to convey their + public key. + </p> + </section> + + <section> + <title>KNOW HOSTS</title> + <p>The known_hosts file contains a list of approved servers and + their public keys. Once a server is listed, it can be verified + without user interaction. + </p> + </section> + + <section> + <title>AUTHORIZED KEYS</title> + <p>The authorized key file keeps track of the user's authorized + public keys. The most common use of this file is to let users + log in without entering their password which is supported by the + Erlang SSH daemon. + </p> + </section> + + <section> + <title>HOST KEYS</title> + <p>Currently rsa and dsa host keys are supported and are + expected to be found in files named ssh_host_rsa_key and + ssh_host_dsa_key. + </p> + </section> + </section> + + <section> + <title>SEE ALSO</title> + <p>application(3)</p> + </section> + +</appref> diff --git a/lib/ssh/doc/src/ssh_channel.xml b/lib/ssh/doc/src/ssh_channel.xml index c2b7aa94a5..f0083ae8d1 100644 --- a/lib/ssh/doc/src/ssh_channel.xml +++ b/lib/ssh/doc/src/ssh_channel.xml @@ -1,11 +1,11 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> <header> <copyright> <year>2009</year> - <year>2009</year> + <year>2012</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -22,31 +22,35 @@ The Initial Developer of the Original Code is Ericsson AB. </legalnotice> - <title>ssh_channel</title> - <prepared>Ingela Anderton Andin</prepared> - <responsible></responsible> - <docno></docno> - <approved></approved> - <checked></checked> - <date></date> - <rev></rev> </header> <module>ssh_channel</module> - <modulesummary>Generic Ssh Channel Behavior + <modulesummary>-behaviour(ssh_channel). </modulesummary> <description> - <p>Ssh services are implemented as channels that are multiplexed - over an ssh connection and communicates via the ssh connection - protocol. This module provides a callback API that takes care of - generic channel aspects such as flow control and close messages - and lets the callback functions take care of the service specific - parts. + <p>SSH services (clients and servers) are implemented as channels + that are multiplexed over an SSH connection and communicates via + the <url href="http://www.ietf.org/rfc/rfc4254.txt"> SSH + Connection Protocol </url>. This module provides a callback API + that takes care of generic channel aspects such as flow control + and close messages and lets the callback functions take care of + the service (application) specific parts. This behavior also ensures + that the channel process honors the principal of an OTP-process so + that it can be part of a supervisor tree. This is a requirement of + channel processes implementing a subsystem that will be added to + the SSH applications supervisor tree. </p> + + <note> When implementing a SSH subsystem use the + <c>-behaviour(ssh_subsystem).</c> instead of <c>-behaviour(ssh_channel).</c> + as the only relevant callback functions for subsystems are + init/1, handle_ssh_msg/2, handle_msg/2 and terminate/2, so the ssh_subsystem + behaviour is limited version of the ssh_channel behaviour. + </note> </description> <section> - <title>COMMON DATA TYPES </title> + <title>DATA TYPES </title> <p>Type definitions that are used more than once in this module and/or abstractions to indicate the intended use of the data @@ -56,10 +60,10 @@ <p><c>string() = list of ASCII characters</c></p> <p><c>timeout() = infinity | integer() - in milliseconds.</c></p> <p><c>ssh_connection_ref() - opaque to the user returned by - ssh:connect/3 or sent to a ssh channel process</c></p> + ssh:connect/3 or sent to an SSH channel process</c></p> <p><c>ssh_channel_id() = integer() </c></p> <p><c>ssh_data_type_code() = 1 ("stderr") | 0 ("normal") are - currently valid values see RFC 4254 section 5.2.</c></p> + currently valid values see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254 </url> section 5.2.</c></p> </section> <funcs> @@ -74,13 +78,15 @@ <v>Timeout = timeout() </v> <v>Reply = term() </v> <v>Reason = closed | timeout </v> + </type> <desc> <p>Makes a synchronous call to the channel process by sending a message and waiting until a reply arrives or a timeout - occurs. The channel will call - <c>CallbackModule:handle_call/3</c> to handle the message. - If the channel process does not exist <c>{error, closed}</c> is returned. + occurs. The channel will call <seealso mark = + "#Module:handle_call-3">Module:handle_call/3</seealso> + to handle the message. If the channel process does not exist + <c>{error, closed}</c> is returned. </p> </desc> </func> @@ -98,26 +104,27 @@ <p>Sends an asynchronous message to the channel process and returns ok immediately, ignoring if the destination node or channel process does not exist. The channel will call - <c>CallbackModule:handle_cast/2</c> to handle the message. + <seealso mark = "#Module:handle_cast-3">Module:handle_cast/2</seealso> + to handle the message. </p> </desc> </func> <func> <name>enter_loop(State) -> _ </name> - <fsummary> Makes an existing process into a ssh_channel process. </fsummary> + <fsummary> Makes an existing process an ssh_channel process. </fsummary> <type> - <v> State = term() - as returned by ssh_channel:init/1</v> + <v> State = term() - as returned by <seealso mark = "#init-1">ssh_channel:init/1</seealso></v> </type> <desc> - <p> Makes an existing process into a <c>ssh_channel</c> + <p> Makes an existing process an <c>ssh_channel</c> process. Does not return, instead the calling process will - enter the <c>ssh_channel</c> process receive loop and become a + enter the <c>ssh_channel</c> process receive loop and become an <c>ssh_channel process.</c> The process must have been started using one of the start functions in proc_lib, see <seealso marker="stdlib:proc_lib">proc_lib(3)</seealso>. The user is responsible for any initialization of the process - and needs to call ssh_channel:init/1. + and needs to call <seealso mark = "#init-1">ssh_channel:init/1</seealso> </p> </desc> </func> @@ -126,7 +133,10 @@ <name>init(Options) -> {ok, State} | {ok, State, Timeout} | {stop, Reason} </name> <fsummary> Initiates a ssh_channel process.</fsummary> <type> - <v> Options = [{Option, Value}]</v> + <v>Options = [{Option, Value}]</v> + <v>State = term()</v> + <v>Timeout = timeout() </v> + <v>Reason = term() </v> </type> <desc> <p> @@ -134,24 +144,27 @@ </p> <taglist> <tag><c><![CDATA[{channel_cb, atom()}]]></c></tag> - <item>The module that implements the channel behavior.</item> + <item>The module that implements the channel behaviour.</item> <tag><c><![CDATA[{init_args(), list()}]]></c></tag> - <item> The list of arguments to the callback modules + <item> The list of arguments to the callback module's init function.</item> <tag><c><![CDATA[{cm, connection_ref()}]]></c></tag> - <item> Reference to the ssh connection.</item> + <item> Reference to the ssh connection as returned by <seealso + marker="ssh#connect-3">ssh:connect/3</seealso></item> <tag><c><![CDATA[{channel_id, channel_id()}]]></c></tag> <item> Id of the ssh channel.</item> </taglist> - <note><p>This function is normally not called by the user, it is - only needed if for some reason the channel process needs - to be started with help of <c>proc_lib</c> instead calling - <c>ssh_channel:start/4</c> or <c>ssh_channel:start_link/4</c> </p> + <note><p>This function is normally not called by the + user. The user only needs to call if for some reason the + channel process needs to be started with help of + <c>proc_lib</c> instead of calling + <c>ssh_channel:start/4</c> or + <c>ssh_channel:start_link/4</c> </p> </note> </desc> </func> @@ -167,12 +180,12 @@ <p>This function can be used by a channel to explicitly send a reply to a client that called <c>call/[2,3]</c> when the reply cannot be defined in the return value of - <c>CallbackModule:handle_call/3</c>.</p> + <seealso marker ="#Module:handle_call-3">Module:handle_call/3</seealso>.</p> <p><c>Client</c> must be the <c>From</c> argument provided to the callback function <c>handle_call/3</c>. <c>Reply</c> is an arbitrary term, - which will be given back to the client as the return value of - <c>ssh_channel:call/[2,3].</c></p> + which will be given back to the client as the return value of + <seealso marker="#call-2">ssh_channel:call/[2,3].</seealso>></p> </desc> </func> @@ -180,11 +193,12 @@ <name>start(SshConnection, ChannelId, ChannelCb, CbInitArgs) -> </name> <name>start_link(SshConnection, ChannelId, ChannelCb, CbInitArgs) -> {ok, ChannelRef} | {error, Reason}</name> - <fsummary> Starts a processes that handles a ssh channel. </fsummary> + <fsummary> Starts a processes that handles a SSH channel. </fsummary> <type> <v>SshConnection = ssh_connection_ref()</v> <v>ChannelId = ssh_channel_id() </v> - <d> As returned by ssh_connection:session_channel/[2,4]</d> + <d> As returned by cannot be defined in the return value of + <seealso marker ="ssh_connection#session_channel/2">ssh_connection:session_channel/[2,4]</seealso></d> <v>ChannelCb = atom()</v> <d> The name of the module implementing the service specific parts of the channel.</d> @@ -193,10 +207,10 @@ <v>ChannelRef = pid()</v> </type> <desc> - <p>Starts a processes that handles a ssh channel. Will be - called internally by the ssh daemon or explicitly by the ssh - client implementations. A channel process traps exit signals - by default. + <p>Starts a processes that handles an SSH channel. It will be + called internally by the SSH daemon or explicitly by the SSH + client implementations. The behavior will set the + <c>trap_exit</c> flag to true. </p> </desc> </func> @@ -204,72 +218,61 @@ </funcs> <section> - <title>CALLBACK FUNCTIONS</title> - - <p>The functions init/1, terminate/2, handle_ssh_msg/2 and - handle_msg/2 are the functions that are required to provide the - implementation for a server side channel, such as a ssh subsystem - channel that can be plugged into the erlang ssh daemon see - <seealso marker="ssh">ssh:daemon/[2, 3]</seealso>. The - handle_call/3, handle_cast/2 code_change/3 and enter_loop/1 - functions are only relevant when implementing a client side - channel.</p> - </section> - - <section> <marker id="cb_timeouts"></marker> <title> CALLBACK TIMEOUTS</title> - <p> If an integer timeout value is provided in a return value of - one of the callback functions, a timeout will occur unless a - message is received within <c>Timeout</c> milliseconds. A timeout - is represented by the atom <c>timeout</c> which should be handled - by the <seealso marker="#handle_msg">handle_msg/2</seealso> - callback function. The atom infinity can be used to wait - indefinitely, this is the default value. </p> + + <p>The timeout values that may be returned by the callback functions + has the same semantics as in a <seealso marker="stdlib#gen_server">gen_server</seealso> + If the timeout occurs <seealso marker="#handle_msg">handle_msg/2</seealso> + will be called as <c>handle_msg(timeout, State). </c></p> </section> <funcs> <func> - <name>CallbackModule:code_change(OldVsn, State, Extra) -> {ok, + <name>Module:code_change(OldVsn, State, Extra) -> {ok, NewState}</name> <fsummary> Converts process state when code is changed.</fsummary> <type> - <v> Converts process state when code is changed.</v> + <v>OldVsn = term()</v> + <d>In the case of an upgrade, <c>OldVsn</c> is <c>Vsn</c>, and + in the case of a downgrade, <c>OldVsn</c> is + <c>{down,Vsn}</c>. <c>Vsn</c> is defined by the <c>vsn</c> + attribute(s) of the old version of the callback module + <c>Module</c>. If no such attribute is defined, the version is + the checksum of the BEAM file.</d> + <v>State = term()</v> + <d>The internal state of the channel.</d> + <v>Extra = term()</v> + <d>Passed as-is from the <c>{advanced,Extra}</c> + part of the update instruction.</d> </type> <desc> - <p>This function is called by a client side channel when it - should update its internal state during a release - upgrade/downgrade, i.e. when the instruction - <c>{update,Module,Change,...}</c> where - <c>Change={advanced,Extra}</c> is given in the <c>appup</c> - file. See <seealso - marker="doc/design_principles:release_handling#instr">OTP - Design Principles</seealso> for more information. Any new - connection will benefit from a server side upgrade but - already started connections on the server side will not be - affected. - </p> + <p> Converts process state when code is changed.</p> + + <p>This function is called by a client side channel when it + should update its internal state during a release + upgrade/downgrade, i.e. when the instruction + <c>{update,Module,Change,...}</c> where + <c>Change={advanced,Extra}</c> is given in the <c>appup</c> + file. See <seealso marker="doc/design_principles:release_handling#instr">OTP + Design Principles</seealso> for more information. + </p> - <note><p>If there are long lived ssh connections and more - than one upgrade in a short time this may cause the old - connections to fail as only two versions of the code may - be loaded simultaneously.</p></note> + <note><p>Soft upgrade according to the OTP release concept + is not straight forward for the server side, as subsystem + channel processes are spawned by the SSH application and + hence added to its supervisor tree. It could be possible to + upgrade the subsystem channels, when upgrading the user + application, if the callback functions can handle two + versions of the state, but this function can not be used in + the normal way.</p> + </note> - <p>In the case of an upgrade, <c>OldVsn</c> is <c>Vsn</c>, and - in the case of a downgrade, <c>OldVsn</c> is - <c>{down,Vsn}</c>. <c>Vsn</c> is defined by the <c>vsn</c> - attribute(s) of the old version of the callback module - <c>Module</c>. If no such attribute is defined, the version - is the checksum of the BEAM file.</p> - <p><c>State</c> is the internal state of the channel.</p> - <p><c>Extra</c> is passed as-is from the <c>{advanced,Extra}</c> - part of the update instruction.</p> - <p>The function should return the updated internal state.</p> </desc> </func> <func> - <name>CallbackModule:init(Args) -> {ok, State} | {ok, State, Timeout} | + <name>Module:init(Args) -> {ok, State} | {ok, State, timeout()} | {stop, Reason}</name> <fsummary> Makes necessary initializations and returns the initial channel state if the initializations succeed.</fsummary> @@ -277,7 +280,6 @@ <v> Args = term() </v> <d> Last argument to ssh_channel:start_link/4.</d> <v> State = term() </v> - <v>Timeout = timeout() </v> <v> Reason = term() </v> </type> <desc> @@ -290,7 +292,7 @@ </func> <func> - <name>CallbackModule:handle_call(Msg, From, State) -> Result</name> + <name>Module:handle_call(Msg, From, State) -> Result</name> <fsummary> Handles messages sent by calling <c>ssh_channel:call/[2,3]</c></fsummary> <type> @@ -298,17 +300,16 @@ <v>From = opaque to the user should be used as argument to ssh_channel:reply/2</v> <v>State = term()</v> - <v>Result = {reply, Reply, NewState} | {reply, Reply, NewState, Timeout} - | {noreply, NewState} | {noreply , NewState, Timeout} + <v>Result = {reply, Reply, NewState} | {reply, Reply, NewState, timeout()} + | {noreply, NewState} | {noreply , NewState, timeout()} | {stop, Reason, Reply, NewState} | {stop, Reason, NewState} </v> <v>Reply = term() - will be the return value of ssh_channel:call/[2,3]</v> - <v>Timeout = timeout() </v> - <v>NewState = term() - a possible updated version of State</v> + <v>NewState = term()</v> <v>Reason = term()</v> </type> <desc> <p>Handles messages sent by calling - <c>ssh_channel:call/[2,3]</c> + <seealso marker="#call-2">ssh_channel:call/[2,3]</seealso> </p> <p>For more detailed information on timeouts see the section <seealso marker="#cb_timeouts">CALLBACK TIMEOUTS</seealso>. </p> @@ -316,16 +317,15 @@ </func> <func> - <name>CallbackModule:handle_cast(Msg, State) -> Result</name> + <name>Module:handle_cast(Msg, State) -> Result</name> <fsummary> Handles messages sent by calling <c>ssh_channel:cact/2</c></fsummary> <type> <v>Msg = term()</v> <v>State = term()</v> - <v>Result = {noreply, NewState} | {noreply, NewState, Timeout} + <v>Result = {noreply, NewState} | {noreply, NewState, timeout()} | {stop, Reason, NewState}</v> - <v>NewState = term() - a possible updated version of State</v> - <v>Timeout = timeout() </v> + <v>NewState = term() </v> <v>Reason = term()</v> </type> <desc> @@ -339,7 +339,7 @@ </func> <func> - <name>CallbackModule:handle_msg(Msg, State) -> {ok, State} | + <name>Module:handle_msg(Msg, State) -> {ok, State} | {stop, ChannelId, State}</name> <fsummary> Handle other messages than ssh connection protocol, @@ -359,136 +359,37 @@ <taglist> <tag><c><![CDATA[{ssh_channel_up, ssh_channel_id(), ssh_connection_ref()}]]></c></tag> - <item>This is the first messages that will be received - by the channel, it is sent just before - the ssh_channel:init/1 function returns successfully. - This is especially useful if the server wants - to send a message to the client without first receiving - a message from the client. If the message is not useful - for your particular problem just ignore it by immediately - returning {ok, State}. + <item>This is the first messages that will be received by + the channel, it is sent just before the <seealso + marker="#init-2">ssh_channel:init/1</seealso> function + returns successfully. This is especially useful if the + server wants to send a message to the client without first + receiving a message from it. If the message is not + useful for your particular scenario just ignore it by + immediately returning {ok, State}. </item> </taglist> </desc> </func> <func> - <name>CallbackModule:handle_ssh_msg(Msg, State) -> {ok, State} | {stop, + <name>Module:handle_ssh_msg(Msg, State) -> {ok, State} | {stop, ssh_channel_id(), State}</name> <fsummary> Handles ssh connection protocol messages. </fsummary> <type> - <v>Msg = {ssh_cm, ssh_connection_ref(), SshMsg}</v> - <v> SshMsg = tuple() - see message list below</v> + <v>Msg = <seealso marker="ssh_connection"> ssh_connection:event() </seealso> </v> <v>State = term()</v> </type> <desc> <p> Handles ssh connection protocol messages that may need service specific attention. </p> - - <p> All channels should handle the following messages. For - channels implementing subsystems the handle_ssh_msg-callback - will not be called for any other messages. </p> - - <taglist> - <tag><c><![CDATA[{ssh_cm, ssh_connection_ref(), {data, ssh_channel_id(), - ssh_data_type_code(), binary() = Data}}]]></c></tag> - <item> Data has arrived on the channel. When the callback - for this message returns the channel behavior will adjust - the ssh flow control window.</item> - - <tag><c><![CDATA[{ssh_cm, ssh_connection_ref(), {eof, - ssh_channel_id()}}]]></c></tag> - <item>Indicteas that the other side will not send any more - data.</item> - - <tag><c><![CDATA[{ssh_cm, ssh_connection_ref(), {signal, - ssh_channel_id(), ssh_signal()}} ]]></c></tag> - <item>A signal can be delivered to the remote - process/service using the following message. Some systems - may not implement signals, in which case they should ignore - this message.</item> - - <tag><c><![CDATA[{ssh_cm, ssh_connection_ref(), - {exit_signal, ssh_channel_id(), string() = exit_signal, - string() = ErrorMsg, string() = - LanguageString}}]]></c></tag> - <item>A remote execution may terminate violently due to a - signal then this message may be received. For details on valid string - values see RFC 4254 section 6.10</item> - - <tag><c><![CDATA[{ssh_cm, ssh_connection_ref(), {exit_status, - ssh_channel_id(), integer() = ExitStatus}}]]></c></tag> - <item> When the command running at the other end terminates, - the following message can be sent to return the exit status - of the command. A zero 'exit_status' usually means that the - command terminated successfully.</item> - </taglist> - - <p> Channels implementing a shell and command execution on the server side - should also handle the following messages. </p> - - <taglist> - <tag><c><![CDATA[{ssh_cm, ssh_connection_ref(), {env, ssh_channel_id(), - boolean() = WantReply, string() = Var, string() = Value}}]]></c></tag> - <item> Environment variables may be passed to the - shell/command to be started later. Note that before the - callback returns it should call the function - ssh_connection:reply_request/4 with the boolean value of <c> - WantReply</c> as the second argument. - </item> - - <tag><c><![CDATA[{ssh_cm, ConnectionRef, {exec, ssh_channel_id(), - boolean() = WantReply, string() = Cmd}}]]></c></tag> - <item> This message will request that the server start the - execution of the given command. Note that before the - callback returns it should call the function - ssh_connection:reply_request/4 with the boolean value of <c> - WantReply</c> as the second argument.</item> - - <tag><c><![CDATA[{ssh_cm, ssh_connection_ref(), {pty, ssh_channel_id(), - boolean() = WantReply, {string() = Terminal, integer() = CharWidth, - integer() = RowHeight, integer() = PixelWidth, integer() = PixelHight, - [{atom() | integer() = Opcode, - integer() = Value}] = TerminalModes}}}]]></c></tag> - <item>A pseudo-terminal has been requested for the - session. Terminal is the value of the TERM environment - variable value (e.g., vt100). Zero dimension parameters must - be ignored. The character/row dimensions override the pixel - dimensions (when nonzero). Pixel dimensions refer to the - drawable area of the window. The <c>Opcode</c> in the - <c>TerminalModes</c> list is the mnemonic name, represented - as an lowercase erlang atom, defined in RFC 4254 section 8, - or the opcode if the mnemonic name is not listed in the - RFC. Example <c>OP code: 53, mnemonic name ECHO erlang atom: - echo</c>. Note that before the callback returns it should - call the function ssh_connection:reply_request/4 with the - boolean value of <c> WantReply</c> as the second - argument.</item> - - <tag><c><![CDATA[{ssh_cm, ConnectionRef, {shell, boolean() = - WantReply}}]]></c></tag> - <item> This message will request that the user's default - shell be started at the other end. Note that before the - callback returns it should call the function - ssh_connection:reply_request/4 with the value of <c> - WantReply</c> as the second argument. - </item> - - <tag><c><![CDATA[ {ssh_cm, ssh_connection_ref(), {window_change, - ssh_channel_id(), integer() = CharWidth, integer() = RowHeight, - integer() = PixWidth, integer() = PixHeight}}]]></c></tag> - <item> When the window (terminal) size changes on the client - side, it MAY send a message to the other side to inform it - of the new dimensions.</item> - </taglist> <p> The following message is completely taken care of by the ssh channel behavior</p> <taglist> - <tag><c><![CDATA[{ssh_cm, ssh_connection_ref(), {closed, - ssh_channel_id()}}]]></c></tag> + <tag><c><![CDATA[{closed, ssh_channel_id()}]]></c></tag> <item> The channel behavior will send a close message to the other side if such a message has not already been sent and then terminate the channel with reason normal.</item> @@ -497,7 +398,7 @@ </func> <func> - <name>CallbackModule:terminate(Reason, State) -> _</name> + <name>Module:terminate(Reason, State) -> _</name> <fsummary> </fsummary> <type> <v>Reason = term()</v> @@ -505,12 +406,12 @@ </type> <desc> <p>This function is called by a channel process when it is - about to terminate. Before this function is called ssh_connection:close/2 - will be called if it has not been called earlier. - This function should be the opposite of <c>CallbackModule:init/1</c> - and do any necessary cleaning up. When it returns, the - channel process terminates with reason <c>Reason</c>. The return value is - ignored. + about to terminate. Before this function is called <seealso + marker="ssh_connection#close-2"> ssh_connection:close/2 + </seealso> will be called if it has not been called earlier. + This function should do any necessary cleaning + up. When it returns, the channel process terminates with + reason <c>Reason</c>. The return value is ignored. </p> </desc> </func> diff --git a/lib/ssh/doc/src/ssh_client_key_api.xml b/lib/ssh/doc/src/ssh_client_key_api.xml new file mode 100644 index 0000000000..abc1070e78 --- /dev/null +++ b/lib/ssh/doc/src/ssh_client_key_api.xml @@ -0,0 +1,124 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2012</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + 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. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + <title>ssh_client_key_api</title> + </header> + <module>ssh_client_key_api</module> + <modulesummary> + -behaviour(ssh_client_key_api). + </modulesummary> + <description> + <p> Behavior describing the API for an SSH client's public key handling. + By implementing the callbacks defined. + in this behavior it is possible to customize the SSH client'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> + </description> + + <section> + <title>DATA TYPES </title> + + <p>Type definitions that are used more than once in this module + and/or abstractions to indicate the intended use of the data + type:</p> + + <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> + + </section> + + <funcs> + <func> + <name>Module:add_host_key(HostNames, Key, ConnectOptions) -> ok | {error, Reason}</name> + <fsummary>Adds a host key to the set of trusted host keys</fsummary> + <type> + <v>HostNames = string()</v> + <d>Description of the host that owns the <c>PublicKey</c></d> + + <v>Key = public_key() </v> + <d> Normally an RSA or DSA public key but handling of other public keys can be added</d> + + <v>ConnectOptions = proplists:proplist() </v> + <d>Options provided to <seealso marker="ssh#daemon">ssh:connect/[3,4]</seealso></d> + <v>Reason = term() </v> + </type> + <desc> + <p> Adds a host key to the set of trusted host keys</p> + </desc> + </func> + + <func> + <name>Module:is_host_key(Key, Host, Algorithm, ConnectOptions) -> Result</name> + <fsummary>Checks if a host key is trusted</fsummary> + <type> + <v>Key = public_key() </v> + <d> Normally an RSA or DSA public key but handling of other public keys can be added</d> + + <v>Host = string()</v> + <d>Description of the host</d> + + <v>Algorithm = public_key_algorithm()</v> + <d> Host key algorithm. Should support 'ssh-rsa'| 'ssh-dss' but additional algorithms + can be handled.</d> + + <v> ConnectOptions = proplists:proplist() </v> + <d>Options provided to <seealso marker="ssh#daemon">ssh:connect/[3,4]</seealso></d> + + <v> Result = boolean()</v> + </type> + <desc> + <p>Checks if a host key is trusted</p> + </desc> + </func> + + <func> + <name>Module:user_key(Algorithm, ConnectOptions) -> + {ok, PrivateKey} | {error, Reason}</name> + <fsummary>Fetches the users "public key" matching the <c>Algorithm</c>.</fsummary> + <type> + <v>Algorithm = public_key_algorithm()</v> + <d> Host key algorithm. Should support 'ssh-rsa'| 'ssh-dss' but additional algorithms + can be handled.</d> + + <v> ConnectOptions = proplists:proplist() </v> + <d>Options provided to <seealso marker="ssh#daemon">ssh:connect/[3,4]</seealso></d> + + <v> PrivateKey = private_key()</v> + <d> The private key of the user matching the <c>Algorithm</c></d> + + <v>Reason = term() </v> + </type> + + <desc> + <p>Fetches the users "public key" matching the <c>Algorithm</c>. + <note>The private key contains the public key</note> + </p> + </desc> + </func> + + </funcs> + +</erlref> diff --git a/lib/ssh/doc/src/ssh_connection.xml b/lib/ssh/doc/src/ssh_connection.xml index a9ae13d556..c66622307f 100644 --- a/lib/ssh/doc/src/ssh_connection.xml +++ b/lib/ssh/doc/src/ssh_connection.xml @@ -1,11 +1,11 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> <header> <copyright> <year>2008</year> - <year>2011</year> + <year>2012</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -24,69 +24,178 @@ </legalnotice> <title>ssh_connection</title> - <prepared>Ingela Anderton Andin</prepared> - <responsible></responsible> - <docno></docno> - <approved></approved> - <checked></checked> <date></date> - <rev></rev> </header> <module>ssh_connection</module> - <modulesummary>This module provides an API to the ssh connection protocol. + <modulesummary>This module provides API functions to send <url href="http://www.ietf.org/rfc/rfc4254.txt"> SSH Connection Protocol </url> + events to the other side of an SSH channel. </modulesummary> + <description> - <p>This module provides an API to the ssh connection protocol. - Not all features of the connection protocol are officially supported yet. - Only the ones supported are documented here.</p> + <p>The SSH Connection Protocol is used by clients and servers + (i.e. SSH channels) to communicate over the SSH connection. The + API functions in this module sends SSH Connection Protocol events + that are received as messages by the remote channel. + In the case that the receiving channel is an Erlang process the + message will be on the following format + <c><![CDATA[{ssh_cm, ssh_connection_ref(), ssh_event_msg()}]]></c>. If the <seealso + marker="ssh_channel">ssh_channel</seealso> behavior is used to + implement the channel process these will be handled by + <seealso + marker="ssh_channel#CallbackModule:handled_ssh_msg-2">handle_ssh_msg/2 </seealso>.</p> </description> - <section> - <title>COMMON DATA TYPES </title> + <section> + <title>DATA TYPES </title> + <p>Type definitions that are used more than once in this module and/or abstractions to indicate the intended use of the data type:</p> - + <p><c>boolean() = true | false </c></p> <p><c>string() = list of ASCII characters</c></p> <p><c>timeout() = infinity | integer() - in milliseconds.</c></p> <p><c>ssh_connection_ref() - opaque to the user returned by - ssh:connect/3 or sent to a ssh channel processes</c></p> + ssh:connect/3 or sent to an SSH channel processes</c></p> <p><c>ssh_channel_id() = integer() </c></p> <p><c>ssh_data_type_code() = 1 ("stderr") | 0 ("normal") are - currently valid values see RFC 4254 section 5.2.</c></p> + currently valid values see</c> <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254 </url> section 5.2.</p> <p><c>ssh_request_status() = success | failure</c></p> - </section> + <p><c>event() = {ssh_cm, ssh_connection_ref(), ssh_event_msg()} </c></p> + <p><c>ssh_event_msg() = data_events() | status_events() | terminal_events() </c></p> + + <taglist> + <tag><b>data_events()</b></tag> + <item> + <taglist> + <tag><c><![CDATA[{data, ssh_channel_id(), ssh_data_type_code(), binary() = Data}]]></c></tag> + <item> Data has arrived on the channel. This event is sent as + result of calling <seealso marker="#send-3"> ssh_connection:send/[3,4,5] </seealso></item> + + <tag><c><![CDATA[{eof, ssh_channel_id()}]]></c></tag> + <item>Indicates that the other side will not send any more + data. This event is sent as result of calling <seealso + marker="#send_eof-2"> ssh_connection:send_eof/2</seealso> + </item> + </taglist> + </item> + + <tag><b>status_events()</b></tag> + <item> + + <taglist> + <tag><c><![CDATA[{signal, ssh_channel_id(), ssh_signal()}]]></c></tag> + <item>A signal can be delivered to the remote process/service + using the following message. Some systems will not support + signals, in which case they should ignore this message. There is + currently no funtion to generate this event as the signals + refered to are on OS-level and not something generated by an + Erlang program.</item> + + <tag><c><![CDATA[{exit_signal, ssh_channel_id(), string() = ExitSignal, string() = ErrorMsg, + string() = LanguageString}]]></c></tag> + + <item>A remote execution may terminate violently due to a signal + then this message may be received. For details on valid string + values see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url> section 6.10. Special case of the signals + mentioned above.</item> + + <tag><c><![CDATA[{exit_status, ssh_channel_id(), integer() = ExitStatus}]]></c></tag> + <item> When the command running at the other end terminates, the + following message can be sent to return the exit status of the + command. A zero 'exit_status' usually means that the command + terminated successfully. This event is sent as result of calling + <seealso marker="#exit_status"> + ssh_connection:exit_status/3</seealso></item> + + <tag><c><![CDATA[{closed, ssh_channel_id()}]]></c></tag> + <item> This event is sent as result of calling + <seealso marker="#close">ssh_connection:close/2</seealso> Both the handling of this + event and sending of it will be taken care of by the + <seealso marker="ssh_channel">ssh_channel</seealso> behavior.</item> + + </taglist> + </item> - <section> - <title>MESSAGES SENT TO CHANNEL PROCESSES</title> + <tag><b>terminal_events()</b></tag> + + <item> + <p> Channels implementing a shell and command execution on the + server side should handle the following messages that may be sent by client channel processes. </p> + + <p><note>Events that includes a <c> WantReply</c> expects the event handling + process to call <seealso marker="#reply_request">ssh_connection:reply_request/4</seealso> + with the boolean value of <c> WantReply</c> as the second + argument. </note> </p> + + <taglist> + <tag><c><![CDATA[{env, ssh_channel_id(), boolean() = WantReply, + string() = Var, string() = Value}]]></c></tag> + <item> Environment variables may be passed to the shell/command + to be started later. This event is sent as result of calling <seealso + marker="#setenv"> ssh_connection:setenv/5</seealso> + </item> + + <tag><c><![CDATA[{pty, ssh_channel_id(), + boolean() = WantReply, {string() = Terminal, integer() = CharWidth, + integer() = RowHeight, integer() = PixelWidth, integer() = PixelHight, + [{atom() | integer() = Opcode, + integer() = Value}] = TerminalModes}}]]></c></tag> + <item>A pseudo-terminal has been requested for the + session. Terminal is the value of the TERM environment + variable value (e.g., vt100). Zero dimension parameters must + be ignored. The character/row dimensions override the pixel + dimensions (when nonzero). Pixel dimensions refer to the + drawable area of the window. The <c>Opcode</c> in the + <c>TerminalModes</c> list is the mnemonic name, represented + as an lowercase erlang atom, defined in + <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254 </url> section 8, + or the opcode if the mnemonic name is not listed in the + RFC. Example <c>OP code: 53, mnemonic name ECHO erlang atom: + echo</c>. There is currently no API function to generate this + event.</item> + + <tag><c><![CDATA[{shell, boolean() = WantReply}]]></c></tag> + <item> This message will request that the user's default shell + be started at the other end. This event is sent as result of calling <seealso + marker="#shell"> ssh_connection:shell/2</seealso> + </item> + + <tag><c><![CDATA[{window_change, ssh_channel_id(), integer() = CharWidth, + integer() = RowHeight, integer() = PixWidth, integer() = PixHeight}]]></c></tag> + <item> When the window (terminal) size changes on the client + side, it MAY send a message to the server side to inform it of + the new dimensions. There is currently no API function to generate this + event.</item> - <p>As a result of the ssh connection protocol messages on the form - <c><![CDATA[{ssh_cm, ssh_connection_ref(), term()}]]></c> - will be sent to a channel process. The term will contain - information regarding the ssh connection protocol event, - for details see the ssh channel behavior callback <seealso - marker="ssh_channel">handle_ssh_msg/2 </seealso> </p> - </section> - - <funcs> + <tag><c><![CDATA[{exec, ssh_channel_id(), + boolean() = WantReply, string() = Cmd}]]></c></tag> + <item> This message will request that the server starts + execution of the given command. This event is sent as result of calling <seealso + marker="#exec">ssh_connection:exec/4 </seealso> + </item> + </taglist> + </item> + </taglist> + </section> + + <funcs> <func> <name>adjust_window(ConnectionRef, ChannelId, NumOfBytes) -> ok</name> - <fsummary>Adjusts the ssh flowcontrol window. </fsummary> + <fsummary>Adjusts the SSH flowcontrol window. </fsummary> <type> <v> ConnectionRef = ssh_connection_ref() </v> <v> ChannelId = ssh_channel_id() </v> <v> NumOfBytes = integer()</v> </type> <desc> - <p>Adjusts the ssh flowcontrol window. </p> + <p>Adjusts the SSH flowcontrol window. This shall be done by both client and server side channel processes.</p> - <note><p>This will be taken care of by the ssh_channel - behavior when the callback <seealso marker="ssh_channel"> - handle_ssh_msg/2 </seealso> has returned after processing a - {ssh_cm, ssh_connection_ref(), {data, ssh_channel_id(), - ssh_data_type_code(), binary()}} - message, and should normally not be called explicitly.</p></note> + <note><p>Channels implemented with the <seealso marker="ssh_channel"> ssh_channel + behavior</seealso> will normaly not need to call this function as flow control + will be handled by the behavior. The behavior will adjust the window every time + the callback <seealso marker="ssh_channel#handled_ssh_msg-2"> + handle_ssh_msg/2 </seealso> has returned after processing channel data</p> </note> </desc> </func> @@ -98,20 +207,19 @@ <v> ChannelId = ssh_channel_id()</v> </type> <desc> - <p>Sends a close message on the channel <c>ChannelId</c> + <p>A server or client channel process can choose to close their session by sending a close event. </p> - <note><p>This function will be called by the ssh channel + <note><p>This function will be called by the ssh_channel behavior when the channel is terminated see <seealso - marker="ssh_channel"> ssh_channel(3) </seealso> and should - normally not be called explicitly.</p></note> + marker="ssh_channel"> ssh_channel(3) </seealso> so channels implemented with the + behavior should not call this function explicitly.</p></note> </desc> </func> <func> <name>exec(ConnectionRef, ChannelId, Command, TimeOut) -> ssh_request_status() </name> - <fsummary>Will request that the server start the - execution of the given command. </fsummary> + <fsummary>Request that the server start the execution of the given command. </fsummary> <type> <v> ConnectionRef = ssh_connection_ref() </v> <v> ChannelId = ssh_channel_id()</v> @@ -119,44 +227,39 @@ <v>Timeout = timeout() </v> </type> <desc> - <p>Will request that the server start the execution of the - given command, the result will be received as:</p> + <p>Should be called by a client channel process to request that the server starts execution of the + given command, the result will be several messages according to the following pattern. Note + that the last message will be a channel close message, as the exec request is a one time + execution that closes the channel when it is done.</p> <taglist> - <tag><c> N X {ssh_cm, - ssh_connection_ref(), {data, ssh_channel_id(), ssh_data_type_code(), - binary() = Data}} </c></tag> + <tag><c> N x {ssh_cm, ssh_connection_ref(), + {data, ssh_channel_id(), ssh_data_type_code(), binary() = Data}} </c></tag> <item>The result of executing the command may be only one line or thousands of lines depending on the command.</item> - <tag><c> 1 X {ssh_cm, ssh_connection_ref(), {eof, ssh_channel_id()}}</c></tag> + <tag><c>0 or 1 x {ssh_cm, ssh_connection_ref(), {eof, ssh_channel_id()}}</c></tag> <item>Indicates that no more data will be sent.</item> - <tag><c>0 or 1 X {ssh_cm, + <tag><c>0 or 1 x {ssh_cm, ssh_connection_ref(), {exit_signal, ssh_channel_id(), string() = ExitSignal, string() = ErrorMsg, string() = LanguageString}}</c></tag> <item>Not all systems send signals. For details on valid string values see RFC 4254 section 6.10 </item> - <tag><c>0 or 1 X {ssh_cm, ssh_connection_ref(), {exit_status, + <tag><c>0 or 1 x {ssh_cm, ssh_connection_ref(), {exit_status, ssh_channel_id(), integer() = ExitStatus}}</c></tag> <item>It is recommended by the <c>ssh connection protocol</c> that this message shall be sent, but that may not always be the case.</item> - <tag><c> 1 X {ssh_cm, ssh_connection_ref(), + <tag><c> 1 x {ssh_cm, ssh_connection_ref(), {closed, ssh_channel_id()}}</c></tag> <item>Indicates that the ssh channel started for the execution of the command has now been shutdown.</item> </taglist> - - <p> These message should be handled by the - client. The <seealso marker="ssh_channel">ssh channel - behavior</seealso> can be used when writing a client. - </p> </desc> </func> - <func> <name>exit_status(ConnectionRef, ChannelId, Status) -> ok</name> <fsummary>Sends the exit status of a command to the client.</fsummary> @@ -166,12 +269,12 @@ <v> Status = integer()</v> </type> <desc> - <p>Sends the exit status of a command to the client.</p> + <p>Should be called by a server channel process to sends the exit status of a command to the client.</p> </desc> - </func> + </func> <func> - <name>reply_request(ConnectionRef, WantReply, Status, CannelId) -> ok</name> + <name>reply_request(ConnectionRef, WantReply, Status, ChannelId) -> ok</name> <fsummary>Send status replies to requests that want such replies. </fsummary> <type> <v> ConnectionRef = ssh_connection_ref() </v> @@ -183,10 +286,9 @@ <p>Sends status replies to requests where the requester has stated that they want a status report e.i .<c> WantReply = true</c>, if <c> WantReply</c> is false calling this function will be a - "noop". Should be called after handling an ssh connection + "noop". Should be called while handling an ssh connection protocol message containing a <c>WantReply</c> boolean - value. See the ssh_channel behavior callback <seealso - marker="ssh_channel"> handle_ssh_msg/2 </seealso> + value. </p> </desc> </func> @@ -206,7 +308,7 @@ <v> Timeout = timeout()</v> </type> <desc> - <p>Sends channel data. + <p>Should be called by client- and server channel processes to send data to each other. </p> </desc> </func> @@ -228,9 +330,7 @@ <name>session_channel(ConnectionRef, Timeout) -> </name> <name>session_channel(ConnectionRef, InitialWindowSize, MaxPacketSize, Timeout) -> {ok, ssh_channel_id()} | {error, Reason}</name> - <fsummary>Opens a channel for a ssh session. A session is a - remote execution of a program. The program may be a shell, an - application, a system command, or some built-in subsystem. </fsummary> + <fsummary>Opens a channel for a ssh session. </fsummary> <type> <v> ConnectionRef = ssh_connection_ref()</v> <v> InitialWindowSize = integer() </v> @@ -239,9 +339,8 @@ <v> Reason = term() </v> </type> <desc> - <p>Opens a channel for a ssh session. A session is a - remote execution of a program. The program may be a shell, an - application, a system command, or some built-in subsystem. + <p>Opens a channel for an SSH session. The channel id returned from this function + is the id used as input to the other funtions in this module. </p> </desc> </func> @@ -258,8 +357,8 @@ <v> Timeout = timeout()</v> </type> <desc> - <p> Environment variables may be passed to the shell/command to be - started later. + <p> Environment variables may be passed before starting the + shell/command. Should be called by a client channel processes. </p> </desc> </func> @@ -267,17 +366,16 @@ <func> <name>shell(ConnectionRef, ChannelId) -> ssh_request_status() </name> - <fsummary> Will request that the user's default shell (typically - defined in /etc/passwd in UNIX systems) be started at the other + <fsummary> Requests that the user's default shell (typically + defined in /etc/passwd in UNIX systems) shall be executed at the server end. </fsummary> <type> <v> ConnectionRef = ssh_connection_ref() </v> <v> ChannelId = ssh_channel_id()</v> </type> <desc> - <p> Will request that the user's default shell (typically - defined in /etc/passwd in UNIX systems) be started at the - other end. + <p> Should be called by a client channel process to request that the user's default shell (typically + defined in /etc/passwd in UNIX systems) shall be executed at the server end. </p> </desc> </func> @@ -292,7 +390,7 @@ <v> Timeout = timeout()</v> </type> <desc> - <p> Sends a request to execute a predefined subsystem. + <p> Should be called by a client channel process for requesting to execute a predefined subsystem on the server. </p> </desc> </func> diff --git a/lib/ssh/doc/src/ssh_protocol.xml b/lib/ssh/doc/src/ssh_protocol.xml new file mode 100644 index 0000000000..6a253c43eb --- /dev/null +++ b/lib/ssh/doc/src/ssh_protocol.xml @@ -0,0 +1,150 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> +<!-- %EricssonCopyright% --> +<chapter> + <header> + <copyright> + <year>2012</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The program may be used and/or copied only with the written permission from + Ericsson AB, or in accordance with the terms and conditions stipulated in + the agreement/contract under which the program has been supplied. + </legalnotice> + <title>Secure Shell (SSH)</title> + <prepared>OTP</prepared> + <date></date> + <rev>%VSN%</rev> + <file>ssh_protocol.xml</file> + </header> + + <section> + <title>SSH Protocol Overview</title> + + <p> Conceptually the SSH protocol can be partitioned into four + layers:</p> + + <image file="SSH_protocols.png"> + <icaption>SSH Protocol Architecture</icaption> + </image> + + <section> + <title>Transport Protocol</title> + + <p> The SSH Transport Protocol is a secure, low level transport. + It provides strong encryption, cryptographic host + authentication and integrity protection. Currently, only a + minimum of MAC- (message authentication code, a short piece of + information used to authenticate a message) and encryption + algorithms are supported see <seealso marker="ssh">ssh(3)</seealso> + </p> + </section> + + <section> + <title>Authentication Protocol</title> + + <p>The SSH authentication protocol is a general-purpose user + authentication protocol run over the SSH transport + protocol. Erlang SSH supports user authentication using public + key technology (RSA and DSA, X509-certificates are currently not + supported). It is also possible to use a so called keyboard + interactive authentication. This method is suitable for + interactive authentication methods that do not need any special + software support on the client side. Instead, all authentication + data should be entered via the keyboard. It is also possible + to use a pure password based authentication scheme, note that in + this case the the plain text password will be encrypted before sent + over the network. There are several configuration options for + authentication handling available in + <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso> + and <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso> + It is also possible to customize the public key handling + by implementing the behaviours <seealso + marker="ssh_client_key_api">ssh_client_key_api</seealso> and + <seealso + marker="ssh_server_key_api">ssh_server_key_api</seealso> + </p> + </section> + + <section> + <title>Connection Protocol</title> + + <p>The SSH Connection Protocol provides application-support + services over the transport pipe, such as channel multiplexing, + flow control, remote program execution, signal propagation, + connection forwarding, etc. Functions for handling the SSH + Connection Protocol can be found in the module <seealso + marker="ssh_connection">ssh_connection</seealso>. + </p> + </section> + + <section> + <title>Channels</title> + + <p>All terminal sessions, forwarded connections etc., are + channels. Multiple channels are multiplexed into a single + connection, and all channels are flow-controlled. Typically an + SSH client will open a channel, send data/commands, receive + data/"control information" and when it is done close the + channel. The <seealso + marker="ssh_channel">ssh_channel</seealso> behaviour makes it easy to + write your own SSH client/server processes that use flow + control. It handles generic parts of SSH channel management and + lets you focus on the application logic. + </p> + + <p>Channels comes in three flavors</p> + + <list type="bulleted"> + <item><em>Subsystem</em> - named services that can be run as + part of an SSH server such as SFTP <seealso + marker="ssh_sftpd">ssh_sftpd</seealso>, that is built in to the + SSH daemon (server) by default but may be disabled. The Erlang SSH + daemon may be configured to run any Erlang + implemented SSH subsystem. + </item> + <item><em>Shell</em> - interactive shell. By default the + Erlang daemon will run the Erlang shell. It is + possible to customize the shell by providing your own + read-eval-print loop. It is also possible, but much more work, + to provide your own CLI (Command Line Interface) implementation. + </item> + <item><em>Exec</em> - one-time remote execution (like + SCP). See <seealso + marker="ssh_connection#exec-4">ssh_connection:exec/4</seealso></item> + </list> + </section> + + <p>Channels are flow controlled. No data may be sent to a channel + peer until a message is received to indicate that window space is + available. The 'initial window size' specifies how many bytes of + channel data that can be sent to the channel peer without adjusting the + window. + </p> + + <p> + For more detailed information about the SSH protocol, see the + following RFCs: + </p> + + <list type="bulleted"> + <item><url href="http://www.ietf.org/rfc/rfc4250.txt">RFC 4250</url> - + Protocol Assigned Numbers.</item> + <item><url href="http://www.ietf.org/rfc/rfc4251.txt">RFC 4251</url> - + Protocol Architecture.</item> + <item><url href="http://www.ietf.org/rfc/rfc4252.txt">RFC 4252</url> - + Authentication Protocol.</item> + <item><url href="http://www.ietf.org/rfc/rfc4253.txt">RFC 4253</url> - + Transport Layer Protocol.</item> + <item><url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url> - + Connection Protocol.</item> + <item><url href="http://www.ietf.org/rfc/rfc4255.txt">RFC 4255</url> - + Key Fingerprints.</item> + <item><url href="http://www.ietf.org/rfc/rfc4344.txt">RFC 4344</url> - + Transport Layer Encryption Modes.</item> + <item><url href="http://www.ietf.org/rfc/rfc4716.txt">RFC 4716</url> - + Public Key File Format.</item> + </list> + </section> +</chapter> diff --git a/lib/ssh/doc/src/ssh_server_key_api.xml b/lib/ssh/doc/src/ssh_server_key_api.xml new file mode 100644 index 0000000000..78ff105387 --- /dev/null +++ b/lib/ssh/doc/src/ssh_server_key_api.xml @@ -0,0 +1,90 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2012</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + 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. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + <title>ssh_server_key_api</title> + </header> + <module>ssh_server_key_api</module> + <modulesummary> + -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 + 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> + </description> + + <section> + <title>DATA TYPES </title> + + <p>Type definitions that are used more than once in this module + and/or abstractions to indicate the intended use of the data + type:</p> + + <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> + </section> + + <funcs> + <func> + <name>Module:host_key(Algorithm, DaemonOptions) -> + {ok, Key} | {error, Reason}</name> + <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 + can be handled.</d> + <v> DaemonOptions = proplists:proplist() </v> + <d>Options provided to <seealso marker="ssh#daemon">ssh:daemon/[2,3]</seealso></d> + <v> Key = private_key()</v> + <d> The private key of the host matching the <c>Algorithm</c></d> + <v>Reason = term() </v> + </type> + <desc> + <p>Fetches the hosts private key</p> + </desc> + </func> + + <func> + <name>Module:is_auth_key(Key, User, DaemonOptions) -> Result</name> + <fsummary> Checks if the user key is authorized</fsummary> + <type> + <v> Key = public_key() </v> + <d> Normally an RSA or DSA public key but handling of other public keys can be added</d> + <v> User = string()</v> + <d> The user owning the public key</d> + <v> DaemonOptions = proplists:proplist() </v> + <d> Options provided to <seealso marker="ssh#daemon">ssh:daemon/[2,3]</seealso></d> + <v> Result = boolean()</v> + </type> + <desc> + <p> Checks if the user key is authorized </p> + </desc> + </func> + + </funcs> + +</erlref> diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml index c1f75461b1..0d61e57edb 100644 --- a/lib/ssh/doc/src/ssh_sftp.xml +++ b/lib/ssh/doc/src/ssh_sftp.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> <header> <copyright> - <year>2005</year><year>2010</year> + <year>2005</year><year>2012</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -22,25 +22,20 @@ </legalnotice> <title>ssh_sftp</title> - <prepared>Jakob Cederlund</prepared> - <responsible></responsible> - <docno>1</docno> - <approved></approved> - <checked></checked> + <prepared>OTP</prepared> <date>2005-09-22</date> - <rev>PA1</rev> <file>ssh_sftp.sgml</file> </header> <module>ssh_sftp</module> <modulesummary>SFTP client.</modulesummary> <description> <p>This module implements an SFTP (SSH FTP) client. SFTP is a - secure, encrypted file transfer service available for - SSH.</p> + secure, encrypted file transfer service available for + SSH.</p> </description> <section> - <title>COMMON DATA TYPES </title> + <title>DATA TYPES </title> <p>Type definitions that are used more than once in this module and/or abstractions to indicate the intended use of the data type: </p> @@ -51,8 +46,8 @@ <section> <title>TIMEOUTS </title> - <p>If the request functions for the sftp channel return {error, timeout} - it does not mean that the request did not reach the server and was + <p>If the request functions for the SFTP channel return {error, timeout} + it does not guarantee that the request did not reach the server and was not performed, it only means that we did not receive an answer from the server within the time that was expected.</p> </section> @@ -64,7 +59,7 @@ <name>start_channel(Host, Options) -></name> <name>start_channel(Host, Port, Options) -> {ok, Pid} | {ok, Pid, ConnectionRef} | {error, Reason}</name> - <fsummary>Starts a sftp client</fsummary> + <fsummary>Starts a SFTP client</fsummary> <type> <v>Host = string()</v> <v>ConnectionRef = ssh_connection_ref()</v> @@ -73,11 +68,11 @@ <v>Reason = term()</v> </type> <desc> - <p>If not provided, setups a ssh connection in this case a - connection reference will be returned too. A ssh channel - process is started to handle the communication with the SFTP - server, the returned pid for this process should be used as - input to all other API functions in this module.</p> + <p>If no connection reference is provided, a connection is set + up and the new connection is returned. An SSH channel process + is started to handle the communication with the SFTP server. + The returned pid for this process should be used as input to + all other API functions in this module.</p> <p>Options are:</p> <taglist> @@ -95,13 +90,13 @@ <func> <name>stop_channel(ChannelPid) -> ok</name> - <fsummary>Stops the sftp client channel.</fsummary> + <fsummary>Stops the SFTP client channel.</fsummary> <type> <v>ChannelPid = pid()</v> </type> <desc> - <p>Stops a sftp channel. If the ssh connection should be closed - call <seealso marker="ssh">ssh:close/1</seealso>.</p> + <p>Stops an SFTP channel. Does not close the SSH connetion. + Use <seealso marker="ssh">ssh:close/1</seealso> to close it.</p> </desc> </func> @@ -133,8 +128,9 @@ <v>Reason = term()</v> </type> <desc> - <p>Writes a file to the server, like <c><![CDATA[file:write_file/2]]></c>. - The file is created if it's not there.</p> + <p>Writes a file to the server, like + <c><![CDATA[file:write_file/2]]></c>. The file is created if + it does not exist or is owerwritten if it does.</p> </desc> </func> <func> @@ -169,7 +165,7 @@ </type> <desc> <p>Opens a file on the server, and returns a handle that - is used for reading or writing.</p> + can be used for reading or writing.</p> </desc> </func> <func> @@ -184,7 +180,7 @@ </type> <desc> <p>Opens a handle to a directory on the server, the handle - is used for reading directory contents.</p> + can be used for reading directory contents.</p> </desc> </func> <func> @@ -218,7 +214,7 @@ </type> <desc> <p>Reads <c><![CDATA[Len]]></c> bytes from the file referenced by - <c><![CDATA[Handle]]></c>. Returns <c><![CDATA[{ok, Data}]]></c>, or <c><![CDATA[eof]]></c>, or + <c><![CDATA[Handle]]></c>. Returns <c><![CDATA[{ok, Data}]]></c>, <c><![CDATA[eof]]></c>, or <c><![CDATA[{error, Reason}]]></c>. If the file is opened with <c><![CDATA[binary]]></c>, <c><![CDATA[Data]]></c> is a binary, otherwise it is a string.</p> <p>If the file is read past eof, only the remaining bytes @@ -267,9 +263,9 @@ <v>Reason = term()</v> </type> <desc> - <p>Write <c><![CDATA[data]]></c> to the file referenced by <c><![CDATA[Handle]]></c>. + <p>Writes<c><![CDATA[data]]></c> to the file referenced by <c><![CDATA[Handle]]></c>. The file should be opened with <c><![CDATA[write]]></c> or <c><![CDATA[append]]></c> - flag. Returns <c><![CDATA[ok]]></c> if successful and <c><![CDATA[{error, Reason}]]></c> + flag. Returns <c><![CDATA[ok]]></c> if successful or S<c><![CDATA[{error, Reason}]]></c> otherwise.</p> <p>Typical error reasons are:</p> <taglist> @@ -317,14 +313,14 @@ <v>ChannelPid = pid()</v> <v>Handle = term()</v> <v>Location = Offset | {bof, Offset} | {cur, Offset} | {eof, Offset} | bof | cur | eof</v> - <v>Offset = int()</v> + <v>Offset = integer()</v> <v>Timeout = timeout()</v> <v>NewPosition = integer()</v> <v>Reason = term()</v> </type> <desc> <p>Sets the file position of the file referenced by <c><![CDATA[Handle]]></c>. - Returns <c><![CDATA[{ok, NewPosition]]></c> (as an absolute offset) if + Returns <c><![CDATA[{ok, NewPosition}]]></c> (as an absolute offset) if successful, otherwise <c><![CDATA[{error, Reason}]]></c>. <c><![CDATA[Location]]></c> is one of the following:</p> <taglist> @@ -413,7 +409,7 @@ <v>Reason = term()</v> </type> <desc> - <p>Read the link target from the symbolic link specified + <p>Reads the link target from the symbolic link specified by <c><![CDATA[name]]></c>, like <c><![CDATA[file:read_link/1]]></c>.</p> </desc> </func> @@ -490,8 +486,9 @@ <v>Reason = term()</v> </type> <desc> - <p>Deletes a directory specified by <c><![CDATA[Name]]></c>. The directory - should be empty.</p> + <p>Deletes a directory specified by <c><![CDATA[Name]]></c>. + Note that the directory must be empty before it can be successfully deleted + </p> </desc> </func> diff --git a/lib/ssh/doc/src/ssh_sftpd.xml b/lib/ssh/doc/src/ssh_sftpd.xml index b3d64e72b4..a4273195b5 100644 --- a/lib/ssh/doc/src/ssh_sftpd.xml +++ b/lib/ssh/doc/src/ssh_sftpd.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> <header> <copyright> - <year>2005</year><year>2010</year> + <year>2005</year><year>2012</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -22,23 +22,17 @@ </legalnotice> <title>ssh_sftpd</title> - <prepared>Ingela Anderton Andin</prepared> - <responsible></responsible> - <docno>1</docno> - <approved></approved> - <checked></checked> <date>2005-09-22</date> - <rev>PA1</rev> <file>ssh_sftpd.sgml</file> </header> <module>ssh_sftpd</module> - <modulesummary>Specifies a channel process to handle a sftp subsystem.</modulesummary> + <modulesummary>Specifies the channel process to handle an sftp subsystem.</modulesummary> <description> <p>Specifies a channel process to handle a sftp subsystem.</p> </description> <section> - <title>COMMON DATA TYPES </title> + <title>DATA TYPES </title> <p><c>subsystem_spec() = {subsystem_name(), {channel_callback(), channel_init_args()}} </c></p> <p><c>subsystem_name() = "sftp"</c></p> <p><c>channel_callback() = atom()</c> - Name of the erlang module implementing the @@ -65,28 +59,28 @@ </item> <tag><c><![CDATA[{file_handler, CallbackModule}]]></c></tag> <item> - <p>Determines which module to call for communicating with - the file server. Default value is <c>ssh_sftpd_file</c> that uses the - file and filelib API:s to access the standard OTP file - server. This option may be used to plug in the use of - other file servers.</p> - </item> - <tag><c><![CDATA[{max_files, Integer}]]></c></tag> - <item> - <p>The default value is <c>0</c>, which means that there is no upper limit. - If supplied, the number of filenames returned to the sftp client per <c>READDIR</c> - request, is limited to at most the given value.</p> - </item> + <p>Determines which module to call for accessing + the file server. The default value is <c>ssh_sftpd_file</c> that uses the + <seealso marker="kernel#file">file</seealso> and <seealso marker="kernel#filelib">filelib</seealso> API:s to access the standard OTP file + server. This option may be used to plug in + other file servers.</p> + </item> + <tag><c><![CDATA[{max_files, Integer}]]></c></tag> + <item> + <p>The default value is <c>0</c>, which means that there is no upper limit. + If supplied, the number of filenames returned to the sftp client per <c>READDIR</c> + request is limited to at most the given value.</p> + </item> <tag><c><![CDATA[{root, String}]]></c></tag> <item> <p>Sets the sftp root directory. The user will then not be - able to see any files above this root. If for instance - the root is set to <c>/tmp</c> the user will see this - directory as <c>/</c> and if the user does cd <c>/etc</c> - the user will end up in <c>/tmp/etc</c>. + able to see any files above this root. If for instance + the root is set to <c>/tmp</c> the user will see this + directory as <c>/</c> and if the user does cd <c>/etc</c> + the user will end up in <c>/tmp/etc</c>. </p> </item> - </taglist> + </taglist> </desc> </func> </funcs> diff --git a/lib/ssh/doc/src/user_guide.gif b/lib/ssh/doc/src/user_guide.gif Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/ssh/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/ssh/doc/src/usersguide.xml b/lib/ssh/doc/src/usersguide.xml new file mode 100644 index 0000000000..c818003090 --- /dev/null +++ b/lib/ssh/doc/src/usersguide.xml @@ -0,0 +1,37 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<part xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>2012</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>SSH User's Guide</title> + <prepared>OTP Team</prepared> + <date>2012-10-11</date> + <file>usersguide.xml</file> + </header> + <description> + <p>The <em>SSH</em> application implements the SSH (Secure Shell) protocol and + provides an SFTP (Secret File Transfer Protocol) client and server. + </p> + </description> + <xi:include href="introduction.xml"/> + <xi:include href="ssh_protocol.xml"/> + <xi:include href="using_ssh.xml"/> +</part> diff --git a/lib/ssh/doc/src/using_ssh.xml b/lib/ssh/doc/src/using_ssh.xml new file mode 100644 index 0000000000..1a54f3f964 --- /dev/null +++ b/lib/ssh/doc/src/using_ssh.xml @@ -0,0 +1,294 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2012</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + + </legalnotice> + + <title>Getting started</title> + <file>using_ssh.xml</file> + </header> + + <section> + <title> General information</title> + <p>The examples in the following sections use the utility function + <seealso marker="ssh#start"> ssh:start/0 </seealso> that starts + all needed applications (crypto, public_key and ssh). All examples + are run in an Erlang shell, or in a bash shell using openssh to + illustrate how the erlang ssh application can be used. The + exampels are run as the user otptest on a local network where the + user is authorized to login in over ssh to the host "tarlop". If + nothing else is stated it is persumed that the otptest user has an + entry in tarlop's authorized_keys file (may log in via ssh without + entering a password). Also tarlop is a known host in the user + otptest's known_hosts file so that host verification can be done + without user interaction. + </p> + </section> + + <section> + <title>Using the Erlang SSH Terminal Client</title> + + <p>The user otptest, that has bash as default shell, uses the + ssh:shell/1 client to connect to the openssh daemon running on a + host called tarlop. Note that currently this client is very simple + and you should not be expected to be as fancy as the openssh + client.</p> + + <code type="erl" > + 1> ssh:start(). + ok + 2> {ok, S} = ssh:shell("tarlop"). + >pwd + /home/otptest + >exit + logout + 3> + </code> + </section> + + <section> + <title>Running an Erlang SSH Daemon </title> + + <p> The option system_dir must be a directory containing a host + key file and it defaults to /etc/ssh. For details see section + Configuration Files in <seealso + marker="ssh_app">ssh(6)</seealso>. + </p> + + <note><p>Normally the /etc/ssh directory is only readable by root. </p> + </note> + + <p> The option user_dir defaults to the users ~/.ssh directory</p> + + <p>In the following example we generate new keys and host keys as + to be able to run the example without having root privilages</p> + + <code> + $bash> ssh-keygen -t rsa -f /tmp/ssh_daemon/ssh_host_rsa_key + [...] + $bash> ssh-keygen -t rsa -f /tmp/otptest_user/.ssh/id_rsa + [...] + </code> + + <p>Create the file /tmp/otptest_user/.ssh/authrized_keys and add the content + of /tmp/otptest_user/.ssh/id_rsa.pub Now we can do</p> + + <code type="erl"> + 1> ssh:start(). + ok + 2> {ok, Sshd} = ssh:daemon(8989, [{system_dir, "/tmp/ssh_daemon"}, + {user_dir, "/tmp/otptest_user/.ssh"}]). + {ok,<0.54.0>} + 3> + </code> + + <p>Use the openssh client from a shell to connect to the Erlang ssh daemon.</p> + + <code> + $bash> ssh tarlop -p 8989 -i /tmp/otptest_user/.ssh/id_rsa -o UserKnownHostsFile=/tmp/otptest_user/.ssh/known_hosts + The authenticity of host 'tarlop' can't be established. + RSA key fingerprint is 14:81:80:50:b1:1f:57:dd:93:a8:2d:2f:dd:90:ae:a8. + Are you sure you want to continue connecting (yes/no)? yes + Warning: Permanently added 'tarlop' (RSA) to the list of known hosts. + Eshell V5.10 (abort with ^G) + 1> + </code> + + <p>There are two ways of shutting down an SSH daemon</p> + + <p>1: Stops the listener, but leaves existing connections started by the listener up and running.</p> + + <code type="erl"> + 3> ssh:stop_listener(Sshd). + ok + 4> + </code> + + <p>2: Stops the listener and all connections started by the listener.</p> + + <code type="erl"> + 3> ssh:stop_daemon(Sshd) + ok + 4> + </code> + + </section> + + <section> + <title>One Time Execution</title> + + <p>In the following example the Erlang shell is the client process + that receives the channel replies. <note> If you run this example + in your environment you may get fewer or more messages back as + this depends on the OS and shell on the machine running the ssh + daemon. See also <seealso marker="ssh_connection#exec-4">ssh_connection:exec/4</seealso> + </note> + </p> + + <code type="erl" > + 1> ssh:start(). + ok + 2> {ok, ConnectionRef} = ssh:connect("tarlop", 22, []). + {ok,<0.57.0>} + 3>{ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity). + {ok,0} + 4> success = ssh_connection:exec(ConnectionRef, ChannelId, "pwd", infinity). + 5> flush(). + Shell got {ssh_cm,<0.57.0>,{data,0,0,<<"/home/otptest\n">>}} + Shell got {ssh_cm,<0.57.0>,{eof,0}} + Shell got {ssh_cm,<0.57.0>,{exit_status,0,0}} + Shell got {ssh_cm,<0.57.0>,{closed,0}} + ok + 6> + </code> + + <p>Note only the channel is closed the connection is still up and can handle other channels</p> + + <code type="erl" > + 6> {ok, NewChannelId} = ssh_connection:session_channel(ConnectionRef, infinity). + {ok,1} + ... + </code> + </section> + + <section> + <title>SFTP (SSH File Transport Protocol) server</title> + + <code type="erl" > + 1> ssh:start(). + ok + 2> ssh:daemon(8989, [{system_dir, "/tmp/ssh_daemon"}, {user_dir, "/tmp/otptest_user/.ssh"}, + {subsystems, [ssh_sftpd:subsystem_spec([{cwd, "/tmp/sftp/example"}])]}]). + {ok,<0.54.0>} + 3> + </code> + + <p> Run the openssh sftp client</p> + + <code type="erl"> + $bash> sftp -oPort=8989 -o IdentityFile=/tmp/otptest_user/.ssh/id_rsa -o UserKnownHostsFile=/tmp/otptest_user/.ssh/known_hosts tarlop + Connecting to tarlop... + sftp> pwd + Remote working directory: /tmp/sftp/example + sftp> + </code> + </section> + + <section> + <title>SFTP (SSH File Transport Protocol) client</title> + + <code type="erl" > + 1> ssh:start(). + ok + 2> {ok, ChannelPid, Connection} = ssh_sftp:start_channel("tarlop", []). + {ok,<0.57.0>,<0.51.0>} + 3> ssh_sftp:read_file(ChannelPid, "/home/otptest/test.txt"). + {ok,<<"This is a test file\n">>} + </code> + </section> + + <section> + <title>Creating a subsystem</title> + + <p>A very small SSH subsystem that echos N bytes could be implemented like this. + See also <seealso marker="ssh_channel"> ssh_channel(3)</seealso> </p> + + <code type="erl" > +-module(ssh_echo_server). +-behaviour(ssh_subsystem). +-record(state, { + n, + id, + cm + }). +-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]). + +init([N]) -> + {ok, #state{n = N}}. + +handle_msg({ssh_channel_up, ChannelId, ConnectionManager}, State) -> + {ok, State#state{id = ChannelId, + cm = ConnectionManager}}. + +handle_ssh_msg({ssh_cm, CM, {data, ChannelId, 0, Data}}, #state{n = N} = State) -> + M = N - size(Data), + case M > 0 of + true -> + ssh_connection:send(CM, ChannelId, Data), + {ok, State#state{n = M}}; + false -> + <<SendData:N/binary, _/binary>> = Data, + ssh_connection:send(CM, ChannelId, SendData), + ssh_connection:send_eof(CM, ChannelId), + {stop, ChannelId, State} + end; +handle_ssh_msg({ssh_cm, _ConnectionManager, + {data, _ChannelId, 1, Data}}, State) -> + error_logger:format(standard_error, " ~p~n", [binary_to_list(Data)]), + {ok, State}; + +handle_ssh_msg({ssh_cm, _ConnectionManager, {eof, _ChannelId}}, State) -> + {ok, State}; + +handle_ssh_msg({ssh_cm, _, {signal, _, _}}, State) -> + %% Ignore signals according to RFC 4254 section 6.9. + {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}. + +terminate(_Reason, _State) -> + ok. + </code> + + <p>And run like this on the host tarlop with the keys generated in section 3.3</p> + + <code type="erl" > + 1> ssh:start(). + ok + 2> ssh:daemon(8989, [{system_dir, "/tmp/ssh_daemon"}, + {user_dir, "/tmp/otptest_user/.ssh"} + {subsystems, [{"echo_n", {ssh_echo_server, [10]}}]}]). + {ok,<0.54.0>} + 3> + </code> + + <code type="erl" > + 1> ssh:start(). + ok + 2>{ok, ConnectionRef} = ssh:connect("tarlop", 8989, [{user_dir, "/tmp/otptest_user/.ssh"}]). + {ok,<0.57.0>} + 3>{ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity). + 4> success = ssh_connection:subsystem(ConnectionRef, ChannelId, "echo_n", infinity). + 5> ok = ssh_connection:send(ConnectionRef, ChannelId, "0123456789", infinity). + 6> flush(). + {ssh_msg, <0.57.0>, {data, 0, 1, "0123456789"}} + {ssh_msg, <0.57.0>, {eof, 0}} + {ssh_msg, <0.57.0>, {closed, 0}} + 7> {error, closed} = ssh_connection:send(ConnectionRef, ChannelId, "10", infinity). + </code> + +</section> + +</chapter> diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index b8eecd3fa2..323f0af191 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -41,7 +41,9 @@ RELSYSDIR = $(RELEASE_PATH)/lib/ssh-$(VSN) BEHAVIOUR_MODULES= \ ssh_sftpd_file_api \ ssh_channel \ - ssh_key_api + ssh_subsystem \ + ssh_client_key_api \ + ssh_server_key_api MODULES= \ ssh \ diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index 316c09eb06..a0ba7cf7d9 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -10,6 +10,7 @@ ssh_auth, ssh_bits, ssh_cli, + ssh_client_key_api, ssh_channel, ssh_channel_sup, ssh_connection, @@ -21,13 +22,14 @@ sshd_sup, ssh_file, ssh_io, - ssh_key_api, ssh_math, ssh_no_io, + ssh_server_key_api, ssh_sftp, ssh_sftpd, ssh_sftpd_file, ssh_sftpd_file_api, + ssh_subsystem, ssh_subsystem_sup, ssh_sup, ssh_system_sup, @@ -35,7 +37,7 @@ ssh_userreg, ssh_xfer]}, {registered, []}, - {applications, [kernel, stdlib, crypto]}, + {applications, [kernel, stdlib, crypto, public_key]}, {env, []}, {mod, {ssh_app, []}}]}. diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index de52913194..3ef26b1678 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -41,19 +41,23 @@ %% %% Type = permanent | transient | temporary %% -%% Description: Starts the inets application. Default type +%% Description: Starts the ssh application. Default type %% is temporary. see application(3) %%-------------------------------------------------------------------- start() -> + application:start(crypto), + application:start(public_key), application:start(ssh). start(Type) -> + application:start(crypto, Type), + application:start(public_key, Type), application:start(ssh, Type). %%-------------------------------------------------------------------- %% Function: stop() -> ok %% -%% Description: Stops the inets application. +%% Description: Stops the ssh application. %%-------------------------------------------------------------------- stop() -> application:stop(ssh). @@ -76,7 +80,7 @@ connect(Host, Port, Options, Timeout) -> {error, _Reason} = Error -> Error; {SocketOptions, SshOptions} -> - DisableIpv6 = proplists:get_value(ip_v6_disabled, SshOptions, false), + DisableIpv6 = proplists:get_value(ipv6_disabled, SshOptions, false), Inet = inetopt(DisableIpv6), do_connect(Host, Port, [Inet | SocketOptions], [{user_pid, self()}, {host, Host} | fix_idle_time(SshOptions)], Timeout, DisableIpv6) @@ -169,7 +173,7 @@ daemon(HostAddr, Port, Options0) -> _ -> Options0 end, - DisableIpv6 = proplists:get_value(ip_v6_disabled, Options0, false), + DisableIpv6 = proplists:get_value(ipv6_disabled, Options0, false), {Host, Inet, Options} = case HostAddr of any -> {ok, Host0} = inet:gethostname(), @@ -264,7 +268,7 @@ start_daemon(Host, Port, Options, Inet) -> do_start_daemon(Host, Port, Options, SocketOptions) -> case ssh_system_sup:system_supervisor(Host, Port) of undefined -> - %% TODO: It would proably make more sense to call the + %% It would proably make more sense to call the %% address option host but that is a too big change at the %% monent. The name is a legacy name! try sshd_sup:start_child([{address, Host}, @@ -325,8 +329,6 @@ handle_option([{user_passwords, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{pwdfun, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{user_auth, _} = Opt | Rest],SocketOptions, SshOptions ) -> - handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{key_cb, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{role, _} = Opt | Rest], SocketOptions, SshOptions) -> @@ -344,7 +346,10 @@ handle_option([{disconnectfun, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{failfun, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); -handle_option([{ip_v6_disabled, _} = Opt | Rest], SocketOptions, SshOptions) -> +%%Backwards compatibility should not be underscore between ip and v6 in API +handle_option([{ip_v6_disabled, Value} | Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option({ipv6_disabled, Value}) | SshOptions]); +handle_option([{ipv6_disabled, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([{transport, _} = Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); @@ -379,10 +384,14 @@ handle_ssh_option({silently_accept_hosts, Value} = Opt) when Value == true; Valu Opt; handle_ssh_option({user_interaction, Value} = Opt) when Value == true; Value == false -> Opt; -handle_ssh_option({public_key_alg, Value} = Opt) when Value == ssh_rsa; Value == ssh_dsa -> +handle_ssh_option({public_key_alg, ssh_dsa}) -> + {public_key_alg, 'ssh-dss'}; +handle_ssh_option({public_key_alg, ssh_rsa}) -> + {public_key_alg, 'ssh-rsa'}; +handle_ssh_option({public_key_alg, Value} = Opt) when Value == 'ssh-rsa'; Value == 'ssh-dss' -> Opt; handle_ssh_option({pref_public_key_algs, Value} = Opt) when is_list(Value), length(Value) >= 1 -> - case check_pref_algs(Value) of + case handle_pref_algs(Value, []) of true -> Opt; _ -> @@ -402,8 +411,6 @@ handle_ssh_option({user_passwords, Value} = Opt) when is_list(Value)-> Opt; handle_ssh_option({pwdfun, Value} = Opt) when is_function(Value) -> Opt; -handle_ssh_option({user_auth, Value} = Opt) when is_function(Value) -> - Opt; handle_ssh_option({key_cb, Value} = Opt) when is_atom(Value) -> Opt; handle_ssh_option({compression, Value} = Opt) when is_atom(Value) -> @@ -422,7 +429,9 @@ handle_ssh_option({disconnectfun , Value} = Opt) when is_function(Value) -> Opt; handle_ssh_option({failfun, Value} = Opt) when is_function(Value) -> Opt; -handle_ssh_option({ip_v6_disabled, Value} = Opt) when is_boolean(Value) -> + +handle_ssh_option({ipv6_disabled, Value} = Opt) when Value == true; + Value == false -> Opt; handle_ssh_option({transport, {Protocol, Cb, ClosTag}} = Opt) when is_atom(Protocol), is_atom(Cb), @@ -452,7 +461,7 @@ handle_inet_option({active, _} = Opt) -> "and activ is handled internaly user is not allowd" "to specify this option"}}); handle_inet_option({inet, _} = Opt) -> - throw({error, {{eoptions, Opt},"Is set internaly use ip_v6_disabled to" + throw({error, {{eoptions, Opt},"Is set internaly use ipv6_disabled to" " enforce iv4 in the server, client will fallback to ipv4 if" " it can not use ipv6"}}); handle_inet_option({reuseaddr, _} = Opt) -> @@ -462,14 +471,18 @@ handle_inet_option({reuseaddr, _} = Opt) -> handle_inet_option(Opt) -> Opt. %% Check preferred algs -check_pref_algs([]) -> - true; -check_pref_algs([H|T]) -> +handle_pref_algs([], Acc) -> + {true, lists:reverse(Acc)}; +handle_pref_algs([H|T], Acc) -> case H of ssh_dsa -> - check_pref_algs(T); + handle_pref_algs(T, ['ssh-dss'| Acc]); ssh_rsa -> - check_pref_algs(T); + handle_pref_algs(T, ['ssh-rsa'| Acc]); + 'ssh-dss' -> + handle_pref_algs(T, ['ssh-dss'| Acc]); + 'ssh-rsa' -> + handle_pref_algs(T, ['ssh-rsa'| Acc]); _ -> false end. diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index c436793dc4..cb0c7751f0 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -48,17 +48,18 @@ publickey_msg([Alg, #ssh{user = User, case KeyCb:user_key(Alg, Opts) of {ok, Key} -> + StrAlgo = algorithm_string(Alg), PubKeyBlob = encode_public_key(Key), SigData = build_sig_data(SessionId, - User, Service, PubKeyBlob, Alg), + User, Service, PubKeyBlob, StrAlgo), Sig = ssh_transport:sign(SigData, Hash, Key), - SigBlob = list_to_binary([?string(Alg), ?binary(Sig)]), + SigBlob = list_to_binary([?string(StrAlgo), ?binary(Sig)]), ssh_transport:ssh_packet( #ssh_msg_userauth_request{user = User, service = Service, method = "publickey", data = [?TRUE, - ?string(Alg), + ?string(StrAlgo), ?binary(PubKeyBlob), ?binary(SigBlob)]}, Ssh); @@ -120,8 +121,7 @@ init_userauth_request_msg(#ssh{opts = Opts} = Ssh) -> data = <<>>}, case proplists:get_value(pref_public_key_algs, Opts, false) of false -> - FirstAlg = algorithm(proplists:get_value(public_key_alg, Opts, - ?PREFERRED_PK_ALG)), + FirstAlg = proplists:get_value(public_key_alg, Opts, ?PREFERRED_PK_ALG), SecondAlg = other_alg(FirstAlg), AllowUserInt = proplists:get_value(user_interaction, Opts, true), Prefs = method_preference(FirstAlg, SecondAlg, AllowUserInt), @@ -130,7 +130,7 @@ init_userauth_request_msg(#ssh{opts = Opts} = Ssh) -> userauth_methods = none, service = "ssh-connection"}); Algs -> - FirstAlg = algorithm(lists:nth(1, Algs)), + FirstAlg = lists:nth(1, Algs), case length(Algs) =:= 2 of true -> SecondAlg = other_alg(FirstAlg), @@ -358,7 +358,7 @@ verify_sig(SessionId, User, Service, Alg, KeyBlob, SigWLen, Opts) -> {ok, Key} = decode_public_key_v2(KeyBlob, Alg), KeyCb = proplists:get_value(key_cb, Opts, ssh_file), - case KeyCb:is_auth_key(Key, User, Alg, Opts) of + case KeyCb:is_auth_key(Key, User, Opts) of true -> PlainText = build_sig_data(SessionId, User, Service, KeyBlob, Alg), @@ -381,9 +381,9 @@ build_sig_data(SessionId, User, Service, KeyBlob, Alg) -> ?binary(KeyBlob)], list_to_binary(Sig). -algorithm(ssh_rsa) -> +algorithm_string('ssh-rsa') -> "ssh-rsa"; -algorithm(ssh_dsa) -> +algorithm_string('ssh-dss') -> "ssh-dss". decode_keyboard_interactive_prompts(NumPrompts, Data) -> @@ -457,10 +457,10 @@ userauth_pk_messages() -> binary]} % key blob ]. -other_alg("ssh-rsa") -> - "ssh-dss"; -other_alg("ssh-dss") -> - "ssh-rsa". +other_alg('ssh-rsa') -> + 'ssh-dss'; +other_alg('ssh-dss') -> + 'ssh-rsa'. decode_public_key_v2(K_S, "ssh-rsa") -> case ssh_bits:decode(K_S,[string,mpint,mpint]) of ["ssh-rsa", E, N] -> diff --git a/lib/ssh/src/ssh_auth.hrl b/lib/ssh/src/ssh_auth.hrl index e74ee10041..6cd8e6bf14 100644 --- a/lib/ssh/src/ssh_auth.hrl +++ b/lib/ssh/src/ssh_auth.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -23,7 +23,7 @@ -define(SUPPORTED_AUTH_METHODS, "publickey,keyboard-interactive,password"). --define(PREFERRED_PK_ALG, ssh_rsa). +-define(PREFERRED_PK_ALG, 'ssh-rsa'). -define(SSH_MSG_USERAUTH_REQUEST, 50). -define(SSH_MSG_USERAUTH_FAILURE, 51). diff --git a/lib/ssh/src/ssh_channel.erl b/lib/ssh/src/ssh_channel.erl index 1938858420..4e8f8538c2 100644 --- a/lib/ssh/src/ssh_channel.erl +++ b/lib/ssh/src/ssh_channel.erl @@ -23,14 +23,35 @@ -include("ssh_connect.hrl"). -%%% Optional callbacks handle_call/3, handle_cast/2, handle_msg/2, -%%% code_change/3 -%% Should be further specified later --callback init(Options::list()) -> - {ok, State::term()} | {ok, State::term(), Timeout::timeout()} | - {stop, Reason ::term()}. - --callback terminate(term(), term()) -> term(). +-callback init(Args :: term()) -> + {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. +-callback handle_call(Request :: term(), From :: {pid(), Tag :: term()}, + State :: term()) -> + {reply, Reply :: term(), NewState :: term()} | + {reply, Reply :: term(), NewState :: term(), timeout() | hibernate} | + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), Reply :: term(), NewState :: term()} | + {stop, Reason :: term(), NewState :: term()}. +-callback handle_cast(Request :: term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), NewState :: term()}. + +-callback terminate(Reason :: (normal | shutdown | {shutdown, term()} | + term()), + State :: term()) -> + term(). +-callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), + Extra :: term()) -> + {ok, NewState :: term()} | {error, Reason :: term()}. + +-callback handle_msg(Msg ::term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), NewState :: term()}. + -callback handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()}, State::term()) -> {ok, State::term()} | diff --git a/lib/ssh/src/ssh_client_key.erl b/lib/ssh/src/ssh_client_key.erl new file mode 100644 index 0000000000..2c48884dc2 --- /dev/null +++ b/lib/ssh/src/ssh_client_key.erl @@ -0,0 +1,34 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssh_client_key). + +-include_lib("public_key/include/public_key.hrl"). +-include("ssh.hrl"). + +-callback is_host_key(Key :: public_key(), Host :: string(), + Algorithm :: 'ssh-rsa'| 'ssh-dsa'| atom(), Options :: proplists:proplist()) -> + boolean(). + +-callback user_key(Algorithm :: 'ssh-rsa'| 'ssh-dsa'| atom(), Options :: list()) -> + {ok, PrivateKey :: term()} | {error, string()}. + + +-callback add_host_key(Host :: string(), PublicKey :: term(), Options :: list()) -> + ok | {error, Error::term()}. diff --git a/lib/ssh/src/ssh_client_key_api.erl b/lib/ssh/src/ssh_client_key_api.erl new file mode 100644 index 0000000000..eed0b85f47 --- /dev/null +++ b/lib/ssh/src/ssh_client_key_api.erl @@ -0,0 +1,35 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssh_client_key_api). + +-include_lib("public_key/include/public_key.hrl"). +-include("ssh.hrl"). + +-callback is_host_key(PublicKey :: #'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term() , Host :: string(), + Algorithm :: 'ssh-rsa'| 'ssh-dss'| atom(), ConnectOptions :: proplists:proplist()) -> + boolean(). + +-callback user_key(Algorithm :: 'ssh-rsa'| 'ssh-dss'| atom(), ConnectOptions :: proplists:proplists()) -> + {ok, PrivateKey :: #'RSAPrivateKey'{}| #'DSAPrivateKey'{} | term()} | {error, string()}. + + +-callback add_host_key(Host :: string(), PublicKey :: #'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term(), + Options :: list()) -> + ok | {error, Error::term()}. diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index e429d3e835..88b45111ff 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -767,9 +767,9 @@ extract_algs([], NewList) -> lists:reverse(NewList); extract_algs([H|T], NewList) -> case H of - ssh_dsa -> + 'ssh-dss' -> extract_algs(T, ["ssh-dss"|NewList]); - ssh_rsa -> + 'ssh-rsa' -> extract_algs(T, ["ssh-rsa"|NewList]) end. available_host_key(KeyCb, "ssh-dss"= Alg, Opts) -> diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index a6b82a7a13..f115a32710 100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl @@ -23,7 +23,8 @@ -module(ssh_file). --behaviour(ssh_key_api). +-behaviour(ssh_server_key_api). +-behaviour(ssh_client_key_api). -include_lib("public_key/include/public_key.hrl"). -include_lib("kernel/include/file.hrl"). @@ -34,7 +35,7 @@ user_key/2, is_host_key/4, add_host_key/3, - is_auth_key/4]). + is_auth_key/3]). -define(PERM_700, 8#700). @@ -53,8 +54,8 @@ host_key(Algorithm, Opts) -> decode(File, Password). -is_auth_key(Key, User, Alg, Opts) -> - case lookup_user_key(Key, User, Alg, Opts) of +is_auth_key(Key, User,Opts) -> + case lookup_user_key(Key, User, Opts) of {ok, Key} -> true; _ -> @@ -138,13 +139,13 @@ add_host_key(Host, Key, Opts) -> Error end. -lookup_user_key(Key, User, Alg, Opts) -> +lookup_user_key(Key, User, Opts) -> SshDir = ssh_dir({remoteuser,User}, Opts), - case lookup_user_key_f(Key, User, SshDir, Alg, "authorized_keys", Opts) of + case lookup_user_key_f(Key, User, SshDir, "authorized_keys", Opts) of {ok, Key} -> {ok, Key}; _ -> - lookup_user_key_f(Key, User, SshDir, Alg, "authorized_keys2", Opts) + lookup_user_key_f(Key, User, SshDir, "authorized_keys2", Opts) end. @@ -213,9 +214,9 @@ do_lookup_host_key(Host, Alg, Opts) -> Error -> Error end. -identity_key_filename("ssh-dss") -> +identity_key_filename('ssh-dss') -> "id_dsa"; -identity_key_filename("ssh-rsa") -> +identity_key_filename('ssh-rsa') -> "id_rsa". identity_pass_phrase("ssh-dss") -> @@ -261,9 +262,9 @@ host_name(Atom) when is_atom(Atom) -> host_name(List) -> List. -key_match(#'RSAPublicKey'{}, "ssh-rsa") -> +key_match(#'RSAPublicKey'{}, 'ssh-rsa') -> true; -key_match({_, #'Dss-Parms'{}}, "ssh-dss") -> +key_match({_, #'Dss-Parms'{}}, 'ssh-dss') -> true; key_match(_, _) -> false. @@ -272,11 +273,11 @@ add_key_fd(Fd, Host,Key) -> SshBin = public_key:ssh_encode([{Key, [{hostnames, [Host]}]}], known_hosts), file:write(Fd, SshBin). -lookup_user_key_f(_, _User, [], _Alg, _F, _Opts) -> +lookup_user_key_f(_, _User, [], _F, _Opts) -> {error, nouserdir}; -lookup_user_key_f(_, _User, nouserdir, _Alg, _F, _Opts) -> +lookup_user_key_f(_, _User, nouserdir, _F, _Opts) -> {error, nouserdir}; -lookup_user_key_f(Key, _User, Dir, _Alg, F, _Opts) -> +lookup_user_key_f(Key, _User, Dir, F, _Opts) -> FileName = filename:join(Dir, F), case file:open(FileName, [read, binary]) of {ok, Fd} -> diff --git a/lib/ssh/src/ssh_key_api.erl b/lib/ssh/src/ssh_key_api.erl deleted file mode 100644 index 8085c12e21..0000000000 --- a/lib/ssh/src/ssh_key_api.erl +++ /dev/null @@ -1,45 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2011-2012. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - --module(ssh_key_api). - --include_lib("public_key/include/public_key.hrl"). --include("ssh.hrl"). - --type ssh_algorithm() :: string(). --type file_error() :: file:posix() | badarg | system_limit | terminated. - --callback host_key(Algorithm :: ssh_algorithm(), Options :: list()) -> - {ok, [{public_key(), Attributes::list()}]} | public_key() - | {error, string()}. - --callback user_key(Algorithm :: ssh_algorithm(), Options :: list()) -> - {ok, [{public_key(), Attributes::list()}]} | public_key() - | {error, string()}. - --callback is_host_key(Key :: public_key(), PeerName :: string(), - Algorithm :: ssh_algorithm(), Options :: list()) -> - boolean(). - --callback add_host_key(Host :: string(), Key :: public_key(), Options :: list()) -> - ok | {error, file_error()}. - --callback is_auth_key(Key :: public_key(), User :: string(), - Algorithm :: ssh_algorithm(), Options :: list()) -> - boolean(). diff --git a/lib/ssh/src/ssh_server_key.erl b/lib/ssh/src/ssh_server_key.erl new file mode 100644 index 0000000000..8140114990 --- /dev/null +++ b/lib/ssh/src/ssh_server_key.erl @@ -0,0 +1,33 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssh_server_key). + +-include_lib("public_key/include/public_key.hrl"). +-include("ssh.hrl"). + +-type ssh_algorithm() :: string(). + +-callback host_key(Algorithm :: ssh_algorithm(), Options :: list()) -> + {ok, [{public_key(), Attributes::list()}]} | public_key() + | {error, string()}. + +-callback is_auth_key(Key :: public_key(), User :: string(), + Algorithm :: ssh_algorithm(), Options :: list()) -> + boolean(). diff --git a/lib/ssh/src/ssh_server_key_api.erl b/lib/ssh/src/ssh_server_key_api.erl new file mode 100644 index 0000000000..4fd660ecb5 --- /dev/null +++ b/lib/ssh/src/ssh_server_key_api.erl @@ -0,0 +1,30 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssh_server_key_api). + +-include_lib("public_key/include/public_key.hrl"). +-include("ssh.hrl"). + +-callback host_key(Algorithm :: 'ssh-rsa'| 'ssh-dss'| atom(), DaemonOptions :: proplists:proplist()) -> + {ok, PrivateKey :: #'RSAPrivateKey'{}| #'DSAPrivateKey'{} | term()} | {error, string()}. + +-callback is_auth_key(PublicKey :: #'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term(), + User :: string(), DaemonOptions :: proplists:proplist()) -> + boolean(). diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index ec7b76b0b3..6d6f4a0121 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -24,7 +24,7 @@ -module(ssh_sftpd). %%-behaviour(gen_server). --behaviour(ssh_channel). +-behaviour(ssh_subsystem). -include_lib("kernel/include/file.hrl"). @@ -36,7 +36,7 @@ -export([subsystem_spec/1, listen/1, listen/2, listen/3, stop/1]). --export([init/1, handle_ssh_msg/2, handle_msg/2, terminate/2, code_change/3]). +-export([init/1, handle_ssh_msg/2, handle_msg/2, terminate/2]). -record(state, { xf, % [{channel,ssh_xfer states}...] @@ -128,14 +128,6 @@ init(Options) -> %%-------------------------------------------------------------------- -%% Function: code_change(OldVsn, State, Extra) -> {ok, NewState} -%% Description: -%%-------------------------------------------------------------------- -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - - -%%-------------------------------------------------------------------- %% Function: handle_ssh_msg(Args) -> {ok, State} | {stop, ChannelId, State} %% %% Description: Handles channel messages diff --git a/lib/ssh/src/ssh_subsystem.erl b/lib/ssh/src/ssh_subsystem.erl new file mode 100644 index 0000000000..5a9fa32668 --- /dev/null +++ b/lib/ssh/src/ssh_subsystem.erl @@ -0,0 +1,47 @@ +-module(ssh_subsystem). + +%% API to special server side channel that can be pluged into the erlang ssh daemeon +-callback init(Args :: term()) -> + {ok, State :: term()} | {ok, State :: term(), timeout() | hibernate} | + {stop, Reason :: term()} | ignore. + +-callback terminate(Reason :: (normal | shutdown | {shutdown, term()} | + term()), + State :: term()) -> + term(). + +-callback handle_msg(Msg ::term(), State :: term()) -> + {noreply, NewState :: term()} | + {noreply, NewState :: term(), timeout() | hibernate} | + {stop, Reason :: term(), NewState :: term()}. + +-callback handle_ssh_msg({ssh_cm, ConnectionRef::term(), SshMsg::term()}, + State::term()) -> {ok, State::term()} | + {stop, ChannelId::integer(), + State::term()}. + +%%% API +-export([start/4, start/5, start_link/4, start_link/5, enter_loop/1]). + +%% gen_server callbacks +-export([init/1, terminate/2]). + +start(ConnectionManager, ChannelId, CallBack, CbInitArgs) -> + ssh_channel:start(ConnectionManager, ChannelId, CallBack, CbInitArgs, undefined). + +start(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec) -> + ssh_channel:start(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec). + +start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs) -> + ssh_channel:start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, undefined). + +start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec) -> + ssh_channel:start_link(ConnectionManager, ChannelId, CallBack, CbInitArgs, Exec). + +enter_loop(State) -> + ssh_channel:enter_loop(State). + +init(Args) -> + ssh_channel:init(Args). +terminate(Reason, State) -> + ssh_channel:terminate(Reason, State). diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 7f6e7d9946..1abb69921d 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -449,7 +449,7 @@ verify_host_key_rsa(SSH, K_S, H, H_SIG) -> false -> {error, bad_signature}; true -> - known_host_key(SSH, Public, "ssh-rsa") + known_host_key(SSH, Public, 'ssh-rsa') end; _ -> {error, bad_format} @@ -464,7 +464,7 @@ verify_host_key_dss(SSH, K_S, H, H_SIG) -> false -> {error, bad_signature}; true -> - known_host_key(SSH, Public, "ssh-dss") + known_host_key(SSH, Public, 'ssh-dss') end; _ -> {error, bad_host_key_format} diff --git a/lib/ssh/test/ssh_echo_server.erl b/lib/ssh/test/ssh_echo_server.erl index 739aabe6fb..007b00c373 100644 --- a/lib/ssh/test/ssh_echo_server.erl +++ b/lib/ssh/test/ssh_echo_server.erl @@ -21,7 +21,7 @@ %%% Description: Example ssh server -module(ssh_echo_server). --behaviour(ssh_channel). +-behaviour(ssh_subsytem). -record(state, { n, id, @@ -50,7 +50,7 @@ handle_ssh_msg({ssh_cm, CM, {data, ChannelId, 0, Data}}, #state{n = N} = State) end; handle_ssh_msg({ssh_cm, _ConnectionManager, {data, _ChannelId, 1, Data}}, State) -> - error_logger:format("ssh: STDERR: ~s\n", [binary_to_list(Data)]), + error_logger:format(standard_error, " ~p~n", [binary_to_list(Data)]), {ok, State}; handle_ssh_msg({ssh_cm, _ConnectionManager, {eof, _ChannelId}}, State) -> diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 7e751a215d..49bbd5d27d 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -30,7 +30,22 @@ </header> <p>This document describes the changes made to the SSL application.</p> - <section><title>SSL 5.1.1</title> + <section><title>SSL 5.1.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + ssl:ssl_accept/2 timeout is no longer ignored</p> + <p> + Own Id: OTP-10600</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 5.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index c118c129e8..9b1227fa7f 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,8 @@ %% -*- erlang -*- {"%VSN%", [ + {"5.1.1", [{restart_application, ssl}] + }, {"5.1", [ {load_module, ssl_connection, soft_purge, soft_purge, []} ] @@ -10,6 +12,8 @@ {<<"3\\.*">>, [{restart_application, ssl}]} ], [ + {"5.1.1", [{restart_application, ssl}] + }, {"5.1", [ {load_module, ssl_connection, soft_purge, soft_purge, []} ] diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 771bfa5739..6224334a6e 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -47,7 +47,7 @@ -export_type([connect_option/0, listen_option/0, ssl_option/0, transport_option/0, erl_cipher_suite/0, %% From ssl_cipher.hrl tls_atom_version/0, %% From ssl_internal.hrl - prf_random/0]). + prf_random/0, sslsocket/0]). -record(config, {ssl, %% SSL parameters inet_user, %% User set inet options @@ -55,6 +55,8 @@ inet_ssl, %% inet options for internal ssl socket cb %% Callback info }). + +-type sslsocket() :: #sslsocket{}. -type connect_option() :: socket_connect_option() | ssl_option() | transport_option(). -type socket_connect_option() :: gen_tcp:connect_option(). -type listen_option() :: socket_listen_option() | ssl_option() | transport_option(). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 87cf49d07d..cde13069b5 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -89,6 +89,7 @@ log_alert, % boolean() renegotiation, % {boolean(), From | internal | peer} start_or_recv_from, % "gen_fsm From" + timer, % start_or_recv_timer send_queue, % queue() terminated = false, % allow_renegotiate = true, @@ -775,8 +776,9 @@ handle_sync_event({application_data, Data}, From, StateName, get_timeout(State)}; handle_sync_event({start, Timeout}, StartFrom, hello, State) -> - start_or_recv_cancel_timer(Timeout, StartFrom), - hello(start, State#state{start_or_recv_from = StartFrom}); + Timer = start_or_recv_cancel_timer(Timeout, StartFrom), + hello(start, State#state{start_or_recv_from = StartFrom, + timer = Timer}); %% The two clauses below could happen if a server upgrades a socket in %% active mode. Note that in this case we are lucky that @@ -792,8 +794,9 @@ handle_sync_event({start,_}, _From, error, {Error, State = #state{}}) -> {stop, {shutdown, Error}, {error, Error}, State}; handle_sync_event({start, Timeout}, StartFrom, StateName, State) -> - start_or_recv_cancel_timer(Timeout, StartFrom), - {next_state, StateName, State#state{start_or_recv_from = StartFrom}, get_timeout(State)}; + Timer = start_or_recv_cancel_timer(Timeout, StartFrom), + {next_state, StateName, State#state{start_or_recv_from = StartFrom, + timer = Timer}, get_timeout(State)}; handle_sync_event(close, _, StateName, State) -> %% Run terminate before returning @@ -825,14 +828,16 @@ handle_sync_event({shutdown, How0}, _, StateName, end; handle_sync_event({recv, N, Timeout}, RecvFrom, connection = StateName, State0) -> - start_or_recv_cancel_timer(Timeout, RecvFrom), - passive_receive(State0#state{bytes_to_read = N, start_or_recv_from = RecvFrom}, StateName); + Timer = start_or_recv_cancel_timer(Timeout, RecvFrom), + passive_receive(State0#state{bytes_to_read = N, + start_or_recv_from = RecvFrom, timer = Timer}, StateName); %% Doing renegotiate wait with handling request until renegotiate is %% finished. Will be handled by next_state_is_connection/2. handle_sync_event({recv, N, Timeout}, RecvFrom, StateName, State) -> - start_or_recv_cancel_timer(Timeout, RecvFrom), - {next_state, StateName, State#state{bytes_to_read = N, start_or_recv_from = RecvFrom}, + Timer = start_or_recv_cancel_timer(Timeout, RecvFrom), + {next_state, StateName, State#state{bytes_to_read = N, start_or_recv_from = RecvFrom, + timer = Timer}, get_timeout(State)}; handle_sync_event({new_user, User}, _From, StateName, @@ -996,13 +1001,20 @@ handle_info({'DOWN', MonitorRef, _, _, _}, _, handle_info(allow_renegotiate, StateName, State) -> {next_state, StateName, State#state{allow_renegotiate = true}, get_timeout(State)}; - -handle_info({cancel_start_or_recv, RecvFrom}, connection = StateName, #state{start_or_recv_from = RecvFrom} = State) -> + +handle_info({cancel_start_or_recv, StartFrom}, StateName, + #state{renegotiation = {false, first}} = State) when StateName =/= connection -> + gen_fsm:reply(StartFrom, {error, timeout}), + {stop, {shutdown, user_timeout}, State#state{timer = undefined}}; + +handle_info({cancel_start_or_recv, RecvFrom}, StateName, #state{start_or_recv_from = RecvFrom} = State) -> gen_fsm:reply(RecvFrom, {error, timeout}), - {next_state, StateName, State#state{start_or_recv_from = undefined}, get_timeout(State)}; + {next_state, StateName, State#state{start_or_recv_from = undefined, + bytes_to_read = undefined, + timer = undefined}, get_timeout(State)}; handle_info({cancel_start_or_recv, _RecvFrom}, StateName, State) -> - {next_state, StateName, State, get_timeout(State)}; + {next_state, StateName, State#state{timer = undefined}, get_timeout(State)}; handle_info(Msg, StateName, State) -> Report = io_lib:format("SSL: Got unexpected info: ~p ~n", [Msg]), @@ -1770,6 +1782,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, socket_options = SOpts, bytes_to_read = BytesToRead, start_or_recv_from = RecvFrom, + timer = Timer, user_data_buffer = Buffer0} = State0) -> Buffer1 = if Buffer0 =:= <<>> -> Data; @@ -1779,9 +1792,11 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, case get_data(SOpts, BytesToRead, Buffer1) of {ok, ClientData, Buffer} -> % Send data SocketOpt = deliver_app_data(Socket, SOpts, ClientData, Pid, RecvFrom), + cancel_timer(Timer), State = State0#state{user_data_buffer = Buffer, start_or_recv_from = undefined, - bytes_to_read = 0, + timer = undefined, + bytes_to_read = undefined, socket_options = SocketOpt }, if @@ -1794,6 +1809,8 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, end; {more, Buffer} -> % no reply, we need more data next_record(State0#state{user_data_buffer = Buffer}); + {passive, Buffer} -> + next_record_if_active(State0#state{user_data_buffer = Buffer}); {error,_Reason} -> %% Invalid packet in packet mode deliver_packet_error(Socket, SOpts, Buffer1, Pid, RecvFrom), {stop, normal, State0} @@ -1835,6 +1852,9 @@ is_time_to_renegotiate(_,_) -> %% Picks ClientData get_data(_, _, <<>>) -> {more, <<>>}; +%% Recv timed out save buffer data until next recv +get_data(#socket_options{active=false}, undefined, Buffer) -> + {passive, Buffer}; get_data(#socket_options{active=Active, packet=Raw}, BytesToRead, Buffer) when Raw =:= raw; Raw =:= 0 -> %% Raw Mode if @@ -2140,7 +2160,6 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, tls_record_buffer = <<>>, tls_cipher_texts = [], user_application = {Monitor, User}, - bytes_to_read = 0, user_data_buffer = <<>>, log_alert = true, session_cache_cb = SessionCacheCb, @@ -2363,9 +2382,11 @@ ack_connection(#state{renegotiation = {true, From}} = State) -> gen_fsm:reply(From, ok), State#state{renegotiation = undefined}; ack_connection(#state{renegotiation = {false, first}, - start_or_recv_from = StartFrom} = State) when StartFrom =/= undefined -> + start_or_recv_from = StartFrom, + timer = Timer} = State) when StartFrom =/= undefined -> gen_fsm:reply(StartFrom, connected), - State#state{renegotiation = undefined, start_or_recv_from = undefined}; + cancel_timer(Timer), + State#state{renegotiation = undefined, start_or_recv_from = undefined, timer = undefined}; ack_connection(State) -> State. @@ -2503,10 +2524,15 @@ default_hashsign(_Version, KeyExchange) {null, anon}. start_or_recv_cancel_timer(infinity, _RecvFrom) -> - ok; + undefined; start_or_recv_cancel_timer(Timeout, RecvFrom) -> erlang:send_after(Timeout, self(), {cancel_start_or_recv, RecvFrom}). +cancel_timer(undefined) -> + ok; +cancel_timer(Timer) -> + erlang:cancel_timer(Timer). + handle_unrecv_data(StateName, #state{socket = Socket, transport_cb = Transport} = State) -> inet:setopts(Socket, [{active, false}]), case Transport:recv(Socket, 0, 0) of diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 4c3548a703..faed91e559 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -259,7 +259,9 @@ api_tests() -> shutdown_both, shutdown_error, hibernate, - listen_socket + listen_socket, + ssl_accept_timeout, + ssl_recv_timeout ]. certificate_verify_tests() -> @@ -3853,6 +3855,61 @@ listen_socket(Config) -> {error, enotconn} = ssl:shutdown(ListenSocket, read_write), ok = ssl:close(ListenSocket). +%%-------------------------------------------------------------------- +ssl_accept_timeout(doc) -> + ["Test ssl:ssl_accept timeout"]; +ssl_accept_timeout(suite) -> + []; +ssl_accept_timeout(Config) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_opts, Config), + {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {timeout, 5000}, + {mfa, {ssl_test_lib, + no_result_msg, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + {ok, CSocket} = gen_tcp:connect(Hostname, Port, [binary, {active, true}]), + + receive + {tcp_closed, CSocket} -> + ssl_test_lib:check_result(Server, {error, timeout}), + receive + {'EXIT', Server, _} -> + [] = supervisor:which_children(ssl_connection_sup) + end + end. + +%%-------------------------------------------------------------------- +ssl_recv_timeout(doc) -> + ["Test ssl:ssl_accept timeout"]; +ssl_recv_timeout(suite) -> + []; +ssl_recv_timeout(Config) -> + ServerOpts = ?config(server_opts, Config), + ClientOpts = ?config(client_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_timeout_server, []}}, + {options, [{active, false} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + send_recv_result_timeout_client, []}}, + {options, [{active, false} | ClientOpts]}]), + + ssl_test_lib:check_result(Client, ok, Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). %%-------------------------------------------------------------------- @@ -4158,6 +4215,23 @@ send_recv_result(Socket) -> {ok,"Hello world"} = ssl:recv(Socket, 11), ok. +send_recv_result_timeout_client(Socket) -> + {error, timeout} = ssl:recv(Socket, 11, 500), + ssl:send(Socket, "Hello world"), + receive + Msg -> + io:format("Msg ~p~n",[Msg]) + after 500 -> + ok + end, + {ok, "Hello world"} = ssl:recv(Socket, 11, 500), + ok. +send_recv_result_timeout_server(Socket) -> + ssl:send(Socket, "Hello"), + {ok, "Hello world"} = ssl:recv(Socket, 11), + ssl:send(Socket, " world"), + ok. + recv_close(Socket) -> {error, closed} = ssl:recv(Socket, 11), receive diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 63731ee25c..f1f5b9ae0a 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -72,7 +72,13 @@ run_server(Opts) -> run_server(ListenSocket, Opts). run_server(ListenSocket, Opts) -> - AcceptSocket = connect(ListenSocket, Opts), + do_run_server(ListenSocket, connect(ListenSocket, Opts), Opts). + +do_run_server(_, {error, timeout} = Result, Opts) -> + Pid = proplists:get_value(from, Opts), + Pid ! {self(), Result}; + +do_run_server(ListenSocket, AcceptSocket, Opts) -> Node = proplists:get_value(node, Opts), Pid = proplists:get_value(from, Opts), {Module, Function, Args} = proplists:get_value(mfa, Opts), @@ -102,7 +108,8 @@ run_server(ListenSocket, Opts) -> connect(ListenSocket, Opts) -> Node = proplists:get_value(node, Opts), ReconnectTimes = proplists:get_value(reconnect_times, Opts, 0), - AcceptSocket = connect(ListenSocket, Node, 1 + ReconnectTimes, dummy), + Timeout = proplists:get_value(timeout, Opts, infinity), + AcceptSocket = connect(ListenSocket, Node, 1 + ReconnectTimes, dummy, Timeout), case ReconnectTimes of 0 -> AcceptSocket; @@ -111,15 +118,21 @@ connect(ListenSocket, Opts) -> AcceptSocket end. -connect(_, _, 0, AcceptSocket) -> +connect(_, _, 0, AcceptSocket, _) -> AcceptSocket; -connect(ListenSocket, Node, N, _) -> +connect(ListenSocket, Node, N, _, Timeout) -> test_server:format("ssl:transport_accept(~p)~n", [ListenSocket]), {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, [ListenSocket]), - test_server:format("ssl:ssl_accept(~p)~n", [AcceptSocket]), - ok = rpc:call(Node, ssl, ssl_accept, [AcceptSocket]), - connect(ListenSocket, Node, N-1, AcceptSocket). + test_server:format("ssl:ssl_accept(~p, ~p)~n", [AcceptSocket, Timeout]), + + case rpc:call(Node, ssl, ssl_accept, [AcceptSocket, Timeout]) of + ok -> + connect(ListenSocket, Node, N-1, AcceptSocket, Timeout); + Result -> + Result + end. + remove_close_msg(0) -> ok; diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index f4e19b3f87..107220c335 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -106,8 +106,8 @@ init_per_testcase(TestCase, Config0) -> special_init(TestCase, Config) when TestCase == erlang_client_openssl_server_renegotiate; - TestCase == erlang_client_openssl_server_no_wrap_sequence_number; - TestCase == erlang_server_openssl_client_no_wrap_sequence_number + TestCase == erlang_client_openssl_server_nowrap_seqnum; + TestCase == erlang_server_openssl_client_nowrap_seqnum -> check_sane_openssl_renegotaite(Config); diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index bc8b8fd039..adfb29e639 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 5.1.1 +SSL_VSN = 5.1.2 diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index 9759a8f001..85defacc43 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -381,9 +381,6 @@ expr({call,Line,{record_field,_,_,_}=M,As0}, St0) -> expr({call,Line,{remote,Lr,M,F},As0}, St0) -> {[M1,F1 | As1],St1} = expr_list([M,F | As0], St0), {{call,Line,{remote,Lr,M1,F1},As1},St1}; -expr({call,Line,{tuple,Lt,[{atom,_,_}=M,{atom,_,_}=F]},As0}, St0) -> - {As,St1} = expr_list(As0, St0), - {{call,Line,{tuple,Lt,[M,F]},As},St1}; expr({call,Line,F,As0}, St0) -> {[Fun1 | As1],St1} = expr_list([F | As0], St0), {{call,Line,Fun1,As1},St1}; diff --git a/lib/tools/doc/src/xref.xml b/lib/tools/doc/src/xref.xml index 17de66bb22..9706ae6746 100644 --- a/lib/tools/doc/src/xref.xml +++ b/lib/tools/doc/src/xref.xml @@ -1453,7 +1453,7 @@ Evaluates a predefined analysis. Note however that the code path will be traversed once for each used <seealso marker="#library_module">library module</seealso> while setting up module data. On the other hand, if there are only a few modules that are - used by not analyzed, using <c>code_path</c> may be faster + used but not analyzed, using <c>code_path</c> may be faster than setting the library path to <c>code:get_path()</c>. </p> <p>If the library path is set to <c>code_path</c>, the set of diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index e2bcd37def..2967acf310 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -997,6 +997,22 @@ behaviour.") 1 'font-lock-function-name-face t)) "Font lock keyword highlighting a function header.") +(defface erlang-font-lock-exported-function-name-face + '((default (:inherit font-lock-function-name-face))) + "Face used for highlighting exported functions.") + +(defvar erlang-font-lock-exported-function-name-face + 'erlang-font-lock-exported-function-name-face) + +(defvar erlang-inhibit-exported-function-name-face nil + "Inhibit separate face for exported functions") + +(defvar erlang-font-lock-keywords-exported-function-header + (list + (list #'erlang-match-next-exported-function + 1 'erlang-font-lock-exported-function-name-face t)) + "Font lock keyword highlighting an exported function header.") + (defvar erlang-font-lock-keywords-int-bifs (list (list (concat erlang-int-bif-regexp "\\s-*(") @@ -1132,7 +1148,8 @@ There exists three levels of Font Lock keywords for Erlang: `erlang-font-lock-keywords-1' - Function headers and reserved keywords. `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'. `erlang-font-lock-keywords-3' - Variables, macros and records. - `erlang-font-lock-keywords-4' - Function names, Funs, LCs (not Atoms) + `erlang-font-lock-keywords-4' - Exported functions, Function names, + Funs, LCs (not Atoms). To use a specific level, please set the variable `font-lock-maximum-decoration' to the appropriate level. Note that the @@ -1174,6 +1191,7 @@ Example: (defvar erlang-font-lock-keywords-4 (append erlang-font-lock-keywords-3 + erlang-font-lock-keywords-exported-function-header erlang-font-lock-keywords-int-function-calls erlang-font-lock-keywords-ext-function-calls erlang-font-lock-keywords-fun-n @@ -3662,6 +3680,38 @@ In the future the list may contain more elements." str) (store-match-data md)))) +(defun erlang-match-next-exported-function (max) + "Returns non-nil if there is an exported function in the current +buffer between point and MAX." + (block nil + (while (and (not erlang-inhibit-exported-function-name-face) + (erlang-match-next-function max)) + (when (erlang-last-match-exported-p) + (return (match-data)))))) + +(defun erlang-match-next-function (max) + "Searches forward in current buffer for the next erlang function, +bounded by position MAX." + (re-search-forward erlang-defun-prompt-regexp max 'move-point)) + +(defun erlang-last-match-exported-p () + "Returns non-nil if match-data describes the name and arity of an +exported function." + (save-excursion + (save-match-data + (goto-char (match-beginning 1)) + (erlang-function-exported-p + (erlang-remove-quotes (erlang-get-function-name)) + (erlang-get-function-arity))))) + +(defun erlang-function-exported-p (name arity) + "Returns non-nil if function of name and arity is exported in current buffer." + (save-excursion + (let* ((old-match-data (match-data)) + (exports (erlang-get-export))) + (store-match-data old-match-data) + (member (cons name arity) exports)))) + ;;; Check module name |
