diff options
author | Björn Gustavsson <[email protected]> | 2012-12-14 21:07:39 +0100 |
---|---|---|
committer | Björn Gustavsson <[email protected]> | 2013-01-22 19:20:09 +0100 |
commit | 8cc1f6e814fb4cfe69cb1f80138c630377d26b57 (patch) | |
tree | 8064a064abf7672c123f77723108f41bd7b74dc9 | |
parent | 60e73d24cfec506b966ff789c8420bc4f466f880 (diff) | |
download | otp-8cc1f6e814fb4cfe69cb1f80138c630377d26b57.tar.gz otp-8cc1f6e814fb4cfe69cb1f80138c630377d26b57.tar.bz2 otp-8cc1f6e814fb4cfe69cb1f80138c630377d26b57.zip |
Add run-time library templates and use them
The template modules (asn1rtt_*.erl) are based on the existing
run-time modules, but with some simplifications and improvements,
for example:
The run-time functions for BER encoding took a Constraint argument which
was not used. It has been eliminated, along with the unused StringType
argument for the encode_restricted_string function.
The Range argument for decode_enumerated() has been dropped since it
was not used.
-rw-r--r-- | lib/asn1/src/Makefile | 6 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct.erl | 4 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl | 85 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_constructed_per.erl | 95 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_gen.erl | 64 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_gen_ber_bin_v2.erl | 372 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_gen_per.erl | 200 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_gen_per_rt2ct.erl | 131 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_imm.erl | 10 | ||||
-rw-r--r-- | lib/asn1/src/asn1rt_ber_bin_v2.erl | 1 | ||||
-rw-r--r-- | lib/asn1/src/asn1rtt_ber.erl | 1619 | ||||
-rw-r--r-- | lib/asn1/src/asn1rtt_per.erl | 1334 | ||||
-rw-r--r-- | lib/asn1/src/asn1rtt_real_common.erl | 292 | ||||
-rw-r--r-- | lib/asn1/src/asn1rtt_uper.erl | 1379 | ||||
-rw-r--r-- | lib/asn1/test/asn1_SUITE_data/Prim.asn1 | 6 |
15 files changed, 5084 insertions, 514 deletions
diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 4096dd4db6..75ffdd66c7 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -173,7 +173,11 @@ release_docs_spec: # Run-time library template files. # -RT_TEMPLATES = asn1rtt_per_common +RT_TEMPLATES = asn1rtt_per_common \ + asn1rtt_real_common \ + asn1rtt_ber \ + asn1rtt_per \ + asn1rtt_uper RT_TEMPLATES_ERL = $(RT_TEMPLATES:%=%.erl) RT_TEMPLATES_TARGET = $(RT_TEMPLATES:%=%.$(EMULATOR)) diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 98877320a0..e361654a81 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -115,13 +115,11 @@ compile1(File,Options) when is_list(Options) -> DbFile = outfile(Base,"asn1db",Options), Includes = [I || {i,I} <- Options], EncodingRule = get_rule(Options), - asn1ct_table:new(asn1_functab), Continue1 = scan(File,Options), Continue2 = parse(Continue1,File,Options), Continue3 = check(Continue2,File,OutFile,Includes,EncodingRule, DbFile,Options,[]), Continue4 = generate(Continue3,OutFile,EncodingRule,Options), - asn1ct_table:delete(asn1_functab), Ret = compile_erl(Continue4,OutFile,Options), case inline(is_inline(Options), inline_output(Options,filename:rootname(File)), @@ -183,7 +181,6 @@ compile_set(SetBase,Files,Options) DbFile = outfile(SetBase,"asn1db",Options), Includes = [I || {i,I} <- Options], EncodingRule = get_rule(Options), - asn1ct_table:new(asn1_functab), ScanRes = scan_set(Files,Options), ParseRes = parse_set(ScanRes,Options), Result = @@ -208,7 +205,6 @@ compile_set(SetBase,Files,Options) {error,{'unexpected error in scan/parse phase', lists:map(fun(X)->element(3,X) end,Other)}} end, - asn1ct_table:delete(asn1_functab), Result. check_set(ParseRes,SetBase,OutFile,Includes,EncRule,DbFile, diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index 78cb9297d8..021002c3b3 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -162,7 +162,8 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> emit([nl," BytesSoFar = "]), case SeqOrSet of 'SET' when (D#type.def)#'SET'.sorted == dynamic -> - emit("asn1rt_check:dynamicsort_SET_components(["), + asn1ct_func:need({ber,dynamicsort_SET_components,1}), + emit("dynamicsort_SET_components(["), mkvlist(asn1ct_name:all(encBytes)), emit(["]),",nl]); _ -> @@ -177,8 +178,8 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> mkvplus(AllLengths) end, emit([",",nl]), - emit(["?RT_BER:encode_tags(TagIn, BytesSoFar, LenSoFar)." - ,nl]). + call(encode_tags, ["TagIn","BytesSoFar","LenSoFar"]), + emit([".",nl]). gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> asn1ct_name:start(), @@ -207,7 +208,8 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> _ -> emit([{curr,tlv}," = "]) end, - emit(["?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), + call(match_tags, [{prev,tlv},"TagIn"]), + emit([com,nl]), asn1ct_name:new(tlv), asn1ct_name:new(v), @@ -371,7 +373,8 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> _ -> emit([{curr,tlv}," = "]) end, - emit(["?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), + call(match_tags, [{prev,tlv},"TagIn"]), + emit([com,nl]), asn1ct_name:new(v), @@ -492,7 +495,8 @@ gen_encode_sof(Erules,Typename,_InnerTypename,D) when is_record(D,type) -> emit([" {EncBytes,EncLen} = 'enc_",asn1ct_gen:list2name(Typename), "_components'(Val",Objfun,",[],0),",nl]), - emit([" ?RT_BER:encode_tags(TagIn, EncBytes, EncLen).",nl,nl]), + emit([" ",{call,ber,encode_tags,["TagIn","EncBytes","EncLen"]}, + ".",nl,nl]), gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont). @@ -512,8 +516,8 @@ gen_decode_sof(Erules,TypeName,_InnerTypeName,D) when is_record(D,type) -> emit([" %%-------------------------------------------------",nl]), asn1ct_name:new(tlv), - emit([{curr,tlv}, - " = ?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), + emit([{curr,tlv}," = ", + {call,ber,match_tags,[{prev,tlv},"TagIn"]},com,nl]), asn1ct_name:new(v), emit(["["]), @@ -551,8 +555,9 @@ gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont) case catch lists:member(der,get(encoding_options)) of true when SeqOrSetOf=='SET OF'-> + asn1ct_func:need({ber,dynamicsort_SETOF,1}), emit([indent(3), - "{asn1rt_check:dynamicsort_SETOF(AccBytes),AccLen};",nl,nl]); + "{dynamicsort_SETOF(AccBytes),AccLen};",nl,nl]); _ -> emit([indent(3),"{lists:reverse(AccBytes),AccLen};",nl,nl]) end, @@ -672,8 +677,9 @@ gen_dec_sequence_call2(Erules,TopType,{Root1,EList,Root2},_Ext,DecObjInf) -> %% including the first mandatory element. TagList = get_root2_taglist(Root2,[]), emit({com,nl}), - emit([{curr,tlv}," = ?RT_BER:skip_ExtensionAdditions(", - {prev,tlv},", ",{asis,TagList},"),",nl]), + emit([{curr,tlv}," = ", + {call,ber,skip_ExtensionAdditions, + [{prev,tlv},{asis,TagList}]},com,nl]), asn1ct_name:new(tlv), gen_dec_sequence_call1(Erules,TopType,Root2, length(Root1)+length(EList),noext, @@ -805,8 +811,8 @@ gen_enc_choice1(Erules,TopType,_Tag,CompList,_Ext) -> emit([" {EncBytes,EncLen} = case element(1,Val) of",nl]), gen_enc_choice2(Erules,TopType,CompList), emit([nl," end,",nl,nl]), - - emit(["?RT_BER:encode_tags(TagIn, EncBytes, EncLen).",nl]). + call(encode_tags, ["TagIn","EncBytes","EncLen"]), + emit([".",nl]). gen_enc_choice2(Erules,TopType,[H1|T]) when is_record(H1,'ComponentType') -> @@ -859,8 +865,8 @@ gen_enc_choice2(_Erules,_TopType,[]) -> gen_dec_choice(Erules,TopType, _ChTag, CompList, Ext) -> asn1ct_name:clear(), asn1ct_name:new(tlv), - emit([{curr,tlv}, - " = ?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), + emit([{curr,tlv}," = ", + {call,ber,match_tags,[{prev,tlv},"TagIn"]},com,nl]), asn1ct_name:new(tlv), asn1ct_name:new(v), emit(["case (case ",{prev,tlv}, @@ -876,8 +882,8 @@ gen_dec_choice(Erules,TopType, _ChTag, CompList, Ext) -> emit([indent(9),"exit({error,{asn1,{invalid_choice_tag,", {curr,else},"}}})",nl]); _ -> - emit([indent(9),"{asn1_ExtAlt, ?RT_BER:encode(",{curr,else}, - asn1ct_gen:nif_parameter(),")}",nl]) + emit([indent(9),"{asn1_ExtAlt,", + {call,ber,ber_encode,[{curr,else}]},"}",nl]) end, emit([indent(3),"end",nl]), asn1ct_name:new(tag), @@ -1018,29 +1024,20 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj) case OptOrMand of mandatory -> emit(["{",{curr,encBytes},",",{curr,encLen}, - "} = "]), - emit(["?RT_BER:encode_open_type(",{curr,tmpBytes}, - ",",{asis,Tag},")"]); + "} = ", + {call,ber,encode_open_type, + [{curr,tmpBytes},{asis,Tag}]},nl]); _ -> -% emit(["{",{next,tmpBytes},", _} = "]), emit(["{",{next,tmpBytes},",",{curr,tmpLen}, - "} = "]), - emit(["?RT_BER:encode_open_type(",{curr,tmpBytes}, - ",",{asis,Tag},"),",nl]), + "} = ", + {call,ber,encode_open_type, + [{curr,tmpBytes},{asis,Tag}]},com,nl]), emit(IndDeep), emit(["{",{next,tmpBytes},", ",{curr,tmpLen},"}"]) end; Err -> throw({asn1,{'internal error',Err}}) end; -%% {{#'ObjectClassFieldType'{type={objectfield,PrimFieldName1, -%% PFNList}},_}, -%% {componentrelation,_,_}} -> -%% %% this is when the dotted list in the FieldName has more -%% %% than one element -%% {_LeadingAttrName,Fun} = EncObj, -%% emit(["?RT_BER:encode_open_type(",Fun,"(",{asis,PrimFieldName1}, -%% ", ",Element,", ",{asis,PFNList},"))"]); _ -> case WhatKind of {primitive,bif} -> @@ -1238,15 +1235,11 @@ gen_dec_call({typefield,_},_,_,_Cname,Type,BytesVar,Tag,_,_,false,_) -> asn1ct_name:new(tmptlv), {FirstPFName,RestPFName} = -% asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info), (Type#type.def)#'ObjectClassFieldType'.fieldname, emit([nl,indent(6),"begin",nl]), -% emit([indent(9),{curr,opendec}," = ?RT_BER:decode_open_type(", - emit([indent(9),{curr,tmptlv}," = ?RT_BER:decode_open_type(", - BytesVar,",",{asis,Tag},asn1ct_gen:nif_parameter(),"),",nl]), -% emit([indent(9),"{",{curr,tmptlv},",_} = ?RT_BER:decode(", -% {curr,opendec},"),",nl]), + emit([indent(9),{curr,tmptlv}," = ", + {call,ber,decode_open_type, + [BytesVar,{asis,Tag}]},com,nl]), emit([indent(9),"case (catch ObjFun(",{asis,FirstPFName}, ", ",{curr,tmptlv},", ",{asis,RestPFName}, @@ -1259,8 +1252,7 @@ gen_dec_call({typefield,_},_,_,_Cname,Type,BytesVar,Tag,_,_,false,_) -> emit([indent(9),"end",nl,indent(6),"end",nl]), []; gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag}, - asn1ct_gen:nif_parameter(),")"]), + call(decode_open_type, [BytesVar,{asis,Tag}]), RefedFieldName = % asn1ct_gen:get_constraint(Type#type.constraint, % tableconstraint_info), @@ -1268,8 +1260,7 @@ gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandC [{Cname,RefedFieldName,asn1ct_gen:mk_var(asn1ct_name:curr(term)), asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; gen_dec_call({objectfield,PrimFieldName,PFNList},_,_,Cname,_,BytesVar,Tag,_,_,_,OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag}, - asn1ct_gen:nif_parameter(),")"]), + call(decode_open_type, [BytesVar,{asis,Tag}]), [{Cname,{PrimFieldName,PFNList},asn1ct_gen:mk_var(asn1ct_name:curr(term)), asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand, @@ -1301,7 +1292,6 @@ gen_dec_call1({primitive,bif},InnerType,Erules,TopType,Cname,Type,BytesVar, asn1ct:add_generated_refed_func({[Cname|TopType],undecoded, Tag,Type}), asn1ct:update_gen_state(namelist,Rest), -% emit(["?RT_BER:match_tags(",BytesVar,",",{asis,Tag},")"]); emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',", BytesVar,"}"]); {_,{fixedtypevaluefield,_,Btype}} -> @@ -1320,7 +1310,6 @@ gen_dec_call1('ASN1_OPEN_TYPE',_InnerType,Erules,TopType,Cname,Type,BytesVar, asn1ct:update_gen_state(namelist,Rest), emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',", BytesVar,"}"]); -% emit(["?RT_BER:match_tags(",BytesVar,",",{asis,Tag},")"]); {_,#'ObjectClassFieldType'{type=OpenType}} -> ?ASN1CT_GEN_BER:gen_dec_prim(Erules,#type{def=OpenType}, BytesVar,Tag,[], @@ -1393,7 +1382,8 @@ gen_dec_call1(WhatKind,_,_Erules,TopType,Cname,Type,BytesVar, parts, [],Type}), emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',"]), - EmitDecFunCall("?RT_BER:match_tags"), + asn1ct_func:need({ber,match_tags,2}), + EmitDecFunCall("match_tags"), emit("}"); _ -> {DecFunName,_,_}= @@ -1522,3 +1512,6 @@ value_match1(Value,[],Acc,Depth) -> Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")")); value_match1(Value,[{VI,_}|VIs],Acc,Depth) -> value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1). + +call(F, Args) -> + asn1ct_func:call(ber, F, Args). diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index e8ec49d0c2..5520b41541 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -32,6 +32,7 @@ %-compile(export_all). -import(asn1ct_gen, [emit/1,demit/1,get_record_name_prefix/0]). +-import(asn1ct_func, [call/3]). %% ENCODE GENERATOR FOR SEQUENCE TYPE ** ********** @@ -86,7 +87,8 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> end,asn1ct_name:all(fixopt)), emit({"{",{next,val},",Opt} = {",{curr,val},",[",FixOpts,"]},",nl}); {_,_,false} -> - Fixoptcall = ",Opt} = ?RT_PER:fixoptionals(", + asn1ct_func:need({Erule,fixoptionals,3}), + Fixoptcall = ",Opt} = fixoptionals(", emit({"{",{next,val},Fixoptcall, {asis,Optionals},",",length(Optionals), ",",{curr,val},"),",nl}) @@ -121,8 +123,9 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> lists:foreach(ExtGroupFun,ExtGroupPosLenList) end, asn1ct_name:new(tmpval), - emit(["Extensions = ?RT_PER:fixextensions(",{asis,Ext},",", - {curr,val},"),",nl]); + emit(["Extensions = ", + {call,Erule,fixextensions,[{asis,Ext},{curr,val}]}, + com,nl]); _ -> true end, EncObj = @@ -191,10 +194,10 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> MaybeComma1 = case Ext of {ext,_Pos,NumExt2} when NumExt2 > 0 -> - emit({"?RT_PER:setext(Extensions =/= [])"}), + call(Erule, setext, ["Extensions =/= []"]), ", "; {ext,_Pos,_} -> - emit({"?RT_PER:setext(false)"}), + call(Erule, setext, ["false"]), ", "; _ -> "" @@ -513,7 +516,7 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) -> _-> "" end, - gen_encode_length(SizeConstraint, is_optimized(Erule)), + gen_encode_length(Erule, SizeConstraint), emit({indent(3),"'enc_",asn1ct_gen:list2name(Typename), "_components'(Val",ObjFun,", [])"}), emit({nl,"].",nl}), @@ -527,7 +530,7 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) -> %% Logic copied from asn1_per_bin_rt2ct:encode_constrained_number -gen_encode_length({Lb,Ub},true) when Ub =< 65535, Lb >= 0 -> +gen_encode_length(per, {Lb,Ub}) when Ub =< 65535, Lb >= 0 -> Range = Ub - Lb + 1, V2 = ["(length(Val) - ",Lb,")"], Encode = if @@ -554,12 +557,20 @@ gen_encode_length({Lb,Ub},true) when Ub =< 65535, Lb >= 0 -> Range =< 65536 -> {"[20,2,<<",V2,":16>>]"}; true -> - {"?RT_PER:encode_length(",{asis,{Lb,Ub}},",length(Val))"} + {call,per,encode_length, + [{asis,{Lb,Ub}},"length(Val)"]} end, emit({nl,Encode,",",nl}); -gen_encode_length(SizeConstraint,_) -> - emit({nl,indent(3),"?RT_PER:encode_length(", - {asis,SizeConstraint},",length(Val)),",nl}). +gen_encode_length(Erules, SizeConstraint) -> + emit([nl,indent(3), + case SizeConstraint of + undefined -> + {call,Erules,encode_length,["length(Val)"]}; + _ -> + {call,Erules,encode_length, + [{asis,SizeConstraint},"length(Val)"]} + end, + com,nl]). gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> asn1ct_name:start(), @@ -1003,7 +1014,9 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> case Ext of {ext,_Ep1,_} -> - emit(["?RT_PER:encode_open_type(dummy,?RT_PER:complete("]); + asn1ct_func:need({Erule,encode_open_type,1}), + asn1ct_func:need({Erule,complete,1}), + emit(["encode_open_type(complete("]); _ -> true end, @@ -1015,7 +1028,9 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> {notype,T} -> throw({error,{notype,type_from_object,T}}); {Name,RestFieldNames} when is_atom(Name) -> - emit({"?RT_PER:encode_open_type([],?RT_PER:complete(",nl}), + asn1ct_func:need({Erule,complete,1}), + asn1ct_func:need({Erule,encode_open_type,1}), + emit({"encode_open_type(complete(",nl}), emit({" ",Fun,"(",{asis,Name},", ", Element,", ",{asis,RestFieldNames},")))"}); Other -> @@ -1025,8 +1040,10 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> {objectfield,PrimFieldName1,PFNList} -> case DynamicEnc of {_LeadingAttrName,Fun} -> - emit({"?RT_PER:encode_open_type([]," - "?RT_PER:complete(",nl}), + asn1ct_func:need({Erule,complete,1}), + asn1ct_func:need({Erule,encode_open_type,1}), + emit({"encode_open_type(" + "complete(",nl}), emit({" ",Fun,"(",{asis,PrimFieldName1}, ", ",Element,", ",{asis,PFNList},")))"}) end; @@ -1105,8 +1122,9 @@ gen_dec_components_call(Erule,TopType,CL={Root1,ExtList,Root2}, NumExtsToSkip = ext_length(ExtList), Finish = fun(St) -> - emit([{next,bytes},"= ?RT_PER:skipextensions(",{curr,bytes},",", - NumExtsToSkip+1,",Extensions)"]), + emit([{next,bytes},"= "]), + call(Erule, skipextensions, + [{curr,bytes},NumExtsToSkip+1,"Extensions"]), asn1ct_name:new(bytes), St end, @@ -1559,29 +1577,33 @@ gen_dec_prim(Ctgenmod, Erule, Type) -> end. gen_enc_choice(Erule,TopType,CompList,Ext) -> - gen_enc_choice_tag(CompList, [], Ext), + gen_enc_choice_tag(Erule, CompList, [], Ext), emit({com,nl}), emit({"case element(1,Val) of",nl}), gen_enc_choice2(Erule,TopType, CompList, Ext), emit({nl,"end"}). -gen_enc_choice_tag({C1,C2},_,_) -> +gen_enc_choice_tag(Erule, {C1,C2}, _, _) -> N1 = get_name_list(C1), N2 = get_name_list(C2), - emit(["?RT_PER:set_choice(element(1,Val),", - {asis,{N1,N2}},", ",{asis,{length(N1),length(N2)}},")"]); - -gen_enc_choice_tag({C1,C2,C3},_,_) -> + call(Erule,set_choice, + ["element(1, Val)", + {asis,{N1,N2}}, + {asis,{length(N1),length(N2)}}]); +gen_enc_choice_tag(Erule, {C1,C2,C3}, _, _) -> N1 = get_name_list(C1), N2 = get_name_list(C2), N3 = get_name_list(C3), Root = N1 ++ N3, - emit(["?RT_PER:set_choice(element(1,Val),", - {asis,{Root,N2}},", ",{asis,{length(Root),length(N2)}},")"]); -gen_enc_choice_tag(C,_,_) -> + call(Erule,set_choice, + ["element(1, Val)", + {asis,{Root,N2}}, + {asis,{length(Root),length(N2)}}]); +gen_enc_choice_tag(Erule, C, _, _) -> N = get_name_list(C), - emit(["?RT_PER:set_choice(element(1,Val),", - {asis,N},", ",{asis,length(N)},")"]). + call(Erule,set_choice, + ["element(1, Val)", + {asis,N},{asis,length(N)}]). get_name_list(L) -> get_name_list(L,[]). @@ -1650,17 +1672,18 @@ gen_enc_choice2(_Erule,_,[], _, _) -> true. gen_dec_choice(Erule,TopType,CompList,{ext,Pos,NumExt}) -> - emit({"{Ext,",{curr,bytes},"} = ?RT_PER:getbit(Bytes),",nl}), + emit(["{Ext,",{curr,bytes},"} = ", + {call,Erule,getbit,["Bytes"]},com,nl]), asn1ct_name:new(bytes), gen_dec_choice1(Erule,TopType,CompList,{ext,Pos,NumExt}); gen_dec_choice(Erule,TopType,CompList,noext) -> gen_dec_choice1(Erule,TopType,CompList,noext). gen_dec_choice1(Erule,TopType,CompList,noext) -> - emit({"{Choice,",{curr,bytes}, - "} = ?RT_PER:getchoice(",{prev,bytes},",", - length(CompList),", 0),",nl}), - emit({"{Cname,{Val,NewBytes}} = case Choice of",nl}), + emit(["{Choice,",{curr,bytes}, + "} = ",{call,Erule,getchoice, + [{prev,bytes},length(CompList),"0"]},com,nl, + "{Cname,{Val,NewBytes}} = case Choice of",nl]), gen_dec_choice2(Erule,TopType,CompList,noext), emit({nl,"end,",nl}), emit({nl,"{{Cname,Val},NewBytes}"}); @@ -1671,9 +1694,9 @@ gen_dec_choice1(Erule,TopType,{RootList,ExtList,RootList2},Ext) -> NewList = RootList ++ RootList2 ++ ExtList, gen_dec_choice1(Erule,TopType, NewList, Ext); gen_dec_choice1(Erule,TopType,CompList,{ext,ExtPos,ExtNum}) -> - emit({"{Choice,",{curr,bytes}, - "} = ?RT_PER:getchoice(",{prev,bytes},",", - length(CompList)-ExtNum,",Ext ),",nl}), + emit(["{Choice,",{curr,bytes},"} = ", + {call,Erule,getchoice, + [{prev,bytes},length(CompList)-ExtNum,"Ext"]},com,nl]), emit({"{Cname,{Val,NewBytes}} = case Choice + Ext*",ExtPos-1," of",nl}), gen_dec_choice2(Erule,TopType,CompList,{ext,ExtPos,ExtNum}), Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)), diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 67efbcc532..eaca7d6ec3 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -46,7 +46,6 @@ un_hyphen_var/1]). -export([gen_encode_constructed/4, gen_decode_constructed/4]). --export([nif_parameter/0]). %% pgen(Outfile, Erules, Module, TypeOrVal, Options) %% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module @@ -534,7 +533,8 @@ gen_part_decode_funcs({constructed,bif},TypeName, {_Name,parts,Tag,_Type}) -> emit([" case Data of",nl, " L when is_list(L) ->",nl, - " 'dec_",TypeName,"'(lists:map(fun(X)->element(1,?RT_BER:decode(X)) end,L),",{asis,Tag},");",nl, + " 'dec_",TypeName,"'(lists:map(fun(X) -> element(1, ", + {call,ber,ber_decode_erlang,["X"]},") end, L),",{asis,Tag},");",nl, " _ ->",nl, " [Res] = 'dec_",TypeName,"'([Data],",{asis,Tag},"),",nl, " Res",nl, @@ -928,13 +928,16 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> {Call,BytesAsBinary} = case Erules of per -> - {["?RT_PER:complete(encode_disp(Type,Data))"],"Bytes"}; + asn1ct_func:need({Erules,complete,1}), + {["complete(encode_disp(Type, Data))"],"Bytes"}; ber -> {"encode_disp(Type,Data)","iolist_to_binary(Bytes)"}; uper when NoFinalPadding == true -> - {"?RT_PER:complete_NFP(encode_disp(Type,Data))","Bytes"}; + asn1ct_func:need({Erules,complete_NFP,1}), + {"complete_NFP(encode_disp(Type, Data))","Bytes"}; uper -> - {["?RT_PER:complete(encode_disp(Type,Data))"],"Bytes"} + asn1ct_func:need({Erules,complete,1}), + {["complete(encode_disp(Type, Data))"],"Bytes"} end, emit(["encode(Type,Data) ->",nl, "case catch ",Call," of",nl, @@ -958,12 +961,11 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> DecAnonymous = case {Erules,Return_rest} of {ber,false} -> - io_lib:format("~s~s~s~n", - ["element(1,?RT_BER:decode(Data", - nif_parameter(),"))"]); + asn1ct_func:need({ber,ber_decode_nif,1}), + "element(1, ber_decode_nif(Data))"; {ber,true} -> - emit(["{Data,Rest} = ?RT_BER:decode(Data0", - nif_parameter(),"),",nl]), + asn1ct_func:need({ber,ber_decode_nif,1}), + emit(["{Data,Rest} = ber_decode_nif(Data0),",nl]), "Data"; _ -> "Data" @@ -1048,16 +1050,16 @@ gen_decode_partial_incomplete(ber) -> emit(["decode_partial_incomplete(Type,Data0,", "Pattern) ->",nl]), emit([" {Data,_RestBin} =",nl, - " ?RT_BER:decode_primitive_", - "incomplete(Pattern,Data0),",nl, + " ",{call,ber,decode_primitive_incomplete, + ["Pattern","Data0"]},com,nl, " case catch decode_partial_inc_disp(Type,", "Data) of",nl]), EmitCaseClauses(), emit([".",nl,nl]), emit(["decode_part(Type, Data0) " "when is_binary(Data0) ->",nl]), - emit([" case catch decode_inc_disp(Type,element(1," - "?RT_BER:decode(Data0",nif_parameter(),"))) of",nl]), + emit([" case catch decode_inc_disp(Type,element(1, ", + {call,ber,ber_decode_nif,["Data0"]},")) of",nl]), EmitCaseClauses(), emit([";",nl]), emit(["decode_part(Type, Data0) ->",nl]), @@ -1101,9 +1103,6 @@ gen_partial_inc_dispatcher([],_) -> emit(["decode_partial_inc_disp(Type,_Data) ->",nl, " exit({error,{asn1,{undefined_type,Type}}}).",nl]). -nif_parameter() -> - ",nif". - gen_dispatcher([F1,F2|T],FuncName,Prefix,ExtraArg) -> emit([FuncName,"('",F1,"',Data) -> '",Prefix,F1,"'(Data",ExtraArg,")",";",nl]), gen_dispatcher([F2|T],FuncName,Prefix,ExtraArg); @@ -1393,23 +1392,19 @@ gen_record(_,_,_,NumRecords) -> % skip CLASS etc for now. gen_head(Erules,Mod,Hrl) -> Options = get(encoding_options), - {Rtmac,Rtmod} = case Erules of - per -> - emit({"%% Generated by the Erlang ASN.1 PER-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl}), - {"RT_PER","asn1rt_per_bin_rt2ct"}; - ber -> - emit({"%% Generated by the Erlang ASN.1 BER_V2-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl}), - {"RT_BER","asn1rt_ber_bin_v2"}; - uper -> - emit(["%% Generated by the Erlang ASN.1 UNALIGNED" - " PER-compiler version, utilizing" - " bit-syntax:", - asn1ct:vsn(),nl]), - {"RT_PER","asn1rt_uper_bin"} + case Erules of + per -> + emit(["%% Generated by the Erlang ASN.1 PER-" + "compiler version, utilizing bit-syntax:", + asn1ct:vsn(),nl]); + ber -> + emit(["%% Generated by the Erlang ASN.1 BER_V2-" + "compiler version, utilizing bit-syntax:", + asn1ct:vsn(),nl]); + uper -> + emit(["%% Generated by the Erlang ASN.1 UNALIGNED" + " PER-compiler version, utilizing bit-syntax:", + asn1ct:vsn(),nl]) end, emit({"%% Purpose: encoder and decoder to the types in mod ",Mod,nl,nl}), emit({"-module('",Mod,"').",nl}), @@ -1421,7 +1416,6 @@ gen_head(Erules,Mod,Hrl) -> _ -> emit({"-include(\"",Mod,".hrl\").",nl}) end, - emit(["-define('",Rtmac,"',",Rtmod,").",nl]), emit(["-asn1_info([{vsn,'",asn1ct:vsn(),"'},",nl, " {module,'",Mod,"'},",nl, " {options,",io_lib:format("~p",[Options]),"}]).",nl,nl]). diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index 664dfc2086..0826384365 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -170,139 +170,84 @@ gen_encode_user(Erules,D) when is_record(D,typedef) -> end. gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> - -%%% Constraint is currently not used for BER (except for BitString) and therefore replaced -%%% with [] as a placeholder BitStringConstraint = D#type.constraint, - Constraint = [], asn1ct_name:new(enumval), - case D#type.def of + Type = case D#type.def of + 'OCTET STRING' -> restricted_string; + 'ObjectDescriptor'-> restricted_string; + 'NumericString' -> restricted_string; + 'TeletexString' -> restricted_string; + 'T61String' -> restricted_string; + 'VideotexString' -> restricted_string; + 'GraphicString' -> restricted_string; + 'VisibleString' -> restricted_string; + 'GeneralString' -> restricted_string; + 'PrintableString' -> restricted_string; + 'IA5String' -> restricted_string; + Other -> Other + end, + case Type of + restricted_string -> + call(encode_restricted_string, [Value,DoTag]); 'BOOLEAN' -> - emit_encode_func('boolean',Value,DoTag); + call(encode_boolean, [Value,DoTag]); 'INTEGER' -> - emit_encode_func('integer',Constraint,Value,DoTag); + call(encode_integer, [Value,DoTag]); {'INTEGER',NamedNumberList} -> - emit_encode_func('integer',Constraint,Value, - NamedNumberList,DoTag); + call(encode_integer, [Value,{asis,NamedNumberList}, DoTag]); {'ENUMERATED',NamedNumberList={_,_}} -> - emit(["case ",Value," of",nl]), emit_enc_enumerated_cases(NamedNumberList,DoTag); {'ENUMERATED',NamedNumberList} -> - emit(["case ",Value," of",nl]), emit_enc_enumerated_cases(NamedNumberList,DoTag); - 'REAL' -> - emit_encode_func('real',Constraint,Value,DoTag); - + emit([{call,ber,encode_tags, + [DoTag,{call,real_common,ber_encode_real,[Value]}]}]); {'BIT STRING',NamedNumberList} -> - emit_encode_func('bit_string',BitStringConstraint,Value, - NamedNumberList,DoTag); + call(encode_bit_string, + [{asis,BitStringConstraint},Value, + {asis,NamedNumberList},DoTag]); 'ANY' -> - emit_encode_func('open_type', Value,DoTag); + call(encode_open_type, [Value,DoTag]); 'NULL' -> - emit_encode_func('null',Value,DoTag); + call(encode_null, [Value,DoTag]); 'OBJECT IDENTIFIER' -> - emit_encode_func("object_identifier",Value,DoTag); + call(encode_object_identifier, [Value,DoTag]); 'RELATIVE-OID' -> - emit_encode_func("relative_oid",Value,DoTag); - 'ObjectDescriptor' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_ObjectDescriptor,DoTag); - 'OCTET STRING' -> - emit_encode_func('octet_string',Constraint,Value,DoTag); - 'NumericString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_NumericString,DoTag); - TString when TString == 'TeletexString'; - TString == 'T61String' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_TeletexString,DoTag); - 'VideotexString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_VideotexString,DoTag); - 'GraphicString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_GraphicString,DoTag); - 'VisibleString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_VisibleString,DoTag); - 'GeneralString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_GeneralString,DoTag); - 'PrintableString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_PrintableString,DoTag); - 'IA5String' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_IA5String,DoTag); + call(encode_relative_oid, [Value,DoTag]); 'UniversalString' -> - emit_encode_func('universal_string',Constraint,Value,DoTag); + call(encode_universal_string, [Value,DoTag]); 'UTF8String' -> - emit_encode_func('UTF8_string',Constraint,Value,DoTag); + call(encode_UTF8_string, [Value,DoTag]); 'BMPString' -> - emit_encode_func('BMP_string',Constraint,Value,DoTag); + call(encode_BMP_string, [Value,DoTag]); 'UTCTime' -> - emit_encode_func('utc_time',Constraint,Value,DoTag); + call(encode_utc_time, [Value,DoTag]); 'GeneralizedTime' -> - emit_encode_func('generalized_time',Constraint,Value,DoTag); + call(encode_generalized_time, [Value,DoTag]); 'ASN1_OPEN_TYPE' -> - emit_encode_func('open_type', Value,DoTag); + call(encode_open_type, [Value,DoTag]); #'ObjectClassFieldType'{} -> case asn1ct_gen:get_inner(D#type.def) of {fixedtypevaluefield,_,InnerType} -> gen_encode_prim(Erules,InnerType,DoTag,Value); 'ASN1_OPEN_TYPE' -> - emit_encode_func('open_type', Value,DoTag); - XX -> - exit({'can not encode' ,XX}) - end; - XX -> - exit({'can not encode' ,XX}) + call(encode_open_type, [Value,DoTag]) + end end. - -emit_encode_func(Name,Value,Tags) when is_atom(Name) -> - emit_encode_func(atom_to_list(Name),Value,Tags); -emit_encode_func(Name,Value,Tags) -> - Fname = "?RT_BER:encode_" ++ Name, - emit([Fname,"(",Value,", ",Tags,")"]). - -emit_encode_func(Name,Constraint,Value,Tags) when is_atom(Name) -> - emit_encode_func(atom_to_list(Name),Constraint,Value,Tags); -emit_encode_func(Name,Constraint,Value,Tags) -> - Fname = "?RT_BER:encode_" ++ Name, - emit([Fname,"(",{asis,Constraint},", ",Value,", ",Tags,")"]). - -emit_encode_func(Name,Constraint,Value,Asis,Tags) when is_atom(Name) -> - emit_encode_func(atom_to_list(Name),Constraint,Value,Asis,Tags); -emit_encode_func(Name,Constraint,Value,Asis,Tags) -> - Fname = "?RT_BER:encode_" ++ Name, - emit([Fname,"(",{asis,Constraint},", ",Value, - ", ",{asis,Asis}, - ", ",Tags,")"]). - emit_enc_enumerated_cases({L1,L2}, Tags) -> emit_enc_enumerated_cases(L1++L2, Tags, ext); emit_enc_enumerated_cases(L, Tags) -> emit_enc_enumerated_cases(L, Tags, noext). -emit_enc_enumerated_cases([{EnumName,EnumVal},H2|T], Tags, Ext) -> - emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), -%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), - emit_enc_enumerated_cases([H2|T], Tags, Ext); -emit_enc_enumerated_cases([{EnumName,EnumVal}], Tags, Ext) -> - emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), -%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), - case Ext of - noext -> emit([";",nl]); - ext -> - emit([";",nl]) -%% emit([";",nl,"{asn1_enum,",{curr,enumval},"} -> ", -%% "?RT_BER:encode_enumerated(",{curr,enumval},",",Tags,");",nl]), -%% asn1ct_name:new(enumval) - end, +emit_enc_enumerated_cases([{EnumName,EnumVal}|T], Tags, Ext) -> + emit([{asis,EnumName}," -> ", + {call,ber,encode_enumerated,[EnumVal,Tags]},";",nl]), + emit_enc_enumerated_cases(T, Tags, Ext); +emit_enc_enumerated_cases([], _Tags, _Ext) -> + %% FIXME: Should extension be handled? emit([{curr,enumval}," -> exit({error,{asn1, {enumerated_not_in_range,",{curr, enumval},"}}})"]), emit([nl,"end"]). @@ -365,9 +310,10 @@ gen_decode_selected(Erules,Type,FuncName) -> {value,{_,P}} -> P; false -> exit({error,{internal,no_pattern_saved}}) end, - emit([" case ?RT_BER:decode_selective(",{asis,Pattern},",Bin) of",nl, + emit([" case ",{call,ber,decode_selective, + [{asis,Pattern},"Bin"]}," of",nl, " {ok,Bin2} when is_binary(Bin2) ->",nl, - " {Tlv,_} = ?RT_BER:decode(Bin2",asn1ct_gen:nif_parameter(),"),",nl]), + " {Tlv,_} = ", {call,ber,ber_decode_nif,["Bin2"]},com,nl]), emit("{ok,"), gen_decode_selected_type(Erules,Type), emit(["};",nl," Err -> exit({error,{selective_decode,Err}})",nl, @@ -555,141 +501,154 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> % DoLength = case NewTypeName of 'BOOLEAN'-> - emit({"?RT_BER:decode_boolean(",BytesVar,","}), - add_func({decode_boolean,2}); + emit(["decode_boolean(",BytesVar,","]), + need(decode_boolean, 2); 'INTEGER' -> - emit({"?RT_BER:decode_integer(",BytesVar,",", - {asis,int_constr(SingleValue,ValueRange)},","}), - add_func({decode_integer,3}); + emit(["decode_integer(",BytesVar,",", + {asis,int_constr(SingleValue,ValueRange)},","]), + need(decode_integer, 3); {'INTEGER',NamedNumberList} -> - emit({"?RT_BER:decode_integer(",BytesVar,",", + emit(["decode_integer(",BytesVar,",", {asis,int_constr(SingleValue,ValueRange)},",", - {asis,NamedNumberList},","}), - add_func({decode_integer,4}); + {asis,NamedNumberList},","]), + need(decode_integer, 4); {'ENUMERATED',NamedNumberList} -> - emit({"?RT_BER:decode_enumerated(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},","}), - add_func({decode_enumerated,4}); + emit(["decode_enumerated(",BytesVar,",", + {asis,NamedNumberList},","]), + need(decode_enumerated, 3); 'REAL' -> - emit({"?RT_BER:decode_real(",BytesVar,","}), - add_func({decode_real,3}); + ok; {'BIT STRING',NamedNumberList} -> case get(compact_bit_string) of true -> - emit({"?RT_BER:decode_compact_bit_string(", + emit(["decode_compact_bit_string(", BytesVar,",",{asis,Constraint},",", - {asis,NamedNumberList},","}), - add_func({decode_compact_bit_string,4}); + {asis,NamedNumberList},","]), + need(decode_compact_bit_string, 4); _ -> - emit({"?RT_BER:decode_bit_string(",BytesVar,",", + emit(["decode_bit_string(",BytesVar,",", {asis,Constraint},",", - {asis,NamedNumberList},","}), - add_func({decode_bit_string,4}) + {asis,NamedNumberList},","]), + need(decode_bit_string, 4) end; 'NULL' -> - emit({"?RT_BER:decode_null(",BytesVar,","}), - add_func({decode_null,2}); + emit(["decode_null(",BytesVar,","]), + need(decode_null, 2); 'OBJECT IDENTIFIER' -> - emit({"?RT_BER:decode_object_identifier(",BytesVar,","}), - add_func({decode_object_identifier,2}); + emit(["decode_object_identifier(",BytesVar,","]), + need(decode_object_identifier, 2); 'RELATIVE-OID' -> - emit({"?RT_BER:decode_relative_oid(",BytesVar,","}), - add_func({decode_relative_oid,2}); + emit(["decode_relative_oid(",BytesVar,","]), + need(decode_relative_oid, 2); 'ObjectDescriptor' -> - emit({"?RT_BER:decode_restricted_string(", - BytesVar,",",{asis,Constraint},",",{asis,?T_ObjectDescriptor},","}), - add_func({decode_restricted_string,4}); + emit(["decode_restricted_string(", + BytesVar,",",{asis,Constraint},",", + {asis,?T_ObjectDescriptor},","]), + need(decode_restricted_string, 4); 'OCTET STRING' -> - emit({"?RT_BER:decode_octet_string",AsBin,"(",BytesVar,",",{asis,Constraint},","}), - add_func({decode_octet_string,3}); + emit(["decode_octet_string",AsBin,"(",BytesVar,",", + {asis,Constraint},","]), + need(decode_octet_string, 3); 'NumericString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_NumericString},","}), - add_func({decode_restricted_string,4}); + emit(["decode_restricted_string",AsBin,"(", + BytesVar,",",{asis,Constraint},",", + {asis,?T_NumericString},","]), + need(decode_restricted_string, 4); TString when TString == 'TeletexString'; TString == 'T61String' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_TeletexString},","}), - add_func({decode_restricted_string,4}); + emit(["decode_restricted_string",AsBin,"(", + BytesVar,",",{asis,Constraint},",", + {asis,?T_TeletexString},","]), + need(decode_restricted_string, 4); 'VideotexString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_VideotexString},","}), - add_func({decode_restricted_string,4}); + emit(["decode_restricted_string",AsBin,"(", + BytesVar,",",{asis,Constraint},",", + {asis,?T_VideotexString},","]), + need(decode_restricted_string, 4); 'GraphicString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_GraphicString},","}), - add_func({decode_restricted_string,4}); + emit(["decode_restricted_string",AsBin,"(", + BytesVar,",",{asis,Constraint},",", + {asis,?T_GraphicString},","]), + need(decode_restricted_string, 4); 'VisibleString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_VisibleString},","}), - add_func({decode_restricted_string,4}); + emit(["decode_restricted_string",AsBin,"(", + BytesVar,",",{asis,Constraint},",", + {asis,?T_VisibleString},","]), + need(decode_restricted_string, 4); 'GeneralString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_GeneralString},","}), - add_func({decode_restricted_string,4}); + emit(["decode_restricted_string",AsBin,"(", + BytesVar,",",{asis,Constraint},",", + {asis,?T_GeneralString},","]), + need(decode_restricted_string, 4); 'PrintableString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_PrintableString},","}), - add_func({decode_restricted_string,4}); + emit(["decode_restricted_string",AsBin,"(", + BytesVar,",",{asis,Constraint},",", + {asis,?T_PrintableString},","]), + need(decode_restricted_string, 4); 'IA5String' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_IA5String},","}), - add_func({decode_restricted_string,4}) ; + emit(["decode_restricted_string",AsBin,"(", + BytesVar,",",{asis,Constraint},",", + {asis,?T_IA5String},","]), + need(decode_restricted_string, 4); 'UniversalString' -> - emit({"?RT_BER:decode_universal_string",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - add_func({decode_universal_string,3}); + emit(["decode_universal_string",AsBin,"(", + BytesVar,",",{asis,Constraint},","]), + need(decode_universal_string, 3); 'UTF8String' -> - emit({"?RT_BER:decode_UTF8_string",AsBin,"(", - BytesVar,","}), - add_func({decode_UTF8_string,2}); + emit(["decode_UTF8_string",AsBin,"(", + BytesVar,","]), + need(decode_UTF8_string, 2); 'BMPString' -> - emit({"?RT_BER:decode_BMP_string",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - add_func({decode_BMP_string,3}); + emit(["decode_BMP_string",AsBin,"(", + BytesVar,",",{asis,Constraint},","]), + need(decode_BMP_string, 3); 'UTCTime' -> - emit({"?RT_BER:decode_utc_time",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - add_func({decode_utc_time,3}); + emit(["decode_utc_time",AsBin,"(", + BytesVar,",",{asis,Constraint},","]), + need(decode_utc_time, 3); 'GeneralizedTime' -> - emit({"?RT_BER:decode_generalized_time",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - add_func({decode_generalized_time,3}); + emit(["decode_generalized_time",AsBin,"(", + BytesVar,",",{asis,Constraint},","]), + need(decode_generalized_time, 3); 'ASN1_OPEN_TYPE' -> - emit(["?RT_BER:decode_open_type_as_binary(", + emit(["decode_open_type_as_binary(", BytesVar,","]), - add_func({decode_open_type_as_binary,3}); + need(decode_open_type_as_binary, 2); #'ObjectClassFieldType'{} -> case asn1ct_gen:get_inner(Att#type.def) of {fixedtypevaluefield,_,InnerType} -> gen_dec_prim(Erules,InnerType,BytesVar,DoTag,TagIn,Form,OptOrMand); 'ASN1_OPEN_TYPE' -> - emit(["?RT_BER:decode_open_type_as_binary(", + emit(["decode_open_type_as_binary(", BytesVar,","]), - add_func({decode_open_type_as_binary,3}); + need(decode_open_type_as_binary, 2); Other -> - exit({'can not decode' ,Other}) + exit({'cannot decode',Other}) end; Other -> - exit({'can not decode' ,Other}) + exit({'cannot decode',Other}) end, - case {DoTag,NewTypeName} of - {_,#'ObjectClassFieldType'{}} -> + TagStr = case DoTag of + {string,Tag1} -> Tag1; + _ when is_list(DoTag) -> {asis,DoTag} + end, + case NewTypeName of + 'REAL' -> + asn1ct_name:new(tmpbuf), + emit(["begin",nl, + {curr,tmpbuf}," = ", + {call,ber,match_tags,[BytesVar,TagStr]},com,nl, + {call,real_common,decode_real,[{curr,tmpbuf}]},nl, + "end",nl]); + #'ObjectClassFieldType'{} -> case asn1ct_gen:get_inner(Att#type.def) of 'ASN1_OPEN_TYPE' -> - emit([{asis,DoTag},asn1ct_gen:nif_parameter(),")"]); + emit([TagStr,")"]); _ -> ok end; - {{string,TagStr},'ASN1_OPEN_TYPE'} -> - emit([TagStr,asn1ct_gen:nif_parameter(),")"]); - {_,'ASN1_OPEN_TYPE'} -> - emit([{asis,DoTag},asn1ct_gen:nif_parameter(),")"]); - {{string,TagStr},_} -> - emit([TagStr,")"]); - _ when is_list(DoTag) -> - emit([{asis,DoTag},")"]) + _ -> + emit([TagStr,")"]) end. @@ -1015,7 +974,7 @@ emit_tlv_format_function() -> end. emit_tlv_format_function1() -> emit(["tlv_format(Bytes) when is_binary(Bytes) ->",nl, - " {Tlv,_}=?RT_BER:decode(Bytes",asn1ct_gen:nif_parameter(),"),",nl, + " {Tlv,_} = ",{call,ber,ber_decode_nif,["Bytes"]},com,nl, " Tlv;",nl, "tlv_format(Bytes) ->",nl, " Bytes.",nl]). @@ -1449,38 +1408,22 @@ gen_objset_dec(_,ObjSetName,UniqueName,[{ObjName,Val,Fields}], emit_default_getdec(ObjSetName,UniqueName), emit([".",nl,nl]), ok; -gen_objset_dec(Erules,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, +gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, _ClFields,_NthObj) -> emit(["'getdec_",ObjSetName,"'(_, _) ->",nl]), emit([indent(2),"fun(_,Bytes, _RestPrimFieldName) ->",nl]), - case Erules of - ber -> - emit([indent(4),"case Bytes of",nl, - indent(6),"Bin when is_binary(Bin) -> ",nl, - indent(8),"Bin;",nl, - indent(6),"_ ->",nl, - indent(8),"?RT_BER:encode(Bytes",driver_parameter(),")",nl, - indent(4),"end",nl]); - _ -> - emit([indent(6),"Len = case Bytes of",nl,indent(9), - "Bin when is_binary(Bin) -> size(Bin);",nl,indent(9), - "_ -> length(Bytes)",nl,indent(6),"end,"]), - emit([indent(4),"{Bytes,[],Len}",nl]) - end, + emit([indent(4),"case Bytes of",nl, + indent(6),"Bin when is_binary(Bin) -> ",nl, + indent(8),"Bin;",nl, + indent(6),"_ ->",nl, + indent(8),{call,ber,ber_encode,["Bytes"]},nl, + indent(4),"end",nl]), emit([indent(2),"end.",nl,nl]), ok; gen_objset_dec(_,_,_,[],_,_,_) -> ok. -driver_parameter() -> - Options = get(encoding_options), - case {lists:member(driver,Options),lists:member(nif,Options)} of - {true,_} -> ",nif"; - {_,true} -> ",nif"; - _ -> ",erlang" - end. - emit_default_getdec(ObjSetName,UniqueName) -> emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), emit([indent(2), "fun(C,V,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). @@ -1771,9 +1714,6 @@ mk_object_val(0, Ack, Len) -> mk_object_val(Val, Ack, Len) -> mk_object_val(Val bsr 7, [((Val band 127) bor 128) | Ack], Len + 1). -add_func(F={_Func,_Arity}) -> - asn1ct_table:insert(asn1_functab, {F}). - %% For BER the ExtensionAdditionGroup notation has no impact on the encoding/decoding %% and therefore we only filter away the ExtensionAdditionGroup start and end markers extaddgroup2sequence(ExtList) when is_list(ExtList) -> @@ -1785,4 +1725,8 @@ extaddgroup2sequence(ExtList) when is_list(ExtList) -> true end, ExtList). +call(F, Args) -> + asn1ct_func:call(ber, F, Args). +need(F, Arity) -> + asn1ct_func:need({ber,F,Arity}). diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index af19edb908..08b65d466d 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -35,6 +35,7 @@ -export([extaddgroup2sequence/1]). -import(asn1ct_gen, [emit/1,demit/1]). +-import(asn1ct_func, [call/3]). %% pgen(Erules, Module, TypeOrVal) %% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module @@ -134,14 +135,13 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> asn1ct_name:new(enumval), case D#type.def of 'INTEGER' -> - emit({"?RT_PER:encode_integer(", %fel - {asis,asn1ct_imm:effective_constraint(integer,Constraint)}, - ",",Value,")"}); + Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)}, + Value], + call(Erules, encode_integer, Args); {'INTEGER',NamedNumberList} -> - emit({"?RT_PER:encode_integer(", - {asis,asn1ct_imm:effective_constraint(integer,Constraint)}, - ",",Value,",", - {asis,NamedNumberList},")"}); + Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)}, + Value,{asis,NamedNumberList}], + call(Erules, encode_integer, Args); {'ENUMERATED',{Nlist1,Nlist2}} -> NewList = lists:concat([[{0,X}||{X,_} <- Nlist1],['EXT_MARK'],[{1,X}||{X,_} <- Nlist2]]), NewC = [{'ValueRange',{0,length(Nlist1)-1}}], @@ -153,7 +153,6 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> {curr,enumval},";_->", Value," end) of",nl]), asn1ct_name:new(enumval) end, -%% emit_enc_enumerated_cases(Erules,NewC, NewList++[{asn1_enum,length(Nlist1)-1}], 0); emit_enc_enumerated_cases(Erules,NewC, NewList, 0); {'ENUMERATED',NamedNumberList} -> NewList = [X||{X,_} <- NamedNumberList], @@ -168,73 +167,68 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> emit_enc_enumerated_cases(Erules,NewC, NewList, 0); 'REAL' -> - emit({"?RT_PER:encode_real(",Value,")"}); + emit_enc_real(Erules, Value); {'BIT STRING',NamedNumberList} -> - emit({"?RT_PER:encode_bit_string(", - {asis,Constraint},",",Value,",", - {asis,NamedNumberList},")"}); + call(Erules, encode_bit_string, + [{asis,Constraint},Value, + {asis,NamedNumberList}]); 'NULL' -> emit("[]"); 'OBJECT IDENTIFIER' -> - emit({"?RT_PER:encode_object_identifier(",Value,")"}); + call(Erules, encode_object_identifier, [Value]); 'RELATIVE-OID' -> - emit({"?RT_PER:encode_relative_oid(",Value,")"}); + call(Erules, encode_relative_oid, [Value]); 'ObjectDescriptor' -> - emit({"?RT_PER:encode_ObjectDescriptor(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_ObjectDescriptor, + [{asis,Constraint},Value]); 'BOOLEAN' -> - emit({"?RT_PER:encode_boolean(",Value,")"}); + call(Erules, encode_boolean, [Value]); 'OCTET STRING' -> - emit({"?RT_PER:encode_octet_string(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_octet_string, [{asis,Constraint},Value]); 'NumericString' -> - emit({"?RT_PER:encode_NumericString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_NumericString, [{asis,Constraint},Value]); TString when TString == 'TeletexString'; TString == 'T61String' -> - emit({"?RT_PER:encode_TeletexString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_TeletexString, [{asis,Constraint},Value]); 'VideotexString' -> - emit({"?RT_PER:encode_VideotexString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_VideotexString, [{asis,Constraint},Value]); 'UTCTime' -> - emit({"?RT_PER:encode_VisibleString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_VisibleString, [{asis,Constraint},Value]); 'GeneralizedTime' -> - emit({"?RT_PER:encode_VisibleString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_VisibleString, [{asis,Constraint},Value]); 'GraphicString' -> - emit({"?RT_PER:encode_GraphicString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_GraphicString, [{asis,Constraint},Value]); 'VisibleString' -> - emit({"?RT_PER:encode_VisibleString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_VisibleString, [{asis,Constraint},Value]); 'GeneralString' -> - emit({"?RT_PER:encode_GeneralString(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_GeneralString, [{asis,Constraint},Value]); 'PrintableString' -> - emit({"?RT_PER:encode_PrintableString(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_PrintableString, [{asis,Constraint},Value]); 'IA5String' -> - emit({"?RT_PER:encode_IA5String(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_IA5String, [{asis,Constraint},Value]); 'BMPString' -> - emit({"?RT_PER:encode_BMPString(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_BMPString, [{asis,Constraint},Value]); 'UniversalString' -> - emit({"?RT_PER:encode_UniversalString(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_UniversalString, [{asis,Constraint},Value]); 'UTF8String' -> - emit({"?RT_PER:encode_UTF8String(",Value,")"}); + call(Erules, encode_UTF8String, [Value]); 'ANY' -> - emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", - Value, ")"]); + call(Erules, encode_open_type, [Value]); 'ASN1_OPEN_TYPE' -> NewValue = case Constraint of [#'Externaltypereference'{type=Tname}] -> - io_lib:format( - "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); + asn1ct_func:need({Erules,complete,1}), + io_lib:format( + "complete(enc_~s(~s))",[Tname,Value]); [#type{def=#'Externaltypereference'{type=Tname}}] -> + asn1ct_func:need({Erules,complete,1}), io_lib:format( - "?RT_PER:complete(enc_~s(~s))", + "complete(enc_~s(~s))", [Tname,Value]); _ -> Value end, - emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", - NewValue, ")"]); + call(Erules, encode_open_type, [NewValue]); #'ObjectClassFieldType'{} -> case asn1ct_gen:get_inner(D#type.def) of {fixedtypevaluefield,_,InnerType} -> @@ -246,6 +240,15 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> exit({asn1_error,nyi,XX}) end. +emit_enc_real(Erules, Real) -> + asn1ct_name:new(tmpval), + asn1ct_name:new(tmplen), + emit(["begin",nl, + "{",{curr,tmpval},com,{curr,tmplen},"} = ", + {call,real_common,encode_real,[Real]},com,nl, + "[",{call,Erules,encode_length,[{curr,tmplen}]},",", + {curr,tmpval},"]",nl, + "end"]). emit_enc_enumerated_cases(Erule,C, [H], Count) -> emit_enc_enumerated_case(Erule,C, H, Count), @@ -264,27 +267,17 @@ emit_enc_enumerated_cases(Erule, C, [H1,H2|T], Count) -> emit_enc_enumerated_cases(Erule, C, [H2|T], Count+1). - -emit_enc_enumerated_case(uper,_C, {asn1_enum,High}, _) -> - emit([ - "{asn1_enum,EnumV} when is_integer(EnumV), EnumV > ",High," -> ", - "[<<1:1>>,?RT_PER:encode_small_number(EnumV)]"]); -emit_enc_enumerated_case(_Per,_C, {asn1_enum,High}, _) -> - emit([ - "{asn1_enum,EnumV} when is_integer(EnumV), EnumV > ",High," -> ", - "[{bit,1},?RT_PER:encode_small_number(EnumV)]"]); emit_enc_enumerated_case(_Erule, _C, 'EXT_MARK', _Count) -> true; -emit_enc_enumerated_case(uper,_C, {1,EnumName}, Count) -> - emit(["'",EnumName,"' -> [<<1:1>>,?RT_PER:encode_small_number(",Count,")]"]); -emit_enc_enumerated_case(_Per,_C, {1,EnumName}, Count) -> - emit(["'",EnumName,"' -> [{bit,1},?RT_PER:encode_small_number(",Count,")]"]); -emit_enc_enumerated_case(uper,C, {0,EnumName}, Count) -> - emit(["'",EnumName,"' -> [<<0:1>>,?RT_PER:encode_integer(",{asis,C},", ",Count,")]"]); -emit_enc_enumerated_case(_Per,C, {0,EnumName}, Count) -> - emit(["'",EnumName,"' -> [{bit,0},?RT_PER:encode_integer(",{asis,C},", ",Count,")]"]); -emit_enc_enumerated_case(_Erule, C, EnumName, Count) -> - emit(["'",EnumName,"' -> ?RT_PER:encode_integer(",{asis,C},", ",Count,")"]). +emit_enc_enumerated_case(uper=Erules,_C, {1,EnumName}, Count) -> + emit(["'",EnumName,"' -> [<<1:1>>,", + {call,Erules,encode_small_number,[Count]},"]"]); +emit_enc_enumerated_case(uper=Erules, C, {0,EnumName}, Count) -> + emit(["'",EnumName,"' -> [<<0:1>>,", + {call,Erules,encode_integer,[{asis,C},Count]},"]"]); +emit_enc_enumerated_case(Erules, C, EnumName, Count) -> + emit(["'",EnumName,"' -> ", + {call,Erules,encode_integer,[{asis,C},Count]}]). get_constraint([{Key,V}], Key) -> V; @@ -446,7 +439,7 @@ gen_encode_field_call(ObjName,FieldName,Type) -> Def = Type#typedef.typespec, case Type#typedef.name of {primitive,bif} -> - gen_encode_prim(per,Def,"false", + gen_encode_prim(uper,Def,"false", "Val"), []; {constructed,bif} -> @@ -584,7 +577,7 @@ gen_decode_field_call(ObjName,FieldName,Bytes,Type) -> Def = Type#typedef.typespec, case Type#typedef.name of {primitive,bif} -> - gen_dec_prim(per,Def,Bytes), + gen_dec_prim(uper, Def, Bytes), []; {constructed,bif} -> emit({" 'dec_",ObjName,'_',FieldName, @@ -845,7 +838,7 @@ emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type}, case {ExtMod,Name} of {primitive,bif} -> emit(indent(12)), - gen_encode_prim(per,Type,dotag,"Val"), + gen_encode_prim(uper,Type,dotag,"Val"), {[],0}; {constructed,bif} -> emit([indent(12),"'enc_", @@ -988,7 +981,7 @@ emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type}, case {ExtName,Name} of {primitive,bif} -> emit(indent(12)), - gen_dec_prim(per,Type,"Val"), + gen_dec_prim(uper, Type, "Val"), 0; {constructed,bif} -> emit({indent(12),"'dec_", @@ -1006,7 +999,7 @@ emit_inner_of_decfun(Type,_) when is_record(Type,type) -> case Type#type.def of Def when is_atom(Def) -> emit({indent(9),Def," ->",nl,indent(12)}), - gen_dec_prim(erules,Type,"Val"); + gen_dec_prim(uper, Type, "Val"); TRef when is_record(TRef,typereference) -> T = TRef#typereference.val, emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); @@ -1120,6 +1113,8 @@ 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('REAL', _Constraint, Aligned) -> + asn1ct_imm:per_dec_real(Aligned); gen_dec_imm_1(_, _, _) -> no. gen_dec_prim(Erule, Type, BytesVar) -> @@ -1134,68 +1129,55 @@ gen_dec_prim_1(Erule, #type{def=Typename,constraint=Constraint}=Att, BytesVar) -> case Typename of - 'REAL' -> - emit({"?RT_PER:decode_real(",BytesVar,")"}); - {'BIT STRING',NamedNumberList} -> - case get(compact_bit_string) of - true -> - emit({"?RT_PER:decode_compact_bit_string(", - BytesVar,",",{asis,Constraint},",", - {asis,NamedNumberList},")"}); - _ -> - emit({"?RT_PER:decode_bit_string(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},")"}) - end; + Func = case get(compact_bit_string) of + true -> decode_compact_bit_string; + _ -> decode_bit_string + end, + call(Erule, Func, + [BytesVar,{asis,Constraint}, + {asis,NamedNumberList}]); 'NULL' -> emit({"{'NULL',",BytesVar,"}"}); 'OBJECT IDENTIFIER' -> - emit({"?RT_PER:decode_object_identifier(", - BytesVar,")"}); + call(Erule, decode_object_identifier, [BytesVar]); 'RELATIVE-OID' -> - emit({"?RT_PER:decode_relative_oid(", - BytesVar,")"}); + call(Erule, decode_relative_oid, [BytesVar]); 'ObjectDescriptor' -> - emit({"?RT_PER:decode_ObjectDescriptor(", - BytesVar,")"}); + call(Erule, decode_ObjectDescriptor, [BytesVar]); 'NumericString' -> - emit({"?RT_PER:decode_NumericString(",BytesVar,",", - {asis,Constraint},")"}); + call(Erule, decode_NumericString, + [BytesVar,{asis,Constraint}]); TString when TString == 'TeletexString'; TString == 'T61String' -> - emit({"?RT_PER:decode_TeletexString(",BytesVar,",", - {asis,Constraint},")"}); + call(Erule, decode_TeletexString, + [BytesVar,{asis,Constraint}]); 'VideotexString' -> - emit({"?RT_PER:decode_VideotexString(",BytesVar,",", - {asis,Constraint},")"}); + call(Erule, decode_VideotexString, + [BytesVar,{asis,Constraint}]); 'UTCTime' -> - emit({"?RT_PER:decode_VisibleString(",BytesVar,",", - {asis,Constraint},")"}); + call(Erule, decode_VisibleString, [BytesVar,{asis,Constraint}]); 'GeneralizedTime' -> - emit({"?RT_PER:decode_VisibleString(",BytesVar,",", - {asis,Constraint},")"}); + call(Erule, decode_VisibleString, [BytesVar,{asis,Constraint}]); 'GraphicString' -> - emit({"?RT_PER:decode_GraphicString(",BytesVar,",", - {asis,Constraint},")"}); + call(Erule, decode_GraphicString,[BytesVar,{asis,Constraint}]); 'VisibleString' -> - emit({"?RT_PER:decode_VisibleString(",BytesVar,",", - {asis,Constraint},")"}); + call(Erule, decode_VisibleString, [BytesVar,{asis,Constraint}]); 'GeneralString' -> - emit({"?RT_PER:decode_GeneralString(",BytesVar,",", - {asis,Constraint},")"}); + call(Erule, decode_GeneralString, [BytesVar,{asis,Constraint}]); 'PrintableString' -> - emit({"?RT_PER:decode_PrintableString(",BytesVar,",",{asis,Constraint},")"}); + call(Erule, decode_PrintableString, + [BytesVar,{asis,Constraint}]); 'IA5String' -> - emit({"?RT_PER:decode_IA5String(",BytesVar,",",{asis,Constraint},")"}); + call(Erule, decode_IA5String, [BytesVar,{asis,Constraint}]); 'BMPString' -> - emit({"?RT_PER:decode_BMPString(",BytesVar,",", - {asis,Constraint},")"}); + call(Erule, decode_BMPString, + [BytesVar,{asis,Constraint}]); 'UniversalString' -> - emit({"?RT_PER:decode_UniversalString(",BytesVar, - ",",{asis,Constraint},")"}); + call(Erule, decode_UniversalString, + [BytesVar,{asis,Constraint}]); 'UTF8String' -> - emit({"?RT_PER:decode_UTF8String(",BytesVar,")"}); + call(Erule, decode_UTF8String, [BytesVar]); #'ObjectClassFieldType'{} -> case asn1ct_gen:get_inner(Typename) of {fixedtypevaluefield,_,InnerType} -> diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index 4f4563833f..b1ecfa135d 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -34,6 +34,7 @@ -import(asn1ct_gen, [emit/1,demit/1]). -import(asn1ct_gen_per, [is_already_generated/2,more_genfields/1, get_class_fields/1,get_object_field/2]). +-import(asn1ct_func, [call/3]). %% pgen(Erules, Module, TypeOrVal) %% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module @@ -152,26 +153,27 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> emit_enc_integer(Erules,NewC,NewVal); 'REAL' -> - emit({"?RT_PER:encode_real(",Value,")"}); + emit_enc_real(Erules, Value); {'BIT STRING',NamedNumberList} -> EffectiveC = effective_constraint(bitstring,Constraint), case EffectiveC of - 0 -> emit({"[]"}); + 0 -> + emit({"[]"}); _ -> - emit({"?RT_PER:encode_bit_string(", - {asis,EffectiveC},",",Value,",", - {asis,NamedNumberList},")"}) + call(Erules, encode_bit_string, + [{asis,EffectiveC},Value, + {asis,NamedNumberList}]) end; 'NULL' -> emit("[]"); 'OBJECT IDENTIFIER' -> - emit({"?RT_PER:encode_object_identifier(",Value,")"}); + call(Erules, encode_object_identifier, [Value]); 'RELATIVE-OID' -> - emit({"?RT_PER:encode_relative_oid(",Value,")"}); + call(Erules, encode_relative_oid, [Value]); 'ObjectDescriptor' -> - emit({"?RT_PER:encode_ObjectDescriptor(",{asis,Constraint}, - ",",Value,")"}); + call(Erules, encode_ObjectDescriptor, + [{asis,Constraint},Value]); 'BOOLEAN' -> emit({"case ",Value," of",nl, " true -> [1];",nl, @@ -185,19 +187,19 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> emit_enc_known_multiplier_string('NumericString',Constraint,Value); TString when TString == 'TeletexString'; TString == 'T61String' -> - emit({"?RT_PER:encode_TeletexString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_TeletexString, [{asis,Constraint},Value]); 'VideotexString' -> - emit({"?RT_PER:encode_VideotexString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_VideotexString, [{asis,Constraint},Value]); 'UTCTime' -> emit_enc_known_multiplier_string('VisibleString',Constraint,Value); 'GeneralizedTime' -> emit_enc_known_multiplier_string('VisibleString',Constraint,Value); 'GraphicString' -> - emit({"?RT_PER:encode_GraphicString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_GraphicString, [{asis,Constraint},Value]); 'VisibleString' -> emit_enc_known_multiplier_string('VisibleString',Constraint,Value); 'GeneralString' -> - emit({"?RT_PER:encode_GeneralString(",{asis,Constraint},",",Value,")"}); + call(Erules, encode_GeneralString, [{asis,Constraint},Value]); 'PrintableString' -> emit_enc_known_multiplier_string('PrintableString',Constraint,Value); 'IA5String' -> @@ -207,23 +209,23 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> 'UniversalString' -> emit_enc_known_multiplier_string('UniversalString',Constraint,Value); 'UTF8String' -> - emit({"?RT_PER:encode_UTF8String(",Value,")"}); + call(Erules, encode_UTF8String, [Value]); 'ANY' -> - emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", - Value, ")"]); + call(Erules, encode_open_type, [Value]); 'ASN1_OPEN_TYPE' -> NewValue = case Constraint of [#'Externaltypereference'{type=Tname}] -> - io_lib:format( - "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); + asn1ct_func:need({Erules,complete,1}), + io_lib:format( + "complete(enc_~s(~s))",[Tname,Value]); [#type{def=#'Externaltypereference'{type=Tname}}] -> + asn1ct_func:need({Erules,complete,1}), io_lib:format( - "?RT_PER:complete(enc_~s(~s))", + "complete(enc_~s(~s))", [Tname,Value]); _ -> Value end, - emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", - NewValue, ")"]); + call(Erules, encode_open_type, [NewValue]); #'ObjectClassFieldType'{} -> case asn1ct_gen:get_inner(D#type.def) of {fixedtypevaluefield,_,InnerType} -> @@ -235,6 +237,17 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> exit({asn1_error,nyi,XX}) end. +emit_enc_real(Erules, Real) -> + asn1ct_name:new(tmpval), + asn1ct_name:new(tmplen), + emit(["begin",nl, + "{",{curr,tmpval},com,{curr,tmplen},"} = ", + {call,real_common,encode_real,[Real]},com,nl, + "[",{call,Erules,encode_length,[{curr,tmplen}]},",",nl, + {call,Erules,octets_to_complete, + [{curr,tmplen},{curr,tmpval}]},"]",nl, + "end"]). + emit_enc_known_multiplier_string(StringType,C,Value) -> SizeC = case get_constraint(C,'SizeConstraint') of @@ -254,13 +267,13 @@ emit_enc_known_multiplier_string(StringType,C,Value) -> NumBits = get_NumBits(C,StringType), CharOutTab = get_CharOutTab(C,StringType), %% NunBits and CharOutTab for chars_encode - emit_enc_k_m_string(StringType,SizeC,NumBits,CharOutTab,Value). + emit_enc_k_m_string(SizeC, NumBits, CharOutTab, Value). -emit_enc_k_m_string(_StringType,0,_NumBits,_CharOutTab,_Value) -> +emit_enc_k_m_string(0, _NumBits, _CharOutTab, _Value) -> emit({"[]"}); -emit_enc_k_m_string(StringType,SizeC,NumBits,CharOutTab,Value) -> - emit({"?RT_PER:encode_known_multiplier_string(",{asis,StringType},",", - {asis,SizeC},",",NumBits,",",{asis,CharOutTab},",",Value,")"}). +emit_enc_k_m_string(SizeC, NumBits, CharOutTab, Value) -> + call(per, encode_known_multiplier_string, + [{asis,SizeC},NumBits,{asis,CharOutTab},Value]). emit_dec_known_multiplier_string(StringType,C,BytesVar) -> SizeC = get_constraint(C,'SizeConstraint'), @@ -280,9 +293,9 @@ emit_dec_known_multiplier_string(StringType,C,BytesVar) -> 0 -> emit({"{[],",BytesVar,"}"}); _ -> - emit({"?RT_PER:decode_known_multiplier_string(", - {asis,StringType},",",{asis,SizeC},",",NumBits, - ",",{asis,CharInTab},",",BytesVar,")"}) + call(per, decode_known_multiplier_string, + [{asis,StringType},{asis,SizeC},NumBits, + {asis,CharInTab},BytesVar]) end. @@ -397,7 +410,7 @@ charbits1(NumOfChars) -> %% copied from run time module -emit_enc_octet_string(_Erules,Constraint,Value) -> +emit_enc_octet_string(Erules, Constraint, Value) -> case get_constraint(Constraint,'SizeConstraint') of 0 -> emit({" []"}); @@ -446,7 +459,8 @@ emit_enc_octet_string(_Erules,Constraint,Value) -> " end",nl, " end"]); C -> - emit({" ?RT_PER:encode_octet_string(",{asis,C},",false,",Value,")",nl}) + call(Erules, encode_octet_string, + [{asis,C},false,Value]) end. emit_enc_integer_case(Value) -> @@ -533,10 +547,8 @@ emit_enc_integer(_Erule,[{_,{Lb,Ub},Range,_}],Value) when Range =< 65536 -> nl," end",nl]), emit_enc_integer_end_case(); - -emit_enc_integer(_Erule,C,Value) -> - emit({" ?RT_PER:encode_integer(",{asis,C},",",Value,")"}). - +emit_enc_integer(Erule, C, Value) -> + call(Erule, encode_integer, [{asis,C},Value]). @@ -582,16 +594,15 @@ emit_enc_enumerated_cases(Erule, C, [H1,H2|T], Count) -> %% %% ENUMERATED with extensionmark %% %% value higher than the extension base and not %% %% present in the extension range. -%% emit(["{asn1_enum,EnumV} when is_integer(EnumV), EnumV > ",High," -> ", -%% "[1,?RT_PER:encode_small_number(EnumV)]"]); -emit_enc_enumerated_case(_Erule,_C, {1,EnumName}, Count) -> +emit_enc_enumerated_case(Erule,_C, {1,EnumName}, Count) -> %% ENUMERATED with extensionmark %% values higher than extension root - emit(["'",EnumName,"' -> [1,?RT_PER:encode_small_number(",Count,")]"]); + emit(["'",EnumName,"' -> [1,"]), + call(Erule, encode_small_number, [Count]), + emit("]"); emit_enc_enumerated_case(_Erule,C, {0,EnumName}, Count) -> %% ENUMERATED with extensionmark %% values within extension root -%% emit(["'",EnumName,"' -> [0,?RT_PER:encode_integer(",{asis,C},", ",Count,")]"]); emit(["'",EnumName,"' -> ",{asis,[0|asn1rt_per_bin_rt2ct:encode_integer(C,Count)]}]); emit_enc_enumerated_case(_Erule, _C, 'EXT_MARK', _Count) -> true. @@ -1367,7 +1378,7 @@ emit_inner_of_decfun(Type,_) when is_record(Type,type) -> case Type#type.def of Def when is_atom(Def) -> emit({indent(9),Def," ->",nl,indent(12)}), - gen_dec_prim(erules,Type,"Val"); + gen_dec_prim(per, Type, "Val"); TRef when is_record(TRef,typereference) -> T = TRef#typereference.val, emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); @@ -1465,30 +1476,18 @@ gen_dec_prim(Erules,Att,BytesVar) -> {'INTEGER',_NamedNumberList} -> asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'REAL' -> - emit(["?RT_PER:decode_real(",BytesVar,")"]); + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); - {'BIT STRING',NamedNumberList} -> - case get(compact_bit_string) of - true -> - emit({"?RT_PER:decode_compact_bit_string(", - BytesVar,",",{asis,Constraint},",", - {asis,NamedNumberList},")"}); - _ -> - emit({"?RT_PER:decode_bit_string(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},")"}) - end; + {'BIT STRING',_} -> + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'NULL' -> emit({"{'NULL',",BytesVar,"}"}); 'OBJECT IDENTIFIER' -> - emit({"?RT_PER:decode_object_identifier(", - BytesVar,")"}); + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'RELATIVE-OID' -> - emit({"?RT_PER:decode_relative_oid(", - BytesVar,")"}); + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'ObjectDescriptor' -> - emit({"?RT_PER:decode_ObjectDescriptor(", - BytesVar,")"}); + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); {'ENUMERATED',_} -> asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'BOOLEAN'-> @@ -1502,12 +1501,10 @@ gen_dec_prim(Erules,Att,BytesVar) -> Constraint,BytesVar); TString when TString == 'TeletexString'; TString == 'T61String' -> - emit({"?RT_PER:decode_TeletexString(",BytesVar,",", - {asis,Constraint},")"}); + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'VideotexString' -> - emit({"?RT_PER:decode_VideotexString(",BytesVar,",", - {asis,Constraint},")"}); + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'UTCTime' -> emit_dec_known_multiplier_string('VisibleString', @@ -1516,15 +1513,13 @@ gen_dec_prim(Erules,Att,BytesVar) -> emit_dec_known_multiplier_string('VisibleString', Constraint,BytesVar); 'GraphicString' -> - emit({"?RT_PER:decode_GraphicString(",BytesVar,",", - {asis,Constraint},")"}); + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'VisibleString' -> emit_dec_known_multiplier_string('VisibleString', Constraint,BytesVar); 'GeneralString' -> - emit({"?RT_PER:decode_GeneralString(",BytesVar,",", - {asis,Constraint},")"}); + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'PrintableString' -> emit_dec_known_multiplier_string('PrintableString', @@ -1540,7 +1535,7 @@ gen_dec_prim(Erules,Att,BytesVar) -> Constraint,BytesVar); 'UTF8String' -> - emit({"?RT_PER:decode_UTF8String(",BytesVar,")"}); + asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'ANY' -> asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar); 'ASN1_OPEN_TYPE' -> diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index d27bea98d0..384d4a86bb 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -21,7 +21,7 @@ -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]). + per_dec_octet_string/2,per_dec_open_type/1,per_dec_real/1]). -export([optimize_alignment/1,optimize_alignment/2, dec_slim_cg/2,dec_code_gen/2]). -export([effective_constraint/2]). @@ -107,6 +107,14 @@ per_dec_open_type(Aligned) -> {get_bits,decode_unconstrained_length(true, Aligned), [8,binary,{align,Aligned}]}. +per_dec_real(Aligned) -> + Dec = fun(V, Buf) -> + emit(["{",{call,real_common,decode_real,[V]}, + com,Buf,"}"]) + end, + {call,Dec, + {get_bits,decode_unconstrained_length(true, Aligned), + [8,binary,{align,Aligned}]}}. %%% %%% Local functions. diff --git a/lib/asn1/src/asn1rt_ber_bin_v2.erl b/lib/asn1/src/asn1rt_ber_bin_v2.erl index 92ca11cf89..10deecee6e 100644 --- a/lib/asn1/src/asn1rt_ber_bin_v2.erl +++ b/lib/asn1/src/asn1rt_ber_bin_v2.erl @@ -24,6 +24,7 @@ -export([decode/1, decode/2, match_tags/2, encode/1, encode/2]). -export([fixoptionals/2, encode_tag_val/1, + encode_tags/2, encode_tags/3, skip_ExtensionAdditions/2]). -export([encode_boolean/2,decode_boolean/2, diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl new file mode 100644 index 0000000000..b374191f37 --- /dev/null +++ b/lib/asn1/src/asn1rtt_ber.erl @@ -0,0 +1,1619 @@ +%% +%% %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(asn1rtt_ber). + +%% encoding / decoding of BER + +-export([ber_decode_nif/1,ber_decode_erlang/1,match_tags/2,ber_encode/1]). +-export([encode_tags/2, + encode_tags/3, + skip_ExtensionAdditions/2]). +-export([encode_boolean/2,decode_boolean/2, + encode_integer/2,encode_integer/3, + decode_integer/3,decode_integer/4, + encode_enumerated/2,decode_enumerated/3, + encode_bit_string/4,decode_bit_string/4, + decode_compact_bit_string/4, + decode_octet_string/3, + encode_null/2,decode_null/2, + encode_relative_oid/2,decode_relative_oid/2, + encode_object_identifier/2,decode_object_identifier/2, + encode_restricted_string/2,decode_restricted_string/4, + encode_universal_string/2,decode_universal_string/3, + encode_UTF8_string/2,decode_UTF8_string/2, + encode_BMP_string/2,decode_BMP_string/3, + encode_generalized_time/2,decode_generalized_time/3, + encode_utc_time/2,decode_utc_time/3]). + +-export([encode_open_type/2,decode_open_type/2, + decode_open_type_as_binary/2]). + +-export([decode_primitive_incomplete/2,decode_selective/2]). + +%% For DER. +-export([dynamicsort_SET_components/1,dynamicsort_SETOF/1]). + +%% the encoding of class of tag bits 8 and 7 +-define(UNIVERSAL, 0). +-define(APPLICATION, 16#40). +-define(CONTEXT, 16#80). +-define(PRIVATE, 16#C0). + +%%% primitive or constructed encoding % bit 6 +-define(PRIMITIVE, 0). +-define(CONSTRUCTED, 2#00100000). + +%%% The tag-number for universal types +-define(N_BOOLEAN, 1). +-define(N_INTEGER, 2). +-define(N_BIT_STRING, 3). +-define(N_OCTET_STRING, 4). +-define(N_NULL, 5). +-define(N_OBJECT_IDENTIFIER, 6). +-define(N_OBJECT_DESCRIPTOR, 7). +-define(N_EXTERNAL, 8). +-define(N_REAL, 9). +-define(N_ENUMERATED, 10). +-define(N_EMBEDDED_PDV, 11). +-define(N_SEQUENCE, 16). +-define(N_SET, 17). +-define(N_NumericString, 18). +-define(N_PrintableString, 19). +-define(N_TeletexString, 20). +-define(N_VideotexString, 21). +-define(N_IA5String, 22). +-define(N_UTCTime, 23). +-define(N_GeneralizedTime, 24). +-define(N_GraphicString, 25). +-define(N_VisibleString, 26). +-define(N_GeneralString, 27). +-define(N_UniversalString, 28). +-define(N_BMPString, 30). + + +% the complete tag-word of built-in types +-define(T_BOOLEAN, ?UNIVERSAL bor ?PRIMITIVE bor 1). +-define(T_INTEGER, ?UNIVERSAL bor ?PRIMITIVE bor 2). +-define(T_BIT_STRING, ?UNIVERSAL bor ?PRIMITIVE bor 3). % can be CONSTRUCTED +-define(T_OCTET_STRING, ?UNIVERSAL bor ?PRIMITIVE bor 4). % can be CONSTRUCTED +-define(T_NULL, ?UNIVERSAL bor ?PRIMITIVE bor 5). +-define(T_OBJECT_IDENTIFIER,?UNIVERSAL bor ?PRIMITIVE bor 6). +-define(T_OBJECT_DESCRIPTOR,?UNIVERSAL bor ?PRIMITIVE bor 7). +-define(T_EXTERNAL, ?UNIVERSAL bor ?PRIMITIVE bor 8). +-define(T_REAL, ?UNIVERSAL bor ?PRIMITIVE bor 9). +-define(T_ENUMERATED, ?UNIVERSAL bor ?PRIMITIVE bor 10). +-define(T_EMBEDDED_PDV, ?UNIVERSAL bor ?PRIMITIVE bor 11). +-define(T_SEQUENCE, ?UNIVERSAL bor ?CONSTRUCTED bor 16). +-define(T_SET, ?UNIVERSAL bor ?CONSTRUCTED bor 17). +-define(T_NumericString, ?UNIVERSAL bor ?PRIMITIVE bor 18). %can be constructed +-define(T_PrintableString, ?UNIVERSAL bor ?PRIMITIVE bor 19). %can be constructed +-define(T_TeletexString, ?UNIVERSAL bor ?PRIMITIVE bor 20). %can be constructed +-define(T_VideotexString, ?UNIVERSAL bor ?PRIMITIVE bor 21). %can be constructed +-define(T_IA5String, ?UNIVERSAL bor ?PRIMITIVE bor 22). %can be constructed +-define(T_UTCTime, ?UNIVERSAL bor ?PRIMITIVE bor 23). +-define(T_GeneralizedTime, ?UNIVERSAL bor ?PRIMITIVE bor 24). +-define(T_GraphicString, ?UNIVERSAL bor ?PRIMITIVE bor 25). %can be constructed +-define(T_VisibleString, ?UNIVERSAL bor ?PRIMITIVE bor 26). %can be constructed +-define(T_GeneralString, ?UNIVERSAL bor ?PRIMITIVE bor 27). %can be constructed +-define(T_UniversalString, ?UNIVERSAL bor ?PRIMITIVE bor 28). %can be constructed +-define(T_BMPString, ?UNIVERSAL bor ?PRIMITIVE bor 30). %can be constructed + +ber_encode([Tlv]) -> + ber_encode(Tlv); +ber_encode(Tlv) when is_binary(Tlv) -> + Tlv; +ber_encode(Tlv) -> + asn1rt_nif:encode_ber_tlv(Tlv). + +ber_decode_nif(B) -> + case asn1rt_nif:decode_ber_tlv(B) of + {error, Reason} -> handle_error(Reason, B); + Else -> Else + end. + +ber_decode_erlang(B) when is_binary(B) -> + decode_primitive(B); +ber_decode_erlang(Tlv) -> + {Tlv,<<>>}. + +handle_error([],_)-> + exit({error,{asn1,{"memory allocation problem"}}}); +handle_error({$1,_},L) -> % error in nif + exit({error,{asn1,L}}); +handle_error({$2,T},L) -> % error in nif due to wrong tag + exit({error,{asn1,{"bad tag after byte:",error_pos(T),L}}}); +handle_error({$3,T},L) -> % error in driver due to length error + exit({error,{asn1,{"bad length field after byte:", + error_pos(T),L}}}); +handle_error({$4,T},L) -> % error in driver due to indefinite length error + exit({error,{asn1, + {"indefinite length without end bytes after byte:", + error_pos(T),L}}}); +handle_error({$5,T},L) -> % error in driver due to indefinite length error + exit({error,{asn1,{"bad encoded value after byte:", + error_pos(T),L}}}); +handle_error(ErrL,L) -> + exit({error,{asn1,ErrL,L}}). + +error_pos([]) -> + "unknown position"; +error_pos([B])-> + B; +error_pos([B|Bs]) -> + BS = 8 * length(Bs), + B bsl BS + error_pos(Bs). + +decode_primitive(Bin) -> + {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), + case Form of + 1 -> % constructed + {{TagNo,decode_constructed(V)},Rest}; + 0 -> % primitive + {{TagNo,V},Rest}; + 2 -> % constructed indefinite + {Vlist,Rest2} = decode_constructed_indefinite(V,[]), + {{TagNo,Vlist},Rest2} + end. + +decode_constructed(Bin) when byte_size(Bin) =:= 0 -> + []; +decode_constructed(Bin) -> + {Tlv,Rest} = decode_primitive(Bin), + [Tlv|decode_constructed(Rest)]. + +decode_constructed_indefinite(<<0,0,Rest/binary>>,Acc) -> + {lists:reverse(Acc),Rest}; +decode_constructed_indefinite(Bin,Acc) -> + {Tlv,Rest} = decode_primitive(Bin), + decode_constructed_indefinite(Rest, [Tlv|Acc]). + +%% decode_primitive_incomplete/2 decodes an encoded message incomplete +%% by help of the pattern attribute (first argument). +decode_primitive_incomplete([[default,TagNo]],Bin) -> %default + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,[],Rest); + _ -> + %{asn1_DEFAULT,Bin} + asn1_NOVALUE + end; +decode_primitive_incomplete([[default,TagNo,Directives]],Bin) -> %default, constructed type, Directives points into this type + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,Directives,Rest); + _ -> + %{asn1_DEFAULT,Bin} + asn1_NOVALUE + end; +decode_primitive_incomplete([[opt,TagNo]],Bin) -> %optional + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,[],Rest); + _ -> + %{{TagNo,asn1_NOVALUE},Bin} + asn1_NOVALUE + end; +decode_primitive_incomplete([[opt,TagNo,Directives]],Bin) -> %optional + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,Directives,Rest); + _ -> + %{{TagNo,asn1_NOVALUE},Bin} + asn1_NOVALUE + end; +%% An optional that shall be undecoded +decode_primitive_incomplete([[opt_undec,Tag]],Bin) -> + case decode_tag_and_length(Bin) of + {_,Tag,_,_} -> + decode_incomplete_bin(Bin); + _ -> + asn1_NOVALUE + end; +%% A choice alternative that shall be undecoded +decode_primitive_incomplete([[alt_undec,TagNo]|RestAlts],Bin) -> + case decode_tag_and_length(Bin) of + {_,TagNo,_,_} -> + decode_incomplete_bin(Bin); + _ -> + decode_primitive_incomplete(RestAlts,Bin) + end; +decode_primitive_incomplete([[alt,TagNo]|RestAlts],Bin) -> + case decode_tag_and_length(Bin) of + {_Form,TagNo,V,Rest} -> + {{TagNo,V},Rest}; + _ -> + decode_primitive_incomplete(RestAlts,Bin) + end; +decode_primitive_incomplete([[alt,TagNo,Directives]|RestAlts],Bin) -> + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,Directives,Rest); + _ -> + decode_primitive_incomplete(RestAlts,Bin) + end; +decode_primitive_incomplete([[alt_parts,TagNo]],Bin) -> + case decode_tag_and_length(Bin) of + {_Form,TagNo,V,Rest} -> + {{TagNo,V},Rest}; + _ -> + asn1_NOVALUE + end; +decode_primitive_incomplete([[alt_parts,TagNo]|RestAlts],Bin) -> + case decode_tag_and_length(Bin) of + {_Form,TagNo,V,Rest} -> + {{TagNo,decode_parts_incomplete(V)},Rest}; + _ -> + decode_primitive_incomplete(RestAlts,Bin) + end; +decode_primitive_incomplete([[undec,_TagNo]|_RestTag],Bin) -> %incomlete decode + decode_incomplete_bin(Bin); +decode_primitive_incomplete([[parts,TagNo]|_RestTag],Bin) -> + case decode_tag_and_length(Bin) of + {_Form,TagNo,V,Rest} -> + {{TagNo,decode_parts_incomplete(V)},Rest}; + Err -> + {error,{asn1,"tag failure",TagNo,Err}} + end; +decode_primitive_incomplete([mandatory|RestTag],Bin) -> + {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), + decode_incomplete2(Form,TagNo,V,RestTag,Rest); +%% A choice that is a toptype or a mandatory component of a +%% SEQUENCE or SET. +decode_primitive_incomplete([[mandatory|Directives]],Bin) -> + {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), + decode_incomplete2(Form,TagNo,V,Directives,Rest); +decode_primitive_incomplete([],Bin) -> + decode_primitive(Bin). + +%% decode_parts_incomplete/1 receives a number of values encoded in +%% sequence and returns the parts as unencoded binaries +decode_parts_incomplete(<<>>) -> + []; +decode_parts_incomplete(Bin) -> + {ok,Rest} = skip_tag(Bin), + {ok,Rest2} = skip_length_and_value(Rest), + LenPart = byte_size(Bin) - byte_size(Rest2), + <<Part:LenPart/binary,RestBin/binary>> = Bin, + [Part|decode_parts_incomplete(RestBin)]. + + +%% decode_incomplete2 checks if V is a value of a constructed or +%% primitive type, and continues the decode propeerly. +decode_incomplete2(_Form=2,TagNo,V,TagMatch,_) -> + %% constructed indefinite length + {Vlist,Rest2} = decode_constr_indef_incomplete(TagMatch,V,[]), + {{TagNo,Vlist},Rest2}; +decode_incomplete2(1,TagNo,V,[TagMatch],Rest) when is_list(TagMatch) -> + {{TagNo,decode_constructed_incomplete(TagMatch,V)},Rest}; +decode_incomplete2(1,TagNo,V,TagMatch,Rest) -> + {{TagNo,decode_constructed_incomplete(TagMatch,V)},Rest}; +decode_incomplete2(0,TagNo,V,_TagMatch,Rest) -> + {{TagNo,V},Rest}. + +decode_constructed_incomplete([Tags=[Ts]],Bin) when is_list(Ts) -> + decode_constructed_incomplete(Tags,Bin); +decode_constructed_incomplete(_TagMatch,<<>>) -> + []; +decode_constructed_incomplete([mandatory|RestTag],Bin) -> + {Tlv,Rest} = decode_primitive(Bin), + [Tlv|decode_constructed_incomplete(RestTag,Rest)]; +decode_constructed_incomplete(Directives=[[Alt,_]|_],Bin) + when Alt =:= alt_undec; Alt =:= alt; Alt =:= alt_parts -> + {_Form,TagNo,V,Rest} = decode_tag_and_length(Bin), + case incomplete_choice_alt(TagNo, Directives) of + {alt_undec,_} -> + LenA = byte_size(Bin) - byte_size(Rest), + <<A:LenA/binary,Rest/binary>> = Bin, + A; + {alt,InnerDirectives} -> + {Tlv,Rest} = decode_primitive_incomplete(InnerDirectives,V), + {TagNo,Tlv}; + {alt_parts,_} -> + [{TagNo,decode_parts_incomplete(V)}]; + no_match -> %% if a choice alternative was encoded that + %% was not specified in the config file, + %% thus decode component anonomous. + {Tlv,_}=decode_primitive(Bin), + Tlv + end; +decode_constructed_incomplete([TagNo|RestTag],Bin) -> + case decode_primitive_incomplete([TagNo],Bin) of + {Tlv,Rest} -> + [Tlv|decode_constructed_incomplete(RestTag,Rest)]; + asn1_NOVALUE -> + decode_constructed_incomplete(RestTag,Bin) + end; +decode_constructed_incomplete([],Bin) -> + {Tlv,Rest}=decode_primitive(Bin), + [Tlv|decode_constructed_incomplete([],Rest)]. + +decode_constr_indef_incomplete(_TagMatch,<<0,0,Rest/binary>>,Acc) -> + {lists:reverse(Acc),Rest}; +decode_constr_indef_incomplete([Tag|RestTags],Bin,Acc) -> + case decode_primitive_incomplete([Tag],Bin) of + {Tlv,Rest} -> + decode_constr_indef_incomplete(RestTags,Rest,[Tlv|Acc]); + asn1_NOVALUE -> + decode_constr_indef_incomplete(RestTags,Bin,Acc) + end. + + +decode_incomplete_bin(Bin) -> + {ok,Rest} = skip_tag(Bin), + {ok,Rest2} = skip_length_and_value(Rest), + IncLen = byte_size(Bin) - byte_size(Rest2), + <<IncBin:IncLen/binary,Ret/binary>> = Bin, + {IncBin,Ret}. + +incomplete_choice_alt(TagNo,[[Alt,TagNo]|Directives]) -> + {Alt,Directives}; +incomplete_choice_alt(TagNo,[D]) when is_list(D) -> + incomplete_choice_alt(TagNo,D); +incomplete_choice_alt(TagNo,[_H|Directives]) -> + incomplete_choice_alt(TagNo,Directives); +incomplete_choice_alt(_,[]) -> + no_match. + + +%% decode_selective(Pattern, Binary) the first argument is a pattern that tells +%% what to do with the next element the second is the BER encoded +%% message as a binary +%% Returns {ok,Value} or {error,Reason} +%% Value is a binary that in turn must be decoded to get the decoded +%% value. +decode_selective([],Binary) -> + {ok,Binary}; +decode_selective([skip|RestPattern],Binary)-> + {ok,RestBinary}=skip_tag(Binary), + {ok,RestBinary2}=skip_length_and_value(RestBinary), + decode_selective(RestPattern,RestBinary2); +decode_selective([[skip_optional,Tag]|RestPattern],Binary) -> + case skip_optional_tag(Tag,Binary) of + {ok,RestBinary} -> + {ok,RestBinary2}=skip_length_and_value(RestBinary), + decode_selective(RestPattern,RestBinary2); + missing -> + decode_selective(RestPattern,Binary) + end; +decode_selective([[choosen,Tag]],Binary) -> + return_value(Tag,Binary); +decode_selective([[choosen,Tag]|RestPattern],Binary) -> + case skip_optional_tag(Tag,Binary) of + {ok,RestBinary} -> + {ok,Value} = get_value(RestBinary), + decode_selective(RestPattern,Value); + missing -> + {ok,<<>>} + end; +decode_selective(P,_) -> + {error,{asn1,{partial_decode,"bad pattern",P}}}. + +return_value(Tag,Binary) -> + {ok,{Tag,RestBinary}}=get_tag(Binary), + {ok,{LenVal,_RestBinary2}} = get_length_and_value(RestBinary), + {ok,<<Tag/binary,LenVal/binary>>}. + + +%% skip_tag and skip_length_and_value are rutines used both by +%% decode_partial_incomplete and decode_selective (decode/2). + +skip_tag(<<_:3,31:5,Rest/binary>>)-> + skip_long_tag(Rest); +skip_tag(<<_:3,_Tag:5,Rest/binary>>) -> + {ok,Rest}. + +skip_long_tag(<<1:1,_:7,Rest/binary>>) -> + skip_long_tag(Rest); +skip_long_tag(<<0:1,_:7,Rest/binary>>) -> + {ok,Rest}. + +skip_optional_tag(<<>>,Binary) -> + {ok,Binary}; +skip_optional_tag(<<Tag,RestTag/binary>>,<<Tag,Rest/binary>>) -> + skip_optional_tag(RestTag,Rest); +skip_optional_tag(_,_) -> + missing. + + +skip_length_and_value(Binary) -> + case decode_length(Binary) of + {indefinite,RestBinary} -> + skip_indefinite_value(RestBinary); + {Length,RestBinary} -> + <<_:Length/unit:8,Rest/binary>> = RestBinary, + {ok,Rest} + end. + +skip_indefinite_value(<<0,0,Rest/binary>>) -> + {ok,Rest}; +skip_indefinite_value(Binary) -> + {ok,RestBinary}=skip_tag(Binary), + {ok,RestBinary2} = skip_length_and_value(RestBinary), + skip_indefinite_value(RestBinary2). + +get_value(Binary) -> + case decode_length(Binary) of + {indefinite,RestBinary} -> + get_indefinite_value(RestBinary,[]); + {Length,RestBinary} -> + <<Value:Length/binary,_Rest/binary>> = RestBinary, + {ok,Value} + end. + +get_indefinite_value(<<0,0,_Rest/binary>>,Acc) -> + {ok,list_to_binary(lists:reverse(Acc))}; +get_indefinite_value(Binary,Acc) -> + {ok,{Tag,RestBinary}}=get_tag(Binary), + {ok,{LenVal,RestBinary2}} = get_length_and_value(RestBinary), + get_indefinite_value(RestBinary2,[LenVal,Tag|Acc]). + +get_tag(<<H:1/binary,Rest/binary>>) -> + case H of + <<_:3,31:5>> -> + get_long_tag(Rest,[H]); + _ -> {ok,{H,Rest}} + end. +get_long_tag(<<H:1/binary,Rest/binary>>,Acc) -> + case H of + <<0:1,_:7>> -> + {ok,{list_to_binary(lists:reverse([H|Acc])),Rest}}; + _ -> + get_long_tag(Rest,[H|Acc]) + end. + +get_length_and_value(Bin = <<0:1,Length:7,_T/binary>>) -> + <<Len,Val:Length/binary,Rest/binary>> = Bin, + {ok,{<<Len,Val/binary>>, Rest}}; +get_length_and_value(Bin = <<1:1,0:7,_T/binary>>) -> + get_indefinite_length_and_value(Bin); +get_length_and_value(<<1:1,LL:7,T/binary>>) -> + <<Length:LL/unit:8,Rest/binary>> = T, + <<Value:Length/binary,Rest2/binary>> = Rest, + {ok,{<<1:1,LL:7,Length:LL/unit:8,Value/binary>>,Rest2}}. + +get_indefinite_length_and_value(<<H,T/binary>>) -> + get_indefinite_length_and_value(T,[H]). + +get_indefinite_length_and_value(<<0,0,Rest/binary>>,Acc) -> + {ok,{list_to_binary(lists:reverse(Acc)),Rest}}; +get_indefinite_length_and_value(Binary,Acc) -> + {ok,{Tag,RestBinary}}=get_tag(Binary), + {ok,{LenVal,RestBinary2}}=get_length_and_value(RestBinary), + get_indefinite_length_and_value(RestBinary2,[LenVal,Tag|Acc]). + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% match_tags takes a Tlv (Tag, Length, Value) structure and matches +%% it with the tags in TagList. If the tags does not match the function +%% crashes otherwise it returns the remaining Tlv after that the tags have +%% been removed. +%% +%% match_tags(Tlv, TagList) +%% + +match_tags({T,V}, [T]) -> + V; +match_tags({T,V}, [T|Tt]) -> + match_tags(V,Tt); +match_tags([{T,V}], [T|Tt]) -> + match_tags(V, Tt); +match_tags([{T,_V}|_]=Vlist, [T]) -> + Vlist; +match_tags(Tlv, []) -> + Tlv; +match_tags({Tag,_V}=Tlv, [T|_Tt]) -> + exit({error,{asn1,{wrong_tag,{{expected,T},{got,Tag,Tlv}}}}}). + +%%% +%% skips components that do not match a tag in Tags +skip_ExtensionAdditions([], _Tags) -> + []; +skip_ExtensionAdditions([{Tag,_}|Rest]=TLV, Tags) -> + case [X || X=T <- Tags, T =:= Tag] of + [] -> + %% skip this TLV and continue with next + skip_ExtensionAdditions(Rest,Tags); + _ -> + TLV + end. + + +%%=============================================================================== +%% Decode a tag +%% +%% decode_tag(OctetListBuffer) -> {{Form, (Class bsl 16)+ TagNo}, RestOfBuffer, RemovedBytes} +%%=============================================================================== + +decode_tag_and_length(<<Class:2, Form:1, TagNo:5, 0:1, Length:7, V:Length/binary, RestBuffer/binary>>) when TagNo < 31 -> + {Form, (Class bsl 16) bor TagNo, V, RestBuffer}; +decode_tag_and_length(<<Class:2, 1:1, TagNo:5, 1:1, 0:7, T/binary>>) when TagNo < 31 -> + {2, (Class bsl 16) + TagNo, T, <<>>}; +decode_tag_and_length(<<Class:2, Form:1, TagNo:5, 1:1, LL:7, Length:LL/unit:8,V:Length/binary, T/binary>>) when TagNo < 31 -> + {Form, (Class bsl 16) bor TagNo, V, T}; +decode_tag_and_length(<<Class:2, Form:1, 31:5, 0:1, TagNo:7, 0:1, Length:7, V:Length/binary, RestBuffer/binary>>) -> + {Form, (Class bsl 16) bor TagNo, V, RestBuffer}; +decode_tag_and_length(<<Class:2, 1:1, 31:5, 0:1, TagNo:7, 1:1, 0:7, T/binary>>) -> + {2, (Class bsl 16) bor TagNo, T, <<>>}; +decode_tag_and_length(<<Class:2, Form:1, 31:5, 0:1, TagNo:7, 1:1, LL:7, Length:LL/unit:8, V:Length/binary, T/binary>>) -> + {Form, (Class bsl 16) bor TagNo, V, T}; +decode_tag_and_length(<<Class:2, Form:1, 31:5, 1:1, TagPart1:7, 0:1, TagPartLast, Buffer/binary>>) -> + TagNo = (TagPart1 bsl 7) bor TagPartLast, + {Length, RestBuffer} = decode_length(Buffer), + << V:Length/binary, RestBuffer2/binary>> = RestBuffer, + {Form, (Class bsl 16) bor TagNo, V, RestBuffer2}; +decode_tag_and_length(<<Class:2, Form:1, 31:5, Buffer/binary>>) -> + {TagNo, Buffer1} = decode_tag(Buffer, 0), + {Length, RestBuffer} = decode_length(Buffer1), + << V:Length/binary, RestBuffer2/binary>> = RestBuffer, + {Form, (Class bsl 16) bor TagNo, V, RestBuffer2}. + + + +%% last partial tag +decode_tag(<<0:1,PartialTag:7, Buffer/binary>>, TagAck) -> + TagNo = (TagAck bsl 7) bor PartialTag, + {TagNo, Buffer}; +% more tags +decode_tag(<<_:1,PartialTag:7, Buffer/binary>>, TagAck) -> + TagAck1 = (TagAck bsl 7) bor PartialTag, + decode_tag(Buffer, TagAck1). + +%%======================================================================= +%% +%% Encode all tags in the list Tags and return a possibly deep list of +%% bytes with tag and length encoded +%% The taglist must be in reverse order (fixed by the asn1 compiler) +%% e.g [T1,T2] will result in +%% {[EncodedT2,EncodedT1|BytesSoFar],LenSoFar+LenT2+LenT1} +%% + +encode_tags([Tag|Trest], BytesSoFar, LenSoFar) -> + {Bytes2,L2} = encode_length(LenSoFar), + encode_tags(Trest, [Tag,Bytes2|BytesSoFar], + LenSoFar + byte_size(Tag) + L2); +encode_tags([], BytesSoFar, LenSoFar) -> + {BytesSoFar,LenSoFar}. + +encode_tags(TagIn, {BytesSoFar,LenSoFar}) -> + encode_tags(TagIn, BytesSoFar, LenSoFar). + +%%=============================================================================== +%% +%% This comment is valid for all the encode/decode functions +%% +%% C = Constraint -> typically {'ValueRange',LowerBound,UpperBound} +%% used for PER-coding but not for BER-coding. +%% +%% Val = Value. If Val is an atom then it is a symbolic integer value +%% (i.e the atom must be one of the names in the NamedNumberList). +%% The NamedNumberList is used to translate the atom to an integer value +%% before encoding. +%% +%%=============================================================================== + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_open_type(Value) -> io_list (i.e nested list with integers, binaries) +%% Value = list of bytes of an already encoded value (the list must be flat) +%% | binary + +encode_open_type(Val, T) when is_list(Val) -> + encode_open_type(list_to_binary(Val), T); +encode_open_type(Val, []) -> + {Val,byte_size(Val)}; +encode_open_type(Val, Tag) -> + encode_tags(Tag, Val, byte_size(Val)). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_open_type(Tlv, TagIn) -> Value +%% Tlv = {Tag,V} | V where V -> binary() +%% TagIn = [TagVal] where TagVal -> int() +%% Value = binary with decoded data (which must be decoded again as some type) +%% +decode_open_type(Tlv, TagIn) -> + case match_tags(Tlv, TagIn) of + Bin when is_binary(Bin) -> + {InnerTlv,_} = ber_decode_nif(Bin), + InnerTlv; + TlvBytes -> TlvBytes + end. + +decode_open_type_as_binary(Tlv, TagIn)-> + ber_encode(match_tags(Tlv, TagIn)). + +%%=============================================================================== +%%=============================================================================== +%%=============================================================================== +%% Boolean, ITU_T X.690 Chapter 8.2 +%%=============================================================================== +%%=============================================================================== +%%=============================================================================== + +%%=============================================================================== +%% encode_boolean(Integer, ReversedTagList) -> {[Octet],Len} +%%=============================================================================== + +encode_boolean(true, TagIn) -> + encode_tags(TagIn, [16#FF],1); +encode_boolean(false, TagIn) -> + encode_tags(TagIn, [0],1); +encode_boolean(X,_) -> + exit({error,{asn1, {encode_boolean, X}}}). + + +%%=============================================================================== +%% decode_boolean(BuffList, HasTag, TotalLen) -> {true, Remain, RemovedBytes} | +%% {false, Remain, RemovedBytes} +%%=============================================================================== +decode_boolean(Tlv,TagIn) -> + Val = match_tags(Tlv, TagIn), + case Val of + <<0:8>> -> + false; + <<_:8>> -> + true; + _ -> + exit({error,{asn1, {decode_boolean, Val}}}) + end. + + +%%=========================================================================== +%% Integer, ITU_T X.690 Chapter 8.3 + +%% encode_integer(Constraint, Value, Tag) -> [octet list] +%% encode_integer(Constraint, Name, NamedNumberList, Tag) -> [octet list] +%% Value = INTEGER | {Name,INTEGER} +%% Tag = tag | notag +%%=========================================================================== + +encode_integer(Val, Tag) when is_integer(Val) -> + encode_tags(Tag, encode_integer(Val)); +encode_integer(Val, _Tag) -> + exit({error,{asn1,{encode_integer,Val}}}). + + +encode_integer(Val, NamedNumberList, Tag) when is_atom(Val) -> + case lists:keyfind(Val, 1, NamedNumberList) of + {_, NewVal} -> + encode_tags(Tag, encode_integer(NewVal)); + _ -> + exit({error,{asn1, {encode_integer_namednumber, Val}}}) + end; +encode_integer(Val, _NamedNumberList, Tag) -> + encode_tags(Tag, encode_integer(Val)). + +encode_integer(Val) -> + Bytes = + if + Val >= 0 -> + encode_integer_pos(Val, []); + true -> + encode_integer_neg(Val, []) + end, + {Bytes,length(Bytes)}. + +encode_integer_pos(0, [B|_Acc]=L) when B < 128 -> + L; +encode_integer_pos(N, Acc) -> + encode_integer_pos((N bsr 8), [N band 16#ff| Acc]). + +encode_integer_neg(-1, [B1|_T]=L) when B1 > 127 -> + L; +encode_integer_neg(N, Acc) -> + encode_integer_neg(N bsr 8, [N band 16#ff|Acc]). + +%%=============================================================================== +%% decode integer +%% (Buffer, Range, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} +%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} +%%=============================================================================== + +decode_integer(Tlv, Range, NamedNumberList, TagIn) -> + V = match_tags(Tlv, TagIn), + Int = range_check_integer(decode_integer(V), Range), + number2name(Int, NamedNumberList). + +decode_integer(Tlv, Range, TagIn) -> + V = match_tags(Tlv, TagIn), + Int = decode_integer(V), + range_check_integer(Int, Range). + +decode_integer(Bin) -> + Len = byte_size(Bin), + <<Int:Len/signed-unit:8>> = Bin, + Int. + +range_check_integer(Int, Range) -> + case Range of + [] -> % No length constraint + Int; + {Lb,Ub} when Int >= Lb, Ub >= Int -> % variable length constraint + Int; + {_,_} -> + exit({error,{asn1,{integer_range,Range,Int}}}); + Int -> % fixed value constraint + Int; + SingleValue when is_integer(SingleValue) -> + exit({error,{asn1,{integer_range,Range,Int}}}); + _ -> % some strange constraint that we don't support yet + Int + end. + +number2name(Int, []) -> + Int; +number2name(Int, NamedNumberList) -> + case lists:keyfind(Int, 2, NamedNumberList) of + {NamedVal,_} -> + NamedVal; + _ -> + Int + end. + + +%%============================================================================ +%% Enumerated value, ITU_T X.690 Chapter 8.4 + +%% encode enumerated value +%%============================================================================ +encode_enumerated(Val, TagIn) when is_integer(Val) -> + encode_tags(TagIn, encode_integer(Val)). + +%%============================================================================ +%% decode enumerated value +%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> Value +%%=========================================================================== +decode_enumerated(Tlv, NamedNumberList, Tags) -> + Buffer = match_tags(Tlv, Tags), + decode_enumerated_notag(Buffer, NamedNumberList, Tags). + +decode_enumerated_notag(Buffer, {NamedNumberList,ExtList}, _Tags) -> + IVal = decode_integer(Buffer), + case decode_enumerated1(IVal, NamedNumberList) of + {asn1_enum,IVal} -> + decode_enumerated1(IVal,ExtList); + EVal -> + EVal + end; +decode_enumerated_notag(Buffer, NNList, _Tags) -> + IVal = decode_integer(Buffer), + case decode_enumerated1(IVal, NNList) of + {asn1_enum,_} -> + exit({error,{asn1, {illegal_enumerated, IVal}}}); + EVal -> + EVal + end. + +decode_enumerated1(Val, NamedNumberList) -> + %% it must be a named integer + case lists:keyfind(Val, 2, NamedNumberList) of + {NamedVal, _} -> + NamedVal; + _ -> + {asn1_enum,Val} + end. + + +%%============================================================================ +%% Bitstring value, ITU_T X.690 Chapter 8.6 +%% +%% encode bitstring value +%% +%% bitstring NamedBitList +%% Val can be of: +%% - [identifiers] where only named identifers are set to one, +%% the Constraint must then have some information of the +%% bitlength. +%% - [list of ones and zeroes] all bits +%% - integer value representing the bitlist +%% C is constrint Len, only valid when identifiers +%%============================================================================ + +encode_bit_string(C,Bin={Unused,BinBits},NamedBitList,TagIn) when is_integer(Unused), is_binary(BinBits) -> + encode_bin_bit_string(C,Bin,NamedBitList,TagIn); +encode_bit_string(C, [FirstVal | RestVal], NamedBitList, TagIn) when is_atom(FirstVal) -> + encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn); + +encode_bit_string(C, [{bit,X} | RestVal], NamedBitList, TagIn) -> + encode_bit_string_named(C, [{bit,X} | RestVal], NamedBitList, TagIn); + +encode_bit_string(C, [FirstVal| RestVal], NamedBitList, TagIn) when is_integer(FirstVal) -> + encode_bit_string_bits(C, [FirstVal | RestVal], NamedBitList, TagIn); + +encode_bit_string(_C, 0, _NamedBitList, TagIn) -> + encode_tags(TagIn, <<0>>,1); + +encode_bit_string(_C, [], _NamedBitList, TagIn) -> + encode_tags(TagIn, <<0>>,1); + +encode_bit_string(C, IntegerVal, NamedBitList, TagIn) when is_integer(IntegerVal) -> + BitListVal = int_to_bitlist(IntegerVal), + encode_bit_string_bits(C, BitListVal, NamedBitList, TagIn). + + +int_to_bitlist(0) -> + []; +int_to_bitlist(Int) when is_integer(Int), Int >= 0 -> + [Int band 1 | int_to_bitlist(Int bsr 1)]. + + +%%================================================================= +%% Encode BIT STRING of the form {Unused,BinBits}. +%% Unused is the number of unused bits in the last byte in BinBits +%% and BinBits is a binary representing the BIT STRING. +%%================================================================= +encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList,TagIn)-> + case get_constraint(C,'SizeConstraint') of + no -> + remove_unused_then_dotag(TagIn, Unused, BinBits); + {_Min,Max} -> + BBLen = (byte_size(BinBits)*8)-Unused, + if + BBLen > Max -> + exit({error,{asn1, + {bitstring_length, + {{was,BBLen},{maximum,Max}}}}}); + true -> + remove_unused_then_dotag(TagIn, Unused, BinBits) + end; + Size -> + case ((byte_size(BinBits)*8)-Unused) of + BBSize when BBSize =< Size -> + remove_unused_then_dotag(TagIn, Unused, BinBits); + BBSize -> + exit({error,{asn1, + {bitstring_length, + {{was,BBSize},{should_be,Size}}}}}) + end + end. + +remove_unused_then_dotag(TagIn,Unused,BinBits) -> + case Unused of + 0 when byte_size(BinBits) =:= 0 -> + encode_tags(TagIn, <<0>>, 1); + 0 -> + Bin = <<Unused,BinBits/binary>>, + encode_tags(TagIn,Bin,size(Bin)); + Num -> + N = byte_size(BinBits)-1, + <<BBits:N/binary,LastByte>> = BinBits, + encode_tags(TagIn, + [Unused,binary_to_list(BBits) ++[(LastByte bsr Num) bsl Num]], + 1+byte_size(BinBits)) + end. + + +%%================================================================= +%% Encode named bits +%%================================================================= + +encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn) -> + ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []), + Size = + case get_constraint(C,'SizeConstraint') of + no -> + lists:max(ToSetPos)+1; + {_Min,Max} -> + Max; + TSize -> + TSize + end, + BitList = make_and_set_list(Size, ToSetPos, 0), + {Len, Unused, OctetList} = encode_bitstring(BitList), + encode_tags(TagIn, [Unused|OctetList],Len+1). + + +%%---------------------------------------- +%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> +%% [sorted_list_of_bitpositions_to_set] +%%---------------------------------------- + +get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); +get_all_bitposes([Val | Rest], NamedBitList, Ack) when is_atom(Val) -> + case lists:keyfind(Val, 1, NamedBitList) of + {_ValName, ValPos} -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); + _ -> + exit({error,{asn1, {bitstring_namedbit, Val}}}) + end; +get_all_bitposes([], _NamedBitList, Ack) -> + lists:sort(Ack). + + +%%---------------------------------------- +%% make_and_set_list(Len of list to return, [list of positions to set to 1])-> +%% returns list of Len length, with all in SetPos set. +%% in positioning in list the first element is 0, the second 1 etc.., but +%% Len will make a list of length Len, not Len + 1. +%% BitList = make_and_set_list(C, ToSetPos, 0), +%%---------------------------------------- + +make_and_set_list(0, [], _) -> []; +make_and_set_list(0, _, _) -> + exit({error,{asn1,bitstring_sizeconstraint}}); +make_and_set_list(Len, [XPos|SetPos], XPos) -> + [1 | make_and_set_list(Len - 1, SetPos, XPos + 1)]; +make_and_set_list(Len, [Pos|SetPos], XPos) -> + [0 | make_and_set_list(Len - 1, [Pos | SetPos], XPos + 1)]; +make_and_set_list(Len, [], XPos) -> + [0 | make_and_set_list(Len - 1, [], XPos + 1)]. + + + + + + +%%================================================================= +%% Encode bit string for lists of ones and zeroes +%%================================================================= +encode_bit_string_bits(C, BitListVal, _NamedBitList, TagIn) when is_list(BitListVal) -> + case get_constraint(C,'SizeConstraint') of + no -> + {Len, Unused, OctetList} = encode_bitstring(BitListVal), + %%add unused byte to the Len + encode_tags(TagIn, [Unused | OctetList], Len+1); + Constr={Min,_Max} when is_integer(Min) -> + %% Max may be an integer or 'MAX' + encode_constr_bit_str_bits(Constr,BitListVal,TagIn); + {Constr={_,_},[]} ->%Constr={Min,Max} + %% constraint with extension mark + encode_constr_bit_str_bits(Constr,BitListVal,TagIn); + Constr={{_,_},{_,_}} ->%{{Min1,Max1},{Min2,Max2}} + %% constraint with extension mark + encode_constr_bit_str_bits(Constr,BitListVal,TagIn); + Size -> + case length(BitListVal) of + BitSize when BitSize == Size -> + {Len, Unused, OctetList} = encode_bitstring(BitListVal), + %%add unused byte to the Len + encode_tags(TagIn, [Unused | OctetList], Len+1); + BitSize when BitSize < Size -> + PaddedList = pad_bit_list(Size-BitSize,BitListVal), + {Len, Unused, OctetList} = encode_bitstring(PaddedList), + %%add unused byte to the Len + encode_tags(TagIn, [Unused | OctetList], Len+1); + BitSize -> + exit({error,{asn1, + {bitstring_length, {{was,BitSize},{should_be,Size}}}}}) + end + + end. + +encode_constr_bit_str_bits({{_Min1,Max1},{Min2,Max2}},BitListVal,TagIn) -> + BitLen = length(BitListVal), + case BitLen of + Len when Len > Max2 -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {maximum,Max2}}}}}); + Len when Len > Max1, Len < Min2 -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {not_allowed_interval, + Max1,Min2}}}}}); + _ -> + {Len, Unused, OctetList} = encode_bitstring(BitListVal), + %%add unused byte to the Len + encode_tags(TagIn, [Unused, OctetList], Len+1) + end; +encode_constr_bit_str_bits({Min,Max},BitListVal,TagIn) -> + BitLen = length(BitListVal), + if + BitLen > Max -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {maximum,Max}}}}}); + BitLen < Min -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {minimum,Max}}}}}); + true -> + {Len, Unused, OctetList} = encode_bitstring(BitListVal), + %%add unused byte to the Len + encode_tags(TagIn, [Unused, OctetList], Len+1) + end. + + +%% returns a list of length Size + length(BitListVal), with BitListVal +%% as the most significant elements followed by padded zero elements +pad_bit_list(Size, BitListVal) -> + Tail = lists:duplicate(Size,0), + lists:append(BitListVal, Tail). + +%%================================================================= +%% Do the actual encoding +%% ([bitlist]) -> {ListLen, UnusedBits, OctetList} +%%================================================================= + +encode_bitstring([B8, B7, B6, B5, B4, B3, B2, B1 | Rest]) -> + Val = (B8 bsl 7) bor (B7 bsl 6) bor (B6 bsl 5) bor (B5 bsl 4) bor + (B4 bsl 3) bor (B3 bsl 2) bor (B2 bsl 1) bor B1, + encode_bitstring(Rest, [Val], 1); +encode_bitstring(Val) -> + {Unused, Octet} = unused_bitlist(Val, 7, 0), + {1, Unused, [Octet]}. + +encode_bitstring([B8, B7, B6, B5, B4, B3, B2, B1 | Rest], Ack, Len) -> + Val = (B8 bsl 7) bor (B7 bsl 6) bor (B6 bsl 5) bor (B5 bsl 4) bor + (B4 bsl 3) bor (B3 bsl 2) bor (B2 bsl 1) bor B1, + encode_bitstring(Rest, [Ack | [Val]], Len + 1); +%%even multiple of 8 bits.. +encode_bitstring([], Ack, Len) -> + {Len, 0, Ack}; +%% unused bits in last octet +encode_bitstring(Rest, Ack, Len) -> + {Unused, Val} = unused_bitlist(Rest, 7, 0), + {Len + 1, Unused, [Ack | [Val]]}. + +%%%%%%%%%%%%%%%%%% +%% unused_bitlist([list of ones and zeros <= 7], 7, []) -> +%% {Unused bits, Last octet with bits moved to right} +unused_bitlist([], Trail, Ack) -> + {Trail + 1, Ack}; +unused_bitlist([Bit | Rest], Trail, Ack) -> + unused_bitlist(Rest, Trail - 1, (Bit bsl Trail) bor Ack). + + +%%============================================================================ +%% decode bitstring value +%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} +%%============================================================================ + +decode_compact_bit_string(Buffer, Range, NamedNumberList, Tags) -> + decode_restricted_string(Buffer, Range, ?N_BIT_STRING, Tags, + NamedNumberList, bin). + +decode_bit_string(Buffer, Range, NamedNumberList, Tags) -> + decode_restricted_string(Buffer, Range, ?N_BIT_STRING, Tags, + NamedNumberList, old). + + +decode_bit_string2(<<0>>, _NamedNumberList, BinOrOld) -> + case BinOrOld of + bin -> + {0,<<>>}; + _ -> + [] + end; +decode_bit_string2(<<Unused,Bits/binary>>, NamedNumberList, BinOrOld) -> + case NamedNumberList of + [] -> + case BinOrOld of + bin -> + {Unused,Bits}; + _ -> + decode_bitstring2(byte_size(Bits), Unused, Bits) + end; + _ -> + BitString = decode_bitstring2(byte_size(Bits), Unused, Bits), + decode_bitstring_NNL(BitString, NamedNumberList) + end. + +%%---------------------------------------- +%% Decode the in buffer to bits +%%---------------------------------------- +decode_bitstring2(1, Unused, + <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,_/binary>>) -> + lists:sublist([B7,B6,B5,B4,B3,B2,B1,B0], 8-Unused); +decode_bitstring2(Len, Unused, + <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,Buffer/binary>>) -> + [B7,B6,B5,B4,B3,B2,B1,B0| + decode_bitstring2(Len - 1, Unused, Buffer)]. + +%%---------------------------------------- +%% Decode the bitlist to names +%%---------------------------------------- + +decode_bitstring_NNL(BitList, NamedNumberList) -> + decode_bitstring_NNL(BitList, NamedNumberList, 0, []). + + +decode_bitstring_NNL([],_,_No,Result) -> + lists:reverse(Result); +decode_bitstring_NNL([B|BitList],[{Name,No}|NamedNumberList],No,Result) -> + if + B =:= 0 -> + decode_bitstring_NNL(BitList,NamedNumberList,No+1,Result); + true -> + decode_bitstring_NNL(BitList,NamedNumberList,No+1,[Name|Result]) + end; +decode_bitstring_NNL([1|BitList],NamedNumberList,No,Result) -> + decode_bitstring_NNL(BitList,NamedNumberList,No+1,[{bit,No}|Result]); +decode_bitstring_NNL([0|BitList],NamedNumberList,No,Result) -> + decode_bitstring_NNL(BitList,NamedNumberList,No+1,Result). + +%%============================================================================ +%% decode octet string +%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} +%% +%% Octet string is decoded as a restricted string +%%============================================================================ +decode_octet_string(Buffer, Range, Tags) -> + decode_restricted_string(Buffer, Range, ?N_OCTET_STRING, + Tags, [], old). + +%%============================================================================ +%% Null value, ITU_T X.690 Chapter 8.8 +%% +%% encode NULL value +%%============================================================================ + +encode_null(_Val, TagIn) -> + encode_tags(TagIn, [], 0). + +%%============================================================================ +%% decode NULL value +%% (Buffer, HasTag, TotalLen) -> {NULL, Remain, RemovedBytes} +%%============================================================================ + +decode_null(Tlv, Tags) -> + Val = match_tags(Tlv, Tags), + case Val of + <<>> -> + 'NULL'; + _ -> + exit({error,{asn1,{decode_null,Val}}}) + end. + +%%============================================================================ +%% Object identifier, ITU_T X.690 Chapter 8.19 +%% +%% encode Object Identifier value +%%============================================================================ + +encode_object_identifier(Val, TagIn) -> + encode_tags(TagIn, e_object_identifier(Val)). + +e_object_identifier({'OBJECT IDENTIFIER', V}) -> + e_object_identifier(V); +e_object_identifier(V) when is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); + +%%%%%%%%%%%%%%% +%% e_object_identifier([List of Obect Identifiers]) -> +%% {[Encoded Octetlist of ObjIds], IntLength} +%% +e_object_identifier([E1,E2|Tail]) -> + Head = 40*E1 + E2, % wow! + {H,Lh} = mk_object_val(Head), + {R,Lr} = lists:mapfoldl(fun enc_obj_id_tail/2, 0, Tail), + {[H|R],Lh+Lr}. + +enc_obj_id_tail(H, Len) -> + {B,L} = mk_object_val(H), + {B,Len+L}. + + +%%%%%%%%%%% +%% mk_object_val(Value) -> {OctetList, Len} +%% returns a Val as a list of octets, the 8th bit is always set to one +%% except for the last octet, where it's 0 +%% + + +mk_object_val(Val) when Val =< 127 -> + {[255 band Val], 1}; +mk_object_val(Val) -> + mk_object_val(Val bsr 7, [Val band 127], 1). +mk_object_val(0, Ack, Len) -> + {Ack, Len}; +mk_object_val(Val, Ack, Len) -> + mk_object_val(Val bsr 7, [((Val band 127) bor 128) | Ack], Len + 1). + + + +%%============================================================================ +%% decode Object Identifier value +%% (Buffer, HasTag, TotalLen) -> {{ObjId}, Remain, RemovedBytes} +%%============================================================================ + +decode_object_identifier(Tlv, Tags) -> + Val = match_tags(Tlv, Tags), + [AddedObjVal|ObjVals] = dec_subidentifiers(Val,0,[]), + {Val1, Val2} = if + AddedObjVal < 40 -> + {0, AddedObjVal}; + AddedObjVal < 80 -> + {1, AddedObjVal - 40}; + true -> + {2, AddedObjVal - 80} + end, + list_to_tuple([Val1, Val2 | ObjVals]). + +dec_subidentifiers(<<>>,_Av,Al) -> + lists:reverse(Al); +dec_subidentifiers(<<1:1,H:7,T/binary>>,Av,Al) -> + dec_subidentifiers(T,(Av bsl 7) + H,Al); +dec_subidentifiers(<<H,T/binary>>,Av,Al) -> + dec_subidentifiers(T,0,[((Av bsl 7) + H)|Al]). + +%%============================================================================ +%% RELATIVE-OID, ITU_T X.690 Chapter 8.20 +%% +%% encode Relative Object Identifier +%%============================================================================ + +encode_relative_oid(Val,TagIn) when is_tuple(Val) -> + encode_relative_oid(tuple_to_list(Val),TagIn); +encode_relative_oid(Val,TagIn) -> + encode_tags(TagIn, enc_relative_oid(Val)). + +enc_relative_oid(Tuple) when is_tuple(Tuple) -> + enc_relative_oid(tuple_to_list(Tuple)); +enc_relative_oid(Val) -> + lists:mapfoldl(fun(X,AccIn) -> + {SO,L} = mk_object_val(X), + {SO,L+AccIn} + end, 0, Val). + +%%============================================================================ +%% decode Relative Object Identifier value +%% (Buffer, HasTag, TotalLen) -> {{ObjId}, Remain, RemovedBytes} +%%============================================================================ +decode_relative_oid(Tlv, Tags) -> + Val = match_tags(Tlv, Tags), + ObjVals = dec_subidentifiers(Val,0,[]), + list_to_tuple(ObjVals). + +%%============================================================================ +%% Restricted character string types, ITU_T X.690 Chapter 8.20 +%% +%% encode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings +%%============================================================================ +encode_restricted_string(OctetList, TagIn) when is_binary(OctetList) -> + encode_tags(TagIn, OctetList, byte_size(OctetList)); +encode_restricted_string(OctetList, TagIn) when is_list(OctetList) -> + encode_tags(TagIn, OctetList, length(OctetList)). + +%%============================================================================ +%% decode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings +%% (Buffer, Range, StringType, HasTag, TotalLen) -> +%% {String, Remain, RemovedBytes} +%%============================================================================ + +decode_restricted_string(Buffer, Range, StringType, Tags) -> + decode_restricted_string(Buffer, Range, StringType, Tags, [], old). + +decode_restricted_string(Tlv, Range, StringType, TagsIn, + NamedNumberList, BinOrOld) -> + Val = match_tags(Tlv, TagsIn), + Val2 = + case Val of + [_|_]=PartList -> % constructed val + Bin = collect_parts(PartList), + decode_restricted(Bin, StringType, + NamedNumberList, BinOrOld); + Bin -> + decode_restricted(Bin, StringType, + NamedNumberList, BinOrOld) + end, + check_and_convert_restricted_string(Val2, StringType, Range, + NamedNumberList, BinOrOld). + +decode_restricted(Bin, StringType, NamedNumberList, BinOrOld) -> + case StringType of + ?N_BIT_STRING -> + decode_bit_string2(Bin, NamedNumberList, BinOrOld); + ?N_UniversalString -> + mk_universal_string(binary_to_list(Bin)); + ?N_BMPString -> + mk_BMP_string(binary_to_list(Bin)); + _ -> + Bin + end. + + +check_and_convert_restricted_string(Val,StringType,Range,NamedNumberList,_BinOrOld) -> + {StrLen,NewVal} = case StringType of + ?N_BIT_STRING when NamedNumberList =/= [] -> + {no_check,Val}; + ?N_BIT_STRING when is_list(Val) -> + {length(Val),Val}; + ?N_BIT_STRING when is_tuple(Val) -> + {(byte_size(element(2,Val))*8) - element(1,Val),Val}; + _ when is_binary(Val) -> + {byte_size(Val),binary_to_list(Val)}; + _ when is_list(Val) -> + {length(Val), Val} + end, + case Range of + _ when StrLen =:= no_check -> + NewVal; + [] -> % No length constraint + NewVal; + {Lb,Ub} when StrLen >= Lb, Ub >= StrLen -> % variable length constraint + NewVal; + {{Lb,_Ub},[]} when StrLen >= Lb -> + NewVal; + {{Lb,_Ub},_Ext=[Min|_]} when StrLen >= Lb; StrLen >= Min -> + NewVal; + {{Lb1,Ub1},{Lb2,Ub2}} when StrLen >= Lb1, StrLen =< Ub1; + StrLen =< Ub2, StrLen >= Lb2 -> + NewVal; + StrLen -> % fixed length constraint + NewVal; + {_,_} -> + exit({error,{asn1,{length,Range,Val}}}); + _Len when is_integer(_Len) -> + exit({error,{asn1,{length,Range,Val}}}); + _ -> % some strange constraint that we don't support yet + NewVal + end. + + +%%============================================================================ +%% encode Universal string +%%============================================================================ + +encode_universal_string(Universal, TagIn) -> + OctetList = mk_uni_list(Universal), + encode_tags(TagIn, OctetList, length(OctetList)). + +mk_uni_list(In) -> + mk_uni_list(In,[]). + +mk_uni_list([],List) -> + lists:reverse(List); +mk_uni_list([{A,B,C,D}|T],List) -> + mk_uni_list(T,[D,C,B,A|List]); +mk_uni_list([H|T],List) -> + mk_uni_list(T,[H,0,0,0|List]). + +%%=========================================================================== +%% decode Universal strings +%% (Buffer, Range, StringType, HasTag, LenIn) -> +%% {String, Remain, RemovedBytes} +%%=========================================================================== + +decode_universal_string(Buffer, Range, Tags) -> + decode_restricted_string(Buffer, Range, ?N_UniversalString, + Tags, [], old). + + +mk_universal_string(In) -> + mk_universal_string(In, []). + +mk_universal_string([], Acc) -> + lists:reverse(Acc); +mk_universal_string([0,0,0,D|T], Acc) -> + mk_universal_string(T, [D|Acc]); +mk_universal_string([A,B,C,D|T], Acc) -> + mk_universal_string(T, [{A,B,C,D}|Acc]). + + +%%============================================================================ +%% encode UTF8 string +%%============================================================================ + +encode_UTF8_string(UTF8String, TagIn) when is_binary(UTF8String) -> + encode_tags(TagIn, UTF8String, byte_size(UTF8String)); +encode_UTF8_string(UTF8String, TagIn) -> + encode_tags(TagIn, UTF8String, length(UTF8String)). + + +%%============================================================================ +%% decode UTF8 string +%%============================================================================ + +decode_UTF8_string(Tlv,TagsIn) -> + Val = match_tags(Tlv, TagsIn), + case Val of + [_|_]=PartList -> % constructed val + collect_parts(PartList); + Bin -> + Bin + end. + + +%%============================================================================ +%% encode BMP string +%%============================================================================ + +encode_BMP_string(BMPString, TagIn) -> + OctetList = mk_BMP_list(BMPString), + encode_tags(TagIn, OctetList, length(OctetList)). + +mk_BMP_list(In) -> + mk_BMP_list(In, []). + +mk_BMP_list([],List) -> + lists:reverse(List); +mk_BMP_list([{0,0,C,D}|T], List) -> + mk_BMP_list(T, [D,C|List]); +mk_BMP_list([H|T], List) -> + mk_BMP_list(T, [H,0|List]). + +%%============================================================================ +%% decode (OctetList, Range(ignored), tag|notag) -> {ValList, RestList} +%% (Buffer, Range, StringType, HasTag, TotalLen) -> +%% {String, Remain, RemovedBytes} +%%============================================================================ +decode_BMP_string(Buffer, Range, Tags) -> + decode_restricted_string(Buffer, Range, ?N_BMPString, + Tags, [], old). + +mk_BMP_string(In) -> + mk_BMP_string(In,[]). + +mk_BMP_string([], US) -> + lists:reverse(US); +mk_BMP_string([0,B|T], US) -> + mk_BMP_string(T, [B|US]); +mk_BMP_string([C,D|T], US) -> + mk_BMP_string(T, [{0,0,C,D}|US]). + + +%%============================================================================ +%% Generalized time, ITU_T X.680 Chapter 39 +%% +%% encode Generalized time +%%============================================================================ + +encode_generalized_time(OctetList, TagIn) -> + encode_tags(TagIn, OctetList, length(OctetList)). + +%%============================================================================ +%% decode Generalized time +%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} +%%============================================================================ + +decode_generalized_time(Tlv, _Range, Tags) -> + Val = match_tags(Tlv, Tags), + NewVal = case Val of + [_H|_T]=PartList -> % constructed + collect_parts(PartList); + Bin -> + Bin + end, + binary_to_list(NewVal). + +%%============================================================================ +%% Universal time, ITU_T X.680 Chapter 40 +%% +%% encode UTC time +%%============================================================================ + +encode_utc_time(OctetList, TagIn) -> + encode_tags(TagIn, OctetList, length(OctetList)). + +%%============================================================================ +%% decode UTC time +%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} +%%============================================================================ + +decode_utc_time(Tlv, _Range, Tags) -> + Val = match_tags(Tlv, Tags), + NewVal = case Val of + [_|_]=PartList -> % constructed + collect_parts(PartList); + Bin -> + Bin + end, + binary_to_list(NewVal). + + +%%============================================================================ +%% Length handling +%% +%% Encode length +%% +%% encode_length(Int) -> +%% [<127]| [128 + Int (<127),OctetList] | [16#80] +%%============================================================================ + +encode_length(L) when L =< 16#7F -> + {[L],1}; +encode_length(L) -> + Oct = minimum_octets(L), + Len = length(Oct), + if + Len =< 126 -> + {[16#80 bor Len|Oct],Len+1}; + true -> + exit({error,{asn1, too_long_length_oct, Len}}) + end. + +%% Val must be >= 0 +minimum_octets(Val) -> + minimum_octets(Val, []). + +minimum_octets(0, Acc) -> + Acc; +minimum_octets(Val, Acc) -> + minimum_octets(Val bsr 8, [Val band 16#FF|Acc]). + + +%%=========================================================================== +%% Decode length +%% +%% decode_length(OctetList) -> {{indefinite, RestOctetsL}, NoRemovedBytes} | +%% {{Length, RestOctetsL}, NoRemovedBytes} +%%=========================================================================== + +decode_length(<<1:1,0:7,T/binary>>) -> + {indefinite,T}; +decode_length(<<0:1,Length:7,T/binary>>) -> + {Length,T}; +decode_length(<<1:1,LL:7,Length:LL/unit:8,T/binary>>) -> + {Length,T}. + +%% dynamicsort_SET_components(Arg) -> +%% Res Arg -> list() +%% Res -> list() +%% Sorts the elements in Arg according to the encoded tag in +%% increasing order. +dynamicsort_SET_components(ListOfEncCs) -> + TagBinL = [begin + Bin = list_to_binary(L), + {dynsort_decode_tag(Bin),Bin} + end || L <- ListOfEncCs], + [E || {_,E} <- lists:keysort(1, TagBinL)]. + +%% dynamicsort_SETOF(Arg) -> Res +%% Arg -> list() +%% Res -> list() +%% Sorts the elements in Arg in increasing size +dynamicsort_SETOF(ListOfEncVal) -> + BinL = lists:map(fun(L) when is_list(L) -> list_to_binary(L); + (B) -> B end, ListOfEncVal), + lists:sort(BinL). + +%% multiple octet tag +dynsort_decode_tag(<<Class:2,_Form:1,31:5,Buffer/binary>>) -> + TagNum = dynsort_decode_tag(Buffer, 0), + {Class,TagNum}; + +%% single tag (< 31 tags) +dynsort_decode_tag(<<Class:2,_Form:1,TagNum:5,_/binary>>) -> + {Class,TagNum}. + +dynsort_decode_tag(<<0:1,PartialTag:7,_/binary>>, TagAcc) -> + (TagAcc bsl 7) bor PartialTag; +dynsort_decode_tag(<<_:1,PartialTag:7,Buffer/binary>>, TagAcc0) -> + TagAcc = (TagAcc0 bsl 7) bor PartialTag, + dynsort_decode_tag(Buffer, TagAcc). + + +%%------------------------------------------------------------------------- +%% INTERNAL HELPER FUNCTIONS (not exported) +%%------------------------------------------------------------------------- + +get_constraint(C, Key) -> + case lists:keyfind(Key, 1, C) of + false -> + no; + {_,V} -> + V + end. + +collect_parts(TlvList) -> + collect_parts(TlvList, []). + +collect_parts([{_,L}|Rest], Acc) when is_list(L) -> + collect_parts(Rest, [collect_parts(L)|Acc]); +collect_parts([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest], _Acc) -> + collect_parts_bit(Rest, [Bits], Unused); +collect_parts([{_T,V}|Rest], Acc) -> + collect_parts(Rest, [V|Acc]); +collect_parts([], Acc) -> + list_to_binary(lists:reverse(Acc)). + +collect_parts_bit([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest], Acc, Uacc) -> + collect_parts_bit(Rest, [Bits|Acc], Unused+Uacc); +collect_parts_bit([], Acc, Uacc) -> + list_to_binary([Uacc|lists:reverse(Acc)]). diff --git a/lib/asn1/src/asn1rtt_per.erl b/lib/asn1/src/asn1rtt_per.erl new file mode 100644 index 0000000000..d545c8a854 --- /dev/null +++ b/lib/asn1/src/asn1rtt_per.erl @@ -0,0 +1,1334 @@ +%% +%% %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(asn1rtt_per). + +-export([setext/1, fixextensions/2, + skipextensions/3, getbit/1, getchoice/3, + set_choice/3,encode_integer/2, + encode_small_number/1, + encode_length/1, + encode_length/2, + decode_compact_bit_string/3, + encode_bit_string/3, decode_bit_string/3, + encode_object_identifier/1, decode_object_identifier/1, + encode_relative_oid/1, decode_relative_oid/1, + complete/1, + encode_open_type/1, + encode_GeneralString/2, decode_GeneralString/2, + encode_GraphicString/2, decode_GraphicString/2, + encode_TeletexString/2, decode_TeletexString/2, + encode_VideotexString/2, decode_VideotexString/2, + encode_ObjectDescriptor/2, decode_ObjectDescriptor/1, + encode_UTF8String/1,decode_UTF8String/1, + encode_octet_string/3, + encode_known_multiplier_string/4, + decode_known_multiplier_string/5, + octets_to_complete/2]). + +-define('16K',16384). +-define('32K',32768). +-define('64K',65536). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% setext(true|false) -> CompleteList +%% + +setext(false) -> + [0]; +setext(true) -> + [1]. + +fixextensions({ext,ExtPos,ExtNum},Val) -> + case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of + 0 -> []; + ExtBits -> + [encode_small_length(ExtNum)|pre_complete_bits(ExtNum,ExtBits)] + end. + +fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> + Acc; +fixextensions(Pos,ExtPos,Val,Acc) -> + Bit = case catch(element(Pos+1,Val)) of + asn1_NOVALUE -> + 0; + asn1_NOEXTVALUE -> + 0; + {'EXIT',_} -> + 0; + _ -> + 1 + end, + fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). + +skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) -> + Prev = Nr - 1, + case ExtensionBitstr of + <<_:Prev,1:1,_/bitstring>> -> + {Len,Bytes1} = decode_length(Bytes0, undefined), + <<_:Len/binary,Bytes2/bitstring>> = Bytes1, + skipextensions(Bytes2, Nr+1, ExtensionBitstr); + <<_:Prev,0:1,_/bitstring>> -> + skipextensions(Bytes0, Nr+1, ExtensionBitstr); + _ -> + Bytes0 + end. + + +getchoice(Bytes, 1, 0) -> % only 1 alternative is not encoded + {0,Bytes}; +getchoice(Bytes, _, 1) -> + decode_small_number(Bytes); +getchoice(Bytes, NumChoices, 0) -> + decode_constrained_number(Bytes, {0,NumChoices-1}). + + +%% getbits_as_binary(Num,Bytes) -> {Bin,Rest} +%% Num = integer(), +%% Bytes = bitstring(), +%% Bin = bitstring(), +%% Rest = bitstring() +getbits_as_binary(Num,Bytes) when is_bitstring(Bytes) -> + <<BS:Num/bitstring,Rest/bitstring>> = Bytes, + {BS,Rest}. + +getbits_as_list(Num,Bytes) when is_bitstring(Bytes) -> + <<BitStr:Num/bitstring,Rest/bitstring>> = Bytes, + {[ B || <<B:1>> <= BitStr],Rest}. + + +getbit(Buffer) -> + <<B:1,Rest/bitstring>> = Buffer, + {B,Rest}. + +getbits(Buffer, Num) when is_bitstring(Buffer) -> + <<Bs:Num,Rest/bitstring>> = Buffer, + {Bs,Rest}. + +align(Bin) when is_binary(Bin) -> + Bin; +align(BitStr) when is_bitstring(BitStr) -> + AlignBits = bit_size(BitStr) rem 8, + <<_:AlignBits,Rest/binary>> = BitStr, + Rest. + + +%% First align buffer, then pick the first Num octets. +%% Returns octets as an integer with bit significance as in buffer. +getoctets(Buffer, Num) when is_binary(Buffer) -> + <<Val:Num/integer-unit:8,RestBin/binary>> = Buffer, + {Val,RestBin}; +getoctets(Buffer, Num) when is_bitstring(Buffer) -> + AlignBits = bit_size(Buffer) rem 8, + <<_:AlignBits,Val:Num/integer-unit:8,RestBin/binary>> = Buffer, + {Val,RestBin}. + + +%% First align buffer, then pick the first Num octets. +%% Returns octets as a binary +getoctets_as_bin(Bin,Num) when is_binary(Bin) -> + <<Octets:Num/binary,RestBin/binary>> = Bin, + {Octets,RestBin}; +getoctets_as_bin(Bin,Num) when is_bitstring(Bin) -> + AlignBits = bit_size(Bin) rem 8, + <<_:AlignBits,Val:Num/binary,RestBin/binary>> = Bin, + {Val,RestBin}. + + +%% same as above but returns octets as a List +getoctets_as_list(Buffer,Num) -> + {Bin,Buffer2} = getoctets_as_bin(Buffer,Num), + {binary_to_list(Bin),Buffer2}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings +%% Alt = atom() +%% Altnum = integer() | {integer(),integer()}% number of alternatives +%% Choices = [atom()] | {[atom()],[atom()]} +%% When Choices is a tuple the first list is the Rootset and the +%% second is the Extensions and then Altnum must also be a tuple with the +%% lengths of the 2 lists +%% +set_choice(Alt,{L1,L2},{Len1,_Len2}) -> + case set_choice_tag(Alt,L1) of + N when is_integer(N), Len1 > 1 -> + [0, % the value is in the root set + encode_constrained_number({0,Len1-1},N)]; + N when is_integer(N) -> + [0]; % no encoding if only 0 or 1 alternative + false -> + [1, % extension value + case set_choice_tag(Alt, L2) of + N2 when is_integer(N2) -> + encode_small_number(N2); + false -> + unknown_choice_alt + end] + end; +set_choice(Alt, L, Len) -> + case set_choice_tag(Alt, L) of + N when is_integer(N), Len > 1 -> + encode_constrained_number({0,Len-1},N); + N when is_integer(N) -> + []; % no encoding if only 0 or 1 alternative + false -> + [unknown_choice_alt] + end. + +set_choice_tag(Alt,Choices) -> + set_choice_tag(Alt,Choices,0). + +set_choice_tag(Alt,[Alt|_Rest],Tag) -> + Tag; +set_choice_tag(Alt,[_H|Rest],Tag) -> + set_choice_tag(Alt,Rest,Tag+1); +set_choice_tag(_Alt,[],_Tag) -> + false. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_fragmented_XXX; decode of values encoded fragmented according +%% to ITU-T X.691 clause 10.9.3.8. The unit (XXX) is either bits, octets, +%% characters or number of components (in a choice,sequence or similar). +%% Buffer is a buffer binary(). +%% C is the constrained length. +%% If the buffer is not aligned, this function does that. +decode_fragmented_bits(Buffer, C) when is_binary(Buffer) -> + decode_fragmented_bits(Buffer, C, []); +decode_fragmented_bits(Buffer,C) when is_bitstring(Buffer) -> + AlignBits = bit_size(Buffer) rem 8, + <<_:AlignBits,Rest/binary>> = Buffer, + decode_fragmented_bits(Rest,C,[]). + +decode_fragmented_bits(<<3:2,Len:6,Bin/binary>>, C, Acc) -> + {Value,Bin2} = split_binary(Bin, Len * ?'16K'), % Len = 1 | 2 | 3 | 4 + decode_fragmented_bits(Bin2,C,[Value|Acc]); +decode_fragmented_bits(<<0:1,0:7,Bin/binary>>, C, Acc) -> + BinBits = erlang:list_to_bitstring(lists:reverse(Acc)), + case C of + Int when is_integer(Int), C =:= bit_size(BinBits) -> + {BinBits,Bin}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,BinBits}}}) + end; +decode_fragmented_bits(<<0:1,Len:7,Bin/binary>>, C, Acc) -> + <<Value:Len/bitstring,Rest/bitstring>> = Bin, + BinBits = erlang:list_to_bitstring([Value|Acc]), + case C of + Int when is_integer(Int), C =:= bit_size(BinBits) -> + {BinBits,Rest}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,BinBits}}}) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_open_type(Constraint, Value) -> CompleteList +%% Value = list of bytes of an already encoded value (the list must be flat) +%% | binary +%% Contraint = not used in this version +%% +encode_open_type(Val) when is_list(Val) -> + Bin = list_to_binary(Val), + case byte_size(Bin) of + Size when Size > 255 -> + [encode_length(Size),21,<<Size:16>>,Bin]; + Size -> + [encode_length(Size),20,Size,Bin] + end; +encode_open_type(Val) when is_binary(Val) -> + case byte_size(Val) of + Size when Size > 255 -> + [encode_length(Size),21,<<Size:16>>,Val]; % octets implies align + Size -> + [encode_length(Size),20,Size,Val] + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_integer(Constraint, Value) -> CompleteList +%% +encode_integer([{Rc,_Ec}],Val) when is_tuple(Rc) -> + try + [0|encode_integer([Rc], Val)] + catch + _:{error,{asn1,_}} -> + [1|encode_unconstrained_number(Val)] + end; +encode_integer([], Val) -> + encode_unconstrained_number(Val); +%% The constraint is the effective constraint, and in this case is a number +encode_integer([{'SingleValue',V}], V) -> + []; +encode_integer([{'ValueRange',{Lb,Ub}=VR,Range,PreEnc}],Val) + when Val >= Lb, Ub >= Val -> + %% this case when NamedNumberList + encode_constrained_number(VR, Range, PreEnc, Val); +encode_integer([{'ValueRange',{Lb,'MAX'}}], Val) -> + encode_semi_constrained_number(Lb, Val); +encode_integer([{'ValueRange',{'MIN',_}}], Val) -> + encode_unconstrained_number(Val); +encode_integer([{'ValueRange',VR={_Lb,_Ub}}], Val) -> + encode_constrained_number(VR, Val); +encode_integer(_,Val) -> + exit({error,{asn1,{illegal_value,Val}}}). + + +%% 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 +encode_small_number(Val) when Val < 64 -> + [10,7,Val]; +encode_small_number(Val) -> + [1|encode_semi_constrained_number(0, Val)]. + +decode_small_number(Bytes) -> + {Bit,Bytes2} = getbit(Bytes), + case Bit of + 0 -> + getbits(Bytes2, 6); + 1 -> + decode_semi_constrained_number(Bytes2) + end. + +%% X.691:10.7 Encoding of a semi-constrained whole number +encode_semi_constrained_number(Lb, Val) -> + Val2 = Val - Lb, + Oct = eint_positive(Val2), + Len = length(Oct), + if + Len < 128 -> + [20,Len+1,Len|Oct]; + Len < 256 -> + [encode_length(Len),20,Len|Oct]; + true -> + [encode_length(Len),21,<<Len:16>>|Oct] + end. + +decode_semi_constrained_number(Bytes) -> + {Len,Bytes2} = decode_length(Bytes, undefined), + getoctets(Bytes2, Len). + +encode_constrained_number({Lb,_Ub},_Range,{bits,N},Val) -> + Val2 = Val-Lb, + [10,N,Val2]; +encode_constrained_number({Lb,_Ub},_Range,{octets,N},Val) when N < 256-> + %% N is 8 or 16 (1 or 2 octets) + Val2 = Val-Lb, + [20,N,Val2]; +encode_constrained_number({Lb,_Ub},_Range,{octets,N},Val) -> % N>255 + %% N is 8 or 16 (1 or 2 octets) + Val2 = Val-Lb, + [21,<<N:16>>,Val2]; +encode_constrained_number({Lb,_Ub},Range,_,Val) -> + Val2 = Val-Lb, + if + Range =< 16#1000000 -> % max 3 octets + Octs = eint_positive(Val2), + L = length(Octs), + [encode_length({1,3},L),[20,L,Octs]]; + Range =< 16#100000000 -> % max 4 octets + Octs = eint_positive(Val2), + L = length(Octs), + [encode_length({1,4},L),[20,L,Octs]]; + Range =< 16#10000000000 -> % max 5 octets + Octs = eint_positive(Val2), + L = length(Octs), + [encode_length({1,5},L),[20,L,Octs]]; + true -> + exit({not_supported,{integer_range,Range}}) + end. + +encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val -> + Range = Ub - Lb + 1, + Val2 = Val - Lb, + if + Range == 1 -> []; + Range == 2 -> + [Val2]; + Range =< 4 -> + [10,2,Val2]; + Range =< 8 -> + [10,3,Val2]; + Range =< 16 -> + [10,4,Val2]; + Range =< 32 -> + [10,5,Val2]; + Range =< 64 -> + [10,6,Val2]; + Range =< 128 -> + [10,7,Val2]; + Range =< 255 -> + [10,8,Val2]; + Range =< 256 -> + [20,1,Val2]; + Range =< 65536 -> + [20,2,<<Val2:16>>]; + Range =< (1 bsl (255*8)) -> + Octs = binary:encode_unsigned(Val2), + RangeOcts = binary:encode_unsigned(Range - 1), + OctsLen = byte_size(Octs), + RangeOctsLen = byte_size(RangeOcts), + LengthBitsNeeded = minimum_bits(RangeOctsLen - 1), + [10,LengthBitsNeeded,OctsLen-1,20,OctsLen,Octs]; + true -> + exit({not_supported,{integer_range,Range}}) + end; +encode_constrained_number({_,_},Val) -> + exit({error,{asn1,{illegal_value,Val}}}). + +decode_constrained_number(Buffer,VR={Lb,Ub}) -> + Range = Ub - Lb + 1, + decode_constrained_number(Buffer,VR,Range). + +decode_constrained_number(Buffer,{Lb,_Ub},Range) -> + % Val2 = Val - Lb, + {Val,Remain} = + if + Range == 1 -> + {0,Buffer}; + Range == 2 -> + getbits(Buffer,1); + Range =< 4 -> + getbits(Buffer,2); + Range =< 8 -> + getbits(Buffer,3); + Range =< 16 -> + getbits(Buffer,4); + Range =< 32 -> + getbits(Buffer,5); + Range =< 64 -> + getbits(Buffer,6); + Range =< 128 -> + getbits(Buffer,7); + Range =< 255 -> + getbits(Buffer,8); + Range =< 256 -> + getoctets(Buffer,1); + Range =< 65536 -> + getoctets(Buffer,2); + Range =< (1 bsl (255*8)) -> + OList = binary:bin_to_list(binary:encode_unsigned(Range - 1)), + RangeOctLen = length(OList), + {Len, Bytes} = decode_length(Buffer, {1, RangeOctLen}), + {Octs, RestBytes} = getoctets_as_bin(Bytes, Len), + {binary:decode_unsigned(Octs), RestBytes}; + true -> + exit({not_supported,{integer_range,Range}}) + end, + {Val+Lb,Remain}. + +%% For some reason the minimum bits needed in the length field in +%% the encoding of constrained whole numbers must always be at least 2? +minimum_bits(N) when N < 4 -> 2; +minimum_bits(N) when N < 8 -> 3; +minimum_bits(N) when N < 16 -> 4; +minimum_bits(N) when N < 32 -> 5; +minimum_bits(N) when N < 64 -> 6; +minimum_bits(N) when N < 128 -> 7; +minimum_bits(_N) -> 8. + +%% X.691:10.8 Encoding of an unconstrained whole number + +encode_unconstrained_number(Val) -> + Oct = if + Val >= 0 -> + eint(Val, []); + true -> + enint(Val, []) + end, + Len = length(Oct), + if + Len < 128 -> + [20,Len + 1,Len|Oct]; + Len < 256 -> + [20,Len + 2,<<2:2,Len:14>>|Oct]; + true -> + [encode_length(Len),21,<<Len:16>>|Oct] + end. + +%% used for positive Values which don't need a sign bit +%% returns a list +eint_positive(Val) -> + case eint(Val,[]) of + [0,B1|T] -> + [B1|T]; + T -> + T + end. + + +eint(0, [B|Acc]) when B < 128 -> + [B|Acc]; +eint(N, Acc) -> + eint(N bsr 8, [N band 16#ff| Acc]). + +enint(-1, [B1|T]) when B1 > 127 -> + [B1|T]; +enint(N, Acc) -> + enint(N bsr 8, [N band 16#ff|Acc]). + +%% X.691:10.9 Encoding of a length determinant +%%encode_small_length(undefined,Len) -> % null means no UpperBound +%% encode_small_number(Len). + +%% X.691:10.9.3.5 +%% X.691:10.9.3.7 +encode_length(Len) -> % unconstrained + if + Len < 128 -> + [20,1,Len]; + Len < 16384 -> + <<20,2,2:2,Len:14>>; + true -> % should be able to endode length >= 16384 i.e. fragmented length + exit({error,{asn1,{encode_length,{nyi,above_16k}}}}) + end. + +encode_length(undefined, Len) -> % un-constrained + encode_length(Len); +encode_length({0,'MAX'},Len) -> + encode_length(undefined,Len); +encode_length({Lb,Ub}=Vr, Len) when Ub =< 65535 ,Lb >= 0 -> % constrained + encode_constrained_number(Vr,Len); +encode_length({Lb,_Ub}, Len) when is_integer(Lb), Lb >= 0 -> % Ub > 65535 + encode_length(Len); +encode_length({{Lb,Ub}=Vr,Ext}, Len) + when Ub =< 65535 ,Lb >= 0,Len=<Ub, is_list(Ext) -> + %% constrained extensible + [0|encode_constrained_number(Vr,Len)]; +encode_length({{Lb,_},Ext},Len) when is_list(Ext) -> + [1|encode_semi_constrained_number(Lb, Len)]; +encode_length(SingleValue, _Len) when is_integer(SingleValue) -> + []. + +%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension +%% additions in a sequence or set +encode_small_length(Len) when Len =< 64 -> + [10,7,Len-1]; +encode_small_length(Len) -> + [1,encode_length(Len)]. + + +decode_length(Buffer, undefined) -> % un-constrained + case align(Buffer) of + <<0:1,Oct:7,Rest/binary>> -> + {Oct,Rest}; + <<2:2,Val:14,Rest/binary>> -> + {Val,Rest}; + <<3:2,_Val:14,_Rest/binary>> -> + %% this case should be fixed + exit({error,{asn1,{decode_length,{nyi,above_16k}}}}) + end; + +decode_length(Buffer, {Lb,Ub}) when Ub =< 65535 ,Lb >= 0 -> % constrained + decode_constrained_number(Buffer, {Lb,Ub}); +decode_length(Buffer, {Lb,_Ub}) when is_integer(Lb), Lb >= 0 -> % Ub > 65535 + decode_length(Buffer,undefined); +decode_length(Buffer, {{Lb,Ub},Ext}) when is_list(Ext) -> + case getbit(Buffer) of + {0,Buffer2} -> + decode_length(Buffer2, {Lb,Ub}); + {1,Buffer2} -> + decode_length(Buffer2, undefined) + end; + +%When does this case occur with {_,_Lb,Ub} ?? +% X.691:10.9.3.5 +decode_length(Bin, {_,_Lb,_Ub}) -> % Unconstrained or large Ub NOTE! this case does not cover case when Ub > 65535 + case Bin of + <<0:1,Val:7,Rest/bitstring>> -> + {Val,Rest}; + _ -> + case align(Bin) of + <<2:2,Val:14,Rest/binary>> -> + {Val,Rest}; + <<3:2,_:14,_Rest/binary>> -> + exit({error,{asn1,{decode_length,{nyi,length_above_64K}}}}) + end + end; +decode_length(Buffer, SingleValue) when is_integer(SingleValue) -> + {SingleValue,Buffer}. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% bitstring NamedBitList +%% Val can be of: +%% - [identifiers] where only named identifers are set to one, +%% the Constraint must then have some information of the +%% bitlength. +%% - [list of ones and zeroes] all bits +%% - integer value representing the bitlist +%% C is constraint Len, only valid when identifiers + + +%% when the value is a list of {Unused,BinBits}, where +%% Unused = integer(), +%% BinBits = binary(). + +encode_bit_string(C, {Unused,BinBits}=Bin, NamedBitList) + when is_integer(Unused), is_binary(BinBits) -> + encode_bin_bit_string(C,Bin,NamedBitList); + +%% when the value is a list of named bits + +encode_bit_string(C, LoNB=[FirstVal | _RestVal], NamedBitList) when is_atom(FirstVal) -> + ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), + BitList = make_and_set_list(ToSetPos,0), + encode_bit_string(C,BitList,NamedBitList);% consider the constraint + +encode_bit_string(C, BL=[{bit,_} | _RestVal], NamedBitList) -> + ToSetPos = get_all_bitposes(BL, NamedBitList, []), + BitList = make_and_set_list(ToSetPos,0), + encode_bit_string(C,BitList,NamedBitList); + +%% when the value is a list of ones and zeroes +encode_bit_string(Int, BitListValue, _) + when is_list(BitListValue),is_integer(Int),Int =< 16 -> + %% The type is constrained by a single value size constraint + %% range_check(Int,length(BitListValue)), + [40,Int,length(BitListValue),BitListValue]; +encode_bit_string(Int, BitListValue, _) + when is_list(BitListValue),is_integer(Int), Int =< 255 -> + %% The type is constrained by a single value size constraint + %% range_check(Int,length(BitListValue)), + [2,40,Int,length(BitListValue),BitListValue]; +encode_bit_string(Int, BitListValue, _) + when is_list(BitListValue),is_integer(Int), Int < ?'64K' -> + {Code,DesiredLength,Length} = + case length(BitListValue) of + B1 when B1 > Int -> + exit({error,{'BIT_STRING_length_greater_than_SIZE', + Int,BitListValue}}); + B1 when B1 =< 255,Int =< 255 -> + {40,Int,B1}; + B1 when B1 =< 255 -> + {42,<<Int:16>>,B1}; + B1 -> + {43,<<Int:16>>,<<B1:16>>} + end, + %% The type is constrained by a single value size constraint + [2,Code,DesiredLength,Length,BitListValue]; +encode_bit_string(no, BitListValue,[]) + when is_list(BitListValue) -> + [encode_length(length(BitListValue)), + 2|BitListValue]; +encode_bit_string({{Fix,Fix},Ext}, BitListValue,[]) + when is_integer(Fix), is_list(Ext) -> + case length(BitListValue) of + Len when Len =< Fix -> + [0|encode_bit_string(Fix, BitListValue, [])]; + _ -> + [1|encode_bit_string(no, BitListValue, [])] + end; +encode_bit_string(C, BitListValue,[]) + when is_list(BitListValue) -> + [encode_length(C, length(BitListValue)), + 2|BitListValue]; +encode_bit_string(no, BitListValue,_NamedBitList) + when is_list(BitListValue) -> + %% this case with an unconstrained BIT STRING can be made more efficient + %% if the complete driver can take a special code so the length field + %% is encoded there. + NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, + lists:reverse(BitListValue))), + [encode_length(length(NewBitLVal)),2|NewBitLVal]; +encode_bit_string({{Fix,Fix},Ext}, BitListValue, NamedBitList) + when is_integer(Fix), is_list(Ext) -> + case length(BitListValue) of + Len when Len =< Fix -> + [0|encode_bit_string(Fix, BitListValue, NamedBitList)]; + _ -> + [1|encode_bit_string(no, BitListValue, NamedBitList)] + end; +encode_bit_string(C, BitListValue, _NamedBitList) + when is_list(BitListValue) -> % C = {_,'MAX'} + NewBitLVal = bit_string_trailing_zeros(BitListValue, C), + [encode_length(C, length(NewBitLVal)),2|NewBitLVal]; + + +%% when the value is an integer +encode_bit_string(C, IntegerVal, NamedBitList) when is_integer(IntegerVal)-> + BitList = int_to_bitlist(IntegerVal), + encode_bit_string(C,BitList,NamedBitList). + +bit_string_trailing_zeros(BitList,C) when is_integer(C) -> + bit_string_trailing_zeros1(BitList,C,C); +bit_string_trailing_zeros(BitList,{Lb,Ub}) when is_integer(Lb) -> + bit_string_trailing_zeros1(BitList,Lb,Ub); +bit_string_trailing_zeros(BitList,{{Lb,Ub},_}) when is_integer(Lb) -> + bit_string_trailing_zeros1(BitList,Lb,Ub); +bit_string_trailing_zeros(BitList,_) -> + BitList. + +bit_string_trailing_zeros1(BitList,Lb,Ub) -> + case length(BitList) of + Lb -> BitList; + B when B < Lb -> BitList++lists:duplicate(Lb-B, 0); + D -> F = fun(L,LB,LB,_,_)->lists:reverse(L); + ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun); + (L,L1,_,UB,_)when L1 =< UB -> lists:reverse(L); + (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING, + BitList}}) end, + F(lists:reverse(BitList),D,Lb,Ub,F) + end. + +%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. +%% Unused = integer(),i.e. number unused bits in least sign. byte of +%% BinBits = binary(). +encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) + when is_integer(C),C=<16 -> + range_check(C, bit_size(BinBits) - Unused), + [45,C,size(BinBits),BinBits]; +encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) + when is_integer(C), C =< 255 -> + range_check(C, bit_size(BinBits) - Unused), + [2,45,C,size(BinBits),BinBits]; +encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) + when is_integer(C), C =< 65535 -> + range_check(C, bit_size(BinBits) - Unused), + case byte_size(BinBits) of + Size when Size =< 255 -> + [2,46,<<C:16>>,Size,BinBits]; + Size -> + [2,47,<<C:16>>,<<Size:16>>,BinBits] + end; +encode_bin_bit_string(C,UnusedAndBin={_,_},NamedBitList) -> + {Unused1,Bin1} = + %% removes all trailing bits if NamedBitList is not empty + remove_trailing_bin(NamedBitList,UnusedAndBin), + case C of + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + Size = byte_size(Bin1), + [encode_length({Lb,Ub}, Size*8 - Unused1), + 2,octets_unused_to_complete(Unused1,Size,Bin1)]; + no -> + Size = byte_size(Bin1), + [encode_length(Size*8 - Unused1), + 2|octets_unused_to_complete(Unused1, Size, Bin1)]; + {{Fix,Fix},Ext} when is_integer(Fix),is_list(Ext) -> + case byte_size(Bin1)*8 - Unused1 of + Size when Size =< Fix -> + [0|encode_bin_bit_string(Fix,UnusedAndBin,NamedBitList)]; + _Size -> + [1|encode_bin_bit_string(no,UnusedAndBin,NamedBitList)] + end; + Sc -> + Size = byte_size(Bin1), + [encode_length(Sc, Size*8 - Unused1), + 2|octets_unused_to_complete(Unused1,Size,Bin1)] + end. + +range_check(C,C) when is_integer(C) -> + ok; +range_check(C1,C2) when is_integer(C1) -> + exit({error,{asn1,{bit_string_out_of_range,{C1,C2}}}}). + +remove_trailing_bin([], {Unused,Bin}) -> + {Unused,Bin}; +remove_trailing_bin(_NamedNumberList,{_Unused,<<>>}) -> + {0,<<>>}; +remove_trailing_bin(NamedNumberList, {_Unused,Bin}) -> + Size = byte_size(Bin)-1, + <<Bfront:Size/binary, LastByte:8>> = Bin, + %% clear the Unused bits to be sure + Unused1 = trailingZeroesInNibble(LastByte band 15), + Unused2 = + case Unused1 of + 4 -> + 4 + trailingZeroesInNibble(LastByte bsr 4); + _ -> Unused1 + end, + case Unused2 of + 8 -> + remove_trailing_bin(NamedNumberList,{0,Bfront}); + _ -> + {Unused2,Bin} + end. + + +trailingZeroesInNibble(0) -> + 4; +trailingZeroesInNibble(1) -> + 0; +trailingZeroesInNibble(2) -> + 1; +trailingZeroesInNibble(3) -> + 0; +trailingZeroesInNibble(4) -> + 2; +trailingZeroesInNibble(5) -> + 0; +trailingZeroesInNibble(6) -> + 1; +trailingZeroesInNibble(7) -> + 0; +trailingZeroesInNibble(8) -> + 3; +trailingZeroesInNibble(9) -> + 0; +trailingZeroesInNibble(10) -> + 1; +trailingZeroesInNibble(11) -> + 0; +trailingZeroesInNibble(12) -> %#1100 + 2; +trailingZeroesInNibble(13) -> + 0; +trailingZeroesInNibble(14) -> + 1; +trailingZeroesInNibble(15) -> + 0. + +%%%%%%%%%%%%%%% +%% The result is presented as a list of named bits (if possible) +%% else as a tuple {Unused,Bits}. Unused is the number of unused +%% bits, least significant bits in the last byte of Bits. Bits is +%% the BIT STRING represented as a binary. +%% +decode_compact_bit_string(Buffer, C, NamedNumberList) -> + case get_constraint(C,'SizeConstraint') of + 0 -> % fixed length + {{8,0},Buffer}; + V when is_integer(V),V=<16 -> %fixed length 16 bits or less + compact_bit_string(Buffer,V,NamedNumberList); + V when is_integer(V),V=<65536 -> %fixed length > 16 bits + Bytes2 = align(Buffer), + compact_bit_string(Bytes2,V,NamedNumberList); + V when is_integer(V) -> % V > 65536 => fragmented value + {BitStr,Buffer2} = decode_fragmented_bits(Buffer,V), + case bit_size(BitStr) band 7 of + 0 -> {{0,BitStr},Buffer2}; + N -> {{8-N,<<BitStr/bitstring,0:(8-N)>>},Buffer2} + end; + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + %% This case may demand decoding of fragmented length/value + {Len,Bytes2} = decode_length(Buffer, {Lb,Ub}), + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList); + no -> + %% This case may demand decoding of fragmented length/value + {Len,Bytes2} = decode_length(Buffer, undefined), + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList); + {{Fix,Fix},Ext} = Sc when is_integer(Fix), is_list(Ext) -> + case decode_length(Buffer,Sc) of + {Len,Bytes2} when Len > Fix -> + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList); + {Len,Bytes2} when Len > 16 -> + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList); + {Len,Bytes2} -> + compact_bit_string(Bytes2,Len,NamedNumberList) + end; + Sc -> + {Len,Bytes2} = decode_length(Buffer,Sc), + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList) + end. + + +%%%%%%%%%%%%%%% +%% The result is presented as a list of named bits (if possible) +%% else as a list of 0 and 1. +%% +decode_bit_string(Buffer, C, NamedNumberList) -> + case get_constraint(C,'SizeConstraint') of + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList); + no -> + {Len,Bytes2} = decode_length(Buffer,undefined), + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList); + 0 -> % fixed length + {[],Buffer}; % nothing to encode + V when is_integer(V),V=<16 -> % fixed length 16 bits or less + bit_list_or_named(Buffer,V,NamedNumberList); + V when is_integer(V),V=<65536 -> + Bytes2 = align(Buffer), + bit_list_or_named(Bytes2,V,NamedNumberList); + V when is_integer(V) -> + Bytes2 = align(Buffer), + {BinBits,_Bytes3} = decode_fragmented_bits(Bytes2,V), + bit_list_or_named(BinBits,V,NamedNumberList); + {{Fix,Fix},Ext} =Sc when is_integer(Fix), is_list(Ext) -> + case decode_length(Buffer,Sc) of + {Len,Bytes2} when Len > Fix -> + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList); + {Len,Bytes2} when Len > 16 -> + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList); + {Len,Bytes2} -> + bit_list_or_named(Bytes2,Len,NamedNumberList) + end; + Sc -> % extension marker + {Len,Bytes2} = decode_length(Buffer,Sc), + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList) + end. + + +%% if no named bits are declared we will return a +%% {Unused,Bits}. Unused = integer(), +%% Bits = binary(). +compact_bit_string(Buffer,Len,[]) -> + {BitStr,Rest} = getbits_as_binary(Len,Buffer), % {{Unused,BinBits},NewBuffer} + PadLen = (8 - (bit_size(BitStr) rem 8)) rem 8, + {{PadLen,<<BitStr/bitstring,0:PadLen>>},Rest}; +compact_bit_string(Buffer,Len,NamedNumberList) -> + bit_list_or_named(Buffer,Len,NamedNumberList). + + +%% if no named bits are declared we will return a +%% BitList = [0 | 1] + +bit_list_or_named(Buffer,Len,[]) -> + getbits_as_list(Len,Buffer); + +%% if there are named bits declared we will return a named +%% BitList where the names are atoms and unnamed bits represented +%% as {bit,Pos} +%% BitList = [atom() | {bit,Pos}] +%% Pos = integer() + +bit_list_or_named(Buffer,Len,NamedNumberList) -> + {BitList,Rest} = getbits_as_list(Len,Buffer), + {bit_list_or_named1(0,BitList,NamedNumberList,[]), Rest}. + +bit_list_or_named1(Pos,[0|Bt],Names,Acc) -> + bit_list_or_named1(Pos+1,Bt,Names,Acc); +bit_list_or_named1(Pos,[1|Bt],Names,Acc) -> + case lists:keyfind(Pos, 2, Names) of + {Name,_} -> + bit_list_or_named1(Pos+1,Bt,Names,[Name|Acc]); + false -> + bit_list_or_named1(Pos+1,Bt,Names,[{bit,Pos}|Acc]) + end; +bit_list_or_named1(_Pos,[],_Names,Acc) -> + lists:reverse(Acc). + + + +%%%%%%%%%%%%%%% +%% + +int_to_bitlist(Int) when is_integer(Int), Int > 0 -> + [Int band 1 | int_to_bitlist(Int bsr 1)]; +int_to_bitlist(0) -> + []. + + +%%%%%%%%%%%%%%%%%% +%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> +%% [sorted_list_of_bitpositions_to_set] + +get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); + +get_all_bitposes([Val | Rest], NamedBitList, Ack) -> + case lists:keyfind(Val, 1, NamedBitList) of + {_ValName, ValPos} -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); + false -> + exit({error,{asn1, {bitstring_namedbit, Val}}}) + end; +get_all_bitposes([], _NamedBitList, Ack) -> + lists:sort(Ack). + +%%%%%%%%%%%%%%%%%% +%% make_and_set_list([list of positions to set to 1])-> +%% returns list with all in SetPos set. +%% in positioning in list the first element is 0, the second 1 etc.., but +%% + +make_and_set_list([XPos|SetPos], XPos) -> + [1 | make_and_set_list(SetPos, XPos + 1)]; +make_and_set_list([Pos|SetPos], XPos) -> + [0 | make_and_set_list([Pos | SetPos], XPos + 1)]; +make_and_set_list([], _) -> + []. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% X.691:16 +%% encode_octet_string(Constraint,ExtensionMarker,Val) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +encode_octet_string(_C, true, _Val) -> + exit({error,{asn1,{'not_supported',extensionmarker}}}); +encode_octet_string({_,_}=SZ, false, Val) -> + Len = length(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), + 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), + try + [encode_length(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}}). + +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(Len)|octets_to_complete(Len, B)]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Restricted char string types +%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) +%% X.691:26 and X.680:34-36 + +encode_restricted_string(Val) when is_list(Val)-> + Len = length(Val), + [encode_length(Len)|octets_to_complete(Len, Val)]. + +encode_known_multiplier_string(SizeC, NumBits, CharOutTab, Val) -> + Result = chars_encode2(Val, NumBits, CharOutTab), + case SizeC of + Ub when is_integer(Ub), Ub*NumBits =< 16 -> + Result; + Ub when is_integer(Ub), Ub =<65535 -> % fixed length + [2,Result]; + {Ub,Lb} -> + [encode_length({Ub,Lb},length(Val)),2,Result]; + no -> + [encode_length(length(Val)),2,Result] + end. + +decode_restricted_string(Bytes,aligned) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + getoctets_as_list(Bytes2,Len). + +decode_known_multiplier_string(StringType,SizeC,NumBits,CharInTab,Bytes) -> + case SizeC of + Ub when is_integer(Ub), Ub*NumBits =< 16 -> + chars_decode(Bytes,NumBits,StringType,CharInTab,Ub); + Ub when is_integer(Ub),Ub =<65535 -> % fixed length + Bytes1 = align(Bytes), + chars_decode(Bytes1,NumBits,StringType,CharInTab,Ub); + Vl when is_list(Vl) -> + {Len,Bytes1} = decode_length(Bytes,{hd(Vl),lists:max(Vl)}), + Bytes2 = align(Bytes1), + chars_decode(Bytes2,NumBits,StringType,CharInTab,Len); + no -> + {Len,Bytes1} = decode_length(Bytes,undefined), + Bytes2 = align(Bytes1), + chars_decode(Bytes2,NumBits,StringType,CharInTab,Len); + {Lb,Ub}-> + {Len,Bytes1} = decode_length(Bytes,{Lb,Ub}), + Bytes2 = align(Bytes1), + chars_decode(Bytes2,NumBits,StringType,CharInTab,Len) + end. + +encode_GeneralString(_C,Val) -> + encode_restricted_string(Val). +decode_GeneralString(Bytes,_C) -> + decode_restricted_string(Bytes,aligned). + +encode_GraphicString(_C,Val) -> + encode_restricted_string(Val). +decode_GraphicString(Bytes,_C) -> + decode_restricted_string(Bytes,aligned). + +encode_ObjectDescriptor(_C,Val) -> + encode_restricted_string(Val). +decode_ObjectDescriptor(Bytes) -> + decode_restricted_string(Bytes,aligned). + +encode_TeletexString(_C,Val) -> % equivalent with T61String + encode_restricted_string(Val). +decode_TeletexString(Bytes,_C) -> + decode_restricted_string(Bytes,aligned). + +encode_VideotexString(_C,Val) -> + encode_restricted_string(Val). +decode_VideotexString(Bytes,_C) -> + decode_restricted_string(Bytes,aligned). + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% getBMPChars(Bytes,Len) ->{BMPcharList,RemainingBytes} +%% +getBMPChars(<<T/binary>>, 0, Acc) -> + {lists:reverse(Acc),T}; +getBMPChars(<<0,O2,Bytes1/bitstring>>, Len, Acc) -> + getBMPChars(Bytes1,Len-1,[O2|Acc]); +getBMPChars(<<O1,O2,Bytes1/bitstring>>, Len, Acc) -> + getBMPChars(Bytes1,Len-1,[{0,0,O1,O2}|Acc]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% chars_encode(C,StringType,Value) -> ValueList +%% +%% encodes chars according to the per rules taking the constraint +%% PermittedAlphabet into account. +%% +%% This function only encodes the value part and NOT the length. + +chars_encode2([H|T],NumBits,T1={Min,Max,notab}) when H =< Max, H >= Min -> + [pre_complete_bits(NumBits,H-Min)|chars_encode2(T,NumBits,T1)]; +chars_encode2([H|T],NumBits,T1={Min,Max,Tab}) when H =< Max, H >= Min -> + [pre_complete_bits(NumBits,exit_if_false(H,element(H-Min+1,Tab)))| + chars_encode2(T,NumBits,T1)]; +chars_encode2([{A,B,C,D}|T],NumBits,T1={Min,_Max,notab}) -> + %% no value range check here (ought to be, but very expensive) + [pre_complete_bits(NumBits, + ((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min)| + chars_encode2(T,NumBits,T1)]; +chars_encode2([H={A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> + %% no value range check here (ought to be, but very expensive) + [pre_complete_bits(NumBits,exit_if_false(H,element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)))|chars_encode2(T,NumBits,{Min,Max,notab})]; +chars_encode2([H|_T],_NumBits,{_Min,_Max,_Tab}) -> + exit({error,{asn1,{illegal_char_value,H}}}); +chars_encode2([],_,_) -> + []. + +exit_if_false(V,false)-> + exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}}); +exit_if_false(_,V) ->V. + +pre_complete_bits(NumBits,Val) when NumBits =< 8 -> + [10,NumBits,Val]; +pre_complete_bits(NumBits,Val) when NumBits =< 16 -> + [10,NumBits-8,Val bsr 8,10,8,(Val band 255)]; +pre_complete_bits(NumBits,Val) when NumBits =< 2040 -> % 255 * 8 + Unused = (8 - (NumBits rem 8)) rem 8, + Len = NumBits + Unused, + [30,Unused,Len div 8,<<(Val bsl Unused):Len>>]. + + +chars_decode(Bytes,_,'BMPString',_,Len) -> + getBMPChars(Bytes,Len,[]); +chars_decode(Bytes,NumBits,_StringType,CharInTab,Len) -> + chars_decode2(Bytes,CharInTab,NumBits,Len). + + +chars_decode2(Bytes,CharInTab,NumBits,Len) -> + chars_decode2(Bytes,CharInTab,NumBits,Len,[]). + +chars_decode2(Bytes,_CharInTab,_NumBits,0,Acc) -> + {lists:reverse(Acc),Bytes}; +chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) when NumBits > 8 -> + {Char,Bytes2} = getbits(Bytes,NumBits), + Result = + if + Char < 256 -> Char; + true -> + list_to_tuple(binary_to_list(<<Char:32>>)) + end, + chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Result|Acc]); +chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) -> + {Char,Bytes2} = getbits(Bytes,NumBits), + chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Char+Min|Acc]); + +%% BMPString and UniversalString with PermittedAlphabet is currently not supported +chars_decode2(Bytes,{Min,Max,CharInTab},NumBits,Len,Acc) -> + {Char,Bytes2} = getbits(Bytes,NumBits), + chars_decode2(Bytes2,{Min,Max,CharInTab},NumBits,Len -1,[element(Char+1,CharInTab)|Acc]). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_UTF8String(Val) -> CompleteList +%% Val -> <<utf8encoded binary>> +%% CompleteList -> [apropriate codes and values for driver complete] +%% +encode_UTF8String(Val) when is_binary(Val) -> + Sz = byte_size(Val), + [encode_length(Sz),octets_to_complete(Sz, Val)]; +encode_UTF8String(Val) -> + encode_UTF8String(list_to_binary(Val)). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_UTF8String(Bytes) -> {Utf8Binary,RemainingBytes} +%% Utf8Binary -> <<utf8 encoded binary>> +%% RemainingBytes -> <<buffer>> +decode_UTF8String(Bytes) -> + {Len,Bytes2} = decode_length(Bytes, undefined), + {_Bin,_Bytes3} = getoctets_as_bin(Bytes2, Len). + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_object_identifier(Val) -> CompleteList +%% encode_object_identifier({Name,Val}) -> CompleteList +%% Val -> {Int1,Int2,...,IntN} % N >= 2 +%% Name -> atom() +%% Int1 -> integer(0..2) +%% Int2 -> integer(0..39) when Int1 (0..1) else integer() +%% Int3-N -> integer() +%% CompleteList -> [{bits,8,Val}|{octets,Ol}|align|...] +%% +encode_object_identifier(Val) -> + OctetList = e_object_identifier(Val), + Octets = list_to_binary(OctetList), + Sz = byte_size(Octets), + [encode_length(Sz), + octets_to_complete(Sz, Octets)]. + +e_object_identifier({'OBJECT IDENTIFIER',V}) -> + e_object_identifier(V); +e_object_identifier(V) when is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); + +%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) +e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> + Head = 40*E1 + E2, % weird + e_object_elements([Head|Tail],[]); +e_object_identifier(Oid=[_,_|_Tail]) -> + exit({error,{asn1,{'illegal_value',Oid}}}). + +e_object_elements([],Acc) -> + lists:reverse(Acc); +e_object_elements([H|T],Acc) -> + e_object_elements(T,[e_object_element(H)|Acc]). + +e_object_element(Num) when Num < 128 -> + [Num]; +e_object_element(Num) -> + [e_o_e(Num bsr 7)|[Num band 2#1111111]]. +e_o_e(Num) when Num < 128 -> + Num bor 2#10000000; +e_o_e(Num) -> + [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]]. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_object_identifier(Bytes) -> {ObjId,RemainingBytes} +%% ObjId -> {integer(),integer(),...} % at least 2 integers +%% RemainingBytes -> [integer()] when integer() (0..255) +decode_object_identifier(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), + [First|Rest] = dec_subidentifiers(Octs,0,[]), + Idlist = if + First < 40 -> + [0,First|Rest]; + First < 80 -> + [1,First - 40|Rest]; + true -> + [2,First - 80|Rest] + end, + {list_to_tuple(Idlist),Bytes3}. + +dec_subidentifiers([H|T],Av,Al) when H >=16#80 -> + dec_subidentifiers(T,(Av bsl 7) + (H band 16#7F),Al); +dec_subidentifiers([H|T],Av,Al) -> + dec_subidentifiers(T,0,[(Av bsl 7) + H |Al]); +dec_subidentifiers([],_Av,Al) -> + lists:reverse(Al). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_relative_oid(Val) -> CompleteList +%% encode_relative_oid({Name,Val}) -> CompleteList +encode_relative_oid(Val) when is_tuple(Val) -> + encode_relative_oid(tuple_to_list(Val)); +encode_relative_oid(Val) when is_list(Val) -> + Octets = list_to_binary([e_object_element(X)||X <- Val]), + Sz = byte_size(Octets), + [encode_length(Sz)|octets_to_complete(Sz, Octets)]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_relative_oid(Val) -> CompleteList +%% decode_relative_oid({Name,Val}) -> CompleteList +decode_relative_oid(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), + ObjVals = dec_subidentifiers(Octs,0,[]), + {list_to_tuple(ObjVals),Bytes3}. + + +get_constraint([{Key,V}],Key) -> + V; +get_constraint([],_) -> + no; +get_constraint(C,Key) -> + case lists:keyfind(Key, 1, C) of + false -> + no; + {_,V} -> + V + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% complete(InList) -> ByteList +%% Takes a coded list with bits and bytes and converts it to a list of bytes +%% Should be applied as the last step at encode of a complete ASN.1 type +%% + +complete(L) -> + case asn1rt_nif:encode_per_complete(L) of + {error, Reason} -> handle_error(Reason, L); + Else when is_binary(Else) -> Else + end. + +handle_error([],_)-> + exit({error,{asn1,{"memory allocation problem in driver"}}}); +handle_error($1,L) -> % error in complete in driver + exit({error,{asn1,L}}); +handle_error(ErrL,L) -> + exit({error,{asn1,ErrL,L}}). + +octets_to_complete(Len,Val) when Len < 256 -> + [20,Len,Val]; +octets_to_complete(Len,Val) -> + [21,<<Len:16>>,Val]. + +octets_unused_to_complete(Unused,Len,Val) when Len < 256 -> + [30,Unused,Len,Val]; +octets_unused_to_complete(Unused,Len,Val) -> + [31,Unused,<<Len:16>>,Val]. diff --git a/lib/asn1/src/asn1rtt_real_common.erl b/lib/asn1/src/asn1rtt_real_common.erl new file mode 100644 index 0000000000..540f0d60a5 --- /dev/null +++ b/lib/asn1/src/asn1rtt_real_common.erl @@ -0,0 +1,292 @@ +%% +%% %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(asn1rtt_real_common). + +-export([encode_real/1,decode_real/1, + ber_encode_real/1]). + +%%============================================================================ +%% +%% Real value, ITU_T X.690 Chapter 8.5 +%%============================================================================ +%% +%% encode real value +%%============================================================================ + +ber_encode_real(0) -> + {[],0}; +ber_encode_real('PLUS-INFINITY') -> + {[64],1}; +ber_encode_real('MINUS-INFINITY') -> + {[65],1}; +ber_encode_real(Val) when is_tuple(Val); is_list(Val) -> + encode_real(Val). + +%%%%%%%%%%%%%% +%% only base 2 encoding! +%% binary encoding: +%% +------------+ +------------+ +-+-+-+-+---+---+ +%% | (tag)9 | | n + p + 1 | |1|S|BB |FF |EE | +%% +------------+ +------------+ +-+-+-+-+---+---+ +%% +%% +------------+ +------------+ +%% | | | | +%% +------------+ ...+------------+ +%% n octets for exponent +%% +%% +------------+ +------------+ +%% | | | | +%% +------------+ ...+------------+ +%% p octets for pos mantissa +%% +%% S is 0 for positive sign +%% 1 for negative sign +%% BB: encoding base, 00 = 2, (01 = 8, 10 = 16) +%% 01 and 10 not used +%% FF: scale factor 00 = 0 (used in base 2 encoding) +%% EE: encoding of the exponent: +%% 00 - on the following octet +%% 01 - on the 2 following octets +%% 10 - on the 3 following octets +%% 11 - encoding of the length of the two's-complement encoding of +%% exponent on the following octet, and two's-complement +%% encoding of exponent on the other octets. +%% +%% In DER and base 2 encoding the mantissa is encoded as value 0 or +%% bit shifted until it is an odd number. Thus, do this for BER as +%% well. + +encode_real(Real) -> + encode_real([], Real). + +encode_real(_C, {Mantissa, Base, Exponent}) when Base =:= 2 -> +%% io:format("Mantissa: ~w Base: ~w, Exp: ~w~n",[Man, Base, Exp]), + {Man,ExpAdd} = truncate_zeros(Mantissa), %% DER adjustment + Exp = Exponent + ExpAdd, + OctExp = if Exp >= 0 -> list_to_binary(encode_pos_integer(Exp, [])); + true -> list_to_binary(encode_neg_integer(Exp, [])) + end, +%% ok = io:format("OctExp: ~w~n",[OctExp]), + SignBit = if Man > 0 -> 0; % bit 7 is pos or neg, no Zeroval + true -> 1 + end, +%% ok = io:format("SignBitMask: ~w~n",[SignBitMask]), + SFactor = 0, + OctExpLen = size(OctExp), + if OctExpLen > 255 -> + exit({error,{asn1, {to_big_exp_in_encode_real, OctExpLen}}}); + true -> true %% make real assert later.. + end, + {LenCode, EOctets} = case OctExpLen of % bit 2,1 + 1 -> {0, OctExp}; + 2 -> {1, OctExp}; + 3 -> {2, OctExp}; + _ -> {3, <<OctExpLen, OctExp/binary>>} + end, + BB = 0, %% 00 for base 2 + FirstOctet = <<1:1,SignBit:1,BB:2,SFactor:2,LenCode:2>>, + OctMantissa = if Man > 0 -> list_to_binary(real_mininum_octets(Man)); + true -> list_to_binary(real_mininum_octets(-(Man))) % signbit keeps track of sign + end, + %% ok = io:format("LenMask: ~w EOctets: ~w~nFirstOctet: ~w OctMantissa: ~w OctExpLen: ~w~n", [LenMask, EOctets, FirstOctet, OctMantissa, OctExpLen]), + Bin = <<FirstOctet/binary, EOctets/binary, OctMantissa/binary>>, + {Bin, size(Bin)}; +encode_real(C, {Mantissa,Base,Exponent}) + when Base =:= 10, is_integer(Mantissa), is_integer(Exponent) -> + %% always encode as NR3 due to DER on the format + %% mmmm.Eseeee where + %% m := digit + %% s := '-' | '+' | [] + %% '+' only allowed in +0 + %% e := digit + %% ex: 1234.E-5679 + ManStr = integer_to_list(Mantissa), + + encode_real_as_string(C,ManStr,Exponent); +encode_real(_C, {_,Base,_}) -> + exit({error,{asn1, {encode_real_non_supported_encoding, Base}}}); +%% base 10 +encode_real(C, Real) when is_list(Real) -> + %% The Real string may come in as a NR1, NR2 or NR3 string. + {Mantissa, Exponent} = + case string:tokens(Real,"Ee") of + [NR2] -> + {NR2,0}; + [NR3MB,NR3E] -> + %% remove beginning zeros + {NR3MB,list_to_integer(NR3E)} + end, + + %% .Decimal | Number | Number.Decimal + ZeroDecimal = + fun("0") -> ""; + (L) -> L + end, + {NewMantissa,LenDecimal} = + case Mantissa of + [$.|Dec] -> + NewMan = remove_trailing_zeros(Dec), + {NewMan,length(ZeroDecimal(NewMan))}; + _ -> + case string:tokens(Mantissa,",.") of + [Num] -> %% No decimal-mark + {integer_to_list(list_to_integer(Num)),0}; + [Num,Dec] -> + NewDec = ZeroDecimal(remove_trailing_zeros(Dec)), + NewMan = integer_to_list(list_to_integer(Num)) ++ NewDec, + {integer_to_list(list_to_integer(NewMan)), + length(NewDec)} + end + end, + + encode_real_as_string(C, NewMantissa, Exponent - LenDecimal). + +encode_real_as_string(_C, Mantissa, Exponent) + when is_list(Mantissa), is_integer(Exponent) -> + %% Remove trailing zeros in Mantissa and add this to Exponent + TruncMant = remove_trailing_zeros(Mantissa), + + ExpIncr = length(Mantissa) - length(TruncMant), + + ExpStr = integer_to_list(Exponent + ExpIncr), + + ExpBin = + case ExpStr of + "0" -> + <<"E+0">>; + _ -> + ExpB = list_to_binary(ExpStr), + <<$E,ExpB/binary>> + end, + ManBin = list_to_binary(TruncMant), + NR3 = 3, + {<<NR3,ManBin/binary,$.,ExpBin/binary>>, + 2 + byte_size(ManBin) + byte_size(ExpBin)}. + +remove_trailing_zeros(IntStr) -> + case lists:dropwhile(fun($0)-> true; + (_) -> false + end, lists:reverse(IntStr)) of + [] -> + "0"; + ReversedIntStr -> + lists:reverse(ReversedIntStr) + end. + +truncate_zeros(Num) -> + truncate_zeros(Num, 0). +truncate_zeros(0, Sum) -> + {0,Sum}; +truncate_zeros(M, Sum) -> + case M band 16#f =:= M band 16#e of + true -> truncate_zeros(M bsr 1, Sum+1); + _ -> {M,Sum} + end. + + +%%============================================================================ +%% decode real value +%% +%% decode_real([OctetBufferList], tuple|value, tag|notag) -> +%% {{Mantissa, Base, Exp} | realval | PLUS-INFINITY | MINUS-INFINITY | 0, +%% RestBuff} +%% +%% only for base 2 decoding sofar!! +%%============================================================================ + +decode_real(Buffer) -> + Sz = byte_size(Buffer), + {RealVal,<<>>,Sz} = decode_real2(Buffer, [], Sz, 0), + RealVal. + +decode_real2(Buffer, _C, 0, _RemBytes) -> + {0,Buffer}; +decode_real2(Buffer0, _C, Len, RemBytes1) -> + <<First, Buffer2/binary>> = Buffer0, + if + First =:= 2#01000000 -> {'PLUS-INFINITY', Buffer2}; + First =:= 2#01000001 -> {'MINUS-INFINITY', Buffer2}; + First =:= 1 orelse First =:= 2 orelse First =:= 3 -> + %% charcter string encoding of base 10 + {NRx,Rest} = split_binary(Buffer2,Len-1), + {binary_to_list(NRx),Rest,Len}; + true -> + %% have some check here to verify only supported bases (2) + %% not base 8 or 16 + <<_B7:1,Sign:1,BB:2,_FF:2,EE:2>> = <<First>>, + Base = + case BB of + 0 -> 2; % base 2, only one so far + _ -> exit({error,{asn1, {non_supported_base, BB}}}) + end, + {FirstLen, {Exp, Buffer3,_Rb2}, RemBytes2} = + case EE of + 0 -> {2, decode_integer2(1, Buffer2, RemBytes1), RemBytes1+1}; + 1 -> {3, decode_integer2(2, Buffer2, RemBytes1), RemBytes1+2}; + 2 -> {4, decode_integer2(3, Buffer2, RemBytes1), RemBytes1+3}; + 3 -> + <<ExpLen1,RestBuffer/binary>> = Buffer2, + { ExpLen1 + 2, + decode_integer2(ExpLen1, RestBuffer, RemBytes1), + RemBytes1+ExpLen1} + end, + %% io:format("FirstLen: ~w, Exp: ~w, Buffer3: ~w ~n", + + Length = Len - FirstLen, + <<LongInt:Length/unit:8,RestBuff/binary>> = Buffer3, + {{Mantissa, Buffer4}, RemBytes3} = + if Sign =:= 0 -> + %% io:format("sign plus~n"), + {{LongInt, RestBuff}, 1 + Length}; + true -> + %% io:format("sign minus~n"), + {{-LongInt, RestBuff}, 1 + Length} + end, + {{Mantissa, Base, Exp}, Buffer4, RemBytes2+RemBytes3} + end. + +encode_pos_integer(0, [B|_Acc]=L) when B < 128 -> + L; +encode_pos_integer(N, Acc) -> + encode_pos_integer(N bsr 8, [N band 16#ff| Acc]). + +encode_neg_integer(-1, [B1|_T]=L) when B1 > 127 -> + L; +encode_neg_integer(N, Acc) -> + encode_neg_integer(N bsr 8, [N band 16#ff|Acc]). + + +%% Val must be >= 0 +real_mininum_octets(Val) -> + real_mininum_octets(Val, []). + +real_mininum_octets(0, Acc) -> + Acc; +real_mininum_octets(Val, Acc) -> + real_mininum_octets(Val bsr 8, [Val band 16#FF | Acc]). + +%% decoding postitive integer values. +decode_integer2(Len, <<0:1,_:7,_Bs/binary>> = Bin, RemovedBytes) -> + <<Int:Len/unit:8,Buffer2/binary>> = Bin, + {Int,Buffer2,RemovedBytes}; +%% decoding negative integer values. +decode_integer2(Len, <<1:1,B2:7,Bs/binary>>, RemovedBytes) -> + <<N:Len/unit:8,Buffer2/binary>> = <<B2,Bs/binary>>, + Int = N - (1 bsl (8 * Len - 1)), + {Int,Buffer2,RemovedBytes}. diff --git a/lib/asn1/src/asn1rtt_uper.erl b/lib/asn1/src/asn1rtt_uper.erl new file mode 100644 index 0000000000..bcc11da63a --- /dev/null +++ b/lib/asn1/src/asn1rtt_uper.erl @@ -0,0 +1,1379 @@ +%% +%% %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(asn1rtt_uper). + +-export([setext/1, fixoptionals/3, + fixextensions/2, + 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/1, encode_length/2, + decode_compact_bit_string/3]). +-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, + complete/1, complete_NFP/1]). + + -export([encode_open_type/1]). + + -export([encode_UniversalString/2, decode_UniversalString/2, + encode_PrintableString/2, decode_PrintableString/2, + encode_GeneralString/2, decode_GeneralString/2, + encode_GraphicString/2, decode_GraphicString/2, + encode_TeletexString/2, decode_TeletexString/2, + encode_VideotexString/2, decode_VideotexString/2, + encode_VisibleString/2, decode_VisibleString/2, + encode_UTF8String/1, decode_UTF8String/1, + encode_BMPString/2, decode_BMPString/2, + encode_IA5String/2, decode_IA5String/2, + encode_NumericString/2, decode_NumericString/2, + encode_ObjectDescriptor/2, decode_ObjectDescriptor/1 + ]). + +-define('16K',16384). +-define('32K',32768). +-define('64K',65536). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% setext(true|false) -> CompleteList +%% + +setext(false) -> + <<0:1>>; +setext(true) -> + <<1:1>>. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% This is the new fixoptionals/3 which is used by the new generates +%% +fixoptionals(OptList,OptLength,Val) when is_tuple(Val) -> + Bits = fixoptionals(OptList,Val,0), + {Val,<<Bits:OptLength>>}; + +fixoptionals([],_Val,Acc) -> + %% Optbits + Acc; +fixoptionals([{Pos,DefVal}|Ot],Val,Acc) -> + case element(Pos,Val) of + asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); + DefVal -> fixoptionals(Ot,Val,Acc bsl 1); + _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) + end; +fixoptionals([Pos|Ot],Val,Acc) -> + case element(Pos,Val) of + asn1_NOVALUE -> fixoptionals(Ot,Val,Acc bsl 1); + asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); + _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) + end. + + +fixextensions({ext,ExtPos,ExtNum},Val) -> + case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of + 0 -> []; + ExtBits -> + [encode_small_length(ExtNum),<<ExtBits:ExtNum>>] + end. + +fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> + Acc; +fixextensions(Pos,ExtPos,Val,Acc) -> + Bit = case catch(element(Pos+1,Val)) of + asn1_NOVALUE -> + 0; + asn1_NOEXTVALUE -> + 0; + {'EXIT',_} -> + 0; + _ -> + 1 + end, + fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). + +skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) -> + Prev = Nr - 1, + case ExtensionBitstr of + <<_:Prev,1:1,_/bitstring>> -> + {Len,Bytes1} = decode_length(Bytes0, undefined), + <<_:Len/binary,Bytes2/bitstring>> = Bytes1, + skipextensions(Bytes2, Nr+1, ExtensionBitstr); + <<_:Prev,0:1,_/bitstring>> -> + skipextensions(Bytes0, Nr+1, ExtensionBitstr); + _ -> + Bytes0 + end. + + +getchoice(Bytes,1,0) -> % only 1 alternative is not encoded + {0,Bytes}; +getchoice(Bytes,_,1) -> + decode_small_number(Bytes); +getchoice(Bytes,NumChoices,0) -> + decode_constrained_number(Bytes,{0,NumChoices-1}). + + +%% getbits_as_binary(Num,Bytes) -> {{Unused,BinBits},RestBytes}, +%% Num = integer(), +%% Bytes = list() | tuple(), +%% Unused = integer(), +%% BinBits = binary(), +%% RestBytes = tuple() +getbits_as_binary(Num,Bytes) when is_bitstring(Bytes) -> + <<BS:Num/bitstring,Rest/bitstring>> = Bytes, + {BS,Rest}. + +getbits_as_list(Num, Bytes) when is_bitstring(Bytes) -> + <<BitStr:Num/bitstring,Rest/bitstring>> = Bytes, + {[B || <<B:1>> <= BitStr],Rest}. + +getbit(Buffer) -> + <<B:1,Rest/bitstring>> = Buffer, + {B,Rest}. + +getbits(Buffer, Num) when is_bitstring(Buffer) -> + <<Bs:Num,Rest/bitstring>> = Buffer, + {Bs,Rest}. + + +%% Pick the first Num octets. +%% Returns octets as an integer with bit significance as in buffer. +getoctets(Buffer, Num) when is_bitstring(Buffer) -> + <<Val:Num/integer-unit:8,RestBitStr/bitstring>> = Buffer, + {Val,RestBitStr}. + +%% Pick the first Num octets. +%% Returns octets as a binary +getoctets_as_bin(Bin,Num) when is_bitstring(Bin) -> + <<Octets:Num/binary,RestBin/bitstring>> = Bin, + {Octets,RestBin}. + +%% same as above but returns octets as a List +getoctets_as_list(Buffer,Num) -> + {Bin,Buffer2} = getoctets_as_bin(Buffer, Num), + {binary_to_list(Bin),Buffer2}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings +%% Alt = atom() +%% Altnum = integer() | {integer(),integer()}% number of alternatives +%% Choices = [atom()] | {[atom()],[atom()]} +%% When Choices is a tuple the first list is the Rootset and the +%% second is the Extensions and then Altnum must also be a tuple with the +%% lengths of the 2 lists +%% +set_choice(Alt, {L1,L2}, {Len1,_Len2}) -> + case set_choice_tag(Alt, L1) of + N when is_integer(N), Len1 > 1 -> + [<<0:1>>, % the value is in the root set + encode_integer([{'ValueRange',{0,Len1-1}}],N)]; + N when is_integer(N) -> + <<0:1>>; % no encoding if only 0 or 1 alternative + false -> + [<<1:1>>, % extension value + case set_choice_tag(Alt,L2) of + N2 when is_integer(N2) -> + encode_small_number(N2); + false -> + unknown_choice_alt + end] + end; +set_choice(Alt,L,Len) -> + case set_choice_tag(Alt,L) of + N when is_integer(N), Len > 1 -> + encode_integer([{'ValueRange',{0,Len-1}}],N); + N when is_integer(N) -> + []; % no encoding if only 0 or 1 alternative + false -> + [unknown_choice_alt] + end. + +set_choice_tag(Alt,Choices) -> + set_choice_tag(Alt,Choices,0). + +set_choice_tag(Alt,[Alt|_Rest],Tag) -> + Tag; +set_choice_tag(Alt,[_H|Rest],Tag) -> + set_choice_tag(Alt,Rest,Tag+1); +set_choice_tag(_Alt,[],_Tag) -> + false. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_fragmented_XXX; decode of values encoded fragmented according +%% to ITU-T X.691 clause 10.9.3.8. The unit (XXX) is either bits, octets, +%% characters or number of components (in a choice,sequence or similar). +%% Buffer is a buffer {Used, Bin}. +%% C is the constrained length. +%% If the buffer is not aligned, this function does that. +decode_fragmented_bits(Buffer,C) -> + decode_fragmented_bits(Buffer,C,[]). +decode_fragmented_bits(<<3:2,Len:6,BitStr/bitstring>>,C,Acc) -> + FragLen = (Len*?'16K') div 8, + <<Value:FragLen/binary,BitStr2/bitstring>> = BitStr, + decode_fragmented_bits(BitStr2,C,[Value|Acc]); +decode_fragmented_bits(<<0:1,0:7,BitStr/bitstring>>,C,Acc) -> + BinBits = list_to_binary(lists:reverse(Acc)), + case C of + Int when is_integer(Int),C =:= byte_size(BinBits) -> + {BinBits,BitStr}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,BinBits}}}) + end; +decode_fragmented_bits(<<0:1,Len:7,BitStr/bitstring>>,C,Acc) -> + <<Val:Len/bitstring,Rest/bitstring>> = BitStr, + ResBitStr = list_to_bitstring(lists:reverse([Val|Acc])), + case C of + Int when is_integer(Int),C == bit_size(ResBitStr) -> + {ResBitStr,Rest}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,ResBitStr}}}) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_open_type(Constraint, Value) -> CompleteList +%% Value = list of bytes of an already encoded value (the list must be flat) +%% | binary +%% Contraint = not used in this version +%% +encode_open_type(Val) when is_list(Val) -> + encode_open_type(list_to_binary(Val)); +encode_open_type(Val) when is_binary(Val) -> + [encode_length(byte_size(Val)),Val]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_integer(Constraint,Value,NamedNumberList) -> CompleteList +%% encode_integer(Constraint,Value) -> CompleteList +%% encode_integer(Constraint,{Name,Value}) -> CompleteList +%% +%% +encode_integer(C, V, NamedNumberList) when is_atom(V) -> + case lists:keyfind(V, 1, NamedNumberList) of + {_,NewV} -> + encode_integer(C, NewV); + false -> + exit({error,{asn1,{namednumber,V}}}) + end; +encode_integer(C, V, _NamedNumberList) when is_integer(V) -> + encode_integer(C, V). + +encode_integer([{Rc,_Ec}],Val) when is_tuple(Rc) -> + try + [<<0:1>>,encode_integer([Rc], Val)] + catch + _:{error,{asn1,_}} -> + [<<1:1>>,encode_unconstrained_number(Val)] + end; +encode_integer(C, Val) when is_list(C) -> + case get_constraint(C, 'SingleValue') of + no -> + encode_integer1(C,Val); + V when is_integer(V), V =:= Val -> + []; % a type restricted to a single value encodes to nothing + V when is_list(V) -> + case lists:member(Val,V) of + true -> + encode_integer1(C,Val); + _ -> + exit({error,{asn1,{illegal_value,Val}}}) + end; + _ -> + exit({error,{asn1,{illegal_value,Val}}}) + end. + +encode_integer1(C, Val) -> + case VR = get_constraint(C, 'ValueRange') of + no -> + encode_unconstrained_number(Val); + {Lb,'MAX'} -> + encode_semi_constrained_number(Lb, Val); + %% positive with range + {Lb,Ub} when Val >= Lb, Ub >= Val -> + encode_constrained_number(VR,Val); + _ -> + exit({error,{asn1,{illegal_value,VR,Val}}}) + 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 +encode_small_number(Val) when Val < 64 -> + <<Val:7>>; +encode_small_number(Val) -> + [<<1:1>>|encode_semi_constrained_number(0, Val)]. + +decode_small_number(Bytes) -> + {Bit,Bytes2} = getbit(Bytes), + case Bit of + 0 -> + getbits(Bytes2,6); + 1 -> + decode_semi_constrained_number(Bytes2) + end. + +%% X.691:10.7 Encoding of a semi-constrained whole number +encode_semi_constrained_number(Lb, Val) -> + %% encoding in minimum number of octets preceeded by a length + Val2 = Val - Lb, + Bin = eint_bin_positive(Val2), + Size = byte_size(Bin), + if + Size < 128 -> + [<<Size>>,Bin]; + Size < 16384 -> + [<<2:2,Size:14>>,Bin]; + true -> + [encode_length(Size),Bin] + end. + +decode_semi_constrained_number(Bytes) -> + {Len,Bytes2} = decode_length(Bytes, undefined), + {V,Bytes3} = getoctets(Bytes2,Len), + {V,Bytes3}. + +encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val -> + Range = Ub - Lb + 1, + Val2 = Val - Lb, + NumBits = num_bits(Range), + <<Val2:NumBits>>; +encode_constrained_number(Range,Val) -> + exit({error,{asn1,{integer_range,Range,value,Val}}}). + + +decode_constrained_number(Buffer, {Lb,Ub}) -> + Range = Ub - Lb + 1, + NumBits = num_bits(Range), + {Val,Remain} = getbits(Buffer,NumBits), + {Val+Lb,Remain}. + +%% X.691:10.8 Encoding of an unconstrained whole number + +encode_unconstrained_number(Val) when Val >= 0 -> + Oct = eint_bin_2Cs(Val), + Len = byte_size(Oct), + if + Len < 128 -> + [<<Len>>,Oct]; % equiv with encode_length(undefined,Len) but faster + Len < 16384 -> + [<<2:2,Len:14>>,Oct]; + true -> + [encode_length(Len),<<Len:16>>,Oct] + end; +encode_unconstrained_number(Val) -> % negative + Oct = enint(Val,[]), + Len = byte_size(Oct), + if + Len < 128 -> + [<<Len>>,Oct]; % equiv with encode_length(undefined,Len) but faster + Len < 16384 -> + [<<2:2,Len:14>>,Oct]; + true -> + [encode_length(Len),Oct] + end. + + +eint_bin_2Cs(Int) -> + case eint_bin_positive(Int) of + <<B,_/binary>> = Bin when B > 16#7f -> + <<0,Bin/binary>>; + Bin -> Bin + end. + +%% returns the integer as a binary +eint_bin_positive(Val) when Val < 16#100 -> + <<Val>>; +eint_bin_positive(Val) when Val < 16#10000 -> + <<Val:16>>; +eint_bin_positive(Val) when Val < 16#1000000 -> + <<Val:24>>; +eint_bin_positive(Val) when Val < 16#100000000 -> + <<Val:32>>; +eint_bin_positive(Val) -> + list_to_binary([eint_bin_positive2(Val bsr 32),<<Val:32>>]). + +eint_bin_positive2(Val) when Val < 16#100 -> + <<Val>>; +eint_bin_positive2(Val) when Val < 16#10000 -> + <<Val:16>>; +eint_bin_positive2(Val) when Val < 16#1000000 -> + <<Val:24>>; +eint_bin_positive2(Val) when Val < 16#100000000 -> + <<Val:32>>; +eint_bin_positive2(Val) -> + [eint_bin_positive2(Val bsr 32),<<Val:32>>]. + + + + +enint(-1, [B1|T]) when B1 > 127 -> + list_to_binary([B1|T]); +enint(N, Acc) -> + enint(N bsr 8, [N band 16#ff|Acc]). + + +%% X.691:10.9 Encoding of a length determinant +%%encode_small_length(undefined,Len) -> % null means no UpperBound +%% encode_small_number(Len). + +%% X.691:10.9.3.5 +%% X.691:10.9.3.7 +encode_length(Len) -> % un-constrained + if + Len < 128 -> + <<Len>>; + Len < 16384 -> + <<2:2,Len:14>>; + true -> % should be able to endode length >= 16384 + error({error,{asn1,{encode_length,{nyi,above_16k}}}}) + end. + +encode_length(undefined, Len) -> % unconstrained + encode_length(Len); +encode_length({0,'MAX'},Len) -> + encode_length(undefined, Len); +encode_length({Lb,Ub}=Vr, Len) when Ub =< 65535, Lb >= 0 -> % constrained + encode_constrained_number(Vr,Len); +encode_length({Lb,_Ub}, Len) when is_integer(Lb), Lb >= 0 -> % Ub > 65535 + encode_length(Len); +encode_length({{Lb,Ub}=Vr,Ext},Len) + when Ub =< 65535, Lb >= 0, Len =< Ub, is_list(Ext) -> + %% constrained extensible + [<<0:1>>,encode_constrained_number(Vr,Len)]; +encode_length({{Lb,_Ub},Ext}, Len) when is_list(Ext) -> + [<<1:1>>,encode_semi_constrained_number(Lb, Len)]; +encode_length(SingleValue, _Len) when is_integer(SingleValue) -> + []. + +%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension +%% additions in a sequence or set +encode_small_length(Len) when Len =< 64 -> + <<(Len-1):7>>; +encode_small_length(Len) -> + [<<1:1>>,encode_length(Len)]. + + +%% un-constrained +decode_length(<<0:1,Oct:7,Rest/bitstring>>,undefined) -> + {Oct,Rest}; +decode_length(<<2:2,Val:14,Rest/bitstring>>,undefined) -> + {Val,Rest}; +decode_length(<<3:2,_:14,_Rest/bitstring>>,undefined) -> + exit({error,{asn1,{decode_length,{nyi,above_16k}}}}); + +decode_length(Buffer,{Lb,Ub}) when Ub =< 65535, Lb >= 0 -> % constrained + decode_constrained_number(Buffer,{Lb,Ub}); +decode_length(Buffer,{Lb,_}) when is_integer(Lb), Lb >= 0 -> % Ub > 65535 + decode_length(Buffer,undefined); +decode_length(Buffer,{VR={_Lb,_Ub},Ext}) when is_list(Ext) -> + {0,Buffer2} = getbit(Buffer), + decode_length(Buffer2, VR); + + +%When does this case occur with {_,_Lb,Ub} ?? +% X.691:10.9.3.5 +decode_length(Bin,{_,_Lb,_Ub}) -> %when Len =< 127 -> % Unconstrained or large Ub NOTE! this case does not cover case when Ub > 65535 + case Bin of + <<0:1,Val:7,Rest/bitstring>> -> + {Val,Rest}; + <<2:2,Val:14,Rest/bitstring>> -> + {Val,Rest}; + <<3:2,_:14,_Rest/bitstring>> -> + exit({error,{asn1,{decode_length,{nyi,length_above_64K}}}}) + end; +decode_length(Buffer,SingleValue) when is_integer(SingleValue) -> + {SingleValue,Buffer}. + + + % X.691:11 +encode_boolean(true) -> + <<1:1>>; +encode_boolean(false) -> + <<0:1>>; +encode_boolean(Val) -> + exit({error,{asn1,{encode_boolean,Val}}}). + + +%%============================================================================ +%%============================================================================ +%% Bitstring value, ITU_T X.690 Chapter 8.5 +%%============================================================================ +%%============================================================================ + +%%============================================================================ +%% encode bitstring value +%%============================================================================ + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% bitstring NamedBitList +%% Val can be of: +%% - [identifiers] where only named identifers are set to one, +%% the Constraint must then have some information of the +%% bitlength. +%% - [list of ones and zeroes] all bits +%% - integer value representing the bitlist +%% C is constraint Len, only valid when identifiers are present + + +%% when the value is a list of {Unused,BinBits}, where +%% Unused = integer(), +%% BinBits = binary(). + +encode_bit_string(C, {Unused,BinBits}=Bin, NamedBitList) + when is_integer(Unused), is_binary(BinBits) -> + encode_bin_bit_string(get_constraint(C,'SizeConstraint'),Bin,NamedBitList); + +encode_bit_string(C, BitListVal, NamedBitList) -> + encode_bit_string1(get_constraint(C, 'SizeConstraint'), BitListVal, NamedBitList). + +%% when the value is a list of named bits +encode_bit_string1(C, [FirstVal|_RestVal]=LoNB, NamedBitList) + when is_atom(FirstVal) -> + ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), + BitList = make_and_set_list(ToSetPos, 0), + encode_bit_string1(C, BitList, NamedBitList); +encode_bit_string1(C, [{bit,_No}|_RestVal]=BL, NamedBitList) -> + ToSetPos = get_all_bitposes(BL, NamedBitList, []), + BitList = make_and_set_list(ToSetPos, 0), + encode_bit_string1(C, BitList, NamedBitList); +%% when the value is a list of ones and zeroes +encode_bit_string1(Int, BitListValue, _) + when is_list(BitListValue), is_integer(Int) -> + %% The type is constrained by a single value size constraint + bit_list2bitstr(Int, BitListValue); +encode_bit_string1(no, BitListValue, []) + when is_list(BitListValue) -> + Len = length(BitListValue), + [encode_length(Len),bit_list2bitstr(Len,BitListValue)]; +encode_bit_string1(C, BitListValue,[]) + when is_list(BitListValue) -> + Len = length(BitListValue), + [encode_length(C, Len),bit_list2bitstr(Len,BitListValue)]; +encode_bit_string1(no, BitListValue,_NamedBitList) + when is_list(BitListValue) -> + NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, + lists:reverse(BitListValue))), + Len = length(NewBitLVal), + [encode_length(Len),bit_list2bitstr(Len,NewBitLVal)]; +encode_bit_string1(C, BitListValue, _NamedBitList) + when is_list(BitListValue) ->% C = {_,'MAX'} + NewBitStr = bitstr_trailing_zeros(BitListValue, C), + [encode_length(C, bit_size(NewBitStr)),NewBitStr]; + + +%% when the value is an integer +encode_bit_string1(C, IntegerVal, NamedBitList) when is_integer(IntegerVal)-> + BitList = int_to_bitlist(IntegerVal), + encode_bit_string1(C, BitList, NamedBitList). + +bit_list2bitstr(Len,BitListValue) -> + case length(BitListValue) of + Len -> + << <<B:1>> || B <- BitListValue>>; + L when L > Len -> % truncate + <<(<< <<B:1>> || B <- BitListValue>>):Len/bitstring>>; + L -> % Len > L -> pad + <<(<< <<B:1>> || B <- BitListValue>>)/bitstring,0:(Len-L)>> + end. + +adjust_trailing_zeros(Len, Bin) when Len =:= bit_size(Bin) -> + Bin; +adjust_trailing_zeros(Len, Bin) when Len > bit_size(Bin) -> + <<Bin/bitstring,0:(Len-bit_size(Bin))>>; +adjust_trailing_zeros(Len,Bin) -> + <<Bin:Len/bitstring>>. + +bitstr_trailing_zeros(BitList, C) when is_integer(C) -> + bitstr_trailing_zeros1(BitList, C, C); +bitstr_trailing_zeros(BitList, {Lb,Ub}) when is_integer(Lb) -> + bitstr_trailing_zeros1(BitList,Lb,Ub); +bitstr_trailing_zeros(BitList, {{Lb,Ub},_}) when is_integer(Lb) -> + bitstr_trailing_zeros1(BitList, Lb, Ub); +bitstr_trailing_zeros(BitList, _) -> + bit_list2bitstr(length(BitList), BitList). + +bitstr_trailing_zeros1(BitList, Lb, Ub) -> + case length(BitList) of + Lb -> bit_list2bitstr(Lb, BitList); + B when B < Lb -> bit_list2bitstr(Lb, BitList); + D -> F = fun(L,LB,LB,_,_)->bit_list2bitstr(LB,lists:reverse(L)); + ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun); + (L,L1,_,UB,_)when L1 =< UB -> + bit_list2bitstr(L1,lists:reverse(L)); + (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING, + BitList}}) end, + F(lists:reverse(BitList),D,Lb,Ub,F) + end. + +%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. +%% Unused = integer(),i.e. number unused bits in least sign. byte of +%% BinBits = binary(). +encode_bin_bit_string(C, {_,BinBits}, _NamedBitList) + when is_integer(C), C =< 16 -> + adjust_trailing_zeros(C, BinBits); +encode_bin_bit_string(C, {_Unused,BinBits}, _NamedBitList) + when is_integer(C) -> + adjust_trailing_zeros(C, BinBits); +encode_bin_bit_string(C, {_,_}=UnusedAndBin, NamedBitList) -> + %% removes all trailing bits if NamedBitList is not empty + BitStr = remove_trailing_bin(NamedBitList, UnusedAndBin), + case C of + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + [encode_length({Lb,Ub},bit_size(BitStr)),BitStr]; + no -> + [encode_length(bit_size(BitStr)),BitStr]; + Sc -> + [encode_length(Sc,bit_size(BitStr)),BitStr] + end. + + +remove_trailing_bin([], {Unused,Bin}) -> + BS = bit_size(Bin)-Unused, + <<BitStr:BS/bitstring,_:Unused>> = Bin, + BitStr; +remove_trailing_bin(_NamedNumberList, {_Unused,<<>>}) -> + <<>>; +remove_trailing_bin(NamedNumberList, {_Unused,Bin}) -> + Size = byte_size(Bin)-1, + <<Bfront:Size/binary, LastByte:8>> = Bin, + + %% clear the Unused bits to be sure + Unused1 = trailingZeroesInNibble(LastByte band 15), + Unused2 = + case Unused1 of + 4 -> + 4 + trailingZeroesInNibble(LastByte bsr 4); + _ -> Unused1 + end, + case Unused2 of + 8 -> + remove_trailing_bin(NamedNumberList,{0,Bfront}); + _ -> + BS = bit_size(Bin) - Unused2, + <<BitStr:BS/bitstring,_:Unused2>> = Bin, + BitStr + end. + +trailingZeroesInNibble(0) -> + 4; +trailingZeroesInNibble(1) -> + 0; +trailingZeroesInNibble(2) -> + 1; +trailingZeroesInNibble(3) -> + 0; +trailingZeroesInNibble(4) -> + 2; +trailingZeroesInNibble(5) -> + 0; +trailingZeroesInNibble(6) -> + 1; +trailingZeroesInNibble(7) -> + 0; +trailingZeroesInNibble(8) -> + 3; +trailingZeroesInNibble(9) -> + 0; +trailingZeroesInNibble(10) -> + 1; +trailingZeroesInNibble(11) -> + 0; +trailingZeroesInNibble(12) -> %#1100 + 2; +trailingZeroesInNibble(13) -> + 0; +trailingZeroesInNibble(14) -> + 1; +trailingZeroesInNibble(15) -> + 0. + +%%%%%%%%%%%%%%% +%% The result is presented as a list of named bits (if possible) +%% else as a tuple {Unused,Bits}. Unused is the number of unused +%% bits, least significant bits in the last byte of Bits. Bits is +%% the BIT STRING represented as a binary. +%% +decode_compact_bit_string(Buffer, C, NamedNumberList) -> + case get_constraint(C, 'SizeConstraint') of + 0 -> % fixed length + {{8,0},Buffer}; + V when is_integer(V),V=<16 -> %fixed length 16 bits or less + compact_bit_string(Buffer,V,NamedNumberList); + V when is_integer(V),V=<65536 -> %fixed length > 16 bits + compact_bit_string(Buffer,V,NamedNumberList); + V when is_integer(V) -> % V > 65536 => fragmented value + {Bin,Buffer2} = decode_fragmented_bits(Buffer,V), + PadLen = (8 - (bit_size(Bin) rem 8)) rem 8, + {{PadLen,<<Bin/bitstring,0:PadLen>>},Buffer2}; + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + %% This case may demand decoding of fragmented length/value + {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), + compact_bit_string(Bytes2,Len,NamedNumberList); + no -> + %% This case may demand decoding of fragmented length/value + {Len,Bytes2} = decode_length(Buffer,undefined), + compact_bit_string(Bytes2,Len,NamedNumberList); + Sc -> + {Len,Bytes2} = decode_length(Buffer,Sc), + compact_bit_string(Bytes2,Len,NamedNumberList) + end. + + +%%%%%%%%%%%%%%% +%% The result is presented as a list of named bits (if possible) +%% else as a list of 0 and 1. +%% +decode_bit_string(Buffer, C, NamedNumberList) -> + case get_constraint(C,'SizeConstraint') of + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), + bit_list_or_named(Bytes2,Len,NamedNumberList); + no -> + {Len,Bytes2} = decode_length(Buffer,undefined), + bit_list_or_named(Bytes2,Len,NamedNumberList); + 0 -> % fixed length + {[],Buffer}; % nothing to encode + V when is_integer(V),V=<16 -> % fixed length 16 bits or less + bit_list_or_named(Buffer,V,NamedNumberList); + V when is_integer(V),V=<65536 -> + bit_list_or_named(Buffer,V,NamedNumberList); + V when is_integer(V) -> + {BinBits,_} = decode_fragmented_bits(Buffer,V), + bit_list_or_named(BinBits,V,NamedNumberList); + Sc -> % extension marker + {Len,Bytes2} = decode_length(Buffer,Sc), + bit_list_or_named(Bytes2,Len,NamedNumberList) + end. + + +%% if no named bits are declared we will return a +%% {Unused,Bits}. Unused = integer(), +%% Bits = binary(). +compact_bit_string(Buffer, Len, []) -> + {BitStr,Rest} = getbits_as_binary(Len,Buffer), % {{Unused,BinBits},NewBuffer} + PadLen = (8 - (bit_size(BitStr) rem 8)) rem 8, + {{PadLen,<<BitStr/bitstring,0:PadLen>>},Rest}; +compact_bit_string(Buffer, Len, NamedNumberList) -> + bit_list_or_named(Buffer, Len, NamedNumberList). + + +%% if no named bits are declared we will return a +%% BitList = [0 | 1] + +bit_list_or_named(Buffer,Len,[]) -> + getbits_as_list(Len,Buffer); + +%% if there are named bits declared we will return a named +%% BitList where the names are atoms and unnamed bits represented +%% as {bit,Pos} +%% BitList = [atom() | {bit,Pos}] +%% Pos = integer() + +bit_list_or_named(Buffer,Len,NamedNumberList) -> + {BitList,Rest} = getbits_as_list(Len,Buffer), + {bit_list_or_named1(0,BitList,NamedNumberList,[]), Rest}. + +bit_list_or_named1(Pos,[0|Bt],Names,Acc) -> + bit_list_or_named1(Pos+1,Bt,Names,Acc); +bit_list_or_named1(Pos,[1|Bt],Names,Acc) -> + case lists:keyfind(Pos, 2, Names) of + {Name,_} -> + bit_list_or_named1(Pos+1,Bt,Names,[Name|Acc]); + false -> + bit_list_or_named1(Pos+1,Bt,Names,[{bit,Pos}|Acc]) + end; +bit_list_or_named1(_,[],_,Acc) -> + lists:reverse(Acc). + + + +%%%%%%%%%%%%%%% +%% + +int_to_bitlist(Int) when is_integer(Int), Int > 0 -> + [Int band 1 | int_to_bitlist(Int bsr 1)]; +int_to_bitlist(0) -> + []. + + +%%%%%%%%%%%%%%%%%% +%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> +%% [sorted_list_of_bitpositions_to_set] + +get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); + +get_all_bitposes([Val | Rest], NamedBitList, Ack) -> + case lists:keyfind(Val, 1, NamedBitList) of + {_ValName, ValPos} -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); + false -> + exit({error,{asn1, {bitstring_namedbit, Val}}}) + end; +get_all_bitposes([], _NamedBitList, Ack) -> + lists:sort(Ack). + +%%%%%%%%%%%%%%%%%% +%% make_and_set_list([list of positions to set to 1])-> +%% returns list with all in SetPos set. +%% in positioning in list the first element is 0, the second 1 etc.., but +%% + +make_and_set_list([XPos|SetPos], XPos) -> + [1 | make_and_set_list(SetPos, XPos + 1)]; +make_and_set_list([Pos|SetPos], XPos) -> + [0 | make_and_set_list([Pos | SetPos], XPos + 1)]; +make_and_set_list([], _) -> + []. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% X.691:16 +%% encode_octet_string(Constraint,Val) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +encode_octet_string(C,Val) -> + case get_constraint(C,'SizeConstraint') of + 0 -> + <<>>; + 1 -> + list_to_binary(Val); + 2 -> + 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) -> + 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 -> + try + [encode_length(length(Val)),list_to_binary(Val)] + catch + error:{error,{asn1,{encode_length,_}}} -> + encode_fragmented_octet_string(Val) + end + end. + +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(Len),B]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Restricted char string types +%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) +%% X.691:26 and X.680:34-36 +%%encode_restricted_string('BMPString',Constraints,Extension,Val) + + +encode_restricted_string(Val) when is_list(Val)-> + [encode_length(length(Val)),list_to_binary(Val)]. + +encode_known_multiplier_string(StringType, C, Val) -> + Result = chars_encode(C, StringType, Val), + NumBits = get_NumBits(C, StringType), + case get_constraint(C, 'SizeConstraint') of + Ub when is_integer(Ub), Ub*NumBits =< 16 -> + Result; + 0 -> + []; + Ub when is_integer(Ub),Ub =<65535 -> % fixed length + Result; + {Ub,Lb} -> + [encode_length({Ub,Lb}, length(Val)),Result]; + Vl when is_list(Vl) -> + [encode_length({lists:min(Vl),lists:max(Vl)}, length(Val)),Result]; + no -> + [encode_length(length(Val)),Result] + end. + +decode_restricted_string(Bytes) -> + {Len,Bytes2} = decode_length(Bytes, undefined), + getoctets_as_list(Bytes2,Len). + +decode_known_multiplier_string(Bytes, StringType, C, _Ext) -> + NumBits = get_NumBits(C, StringType), + case get_constraint(C, 'SizeConstraint') of + Ub when is_integer(Ub), Ub*NumBits =< 16 -> + chars_decode(Bytes, NumBits, StringType, C, Ub); + Ub when is_integer(Ub), Ub =<65535 -> % fixed length + chars_decode(Bytes,NumBits,StringType,C,Ub); + 0 -> + {[],Bytes}; + Vl when is_list(Vl) -> + {Len,Bytes1} = decode_length(Bytes,{hd(Vl),lists:max(Vl)}), + chars_decode(Bytes1,NumBits,StringType,C,Len); + no -> + {Len,Bytes1} = decode_length(Bytes,undefined), + chars_decode(Bytes1,NumBits,StringType,C,Len); + {Lb,Ub}-> + {Len,Bytes1} = decode_length(Bytes,{Lb,Ub}), + chars_decode(Bytes1,NumBits,StringType,C,Len) + end. + + +encode_NumericString(C,Val) -> + encode_known_multiplier_string('NumericString',C,Val). +decode_NumericString(Bytes,C) -> + decode_known_multiplier_string(Bytes,'NumericString',C,false). + +encode_PrintableString(C,Val) -> + encode_known_multiplier_string('PrintableString',C,Val). +decode_PrintableString(Bytes,C) -> + decode_known_multiplier_string(Bytes,'PrintableString',C,false). + +encode_VisibleString(C,Val) -> % equivalent with ISO646String + encode_known_multiplier_string('VisibleString',C,Val). +decode_VisibleString(Bytes,C) -> + decode_known_multiplier_string(Bytes,'VisibleString',C,false). + +encode_IA5String(C,Val) -> + encode_known_multiplier_string('IA5String',C,Val). +decode_IA5String(Bytes,C) -> + decode_known_multiplier_string(Bytes,'IA5String',C,false). + +encode_BMPString(C,Val) -> + encode_known_multiplier_string('BMPString',C,Val). +decode_BMPString(Bytes,C) -> + decode_known_multiplier_string(Bytes,'BMPString',C,false). + +encode_UniversalString(C,Val) -> + encode_known_multiplier_string('UniversalString',C,Val). +decode_UniversalString(Bytes,C) -> + decode_known_multiplier_string(Bytes,'UniversalString',C,false). + + +%% end of known-multiplier strings for which PER visible constraints are +%% applied + +encode_GeneralString(_C,Val) -> + encode_restricted_string(Val). +decode_GeneralString(Bytes,_C) -> + decode_restricted_string(Bytes). + +encode_GraphicString(_C,Val) -> + encode_restricted_string(Val). +decode_GraphicString(Bytes,_C) -> + decode_restricted_string(Bytes). + +encode_ObjectDescriptor(_C,Val) -> + encode_restricted_string(Val). +decode_ObjectDescriptor(Bytes) -> + decode_restricted_string(Bytes). + +encode_TeletexString(_C,Val) -> % equivalent with T61String + encode_restricted_string(Val). +decode_TeletexString(Bytes,_C) -> + decode_restricted_string(Bytes). + +encode_VideotexString(_C,Val) -> + encode_restricted_string(Val). +decode_VideotexString(Bytes,_C) -> + decode_restricted_string(Bytes). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% getBMPChars(Bytes, Len) -> {BMPcharList,RemainingBytes} +%% +getBMPChars(Bytes, 1) -> + {O1,Bytes2} = getbits(Bytes, 8), + {O2,Bytes3} = getbits(Bytes2, 8), + if + O1 == 0 -> + {[O2],Bytes3}; + true -> + {[{0,0,O1,O2}],Bytes3} + end; +getBMPChars(Bytes, Len) -> + getBMPChars(Bytes, Len, []). + +getBMPChars(Bytes, 0, Acc) -> + {lists:reverse(Acc),Bytes}; +getBMPChars(Bytes, Len, Acc) -> + {Octs,Bytes1} = getoctets_as_list(Bytes,2), + case Octs of + [0,O2] -> + getBMPChars(Bytes1, Len-1, [O2|Acc]); + [O1,O2]-> + getBMPChars(Bytes1, Len-1, [{0,0,O1,O2}|Acc]) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% chars_encode(C,StringType,Value) -> ValueList +%% +%% encodes chars according to the per rules taking the constraint PermittedAlphabet +%% into account. +%% This function does only encode the value part and NOT the length + +chars_encode(C,StringType,Value) -> + case {StringType,get_constraint(C,'PermittedAlphabet')} of + {'UniversalString',{_,_Sv}} -> + exit({error,{asn1,{'not implemented',"UniversalString with PermittedAlphabet constraint"}}}); + {'BMPString',{_,_Sv}} -> + exit({error,{asn1,{'not implemented',"BMPString with PermittedAlphabet constraint"}}}); + _ -> + {NumBits,CharOutTab} = {get_NumBits(C,StringType),get_CharOutTab(C,StringType)}, + chars_encode2(Value,NumBits,CharOutTab) + end. + +chars_encode2([H|T],NumBits,{Min,Max,notab}) when H =< Max, H >= Min -> + [<<(H-Min):NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; +chars_encode2([H|T],NumBits,{Min,Max,Tab}) when H =< Max, H >= Min -> + Ch = exit_if_false(H,element(H-Min+1,Tab)), + [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,Tab})]; +chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,notab}) -> + %% no value range check here (ought to be, but very expensive) + Ch = ((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min, + [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; +chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> + %% no value range check here (ought to be, but very expensive) + Ch = exit_if_false({A,B,C,D},element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)), + [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; +chars_encode2([H|_T],_,{_,_,_}) -> + exit({error,{asn1,{illegal_char_value,H}}}); +chars_encode2([],_,_) -> + []. + +exit_if_false(V,false)-> + exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}}); +exit_if_false(_,V) ->V. + + +get_NumBits(C,StringType) -> + case get_constraint(C,'PermittedAlphabet') of + {'SingleValue',Sv} -> + charbits(length(Sv)); + no -> + case StringType of + 'IA5String' -> + charbits(128); % 16#00..16#7F + 'VisibleString' -> + charbits(95); % 16#20..16#7E + 'PrintableString' -> + charbits(74); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z + 'NumericString' -> + charbits(11); % $ ,"0123456789" + 'UniversalString' -> + 32; + 'BMPString' -> + 16 + end + end. + +get_CharOutTab(C,StringType) -> + get_CharTab(C,StringType,out). + +get_CharInTab(C,StringType) -> + get_CharTab(C,StringType,in). + +get_CharTab(C,StringType,InOut) -> + case get_constraint(C,'PermittedAlphabet') of + {'SingleValue',Sv} -> + get_CharTab2(C,StringType,hd(Sv),lists:max(Sv),Sv,InOut); + no -> + case StringType of + 'IA5String' -> + {0,16#7F,notab}; + 'VisibleString' -> + get_CharTab2(C,StringType,16#20,16#7F,notab,InOut); + 'PrintableString' -> + Chars = lists:sort( + " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), + get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars,InOut); + 'NumericString' -> + get_CharTab2(C,StringType,16#20,$9," 0123456789",InOut); + 'UniversalString' -> + {0,16#FFFFFFFF,notab}; + 'BMPString' -> + {0,16#FFFF,notab} + end + end. + +get_CharTab2(C,StringType,Min,Max,Chars,InOut) -> + BitValMax = (1 bsl get_NumBits(C,StringType))-1, + if + Max =< BitValMax -> + {0,Max,notab}; + true -> + case InOut of + out -> + {Min,Max,create_char_tab(Min,Chars)}; + in -> + {Min,Max,list_to_tuple(Chars)} + end + end. + +create_char_tab(Min,L) -> + list_to_tuple(create_char_tab(Min,L,0)). +create_char_tab(Min,[Min|T],V) -> + [V|create_char_tab(Min+1,T,V+1)]; +create_char_tab(_Min,[],_V) -> + []; +create_char_tab(Min,L,V) -> + [false|create_char_tab(Min+1,L,V)]. + +%% See Table 20.3 in Dubuisson +charbits(NumOfChars) when NumOfChars =< 2 -> 1; +charbits(NumOfChars) when NumOfChars =< 4 -> 2; +charbits(NumOfChars) when NumOfChars =< 8 -> 3; +charbits(NumOfChars) when NumOfChars =< 16 -> 4; +charbits(NumOfChars) when NumOfChars =< 32 -> 5; +charbits(NumOfChars) when NumOfChars =< 64 -> 6; +charbits(NumOfChars) when NumOfChars =< 128 -> 7; +charbits(NumOfChars) when NumOfChars =< 256 -> 8; +charbits(NumOfChars) when NumOfChars =< 512 -> 9; +charbits(NumOfChars) when NumOfChars =< 1024 -> 10; +charbits(NumOfChars) when NumOfChars =< 2048 -> 11; +charbits(NumOfChars) when NumOfChars =< 4096 -> 12; +charbits(NumOfChars) when NumOfChars =< 8192 -> 13; +charbits(NumOfChars) when NumOfChars =< 16384 -> 14; +charbits(NumOfChars) when NumOfChars =< 32768 -> 15; +charbits(NumOfChars) when NumOfChars =< 65536 -> 16; +charbits(NumOfChars) when is_integer(NumOfChars) -> + 16 + charbits1(NumOfChars bsr 16). + +charbits1(0) -> + 0; +charbits1(NumOfChars) -> + 1 + charbits1(NumOfChars bsr 1). + + +chars_decode(Bytes,_,'BMPString',C,Len) -> + case get_constraint(C,'PermittedAlphabet') of + no -> + getBMPChars(Bytes,Len); + _ -> + exit({error,{asn1, + {'not implemented', + "BMPString with PermittedAlphabet constraint"}}}) + end; +chars_decode(Bytes,NumBits,StringType,C,Len) -> + CharInTab = get_CharInTab(C,StringType), + chars_decode2(Bytes,CharInTab,NumBits,Len). + + +chars_decode2(Bytes,CharInTab,NumBits,Len) -> + chars_decode2(Bytes,CharInTab,NumBits,Len,[]). + +chars_decode2(Bytes,_CharInTab,_NumBits,0,Acc) -> + {lists:reverse(Acc),Bytes}; +chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) when NumBits > 8 -> + {Char,Bytes2} = getbits(Bytes,NumBits), + Result = + if + Char < 256 -> Char; + true -> + list_to_tuple(binary_to_list(<<Char:32>>)) + end, + chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Result|Acc]); +chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) -> + {Char,Bytes2} = getbits(Bytes,NumBits), + chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Char+Min|Acc]); + +%% BMPString and UniversalString with PermittedAlphabet is currently not supported +chars_decode2(Bytes,{Min,Max,CharInTab},NumBits,Len,Acc) -> + {Char,Bytes2} = getbits(Bytes,NumBits), + chars_decode2(Bytes2,{Min,Max,CharInTab},NumBits,Len -1,[element(Char+1,CharInTab)|Acc]). + + +%% UTF8String +encode_UTF8String(Val) when is_binary(Val) -> + [encode_length(byte_size(Val)),Val]; +encode_UTF8String(Val) -> + Bin = list_to_binary(Val), + encode_UTF8String(Bin). + +decode_UTF8String(Bytes) -> + {Len,Bytes2} = decode_length(Bytes, undefined), + getoctets_as_bin(Bytes2,Len). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_object_identifier(Val) -> CompleteList +%% encode_object_identifier({Name,Val}) -> CompleteList +%% Val -> {Int1,Int2,...,IntN} % N >= 2 +%% Name -> atom() +%% Int1 -> integer(0..2) +%% Int2 -> integer(0..39) when Int1 (0..1) else integer() +%% Int3-N -> integer() +%% CompleteList -> [binary()|bitstring()|list()] +%% +encode_object_identifier(Val) -> + OctetList = e_object_identifier(Val), + Octets = list_to_binary(OctetList), % performs a flatten at the same time + [encode_length(byte_size(Octets)),Octets]. + +%% This code is copied from asn1_encode.erl (BER) and corrected and modified + +e_object_identifier({'OBJECT IDENTIFIER',V}) -> + e_object_identifier(V); +e_object_identifier(V) when is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); + +%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) +e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> + Head = 40*E1 + E2, % weird + e_object_elements([Head|Tail],[]); +e_object_identifier(Oid=[_,_|_Tail]) -> + exit({error,{asn1,{'illegal_value',Oid}}}). + +e_object_elements([],Acc) -> + lists:reverse(Acc); +e_object_elements([H|T],Acc) -> + e_object_elements(T,[e_object_element(H)|Acc]). + +e_object_element(Num) when Num < 128 -> + [Num]; +e_object_element(Num) -> + [e_o_e(Num bsr 7)|[Num band 2#1111111]]. +e_o_e(Num) when Num < 128 -> + Num bor 2#10000000; +e_o_e(Num) -> + [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]]. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_object_identifier(Bytes) -> {ObjId,RemainingBytes} +%% ObjId -> {integer(),integer(),...} % at least 2 integers +%% RemainingBytes -> [integer()] when integer() (0..255) +decode_object_identifier(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), + [First|Rest] = dec_subidentifiers(Octs,0,[]), + Idlist = if + First < 40 -> + [0,First|Rest]; + First < 80 -> + [1,First - 40|Rest]; + true -> + [2,First - 80|Rest] + end, + {list_to_tuple(Idlist),Bytes3}. + +dec_subidentifiers([H|T],Av,Al) when H >=16#80 -> + dec_subidentifiers(T, (Av bsl 7) + (H band 16#7F),Al); +dec_subidentifiers([H|T],Av,Al) -> + dec_subidentifiers(T,0, [(Av bsl 7) + H |Al]); +dec_subidentifiers([],_Av,Al) -> + lists:reverse(Al). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_relative_oid(Val) -> CompleteList +%% encode_relative_oid({Name,Val}) -> CompleteList +encode_relative_oid(Val) when is_tuple(Val) -> + encode_relative_oid(tuple_to_list(Val)); +encode_relative_oid(Val) when is_list(Val) -> + Octets = list_to_binary([e_object_element(X)||X <- Val]), + [encode_length(byte_size(Octets)),Octets]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_relative_oid(Val) -> CompleteList +%% decode_relative_oid({Name,Val}) -> CompleteList +decode_relative_oid(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), + ObjVals = dec_subidentifiers(Octs,0,[]), + {list_to_tuple(ObjVals),Bytes3}. + + +get_constraint([{Key,V}],Key) -> + V; +get_constraint([],_Key) -> + no; +get_constraint(C,Key) -> + case lists:keyfind(Key, 1, C) of + false -> + no; + {_,V} -> + V + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% complete(InList) -> ByteList +%% Takes a coded list with bits and bytes and converts it to a list of bytes +%% Should be applied as the last step at encode of a complete ASN.1 type +%% +complete(InList) when is_list(InList) -> + case complete1(InList) of + <<>> -> + <<0>>; + Res -> + case bit_size(Res) band 7 of + 0 -> Res; + Bits -> <<Res/bitstring,0:(8-Bits)>> + end + end; +complete(InList) when is_binary(InList) -> + InList; +complete(InList) when is_bitstring(InList) -> + PadLen = 8 - (bit_size(InList) band 7), + <<InList/bitstring,0:PadLen>>. + +complete1(L) when is_list(L) -> + list_to_bitstring(L). + +%% Special version of complete that does not align the completed message. +complete_NFP(InList) when is_list(InList) -> + list_to_bitstring(InList); +complete_NFP(InList) when is_bitstring(InList) -> + InList. + +%% unaligned helpers + +%% 10.5.6 NOTE: If "range" satisfies the inequality 2^m < "range" =< +%% 2^(m+1) then the number of bits = m + 1 + +num_bits(N) -> num_bits(N, 1, 0). + +num_bits(N,T,B) when N =< T -> B; +num_bits(N,T,B) -> num_bits(N, T bsl 1, B+1). diff --git a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 index 1a905988f5..17a5d3490a 100644 --- a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 @@ -29,4 +29,10 @@ BEGIN Null ::= NULL + -- Test that REAL numbers can co-exist with other data types. + App-X-Real ::= REAL (WITH COMPONENTS { + mantissa (-16777215..16777215), + base (2), + exponent (-125..128) } ) + END |