diff options
Diffstat (limited to 'lib/asn1/src')
| -rw-r--r-- | lib/asn1/src/Makefile | 1 | ||||
| -rw-r--r-- | lib/asn1/src/asn1.app.src | 3 | ||||
| -rw-r--r-- | lib/asn1/src/asn1_records.hrl | 12 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct.erl | 21 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_check.erl | 613 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl | 58 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_constructed_per.erl | 3 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_func.erl | 12 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_gen.erl | 373 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_gen_ber_bin_v2.erl | 338 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_gen_check.erl | 271 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_gen_per.erl | 10 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_imm.erl | 78 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_parser2.erl | 23 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_tok.erl | 2 | ||||
| -rw-r--r-- | lib/asn1/src/asn1rtt_ber.erl | 221 | ||||
| -rw-r--r-- | lib/asn1/src/asn1rtt_check.erl | 300 | ||||
| -rw-r--r-- | lib/asn1/src/asn1rtt_per_common.erl | 13 |
18 files changed, 1105 insertions, 1247 deletions
diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 500f4a1358..6798da0072 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -52,6 +52,7 @@ CT_MODULES= \ asn1ct_pretty_format \ asn1ct_func \ asn1ct_gen \ + asn1ct_gen_check \ asn1ct_gen_per \ asn1ct_name \ asn1ct_constructed_per \ diff --git a/lib/asn1/src/asn1.app.src b/lib/asn1/src/asn1.app.src index f2ee8deb75..02cbba0f10 100644 --- a/lib/asn1/src/asn1.app.src +++ b/lib/asn1/src/asn1.app.src @@ -10,5 +10,6 @@ asn1db ]}, {env, []}, - {applications, [kernel, stdlib]} + {applications, [kernel, stdlib]}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]} ]}. diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl index 396ba0fcfa..6c1cf1b12a 100644 --- a/lib/asn1/src/asn1_records.hrl +++ b/lib/asn1/src/asn1_records.hrl @@ -37,7 +37,7 @@ -record('ObjectClassFieldType',{classname,class,fieldname,type}). -record(typedef,{checked=false,pos,name,typespec}). --record(classdef,{checked=false,pos,name,typespec}). +-record(classdef, {checked=false,pos,name,module,typespec}). -record(valuedef,{checked=false,pos,name,type,value,module}). -record(ptypedef,{checked=false,pos,name,args,typespec}). -record(pvaluedef,{checked=false,pos,name,args,type,value}). @@ -45,7 +45,6 @@ -record(pobjectdef,{checked=false,pos,name,args,class,def}). -record(pobjectsetdef,{checked=false,pos,name,args,class,def}). --record(identifier,{pos,val}). -record('Constraint',{'SingleValue'=no,'SizeConstraint'=no,'ValueRange'=no,'PermittedAlphabet'=no, 'ContainedSubtype'=no, 'TypeConstraint'=no,'InnerSubtyping'=no,e=no,'Other'=no}). -record(simpletableattributes,{objectsetname,c_name,c_index,usedclassfield, @@ -73,6 +72,15 @@ % Externalvaluereference -> modulename '.' typename -record('Externalvaluereference',{pos,module,value}). +%% Used to hold a tag for a field in a SEQUENCE/SET. It can also +%% be used for identifiers in OBJECT IDENTIFIER values, since the +%% parser cannot always distinguish a SEQUENCE with one element from +%% an OBJECT IDENTIFIER. +-record(seqtag, + {pos :: integer(), + module :: atom(), + val :: atom()}). + -record(state,{module,mname,type,tname,value,vname,erule,parameters=[], inputmodules,abscomppath=[],recordtopname=[],options, sourcedir}). diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 9ec43197bf..df341e5aab 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -43,7 +43,7 @@ add_tobe_refed_func/1,add_generated_refed_func/1, maybe_rename_function/3,current_sindex/0, set_current_sindex/1,maybe_saved_sindex/2, - parse_and_save/2,verbose/3,warning/3,warning/4,error/3]). + parse_and_save/2,verbose/3,warning/3,warning/4,error/3,format_error/1]). -export([get_bit_string_format/0,use_legacy_types/0]). -include("asn1_records.hrl"). @@ -143,7 +143,8 @@ parse_and_save_passes() -> {pass,save,fun save_pass/1}]. common_passes() -> - [{pass,check,fun check_pass/1}, + [{iff,parse,{pass,parse_listing,fun parse_listing/1}}, + {pass,check,fun check_pass/1}, {iff,abs,{pass,abs_listing,fun abs_listing/1}}, {pass,generate,fun generate_pass/1}, {unless,noobj,{pass,compile,fun compile_pass/1}}]. @@ -243,6 +244,16 @@ save_pass(#st{code=M,erule=Erule,dbfile=DbFile}=St) -> asn1_db:dbsave(DbFile,M#module.name), {ok,St}. +parse_listing(#st{code=Code,outfile=OutFile0}=St) -> + OutFile = OutFile0 ++ ".parse", + case file:write_file(OutFile, io_lib:format("~p\n", [Code])) of + ok -> + done; + {error,Reason} -> + Error = {write_error,OutFile,Reason}, + {error,St#st{error=[{structured_error,{OutFile0,none},?MODULE,Error}]}} + end. + abs_listing(#st{code={M,_},outfile=OutFile}) -> pretty2(M#module.name, OutFile++".abs"), done. @@ -566,6 +577,8 @@ get_pos_of_def(#pobjectdef{pos=Pos}) -> Pos; get_pos_of_def(#pobjectsetdef{pos=Pos}) -> Pos; +get_pos_of_def(#'Externaltypereference'{pos=Pos}) -> + Pos; get_pos_of_def(#'Externalvaluereference'{pos=Pos}) -> Pos; get_pos_of_def(_) -> @@ -2428,6 +2441,10 @@ verbose(Format, Args, S) -> ok end. +format_error({write_error,File,Reason}) -> + io_lib:format("writing output file ~s failed: ~s", + [File,file:format_error(Reason)]). + is_error(S) when is_record(S, state) -> is_error(S#state.options); is_error(O) -> diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index b9f2cb876a..240f1cbb16 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -91,7 +91,7 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> save_asn1db_uptodate(S,S#state.erule,S#state.mname), put(top_module,S#state.mname), - _ = checkp(S, ParameterizedTypes), %must do this before the templates are used + ParamError = checkp(S, ParameterizedTypes), %must do this before the templates are used %% table to save instances of parameterized objects,object sets asn1ct_table:new(parameterized_objects), @@ -160,8 +160,10 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> Exporterror = check_exports(S,S#state.module), ImportError = check_imports(S,S#state.module), - case {Terror3,Verror5,Cerror,Oerror,Exporterror,ImportError} of - {[],[],[],[],[],[]} -> + AllErrors = lists:flatten([ParamError,Terror3,Verror5,Cerror, + Oerror,Exporterror,ImportError]), + case AllErrors of + [] -> ContextSwitchTs = context_switch_in_spec(), InstanceOf = instance_of_in_spec(S#state.mname), NewTypes = lists:subtract(Types,AddClasses) ++ ContextSwitchTs @@ -175,8 +177,7 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> lists:subtract(NewObjects,ExclO)++InlinedObjects, lists:subtract(NewObjectSets,ExclOS)++ParObjectSetNames}}; _ -> - {error,lists:flatten([Terror3,Verror5,Cerror, - Oerror,Exporterror,ImportError])} + {error,AllErrors} end. context_switch_in_spec() -> @@ -270,46 +271,30 @@ check_exports(S,Module = #module{}) -> end end. -check_imports(S,Module = #module{ }) -> - case Module#module.imports of - {imports,[]} -> - []; - {imports,ImportList} when is_list(ImportList) -> - check_imports2(S,ImportList,[]); - _ -> - [] - end. -check_imports2(_S,[],Acc) -> +check_imports(S, #module{imports={imports,Imports}}) -> + check_imports_1(S, Imports, []). + +check_imports_1(_S, [], Acc) -> Acc; -check_imports2(S,[#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs],Acc) -> - NameOfDef = - fun(#'Externaltypereference'{type=N}) -> N; - (#'Externalvaluereference'{value=N}) -> N - end, - Module = NameOfDef(ModuleRef), - Refs = [{M,R}||{{M,_},R} <- [{catch get_referenced_type(S,Ref),Ref}||Ref <- Imports]], - {Illegal,Other} = lists:splitwith(fun({error,_}) -> true;(_) -> false end, - Refs), - ChainedRefs = [R||{M,R} <- Other, M =/= Module], - IllegalRefs = [R||{error,R} <- Illegal] ++ - [R||{M,R} <- ChainedRefs, - ok =/= chained_import(S,Module,M,NameOfDef(R))], - ReportError = - fun(Ref) -> - NewS=S#state{type=Ref,tname=NameOfDef(Ref)}, - error({import,"imported undefined entity",NewS}) - end, - check_imports2(S,SFMs,[ReportError(Err)||Err <- IllegalRefs]++Acc). +check_imports_1(S, [#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs], Acc0) -> + Module = name_of_def(ModuleRef), + Refs0 = [{catch get_referenced_type(S, Ref),Ref} || Ref <- Imports], + Refs = [{M,R} || {{M,_},R} <- Refs0], + {Illegal,Other} = lists:splitwith(fun({error,_}) -> true; + (_) -> false + end, Refs), + ChainedRefs = [R || {M,R} <- Other, M =/= Module], + IllegalRefs = [R || {error,R} <- Illegal] ++ + [R || {M,R} <- ChainedRefs, + ok =/= chained_import(S, Module, M, name_of_def(R))], + Acc = [return_asn1_error(S, Ref, {undefined_import,name_of_def(Ref),Module}) || + Ref <- IllegalRefs] ++ Acc0, + check_imports_1(S, SFMs, Acc). chained_import(S,ImpMod,DefMod,Name) -> %% Name is a referenced structure that is not defined in ImpMod, %% but must be present in the Imports list of ImpMod. The chain of %% imports of Name must end in DefMod. - NameOfDef = - fun(#'Externaltypereference'{type=N}) -> N; - (#'Externalvaluereference'{value=N}) -> N; - (Other) -> Other - end, GetImports = fun(_M_) -> case asn1_db:dbget(_M_,'MODULE') of @@ -321,9 +306,9 @@ chained_import(S,ImpMod,DefMod,Name) -> FindNameInImports = fun([],N,_) -> {no_mod,N}; ([#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs],N,F) -> - case [NameOfDef(X)||X <- Imports, NameOfDef(X) =:= N] of + case [name_of_def(X) || X <- Imports, name_of_def(X) =:= N] of [] -> F(SFMs,N,F); - [N] -> {NameOfDef(ModuleRef),N} + [N] -> {name_of_def(ModuleRef),N} end end, case GetImports(ImpMod) of @@ -565,14 +550,10 @@ check_class(S = #state{mname=M,tname=T},ClassSpec) #objectclass{fields=Def}; % in case of recursive definitions Tref = #'Externaltypereference'{type=TName} -> {MName,RefType} = get_referenced_type(S,Tref), - case is_class(S,RefType) of - true -> - NewState = update_state(S#state{type=RefType, - tname=TName},MName), - check_class(NewState,get_class_def(S,RefType)); - _ -> - error({class,{internal_error,RefType},S}) - end; + #classdef{} = CD = get_class_def(S, RefType), + NewState = update_state(S#state{type=RefType, + tname=TName}, MName), + check_class(NewState, CD); {pt,ClassRef,Params} -> %% parameterized class {_,PClassDef} = get_referenced_type(S,ClassRef), @@ -966,6 +947,8 @@ prepare_objset(ObjDef={object,definedsyntax,_ObjFields}) -> {set,[ObjDef],false}; prepare_objset({ObjDef=#type{},Ext}) when is_list(Ext) -> {set,[ObjDef|Ext],true}; +prepare_objset({#type{}=Type,#type{}=Ext}) -> + {set,[Type,Ext],true}; prepare_objset(Ret) -> Ret. @@ -1293,10 +1276,25 @@ get_fieldname_element(_S,Def,[{_RefType,_FieldName}|_RestFName]) check_fieldname_element(S,{value,{_,Def}}) -> check_fieldname_element(S,Def); -check_fieldname_element(S,TDef) when is_record(TDef,typedef) -> - check_type(S,TDef,TDef#typedef.typespec); -check_fieldname_element(S,VDef) when is_record(VDef,valuedef) -> - check_value(S,VDef); +check_fieldname_element(S, #typedef{typespec=Ts}=TDef) -> + case Ts of + #'Object'{} -> + check_object(S, TDef, Ts); + _ -> + check_type(S, TDef, Ts) + end; +check_fieldname_element(S, #valuedef{}=VDef) -> + try + check_value(S, VDef) + catch + throw:{objectdef} -> + #valuedef{checked=C,pos=Pos,name=N,type=Type, + value=Def} = VDef, + ClassName = Type#type.def, + NewSpec = #'Object'{classname=ClassName,def=Def}, + NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec}, + check_fieldname_element(S, NewDef) + end; check_fieldname_element(S,Eref) when is_record(Eref,'Externaltypereference'); is_record(Eref,'Externalvaluereference') -> @@ -1567,13 +1565,13 @@ check_defaultfields(S, Fields, ClassFields) -> [] -> ok; [_|_]=Invalid -> - throw(asn1_error(S, T, {invalid_fields,Invalid,Obj})) + asn1_error(S, T, {invalid_fields,Invalid,Obj}) end, case ordsets:subtract(Mandatory, Present) of [] -> check_defaultfields_1(S, Fields, ClassFields, []); [_|_]=Missing -> - throw(asn1_error(S, T, {missing_mandatory_fields,Missing,Obj})) + asn1_error(S, T, {missing_mandatory_fields,Missing,Obj}) end. check_defaultfields_1(_S, [], _ClassFields, Acc) -> @@ -1819,12 +1817,10 @@ convert_to_defaultfield(S,ObjFieldName,[OFS|RestOFS],CField)-> FieldName); ValSetting = #valuedef{} -> ValSetting; - ValSetting = {'CHOICE',{Alt,_ChVal}} when is_atom(Alt) -> - #valuedef{type=element(3,CField), - value=ValSetting, - module=S#state.mname}; ValSetting -> - #identifier{val=ValSetting} + #valuedef{type=element(3,CField), + value=ValSetting, + module=S#state.mname} end, ?dbg("fixedtypevaluefield ValRef: ~p~n",[ValRef]), case ValRef of @@ -2152,11 +2148,9 @@ check_valuedef(#state{recordtopname=TopName}=S0, V0) -> {'INTEGER',NamedNumberList} -> ok = validate_integer(SVal, Value, NamedNumberList, Constr), V#valuedef{value=normalize_value(SVal, Vtype, Value, [])}; - #'SEQUENCE'{components=Components} -> - {ok,SeqVal} = validate_sequence(SVal, Value, - Components, Constr), - V#valuedef{value=normalize_value(SVal, Vtype, - SeqVal, TopName)}; + #'SEQUENCE'{} -> + {ok,SeqVal} = convert_external(SVal, Value), + V#valuedef{value=normalize_value(SVal, Vtype, SeqVal, TopName)}; {'SelectionType',SelName,SelT} -> CheckedT = check_selectiontype(SVal, SelName, SelT), NewV = V#valuedef{type=CheckedT}, @@ -2308,22 +2302,23 @@ validate_oid(_, S, OID, [Id|Vrest], Acc) error({value, {"illegal "++to_string(OID),[Id,Vrest],Acc}, S}) end end; -validate_oid(_, S, OID, [{Atom,Value}],[]) +validate_oid(_, S, OID, [{#seqtag{module=Mod,val=Atom},Value}], []) when is_atom(Atom),is_integer(Value) -> %% this case when an OBJECT IDENTIFIER value has been parsed as a %% SEQUENCE value - Rec = #'Externalvaluereference'{module=S#state.mname, + Rec = #'Externalvaluereference'{module=Mod, value=Atom}, validate_objectidentifier1(S, OID, [Rec,Value]); -validate_oid(_, S, OID, [{Atom,EVRef}],[]) +validate_oid(_, S, OID, [{#seqtag{module=Mod,val=Atom},EVRef}], []) when is_atom(Atom),is_record(EVRef,'Externalvaluereference') -> %% this case when an OBJECT IDENTIFIER value has been parsed as a %% SEQUENCE value OTP-4354 - Rec = #'Externalvaluereference'{module=EVRef#'Externalvaluereference'.module, + Rec = #'Externalvaluereference'{module=Mod, value=Atom}, validate_objectidentifier1(S, OID, [Rec,EVRef]); -validate_oid(_, S, OID, [Atom|Rest],Acc) when is_atom(Atom) -> - Rec = #'Externalvaluereference'{module=S#state.mname, +validate_oid(_, S, OID, [#seqtag{module=Mod,val=Atom}|Rest], Acc) + when is_atom(Atom) -> + Rec = #'Externalvaluereference'{module=Mod, value=Atom}, validate_oid(true,S, OID, [Rec|Rest],Acc); validate_oid(_, S, OID, V, Acc) -> @@ -2415,13 +2410,13 @@ valid_objectid(o_id,_I,[1]) -> false; valid_objectid(o_id,_I,[2]) -> true; valid_objectid(_,_,_) -> true. -validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) -> +convert_external(S=#state{type=Vtype}, Value) -> case Vtype of #type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} -> %% this is an 'EXTERNAL' (or INSTANCE OF) case Value of - [{identification,_}|_RestVal] -> - {ok,to_EXTERNAL1990(S,Value)}; + [{#seqtag{val=identification},_}|_] -> + {ok,to_EXTERNAL1990(S, Value)}; _ -> {ok,Value} end; @@ -2429,21 +2424,25 @@ validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) -> {ok,Value} end. -to_EXTERNAL1990(S,[{identification,{'CHOICE',{syntax,Stx}}}|Rest]) -> - to_EXTERNAL1990(S,Rest,[{'direct-reference',Stx}]); -to_EXTERNAL1990(S,[{identification,{'CHOICE',{'presentation-context-id',I}}}|Rest]) -> - to_EXTERNAL1990(S,Rest,[{'indirect-reference',I}]); -to_EXTERNAL1990(S,[{identification,{'CHOICE',{'context-negotiation',[{_,PCid},{_,TrStx}]}}}|Rest]) -> - to_EXTERNAL1990(S,Rest,[{'indirect-reference',PCid},{'direct-reference',TrStx}]); -to_EXTERNAL1990(S,_) -> +to_EXTERNAL1990(S, [{#seqtag{val=identification}=T, + {'CHOICE',{syntax,Stx}}}|Rest]) -> + to_EXTERNAL1990(S, Rest, [{T#seqtag{val='direct-reference'},Stx}]); +to_EXTERNAL1990(S, [{#seqtag{val=identification}=T, + {'CHOICE',{'presentation-context-id',I}}}|Rest]) -> + to_EXTERNAL1990(S, Rest, [{T#seqtag{val='indirect-reference'},I}]); +to_EXTERNAL1990(S, [{#seqtag{val=identification}=T, + {'CHOICE',{'context-negotiation',[{_,PCid},{_,TrStx}]}}}|Rest]) -> + to_EXTERNAL1990(S, Rest, [{T#seqtag{val='indirect-reference'},PCid}, + {T#seqtag{val='direct-reference'},TrStx}]); +to_EXTERNAL1990(S, _) -> error({value,"illegal value in EXTERNAL type",S}). -to_EXTERNAL1990(S,[V={'data-value-descriptor',_}|Rest],Acc) -> - to_EXTERNAL1990(S,Rest,[V|Acc]); -to_EXTERNAL1990(_S,[{'data-value',Val}],Acc) -> - Encoding = {encoding,{'CHOICE',{'octet-aligned',Val}}}, +to_EXTERNAL1990(S, [V={#seqtag{val='data-value-descriptor'},_}|Rest], Acc) -> + to_EXTERNAL1990(S, Rest, [V|Acc]); +to_EXTERNAL1990(_S, [{#seqtag{val='data-value'}=T,Val}], Acc) -> + Encoding = {T#seqtag{val=encoding},{'CHOICE',{'octet-aligned',Val}}}, lists:reverse([Encoding|Acc]); -to_EXTERNAL1990(S,_,_) -> +to_EXTERNAL1990(S, _, _) -> error({value,"illegal value in EXTERNAL type",S}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2614,7 +2613,7 @@ normalize_octetstring(S,Value,CType) -> normalize_octetstring(S,String,CType); _ -> Item = S#state.value, - throw(asn1_error(S, Item, illegal_octet_string_value)) + asn1_error(S, Item, illegal_octet_string_value) end. normalize_objectidentifier(S, Value) -> @@ -2645,7 +2644,7 @@ lookup_enum_value(S, Id, NNL) when is_atom(Id) -> {_,_}=Ret -> Ret; false -> - throw(asn1_error(S, S#state.value, {undefined,Id})) + asn1_error(S, S#state.value, {undefined,Id}) end. normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when is_atom(C) -> @@ -2705,20 +2704,20 @@ normalize_set(S,Value,Components,NameList) -> normalized_record('SET',S,SortedVal,Components,NameList) end. -sort_value(Components,Value) -> - ComponentNames = lists:map(fun(#'ComponentType'{name=Cname}) -> Cname end, - Components), - sort_value1(ComponentNames,Value,[]). -sort_value1(_,V=#'Externalvaluereference'{},_) -> - %% sort later, get the value in normalize_seq_or_set - V; -sort_value1([N|Ns],Value,Acc) -> - case lists:keysearch(N,1,Value) of - {value,V} ->sort_value1(Ns,Value,[V|Acc]); - _ -> sort_value1(Ns,Value,Acc) - end; -sort_value1([],_,Acc) -> - lists:reverse(Acc). +sort_value(Components, Value0) when is_list(Value0) -> + {Keys0,_} = lists:mapfoldl(fun(#'ComponentType'{name=N}, I) -> + {{N,I},I+1} + end, 0, Components), + Keys = gb_trees:from_orddict(orddict:from_list(Keys0)), + Value1 = [{case gb_trees:lookup(N, Keys) of + {value,K} -> K; + none -> 'end' + end,Pair} || {#seqtag{val=N},_}=Pair <- Value0], + Value = lists:sort(Value1), + [Pair || {_,Pair} <- Value]; +sort_value(_Components, #'Externalvaluereference'{}=Value) -> + %% Sort later. + Value. sort_val_if_set(['SET'|_],Val,Type) -> sort_value(Type,Val); @@ -2751,9 +2750,9 @@ is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) -> is_record_normalized(_,_,_,_) -> false. -normalize_seq_or_set(SorS,S,[{Cname,V}|Vs], +normalize_seq_or_set(SorS, S, [{#seqtag{val=Cname},V}|Vs], [#'ComponentType'{name=Cname,typespec=TS}|Cs], - NameList,Acc) -> + NameList, Acc) -> NewNameList = case TS#type.def of #'Externaltypereference'{type=TName} -> @@ -2931,8 +2930,7 @@ get_canonic_type(S,Type,NameList) -> check_ptype(S,Type,Ts) when is_record(Ts,type) -> - %Tag = Ts#type.tag, - %Constr = Ts#type.constraint, + check_formal_parameters(S, Type#ptypedef.args), Def = Ts#type.def, NewDef= case Def of @@ -2958,6 +2956,16 @@ check_ptype(S,Type,Ts) when is_record(Ts,type) -> check_ptype(_S,_PTDef,Ts) when is_record(Ts,objectclass) -> throw({asn1_param_class,Ts}). +check_formal_parameters(S, Args) -> + _ = [check_formal_parameter(S, A) || A <- Args], + ok. + +check_formal_parameter(_, {_,_}) -> + ok; +check_formal_parameter(_, #'Externaltypereference'{}) -> + ok; +check_formal_parameter(S, #'Externalvaluereference'{value=Name}=Ref) -> + asn1_error(S, Ref, {illegal_typereference,Name}). % check_type(S,Type,ObjSpec={{objectclassname,_},_}) -> % check_class(S,ObjSpec); @@ -3005,9 +3013,9 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> {TmpRefMod,TmpRefDef} -> {TmpRefMod,TmpRefDef,false} end, - case is_class(S,RefTypeDef) of - true -> throw({asn1_class,RefTypeDef}); - _ -> ok + case get_class_def(S, RefTypeDef) of + none -> ok; + #classdef{} -> throw({asn1_class,RefTypeDef}) end, Ct = TestFun(Ext), {RefType,ExtRef} = @@ -3084,7 +3092,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; {'INTEGER',NamedNumberList} -> - TempNewDef#newt{type={'INTEGER',check_integer(S,NamedNumberList,Constr)}, + TempNewDef#newt{type={'INTEGER',check_integer(S,NamedNumberList)}, tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; 'REAL' -> @@ -3092,8 +3100,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> TempNewDef#newt{tag=merge_tags(Tag,?TAG_PRIMITIVE(?N_REAL))}; {'BIT STRING',NamedNumberList} -> - NewL = check_bitstring(S,NamedNumberList,Constr), -%% erlang:display({asn1ct_check,NamedNumberList,NewL}), + NewL = check_bitstring(S, NamedNumberList), TempNewDef#newt{type={'BIT STRING',NewL}, tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_BIT_STRING))}; @@ -3389,23 +3396,17 @@ get_type_from_object(S,Object,TypeField) ObjSpec = check_object(S,ObjectDef,ObjectDef#typedef.typespec), get_fieldname_element(S,ObjectDef#typedef{typespec=ObjSpec},TypeField). -is_class(_S,#classdef{}) -> - true; -is_class(S,#typedef{typespec=#type{def=Eref}}) - when is_record(Eref,'Externaltypereference')-> - is_class(S,Eref); -is_class(S,Eref) when is_record(Eref,'Externaltypereference')-> - {_,NextDef} = get_referenced_type(S,Eref), - is_class(S,NextDef); -is_class(_,_) -> - false. - -get_class_def(_S,CD=#classdef{}) -> +%% get_class_def(S, Type) -> #classdef{} | 'none'. +get_class_def(S, #typedef{typespec=#type{def=#'Externaltypereference'{}=Eref}}) -> + {_,NextDef} = get_referenced_type(S, Eref), + get_class_def(S, NextDef); +get_class_def(S, #'Externaltypereference'{}=Eref) -> + {_,NextDef} = get_referenced_type(S, Eref), + get_class_def(S, NextDef); +get_class_def(_S, #classdef{}=CD) -> CD; -get_class_def(S,#typedef{typespec=#type{def=Eref}}) - when is_record(Eref,'Externaltypereference') -> - {_,NextDef} = get_referenced_type(S,Eref), - get_class_def(S,NextDef). +get_class_def(_S, _) -> + none. maybe_illicit_implicit_tag(Kind,Tag) -> case Tag of @@ -3612,109 +3613,54 @@ match_args(_,_, _, _) -> %% categorize_arg(S,FormalArg,ActualArg) -> {FormalArg,CatgorizedActualArg} %% categorize_arg(S,{Governor,Param},ActArg) -> - case {governor_category(S,Governor),parameter_name_style(Param,ActArg)} of -%% {absent,beginning_uppercase} -> %% a type -%% categorize(S,type,ActArg); - {type,beginning_lowercase} -> %% a value - categorize(S,value,Governor,ActArg); - {type,beginning_uppercase} -> %% a value set - categorize(S,value_set,ActArg); -%% {absent,entirely_uppercase} -> %% a class -%% categorize(S,class,ActArg); + case {governor_category(S, Governor),parameter_name_style(Param)} of + {type,beginning_lowercase} -> %a value + categorize(S, value, Governor, ActArg); + {type,beginning_uppercase} -> %a value set + categorize(ActArg); {{class,ClassRef},beginning_lowercase} -> - categorize(S,object,ActArg,ClassRef); + categorize(S, object, ActArg, ClassRef); {{class,ClassRef},beginning_uppercase} -> - categorize(S,object_set,ActArg,ClassRef); - _ -> - [ActArg] + categorize(S, object_set, ActArg, ClassRef) end; -categorize_arg(S,FormalArg,ActualArg) -> - %% governor is absent => a type or a class - case FormalArg of - #'Externaltypereference'{type=Name} -> - case is_class_name(Name) of - true -> - categorize(S,class,ActualArg); - _ -> - categorize(S,type,ActualArg) - end; - FA -> - throw({error,{unexpected_formal_argument,FA}}) - end. - -governor_category(S,#type{def=Eref}) - when is_record(Eref,'Externaltypereference') -> - governor_category(S,Eref); -governor_category(_S,#type{}) -> +categorize_arg(_S, _FormalArg, ActualArg) -> + %% Governor is absent -- must be a type or a class. We have already + %% checked that the FormalArg begins with an uppercase letter. + categorize(ActualArg). + +%% governor_category(S, Item) -> type | {class,#'Externaltypereference'{}} +%% Determine whether Item is a type or a class. +governor_category(S, #type{def=#'Externaltypereference'{}=Eref}) -> + governor_category(S, Eref); +governor_category(_S, #type{}) -> type; -governor_category(S,Ref) when is_record(Ref,'Externaltypereference') -> - case is_class(S,Ref) of - true -> - {class,Ref}; - _ -> +governor_category(S, #'Externaltypereference'{}=Ref) -> + case get_class_def(S, Ref) of + #classdef{pos=Pos,module=Mod,name=Name} -> + {class,#'Externaltypereference'{pos=Pos,module=Mod,type=Name}}; + none -> type - end; -governor_category(_,Class) - when Class == 'TYPE-IDENTIFIER'; Class == 'ABSTRACT-SYNTAX' -> - class. -%% governor_category(_,_) -> -%% absent. + end. %% parameter_name_style(Param,Data) -> Result %% gets the Parameter and the name of the Data and if it exists tells %% whether it begins with a lowercase letter or is partly or entirely %% spelled with uppercase letters. Otherwise returns undefined %% -parameter_name_style(_,#'Externaltypereference'{type=Name}) -> - name_category(Name); -parameter_name_style(_,#'Externalvaluereference'{value=Name}) -> - name_category(Name); -parameter_name_style(_,{valueset,_}) -> - %% It is a object set or value set +parameter_name_style(#'Externaltypereference'{}) -> beginning_uppercase; -parameter_name_style(#'Externalvaluereference'{},_) -> - beginning_lowercase; -parameter_name_style(#'Externaltypereference'{type=Name},_) -> - name_category(Name); -parameter_name_style(_,_) -> - undefined. - -name_category(Atom) when is_atom(Atom) -> - name_category(atom_to_list(Atom)); -name_category([H|T]) -> - case is_lowercase(H) of - true -> - beginning_lowercase; - _ -> - case is_class_name(T) of - true -> - entirely_uppercase; - _ -> - beginning_uppercase - end - end; -name_category(_) -> - undefined. +parameter_name_style(#'Externalvaluereference'{}) -> + beginning_lowercase. is_lowercase(X) when X >= $A,X =< $W -> false; is_lowercase(_) -> true. - -is_class_name(Name) when is_atom(Name) -> - is_class_name(atom_to_list(Name)); -is_class_name(Name) -> - case [X||X <- Name, X >= $a,X =< $w] of - [] -> - true; - _ -> - false - end. -%% categorize(S,Category,Parameter) -> CategorizedParameter +%% categorize(Parameter) -> CategorizedParameter %% If Parameter has an abstract syntax of another category than %% Category, transform it to a known syntax. -categorize(_S,type,{object,_,Type}) -> +categorize({object,_,Type}) -> %% One example of this case is an object with a parameterized type %% having a locally defined type as parameter. Def = fun(D = #type{}) -> @@ -3726,11 +3672,12 @@ categorize(_S,type,{object,_,Type}) -> D end, [Def(X)||X<-Type]; -categorize(_S,type,Def) when is_record(Def,type) -> +categorize(#type{}=Def) -> [#typedef{name = new_reference_name("type_argument"), typespec = Def#type{inlined=yes}}]; -categorize(_,_,Def) -> +categorize(Def) -> [Def]. + categorize(S,object_set,Def,ClassRef) -> NewObjSetSpec = check_object(S,Def,#'ObjectSet'{class = ClassRef, @@ -4563,55 +4510,43 @@ check_reference(S,#'Externaltypereference'{pos=Pos,module=Emod,type=Name}) -> #'Externaltypereference'{pos=Pos,module=ModName,type=Name} end. +get_referenced_type(S, T) -> + case do_get_referenced_type(S, T) of + {_,#type{def=#'Externaltypereference'{}=ERef}} -> + get_referenced_type(S, ERef); + {_,#type{def=#'Externalvaluereference'{}=VRef}} -> + get_referenced_type(S, VRef); + {_,_}=Res -> + Res + end. -get_referenced_type(S,Ext) when is_record(Ext,'Externaltypereference') -> - case match_parameters(S,Ext, S#state.parameters) of - Ext -> - #'Externaltypereference'{pos=Pos,module=Emod,type=Etype} = Ext, - case S#state.mname of - Emod -> % a local reference in this module - get_referenced1(S,Emod,Etype,Pos); - _ ->% always when multi file compiling - case lists:member(Emod,S#state.inputmodules) of - true -> - get_referenced1(S,Emod,Etype,Pos); - false -> - get_referenced(S,Emod,Etype,Pos) - end - end; - ERef = #'Externaltypereference'{} -> - get_referenced_type(S,ERef); - Other -> - {undefined,Other} - end; -get_referenced_type(S=#state{mname=Emod}, - ERef=#'Externalvaluereference'{pos=P,module=Emod, - value=Eval}) -> - case match_parameters(S,ERef,S#state.parameters) of - ERef -> - get_referenced1(S,Emod,Eval,P); - OtherERef when is_record(OtherERef,'Externalvaluereference') -> - get_referenced_type(S,OtherERef); - Value -> - {Emod,Value} - end; -get_referenced_type(S,ERef=#'Externalvaluereference'{pos=Pos,module=Emod, - value=Eval}) -> - case match_parameters(S,ERef,S#state.parameters) of - ERef -> - case lists:member(Emod,S#state.inputmodules) of - true -> - get_referenced1(S,Emod,Eval,Pos); - false -> - get_referenced(S,Emod,Eval,Pos) - end; - OtherERef -> - get_referenced_type(S,OtherERef) - end; -get_referenced_type(S,#identifier{val=Name,pos=Pos}) -> - get_referenced1(S,undefined,Name,Pos); -get_referenced_type(_S,Type) -> - {undefined,Type}. +do_get_referenced_type(#state{parameters=Ps}=S, T0) -> + case match_parameters(S, T0, Ps) of + T0 -> + do_get_ref_type_1(S, T0); + T -> + do_get_referenced_type(S, T) + end. + +do_get_ref_type_1(S, #'Externaltypereference'{pos=P, + module=M, + type=T}) -> + do_get_ref_type_2(S, P, M, T); +do_get_ref_type_1(S, #'Externalvaluereference'{pos=P, + module=M, + value=V}) -> + do_get_ref_type_2(S, P, M, V); +do_get_ref_type_1(_, T) -> + {undefined,T}. + +do_get_ref_type_2(#state{mname=Current,inputmodules=Modules}=S, + Pos, M, T) -> + case M =:= Current orelse lists:member(M, Modules) of + true -> + get_referenced1(S, M, T, Pos); + false -> + get_referenced(S, M, T, Pos) + end. %% get_referenced/3 %% The referenced entity Ename may in case of an imported parameterized @@ -4910,73 +4845,46 @@ imported1(Name, end; imported1(_Name,[]) -> false. - -check_integer(_S,[],_C) -> +%% Check the named number list for an INTEGER or a BIT STRING. +check_named_number_list(_S, []) -> []; -check_integer(S,NamedNumberList,_C) -> - case [X || X <- NamedNumberList, tuple_size(X) =:= 2] of - NamedNumberList -> - %% An already checked integer with NamedNumberList - NamedNumberList; - _ -> - case check_unique(NamedNumberList,2) of - [] -> - check_int(S,NamedNumberList,[]); - L when is_list(L) -> - error({type,{duplicates,L},S}), - unchanged - end +check_named_number_list(_S, [{_,_}|_]=NNL) -> + %% The named number list has already been checked. + NNL; +check_named_number_list(S, NNL0) -> + %% Check that the names are unique. + T = S#state.type, + case check_unique(NNL0, 2) of + [] -> + NNL1 = [{Id,resolve_valueref(S, Val)} || {'NamedNumber',Id,Val} <- NNL0], + NNL = lists:keysort(2, NNL1), + case check_unique(NNL, 2) of + [] -> + NNL; + [Val|_] -> + asn1_error(S, T, {value_reused,Val}) + end; + [H|_] -> + asn1_error(S, T, {namelist_redefinition,H}) end. - -check_int(S,[{'NamedNumber',Id,Num}|T],Acc) when is_integer(Num) -> - check_int(S,T,[{Id,Num}|Acc]); -check_int(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) -> - Val = dbget_ex(S,S#state.mname,Name), - check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); -check_int(S,[{'NamedNumber',Id,{'Externalvaluereference',_,Mod,Name}}|T],Acc) -> - Val = dbget_ex(S,Mod,Name), - check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); -check_int(_S,[],Acc) -> - lists:keysort(2,Acc). +resolve_valueref(S, #'Externalvaluereference'{module=Mod,value=Name}) -> + dbget_ex(S, Mod, Name); +resolve_valueref(_, Val) when is_integer(Val) -> + Val. -check_real(_S,_Constr) -> - ok. +check_integer(S, NNL) -> + check_named_number_list(S, NNL). -check_bitstring(_S,[],_Constr) -> - []; -check_bitstring(S,NamedNumberList,_Constr) -> - case check_unique(NamedNumberList,2) of - [] -> - check_bitstr(S,NamedNumberList,[]); - L when is_list(L) -> - error({type,{duplicates,L},S}), - unchanged - end. +check_bitstring(S, NNL0) -> + NNL = check_named_number_list(S, NNL0), + _ = [asn1_error(S, S#state.type, {invalid_bit_number,Bit}) || + {_,Bit} <- NNL, Bit < 0], + NNL. -check_bitstr(S,[{'NamedNumber',Id,Num}|T],Acc)when is_integer(Num) -> - check_bitstr(S,T,[{Id,Num}|Acc]); -check_bitstr(S,[{'NamedNumber',Id,Name}|T],Acc) when is_atom(Name) -> -%%check_bitstr(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) -> -%% io:format("asn1ct_check:check_bitstr/3 hej hop ~w~n",[Name]), - Val = dbget_ex(S,S#state.mname,Name), -%% io:format("asn1ct_check:check_bitstr/3: ~w~n",[Val]), - check_bitstr(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); -check_bitstr(S,[],Acc) -> - case check_unique(Acc,2) of - [] -> - lists:keysort(2,Acc); - L when is_list(L) -> - error({type,{duplicate_values,L},S}), - unchanged - end; -%% When a BIT STRING already is checked, for instance a COMPONENTS OF S -%% where S is a sequence that has a component that is a checked BS, the -%% NamedNumber list is a list of {atom(),integer()} elements. -check_bitstr(S,[El={Id,Num}|Rest],Acc) when is_atom(Id),is_integer(Num) -> - check_bitstr(S,Rest,[El|Acc]). - +check_real(_S,_Constr) -> + ok. %% Check INSTANCE OF %% check that DefinedObjectClass is of TYPE-IDENTIFIER class @@ -4987,20 +4895,16 @@ check_instance_of(S,DefinedObjectClass,Constraint) -> check_type_identifier(S,DefinedObjectClass), iof_associated_type(S,Constraint). - -check_type_identifier(_S,'TYPE-IDENTIFIER') -> - ok; -check_type_identifier(S,Eref=#'Externaltypereference'{}) -> - case get_referenced_type(S,Eref) of - {_,#classdef{name='TYPE-IDENTIFIER'}} -> ok; - {_,#classdef{typespec=NextEref}} - when is_record(NextEref,'Externaltypereference') -> - check_type_identifier(S,NextEref); +check_type_identifier(S, Eref=#'Externaltypereference'{type=Class}) -> + case get_referenced_type(S, Eref) of + {_,#classdef{name='TYPE-IDENTIFIER'}} -> + ok; + {_,#classdef{typespec=#'Externaltypereference'{}=NextEref}} -> + check_type_identifier(S, NextEref); {_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} -> - check_type_identifier(S,(TD#typedef.typespec)#type.def); - Err -> - error({type,{"object set in type INSTANCE OF " - "not of class TYPE-IDENTIFIER",Eref,Err},S}) + check_type_identifier(S, (TD#typedef.typespec)#type.def); + _ -> + asn1_error(S, S#state.type, {illegal_instance_of,Class}) end. iof_associated_type(S,[]) -> @@ -5130,9 +5034,6 @@ check_enumerated(S,NamedNumberList,_Constr) -> %% the latter is returned if the ENUMERATION contains EXTENSIONMARK check_enum(S,[{'NamedNumber',Id,Num}|T],Acc1,Acc2,Root) when is_integer(Num) -> check_enum(S,T,[{Id,Num}|Acc1],Acc2,Root); -check_enum(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc1,Acc2,Root) -> - Val = dbget_ex(S,S#state.mname,Name), - check_enum(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc1,Acc2,Root); check_enum(S,['EXTENSIONMARK'|T],Acc1,Acc2,_Root) -> NewAcc2 = lists:keysort(2,Acc1), NewList = enum_number(lists:reverse(Acc2),NewAcc2,0,[],[]), @@ -6682,6 +6583,8 @@ merge_tags2([T1= #tag{type='IMPLICIT'}, T2 |Rest], Acc) -> merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); merge_tags2([T1= #tag{type={default,'IMPLICIT'}}, T2 |Rest], Acc) -> merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); +merge_tags2([T1= #tag{type={default,'AUTOMATIC'}}, T2 |Rest], Acc) -> + merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); merge_tags2([H|T],Acc) -> merge_tags2(T, [H|Acc]); merge_tags2([], Acc) -> @@ -6748,7 +6651,7 @@ storeindb(#state{mname=Module}=S, [H|T], Errors) -> storeindb(S, T, Errors); Prev -> PrevLine = asn1ct:get_pos_of_def(Prev), - {error,Error} = asn1_error(S, H, {already_defined,Name,PrevLine}), + Error = return_asn1_error(S, H, {already_defined,Name,PrevLine}), storeindb(S, T, [Error|Errors]) end; storeindb(_, [], []) -> @@ -6795,22 +6698,39 @@ findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) -> {lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc), lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}. -asn1_error(#state{mname=Where}, Item, Error) -> +return_asn1_error(#state{mname=Where}, Item, Error) -> Pos = asn1ct:get_pos_of_def(Item), - {error,{structured_error,{Where,Pos},?MODULE,Error}}. + {structured_error,{Where,Pos},?MODULE,Error}. + +asn1_error(S, Item, Error) -> + throw({error,return_asn1_error(S, Item, Error)}). format_error({already_defined,Name,PrevLine}) -> io_lib:format("the name ~p has already been defined at line ~p", [Name,PrevLine]); +format_error({illegal_instance_of,Class}) -> + io_lib:format("using INSTANCE OF on class '~s' is illegal, " + "because INSTANCE OF may only be used on the class TYPE-IDENTFIER", + [Class]); format_error(illegal_octet_string_value) -> "expecting a bstring or an hstring as value for an OCTET STRING"; +format_error({illegal_typereference,Name}) -> + io_lib:format("'~p' is used as a typereference, but does not start with an uppercase letter", [Name]); format_error({invalid_fields,Fields,Obj}) -> io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]); +format_error({invalid_bit_number,Bit}) -> + io_lib:format("the bit number '~p' is invalid", [Bit]); format_error({missing_mandatory_fields,Fields,Obj}) -> io_lib:format("missing mandatory ~s in ~p", [format_fields(Fields),Obj]); +format_error({namelist_redefinition,Name}) -> + io_lib:format("the name '~s' can not be redefined", [Name]); format_error({undefined,Name}) -> io_lib:format("'~s' is referenced, but is not defined", [Name]); +format_error({undefined_import,Ref,Module}) -> + io_lib:format("'~s' is not exported from ~s", [Ref,Module]); +format_error({value_reused,Val}) -> + io_lib:format("the value '~p' is used more than once", [Val]); format_error(Other) -> io_lib:format("~p", [Other]). @@ -6826,14 +6746,6 @@ error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) -> Pos = Ref#'Externaltypereference'.pos, io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]), {error,{export,Pos,Mname,Typename,Msg}}; -error({import,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) -> - PosOfDef = - fun(#'Externaltypereference'{pos=P}) -> P; - (#'Externalvaluereference'{pos=P}) -> P - end, - Pos = PosOfDef(Ref), - io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]), - {error,{import,Pos,Mname,Typename,Msg}}; % error({type,{Msg1,Msg2},#state{mname=Mname,type=Type,tname=Typename}}) % when is_record(Type,typedef) -> % io:format("asn1error:~p:~p:~p ~p~n", @@ -7050,7 +6962,7 @@ include_default_class1(_,[]) -> include_default_class1(Module,[{Name,TS}|Rest]) -> case asn1_db:dbget(Module,Name) of undefined -> - C = #classdef{checked=true,name=Name, + C = #classdef{checked=true,module=Module,name=Name, typespec=TS}, asn1_db:dbput(Module,Name,C); _ -> ok @@ -7134,3 +7046,6 @@ check_fold(S, [H|T], Check) -> [Error|check_fold(S, T, Check)] end; check_fold(_, [], Check) when is_function(Check, 3) -> []. + +name_of_def(#'Externaltypereference'{type=N}) -> N; +name_of_def(#'Externalvaluereference'{value=N}) -> N. diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index a38da8bcc2..5fadd0495a 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -962,8 +962,7 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj) WhatKind = asn1ct_gen:type(InnerType), emit(IndDeep), emit(Assign), - gen_optormand_case(OptOrMand,Erules,TopType,Cname,Type,InnerType,WhatKind, - Element), + gen_optormand_case(OptOrMand, Erules, TopType, Cname, Type, Element), case {Type,asn1ct_gen:get_constraint(Type#type.constraint, componentrelation)} of % #type{constraint=[{tableconstraint_info,RefedFieldName}], @@ -1029,26 +1028,19 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj) emit([nl,indent(7),"end"]) end. -gen_optormand_case(mandatory,_Erules,_TopType,_Cname,_Type,_InnerType,_WhatKind, - _Element) -> +gen_optormand_case(mandatory, _Erules, _TopType, _Cname, _Type, _Element) -> ok; -gen_optormand_case('OPTIONAL',Erules,_TopType,_Cname,_Type,_InnerType,_WhatKind, - Element) -> +gen_optormand_case('OPTIONAL', Erules, _TopType, _Cname, _Type, Element) -> emit([" case ",Element," of",nl]), emit([indent(9),"asn1_NOVALUE -> {", empty_lb(Erules),",0};",nl]), emit([indent(9),"_ ->",nl,indent(12)]); -gen_optormand_case({'DEFAULT',DefaultValue},Erules,TopType,Cname,Type, - InnerType,WhatKind,Element) -> +gen_optormand_case({'DEFAULT',DefaultValue}, Erules, _TopType, + _Cname, Type, Element) -> CurrMod = get(currmod), case catch lists:member(der,get(encoding_options)) of true -> - emit(" case catch "), - asn1ct_gen:gen_check_call(TopType,Cname,Type,InnerType, - WhatKind,{asis,DefaultValue}, - Element), - emit([" of",nl]), - emit([indent(12),"true -> {[],0};",nl]); + asn1ct_gen_check:emit(Type, DefaultValue, Element); _ -> emit([" case ",Element," of",nl]), emit([indent(9),"asn1_DEFAULT -> {", @@ -1063,10 +1055,9 @@ gen_optormand_case({'DEFAULT',DefaultValue},Erules,TopType,Cname,Type, emit([indent(9),{asis, DefaultValue}," -> {", empty_lb(Erules),",0};",nl]) - end - end, - emit([indent(9),"_ ->",nl,indent(12)]). - + end, + emit([indent(9),"_ ->",nl,indent(12)]) + end. gen_dec_line(Erules,TopType,Cname,CTags,Type,OptOrMand,DecObjInf) -> @@ -1210,11 +1201,11 @@ gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandC (Type#type.def)#'ObjectClassFieldType'.fieldname, [{Cname,RefedFieldName,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, - OptOrMand,DecObjInf,_) -> +gen_dec_call(InnerType, _Erules, TopType, Cname, Type, BytesVar, + Tag, _PrimOptOrMand, _OptOrMand, DecObjInf,_) -> WhatKind = asn1ct_gen:type(InnerType), - gen_dec_call1(WhatKind,InnerType,Erules,TopType,Cname,Type,BytesVar,Tag, - PrimOptOrMand,OptOrMand), + gen_dec_call1(WhatKind, InnerType, TopType, Cname, + Type, BytesVar, Tag), case DecObjInf of {Cname,{_,OSet,_UniqueFName,ValIndex}} -> Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), @@ -1226,8 +1217,9 @@ gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand, ok end, []. -gen_dec_call1({primitive,bif},InnerType,Erules,TopType,Cname,Type,BytesVar, - Tag,OptOrMand,_) -> + +gen_dec_call1({primitive,bif}, InnerType, TopType, Cname, + Type, BytesVar, Tag) -> case {asn1ct:get_gen_state_field(namelist),InnerType} of {[{Cname,undecoded}|Rest],_} -> asn1ct:add_generated_refed_func({[Cname|TopType],undecoded, @@ -1236,11 +1228,10 @@ gen_dec_call1({primitive,bif},InnerType,Erules,TopType,Cname,Type,BytesVar, emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',", BytesVar,"}"]); _ -> - ?ASN1CT_GEN_BER:gen_dec_prim(Erules,Type,BytesVar,Tag,[], - ?PRIMITIVE,OptOrMand) + ?ASN1CT_GEN_BER:gen_dec_prim(Type, BytesVar, Tag) end; -gen_dec_call1('ASN1_OPEN_TYPE',_InnerType,Erules,TopType,Cname,Type,BytesVar, - Tag,OptOrMand,_) -> +gen_dec_call1('ASN1_OPEN_TYPE', _InnerType, TopType, Cname, + Type, BytesVar, Tag) -> case {asn1ct:get_gen_state_field(namelist),Type#type.def} of {[{Cname,undecoded}|Rest],_} -> asn1ct:add_generated_refed_func({[Cname|TopType],undecoded, @@ -1249,15 +1240,12 @@ gen_dec_call1('ASN1_OPEN_TYPE',_InnerType,Erules,TopType,Cname,Type,BytesVar, emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',", BytesVar,"}"]); {_,#'ObjectClassFieldType'{type=OpenType}} -> - ?ASN1CT_GEN_BER:gen_dec_prim(Erules,#type{def=OpenType}, - BytesVar,Tag,[], - ?PRIMITIVE,OptOrMand); + ?ASN1CT_GEN_BER:gen_dec_prim(#type{def=OpenType}, + BytesVar, Tag); _ -> - ?ASN1CT_GEN_BER:gen_dec_prim(Erules,Type,BytesVar,Tag,[], - ?PRIMITIVE,OptOrMand) + ?ASN1CT_GEN_BER:gen_dec_prim(Type, BytesVar, Tag) end; -gen_dec_call1(WhatKind,_,_Erules,TopType,Cname,Type,BytesVar, - Tag,_,_OptOrMand) -> +gen_dec_call1(WhatKind, _, TopType, Cname, Type, BytesVar, Tag) -> case asn1ct:get_gen_state_field(namelist) of [{Cname,undecoded}|Rest] -> asn1ct:add_generated_refed_func({[Cname|TopType],undecoded, diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index ed3f6f886e..a91404ed54 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -426,8 +426,7 @@ gen_dec_open_type(Erule, Val, {Xmod,Xtype}, LeadingAttr, emit([Term," = ",{asis,F},"(",TmpTerm,", ",Val,")"]). dec_objset_optional(N, {'DEFAULT',Val}) -> - dec_objset_optional_1(N, Val), - dec_objset_optional_1(N, asn1_DEFAULT); + dec_objset_optional_1(N, Val); dec_objset_optional(N, 'OPTIONAL') -> dec_objset_optional_1(N, asn1_NOVALUE); dec_objset_optional(_N, mandatory) -> ok. diff --git a/lib/asn1/src/asn1ct_func.erl b/lib/asn1/src/asn1ct_func.erl index 33f998722a..fb94f65b32 100644 --- a/lib/asn1/src/asn1ct_func.erl +++ b/lib/asn1/src/asn1ct_func.erl @@ -19,7 +19,8 @@ %% -module(asn1ct_func). --export([start_link/0,need/1,call/3,call_gen/3,call_gen/4,generate/1]). +-export([start_link/0,need/1,call/3,call_gen/3,call_gen/4, + generate/1,is_used/1]). -export([init/1,handle_call/3,handle_cast/2,terminate/2]). start_link() -> @@ -63,6 +64,10 @@ generate(Fd) -> Funcs = sofs:to_external(Funcs0), ok = file:write(Fd, Funcs). +is_used({_,_,_}=MFA) -> + req({is_used,MFA}). + + req(Req) -> gen_server:call(get(?MODULE), Req, infinity). @@ -103,7 +108,10 @@ handle_call({gen_func,Prefix,Key,GenFun}, _From, #st{gen=G0,gc=Gc0}=St) -> {reply,Name,St#st{gen=G,gc=Gc}}; {value,{Name,_}} -> {reply,Name,St} - end. + end; +handle_call({is_used,MFA}, _From, #st{used=Used}=St) -> + {reply,gb_sets:is_member(MFA, Used),St}. + terminate(_, _) -> ok. diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 4707e517b4..450d309688 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -29,7 +29,6 @@ list2rname/1, constructed_suffix/2, unify_if_string/1, - gen_check_call/7, get_constraint/2, insert_once/2, ct_gen_module/1, @@ -43,6 +42,8 @@ -export([gen_encode_constructed/4, gen_decode_constructed/4]). +-define(SUPPRESSION_FUNC, 'dialyzer-suppressions'). + %% pgen(Outfile, Erules, Module, TypeOrVal, Options) %% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module %% .hrl file is only generated if necessary @@ -85,12 +86,18 @@ pgen_module(OutFile,Erules,Module, "%%%",nl, "%%% Run-time functions.",nl, "%%%",nl]), + dialyzer_suppressions(Erules), Fd = get(gen_file_out), asn1ct_func:generate(Fd), close_output_file(), _ = erase(outfile), asn1ct:verbose("--~p--~n",[{generated,ErlFile}],Options). +dialyzer_suppressions(Erules) -> + emit([nl, + {asis,?SUPPRESSION_FUNC},"(Arg) ->",nl]), + Rtmod = ct_gen_module(Erules), + Rtmod:dialyzer_suppressions(Erules). pgen_typeorval(Erules,Module,N2nConvEnums,{Types,Values,_Ptypes,_Classes,Objects,ObjectSets}) -> Rtmod = ct_gen_module(Erules), @@ -98,11 +105,6 @@ pgen_typeorval(Erules,Module,N2nConvEnums,{Types,Values,_Ptypes,_Classes,Objects pgen_values(Erules,Module,Values), pgen_objects(Rtmod,Erules,Module,Objects), pgen_objectsets(Rtmod,Erules,Module,ObjectSets), - case catch lists:member(der,get(encoding_options)) of - true -> - pgen_check_defaultval(Erules,Module); - _ -> ok - end, pgen_partial_decode(Rtmod,Erules,Module). pgen_values(_,_,[]) -> @@ -178,23 +180,6 @@ pgen_objectsets(Rtmod,Erules,Module,[H|T]) -> Rtmod:gen_objectset_code(Erules,TypeDef), pgen_objectsets(Rtmod,Erules,Module,T). -pgen_check_defaultval(Erules,Module) -> - CheckObjects = asn1ct_table:to_list(check_functions), - case get(asndebug) of - true -> - FileName = lists:concat([Module,".table"]), - {ok,IoDevice} = file:open(FileName,[write]), - Fun = - fun(X)-> - io:format(IoDevice,"~n~n************~n~n~p~n~n*****" - "********~n~n",[X]) - end, - lists:foreach(Fun,CheckObjects), - ok = file:close(IoDevice); - _ -> ok - end, - gen_check_defaultval(Erules,Module,CheckObjects). - pgen_partial_decode(Rtmod,Erule,Module) when Erule == ber -> pgen_partial_inc_dec(Rtmod,Erule,Module), pgen_partial_dec(Rtmod,Erule,Module); @@ -542,8 +527,7 @@ gen_part_decode_funcs({constructed,bif},TypeName, emit([" 'dec_",TypeName,"'(Data,",{asis,Tag},")"]); gen_part_decode_funcs({primitive,bif},_TypeName, {_Name,undecoded,Tag,Type}) -> - % Argument no 6 is 0, i.e. bit 6 for primitive encoding. - asn1ct_gen_ber_bin_v2:gen_dec_prim(ber_bin_v2,Type,"Data",Tag,[],0,", mandatory, "); + asn1ct_gen_ber_bin_v2:gen_dec_prim(Type, "Data", Tag); gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) -> throw({error,{asn1,{"Not implemented yet",WhatKind," partial incomplete directive:",Directive}}}). @@ -576,131 +560,6 @@ gen_types(Erules,Tname,Type) when is_record(Type,type) -> asn1ct_name:clear(), Rtmod:gen_decode(Erules,Tname,Type). -gen_check_defaultval(Erules,Module,[{Name,Type}|Rest]) -> - gen_check_func(Name,Type), - gen_check_defaultval(Erules,Module,Rest); -gen_check_defaultval(_,_,[]) -> - ok. - -gen_check_func(Name,FType = #type{def=Def}) -> - EncName = ensure_atom(Name), - emit({{asis,EncName},"(_V,asn1_DEFAULT) ->",nl," true;",nl}), - emit({{asis,EncName},"(V,V) ->",nl," true;",nl}), - emit({{asis,EncName},"(V,{_,V}) ->",nl," true;",nl}), - case Def of - {'SEQUENCE OF',Type} -> - gen_check_sof(Name,'SEQOF',Type); - {'SET OF',Type} -> - gen_check_sof(Name,'SETOF',Type); - #'SEQUENCE'{components=Components} -> - gen_check_sequence(Name,Components); - #'SET'{components=Components} -> - gen_check_sequence(Name,Components); - {'CHOICE',Components} -> - gen_check_choice(Name,Components); - #'Externaltypereference'{type=T} -> - emit({{asis,EncName},"(DefaultValue,Value) ->",nl}), - emit({" '",list2name([T,check]),"'(DefaultValue,Value).",nl}); - MaybePrim -> - InnerType = get_inner(MaybePrim), - case type(InnerType) of - {primitive,bif} -> - emit({{asis,EncName},"(DefaultValue,Value) ->",nl," "}), - gen_prim_check_call(get_inner(InnerType),"DefaultValue","Value", - FType), - emit({".",nl,nl}); - _ -> - throw({asn1_error,{unknown,type,MaybePrim}}) - end - end. - -gen_check_sof(Name,SOF,Type) -> - EncName = ensure_atom(Name), - NewName = ensure_atom(list2name([sorted,Name])), - emit({{asis,EncName},"(V1,V2) ->",nl}), - emit({" ",{asis,NewName},"(lists:sort(V1),lists:sort(V2)).",nl,nl}), - emit({{asis,NewName},"([],[]) ->",nl," true;",nl}), - emit({{asis,NewName},"([DV|DVs],[V|Vs]) ->",nl," "}), - InnerType = get_inner(Type#type.def), - case type(InnerType) of - {primitive,bif} -> - gen_prim_check_call(get_inner(InnerType),"DV","V",Type), - emit({",",nl}); - {constructed,bif} -> - emit([{asis,ensure_atom(list2name([SOF,Name]))},"(DV, V),",nl]); - #'Externaltypereference'{type=T} -> - emit([{asis,ensure_atom(list2name([T,check]))},"(DV,V),",nl]); - 'ASN1_OPEN_TYPE' -> - emit(["DV = V,",nl]); - _ -> - emit(["DV = V,",nl]) - end, - emit({" ",{asis,NewName},"(DVs,Vs).",nl,nl}). - -gen_check_sequence(Name, []) -> - emit([{asis,ensure_atom(Name)},"(_,_) ->",nl, - " throw(badval).",nl,nl]); -gen_check_sequence(Name,Components) -> - emit([{asis,ensure_atom(Name)},"(DefaultValue,Value) ->",nl]), - gen_check_sequence(Name,Components,1). - -gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) -> - InnerType = get_inner(Type#type.def), - NthDefV = ["element(",Num+1,",DefaultValue)"], - NthV = ["element(",Num+1,",Value)"], - gen_check_func_call(Name,Type,InnerType,NthDefV,NthV,N), - case Cs of - [] -> - emit({".",nl,nl}); - _ -> - emit({",",nl}), - gen_check_sequence(Name,Cs,Num+1) - end. - -gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) -> - emit([{asis,ensure_atom(Name)},"({Id,DefaultValue},{Id,Value}) ->",nl]), - emit([" case Id of",nl]), - gen_check_choice_components(Name,CList,1). - -gen_check_choice_components(_,[],_)-> - ok; -gen_check_choice_components(Name,[#'ComponentType'{name=N,typespec=Type}| - Cs],Num) -> - Ind6 = " ", - InnerType = get_inner(Type#type.def), - emit({Ind6,"'",N,"' ->",nl,Ind6}), - gen_check_func_call(Name,Type,InnerType,{var,"defaultValue"}, - {var,"value"},N), - case Cs of - [] -> - emit({nl," end.",nl,nl}); - _ -> - emit({";",nl}), - gen_check_choice_components(Name,Cs,Num+1) - end. - -gen_check_func_call(Name,Type,InnerType,DefVal,Val,N) -> - case type(InnerType) of - {primitive,bif} -> - emit(" "), - gen_prim_check_call(get_inner(InnerType),DefVal,Val,Type); - #'Externaltypereference'{type=T} -> - emit({" ",{asis,ensure_atom(list2name([T,check]))},"(",DefVal,",",Val,")"}); - 'ASN1_OPEN_TYPE' -> - emit([" if",nl, - " ",DefVal," == ",Val," -> true;",nl, - " true -> throw({error,{asn1_open_type}})",nl, - " end",nl]); - {constructed,bif} -> - emit([" ",{asis,ensure_atom(list2name([N,Name]))},"(",DefVal,",",Val,")"]); - _ -> - emit([" if",nl, - " ",DefVal," == ",Val," -> true;",nl, - " true -> throw({error,{asn1_open_type}})",nl, - " end",nl]) - end. - - %% VARIOUS GENERATOR STUFF %% ************************************************* %%************************************************** @@ -790,8 +649,9 @@ gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,typedef) -> pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> - emit(["-export([encoding_rule/0,bit_string_format/0," + emit(["-export([encoding_rule/0,bit_string_format/0,",nl, " legacy_erlang_types/0]).",nl]), + emit(["-export([",{asis,?SUPPRESSION_FUNC},"/1]).",nl]), case Types of [] -> ok; _ -> @@ -1077,9 +937,10 @@ gen_partial_inc_dispatcher() -> ok; {Data1,Data2} -> % io:format("partial_incomplete_decode: ~p~ninc_type_pattern: ~p~n",[Data,Data2]), - gen_partial_inc_dispatcher(Data1,Data2) + gen_partial_inc_dispatcher(Data1, Data2, "") end. -gen_partial_inc_dispatcher([{FuncName,TopType,_Pattern}|Rest],TypePattern) -> + +gen_partial_inc_dispatcher([{FuncName,TopType,_Pattern}|Rest], TypePattern, Sep) -> TPattern = case lists:keysearch(FuncName,1,TypePattern) of {value,{_,TP}} -> TP; @@ -1093,13 +954,13 @@ gen_partial_inc_dispatcher([{FuncName,TopType,_Pattern}|Rest],TypePattern) -> _ -> atom_to_list(TopType) end, - emit(["decode_partial_inc_disp('",TopTypeName,"',Data) ->",nl, + emit([Sep, + "decode_partial_inc_disp('",TopTypeName,"',Data) ->",nl, " ",{asis,list_to_atom(lists:concat(["dec-inc-",FuncName2]))}, - "(Data);",nl]), - gen_partial_inc_dispatcher(Rest,TypePattern); -gen_partial_inc_dispatcher([],_) -> - emit(["decode_partial_inc_disp(Type,_Data) ->",nl, - " exit({error,{asn1,{undefined_type,Type}}}).",nl]). + "(Data)"]), + gen_partial_inc_dispatcher(Rest, TypePattern, ";\n"); +gen_partial_inc_dispatcher([], _, _) -> + emit([".",nl]). gen_dispatcher([F1,F2|T],FuncName,Prefix,ExtraArg) -> emit([FuncName,"('",F1,"',Data) -> '",Prefix,F1,"'(Data",ExtraArg,")",";",nl]), @@ -1125,7 +986,22 @@ pgen_info() -> open_hrl(OutFile,Module) -> File = lists:concat([OutFile,".hrl"]), _ = open_output_file(File), - gen_hrlhead(Module). + gen_hrlhead(Module), + Protector = hrl_protector(OutFile), + emit(["-ifndef(",Protector,").\n", + "-define(",Protector,", true).\n" + "\n"]). + +hrl_protector(OutFile) -> + BaseName = filename:basename(OutFile), + P = "_" ++ string:to_upper(BaseName) ++ "_HRL_", + [if + $A =< C, C =< $Z -> C; + $a =< C, C =< $a -> C; + $0 =< C, C =< $9 -> C; + true -> $_ + end || C <- P]. + %% EMIT functions ************************ %% *************************************** @@ -1232,6 +1108,8 @@ pgen_hrl(Erules,Module,TypeOrVal,Options,_Indent) -> 0 -> 0; Y -> + Protector = hrl_protector(get(outfile)), + emit(["-endif. %% ",Protector,"\n"]), close_output_file(), asn1ct:verbose("--~p--~n", [{generated,lists:concat([get(outfile),".hrl"])}], @@ -1448,171 +1326,6 @@ to_textual_order(Cs=[#'ComponentType'{textual_order=undefined}|_]) -> to_textual_order(Cs) when is_list(Cs) -> lists:keysort(#'ComponentType'.textual_order,Cs). - -gen_check_call(TopType,Cname,Type,InnerType,WhatKind,DefaultValue,Element) -> - case WhatKind of - {primitive,bif} -> - gen_prim_check_call(InnerType,DefaultValue,Element,Type); - #'Externaltypereference'{module=M,type=T} -> - %% generate function call - Name = list2name([T,check]), - emit({"'",Name,"'(",DefaultValue,", ",Element,")"}), - %% insert in ets table and do look ahead check - Typedef = asn1_db:dbget(M,T), - RefType = Typedef#typedef.typespec, - InType = asn1ct_gen:get_inner(RefType#type.def), - case insert_once(check_functions,{Name,RefType}) of - true -> - lookahead_innertype([T],InType,RefType); - _ -> - ok - end; - {constructed,bif} -> - NameList = [Cname|TopType], - Name = list2name(NameList ++ [check]), - emit({"'",Name,"'(",DefaultValue,", ",Element,")"}), - asn1ct_table:insert(check_functions, {Name, Type}), - %% Must look for check functions in InnerType, - %% that may be referenced or internal defined - %% constructed types not used elsewhere. - lookahead_innertype(NameList,InnerType,Type); - _ -> - %% Generate Dummy function call i.e. anything is accepted - emit(["fun() -> true end ()"]) - end. - -gen_prim_check_call(PrimType, Default, Element, Type) -> - case unify_if_string(PrimType) of - 'BOOLEAN' -> - check_call(check_bool, [Default,Element]); - 'INTEGER' -> - NNL = case Type#type.def of - {_,NamedNumberList} -> NamedNumberList; - _ -> [] - end, - check_call(check_int, [Default,Element,{asis,NNL}]); - 'BIT STRING' -> - case Type#type.def of - {_,[]} -> - check_call(check_bitstring, - [Default,Element]); - {_,[_|_]=NBL} -> - check_call(check_named_bitstring, - [Default,Element,{asis,NBL}]) - end; - 'OCTET STRING' -> - check_call(check_octetstring, [Default,Element]); - 'NULL' -> - check_call(check_null, [Default,Element]); - 'OBJECT IDENTIFIER' -> - check_call(check_objectidentifier, [Default,Element]); - 'RELATIVE-OID' -> - check_call(check_objectidentifier, [Default,Element]); - 'ObjectDescriptor' -> - check_call(check_objectdescriptor, [Default,Element]); - 'REAL' -> - check_call(check_real, [Default,Element]); - 'ENUMERATED' -> - {_,Enumerations} = Type#type.def, - check_call(check_enum, [Default,Element,{asis,Enumerations}]); - restrictedstring -> - check_call(check_restrictedstring, [Default,Element]) - end. - -check_call(F, Args) -> - asn1ct_func:call(check, F, Args). - -%% lokahead_innertype/3 traverses Type and checks if check functions -%% have to be generated, i.e. for all constructed or referenced types. -lookahead_innertype(Name,'SEQUENCE',Type) -> - Components = (Type#type.def)#'SEQUENCE'.components, - lookahead_components(Name,Components); -lookahead_innertype(Name,'SET',Type) -> - Components = (Type#type.def)#'SET'.components, - lookahead_components(Name,Components); -lookahead_innertype(Name,'CHOICE',Type) -> - {_,Components} = Type#type.def, - lookahead_components(Name,Components); -lookahead_innertype(Name,'SEQUENCE OF',SeqOf) -> - lookahead_sof(Name,'SEQOF',SeqOf); -lookahead_innertype(Name,'SET OF',SeqOf) -> - lookahead_sof(Name,'SETOF',SeqOf); -lookahead_innertype(_Name,#'Externaltypereference'{module=M,type=T},_) -> - Typedef = asn1_db:dbget(M,T), - RefType = Typedef#typedef.typespec, - insert_once(check_functions,{list2name([T,check]),RefType}), - InType = asn1ct_gen:get_inner(RefType#type.def), - case type(InType) of - {constructed,bif} -> - lookahead_innertype([T],InType,RefType); - Ref = #'Externaltypereference'{} -> - lookahead_reference(Ref); - _ -> - ok - end; -lookahead_innertype(_,_,_) -> - ok. - -lookahead_components(_,[]) -> ok; -lookahead_components(Name,[C|Cs]) -> - #'ComponentType'{name=Cname,typespec=Type} = C, - InType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InType) of - {constructed,bif} -> - case insert_once(check_functions, - {list2name([Cname|Name] ++ [check]),Type}) of - true -> - lookahead_innertype([Cname|Name],InType,Type); - _ -> - ok - end; - #'Externaltypereference'{module=RefMod,type=RefName} -> - Typedef = asn1_db:dbget(RefMod,RefName), - RefType = Typedef#typedef.typespec, - case insert_once(check_functions,{list2name([RefName,check]), - RefType}) of - true -> - lookahead_innertype([RefName],InType,RefType); - _ -> - ok - end; - _ -> - ok - end, - lookahead_components(Name,Cs). - -lookahead_sof(Name,SOF,SOFType) -> - Type = case SOFType#type.def of - {_,_Type} -> _Type; - _Type -> _Type - end, - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - %% this is if a constructed type is defined in - %% the SEQUENCE OF type - NameList = [SOF|Name], - insert_once(check_functions, - {list2name(NameList ++ [check]),Type}), - lookahead_innertype(NameList,InnerType,Type); - Ref = #'Externaltypereference'{} -> - lookahead_reference(Ref); - _ -> - ok - end. - -lookahead_reference(#'Externaltypereference'{module=M,type=T}) -> - Typedef = asn1_db:dbget(M,T), - RefType = Typedef#typedef.typespec, - InType = get_inner(RefType#type.def), - case insert_once(check_functions, - {list2name([T,check]),RefType}) of - true -> - lookahead_innertype([T],InType,RefType); - _ -> - ok - end. - insert_once(Table,Object) -> case asn1ct_table:lookup(Table, element(1, Object)) of [] -> @@ -1666,6 +1379,11 @@ conform_value(#type{def={'BIT STRING',[]}}, Bs) -> bitstring when is_bitstring(Bs) -> Bs end; +conform_value(#type{def='OCTET STRING'}, String) -> + case asn1ct:use_legacy_types() of + false -> String; + true -> binary_to_list(String) + end; conform_value(_, Value) -> Value. named_bitstring_value(List, Names) -> @@ -1884,11 +1602,6 @@ get_constraint(C,Key) -> {value,Cnstr} -> Cnstr end. - -ensure_atom(Atom) when is_atom(Atom) -> - Atom; -ensure_atom(List) when is_list(List) -> - list_to_atom(List). get_record_name_prefix() -> case lists:keysearch(record_name_prefix,1,get(encoding_options)) of diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index bea0ec8968..e51b0898be 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -27,11 +27,12 @@ -export([decode_class/1, decode_type/1]). -export([gen_encode/2,gen_encode/3,gen_decode/2,gen_decode/3]). -export([gen_encode_prim/4]). --export([gen_dec_prim/7]). +-export([gen_dec_prim/3]). -export([gen_objectset_code/2, gen_obj_code/3]). -export([encode_tag_val/3]). -export([gen_inc_decode/2,gen_decode_selected/3]). -export([extaddgroup2sequence/1]). +-export([dialyzer_suppressions/1]). -import(asn1ct_gen, [emit/1,demit/1]). @@ -65,6 +66,23 @@ %%=============================================================================== %%=============================================================================== +dialyzer_suppressions(_) -> + case asn1ct:use_legacy_types() of + false -> ok; + true -> suppress({ber,encode_bit_string,4}) + end, + suppress({ber,decode_selective,2}), + emit([" ok.",nl]). + +suppress({M,F,A}=MFA) -> + case asn1ct_func:is_used(MFA) of + false -> + ok; + true -> + Args = [lists:concat(["element(",I,", Arg)"]) || I <- lists:seq(1, A)], + emit([" ",{call,M,F,Args},com,nl]) + end. + %%=============================================================================== %% encode #{typedef, {pos, name, typespec}} %%=============================================================================== @@ -163,6 +181,12 @@ gen_encode_user(Erules, #typedef{}=D, Wrapper) -> gen_encode_prim(_Erules, #type{}=D, DoTag, Value) -> BitStringConstraint = get_size_constraint(D#type.constraint), + MaxBitStrSize = case BitStringConstraint of + [] -> none; + {_,'MAX'} -> none; + {_,Max} -> Max; + Max when is_integer(Max) -> Max + end, asn1ct_name:new(enumval), Type = case D#type.def of 'OCTET STRING' -> restricted_string; @@ -208,11 +232,11 @@ gen_encode_prim(_Erules, #type{}=D, DoTag, Value) -> "end"]); {'BIT STRING',[]} -> case asn1ct:use_legacy_types() of - false when BitStringConstraint =:= [] -> + false when MaxBitStrSize =:= none -> call(encode_unnamed_bit_string, [Value,DoTag]); false -> call(encode_unnamed_bit_string, - [{asis,BitStringConstraint},Value,DoTag]); + [{asis,MaxBitStrSize},Value,DoTag]); true -> call(encode_bit_string, [{asis,BitStringConstraint},Value, @@ -220,12 +244,12 @@ gen_encode_prim(_Erules, #type{}=D, DoTag, Value) -> end; {'BIT STRING',NamedNumberList} -> case asn1ct:use_legacy_types() of - false when BitStringConstraint =:= [] -> + false when MaxBitStrSize =:= none -> call(encode_named_bit_string, [Value,{asis,NamedNumberList},DoTag]); false -> call(encode_named_bit_string, - [{asis,BitStringConstraint},Value, + [{asis,MaxBitStrSize},Value, {asis,NamedNumberList},DoTag]); true -> call(encode_bit_string, @@ -254,14 +278,20 @@ emit_enc_enumerated_cases(L, Tags) -> emit_enc_enumerated_cases(L, Tags, noext). emit_enc_enumerated_cases([{EnumName,EnumVal}|T], Tags, Ext) -> + Bytes = encode_pos_integer(EnumVal, []), + Len = length(Bytes), emit([{asis,EnumName}," -> ", - {call,ber,encode_enumerated,[EnumVal,Tags]},";",nl]), + {call,ber,encode_tags,[Tags,{asis,Bytes},Len]},";",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"]). +encode_pos_integer(0, [B|_Acc] = L) when B < 128 -> + L; +encode_pos_integer(N, Acc) -> + encode_pos_integer(N bsr 8, [N band 255|Acc]). %%=============================================================================== %%=============================================================================== @@ -339,15 +369,11 @@ gen_decode_selected_type(_Erules,TypeDef) -> case asn1ct_gen:type(InnerType) of 'ASN1_OPEN_TYPE' -> asn1ct_name:new(len), - gen_dec_prim(ber, Def#type{def='ASN1_OPEN_TYPE'}, - BytesVar,Tag, [] , - ?PRIMITIVE,"OptOrMand"); -% emit({";",nl}); + gen_dec_prim(Def#type{def='ASN1_OPEN_TYPE'}, + BytesVar, Tag); {primitive,bif} -> asn1ct_name:new(len), - gen_dec_prim(ber, Def, BytesVar,Tag,[] , - ?PRIMITIVE,"OptOrMand"); -% emit([";",nl]); + gen_dec_prim(Def, BytesVar, Tag); {constructed,bif} -> TopType = case TypeDef#typedef.name of A when is_atom(A) -> [A]; @@ -461,14 +487,12 @@ gen_decode_user(Erules,D) when is_record(D,typedef) -> case asn1ct_gen:type(InnerType) of 'ASN1_OPEN_TYPE' -> asn1ct_name:new(len), - gen_dec_prim(ber, Def#type{def='ASN1_OPEN_TYPE'}, - BytesVar,{string,"TagIn"}, [] , - ?PRIMITIVE,"OptOrMand"), + gen_dec_prim(Def#type{def='ASN1_OPEN_TYPE'}, + BytesVar, {string,"TagIn"}), emit({".",nl,nl}); {primitive,bif} -> asn1ct_name:new(len), - gen_dec_prim(ber, Def, BytesVar,{string,"TagIn"},[] , - ?PRIMITIVE,"OptOrMand"), + gen_dec_prim(Def, BytesVar, {string,"TagIn"}), emit([".",nl,nl]); {constructed,bif} -> asn1ct:update_namelist(D#typedef.name), @@ -481,17 +505,10 @@ gen_decode_user(Erules,D) when is_record(D,typedef) -> end. -gen_dec_prim(_Erules, Att, BytesVar, DoTag, _TagIn, _Form, _OptOrMand) -> +gen_dec_prim(Att, BytesVar, DoTag) -> Typename = Att#type.def, -%% Currently not used for BER replaced with [] as place holder -%% Constraint = Att#type.constraint, -%% Constraint = [], Constraint = get_size_constraint(Att#type.constraint), IntConstr = int_constr(Att#type.constraint), - AsBin = case get(binary_strings) of - true -> "_as_bin"; - _ -> "" - end, NewTypeName = case Typename of 'NumericString' -> restricted_string; 'TeletexString' -> restricted_string; @@ -505,107 +522,77 @@ gen_dec_prim(_Erules, Att, BytesVar, DoTag, _TagIn, _Form, _OptOrMand) -> 'ObjectDescriptor'-> restricted_string; 'UTCTime' -> restricted_string; 'GeneralizedTime' -> restricted_string; + 'OCTET STRING' -> + case asn1ct:use_legacy_types() of + true -> restricted_string; + false -> Typename + end; _ -> Typename end, + TagStr = case DoTag of + {string,Tag1} -> Tag1; + _ when is_list(DoTag) -> {asis,DoTag} + end, case NewTypeName of 'BOOLEAN'-> - emit(["decode_boolean(",BytesVar,","]), - need(decode_boolean, 2); + call(decode_boolean, [BytesVar,TagStr]); 'INTEGER' -> - case IntConstr of - [] -> - emit(["decode_integer(",BytesVar,","]), - need(decode_integer, 2); - {_,_} -> - emit(["decode_integer(",BytesVar,",", - {asis,IntConstr},","]), - need(decode_integer, 3) - end; - {'INTEGER',NamedNumberList} -> - case IntConstr of - [] -> - emit(["decode_named_integer(",BytesVar,",", - {asis,NamedNumberList},","]), - need(decode_named_integer, 3); - {_,_} -> - emit(["decode_named_integer(",BytesVar,",", - {asis,IntConstr},",", - {asis,NamedNumberList},","]), - need(decode_named_integer, 4) - end; - {'ENUMERATED',NamedNumberList} -> - emit(["decode_enumerated(",BytesVar,",", - {asis,NamedNumberList},","]), - need(decode_enumerated, 3); + check_constraint(decode_integer, [BytesVar,TagStr], + IntConstr, + identity, + identity); + {'INTEGER',NNL} -> + check_constraint(decode_integer, + [BytesVar,TagStr], + IntConstr, + identity, + fun(Val) -> + asn1ct_name:new(val), + emit([{curr,val}," = "]), + Val(), + emit([com,nl, + {call,ber,number2name, + [{curr,val},{asis,NNL}]}]) + end); + {'ENUMERATED',NNL} -> + gen_dec_enumerated(BytesVar, NNL, TagStr); 'REAL' -> - ok; - {'BIT STRING',_NamedNumberList} -> - ok; + 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]); + {'BIT STRING',NNL} -> + gen_dec_bit_string(BytesVar, Constraint, NNL, TagStr); 'NULL' -> - emit(["decode_null(",BytesVar,","]), - need(decode_null, 2); + call(decode_null, [BytesVar,TagStr]); 'OBJECT IDENTIFIER' -> - emit(["decode_object_identifier(",BytesVar,","]), - need(decode_object_identifier, 2); + call(decode_object_identifier, [BytesVar,TagStr]); 'RELATIVE-OID' -> - emit(["decode_relative_oid(",BytesVar,","]), - need(decode_relative_oid, 2); + call(decode_relative_oid, [BytesVar,TagStr]); 'OCTET STRING' -> - F = case asn1ct:use_legacy_types() of - false -> decode_octet_string; - true -> decode_restricted_string - end, - emit([{asis,F},"(",BytesVar,","]), - case Constraint of - [] -> - need(F, 2); - _ -> - emit([{asis,Constraint},","]), - need(F, 3) - end; + check_constraint(decode_octet_string, [BytesVar,TagStr], + Constraint, {erlang,byte_size}, identity); restricted_string -> - emit(["decode_restricted_string",AsBin,"(",BytesVar,","]), - case Constraint of - [] -> - need(decode_restricted_string, 2); - _ -> - emit([{asis,Constraint},","]), - need(decode_restricted_string, 3) - end; + check_constraint(decode_restricted_string, [BytesVar,TagStr], + Constraint, + {erlang,byte_size}, + fun(Val) -> + emit("binary_to_list("), + Val(), + emit(")") + end); 'UniversalString' -> - emit(["decode_universal_string",AsBin,"(", - BytesVar,",",{asis,Constraint},","]), - need(decode_universal_string, 3); + check_constraint(decode_universal_string, [BytesVar,TagStr], + Constraint, {erlang,length}, identity); 'UTF8String' -> - emit(["decode_UTF8_string",AsBin,"(", - BytesVar,","]), - need(decode_UTF8_string, 2); + call(decode_UTF8_string, [BytesVar,TagStr]); 'BMPString' -> - emit(["decode_BMP_string",AsBin,"(", - BytesVar,",",{asis,Constraint},","]), - need(decode_BMP_string, 3); + check_constraint(decode_BMP_string, [BytesVar,TagStr], + Constraint, {erlang,length}, identity); 'ASN1_OPEN_TYPE' -> - emit(["decode_open_type_as_binary(", - BytesVar,","]), - need(decode_open_type_as_binary, 2) - end, - - TagStr = case DoTag of - {string,Tag1} -> Tag1; - _ when is_list(DoTag) -> {asis,DoTag} - end, - case NewTypeName of - {'BIT STRING',NNL} -> - gen_dec_bit_string(BytesVar, Constraint, NNL, TagStr); - '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]); - _ -> - emit([TagStr,")"]) + call(decode_open_type_as_binary, [BytesVar,TagStr]) end. %% Simplify an integer constraint so that we can efficiently test it. @@ -621,7 +608,7 @@ int_constr(C) -> [{'ValueRange',{_,_}=Range}] -> Range; [{'SingleValue',Sv}] -> - {Sv,Sv}; + Sv; [] -> [] end. @@ -632,16 +619,108 @@ gen_dec_bit_string(BytesVar, _Constraint, [_|_]=NNL, TagStr) -> gen_dec_bit_string(BytesVar, Constraint, [], TagStr) -> case asn1ct:get_bit_string_format() of compact -> - call(decode_compact_bit_string, - [BytesVar,{asis,Constraint},TagStr]); + check_constraint(decode_compact_bit_string, + [BytesVar,TagStr], + Constraint, + {ber,compact_bit_string_size}, + identity); legacy -> - call(decode_legacy_bit_string, - [BytesVar,{asis,Constraint},TagStr]); + check_constraint(decode_native_bit_string, + [BytesVar,TagStr], + Constraint, + {erlang,bit_size}, + fun(Val) -> + asn1ct_name:new(val), + emit([{curr,val}," = "]), + Val(), + emit([com,nl, + {call,ber,native_to_legacy_bit_string, + [{curr,val}]}]) + end); bitstring -> - call(decode_native_bit_string, - [BytesVar,{asis,Constraint},TagStr]) + check_constraint(decode_native_bit_string, + [BytesVar,TagStr], + Constraint, + {erlang,bit_size}, + identity) + end. + +check_constraint(F, Args, Constr, PreConstr0, ReturnVal0) -> + PreConstr = case PreConstr0 of + identity -> + fun(V) -> V end; + {Mod,Name} -> + fun(V) -> + asn1ct_name:new(c), + emit([{curr,c}," = ", + {call,Mod,Name,[V]},com,nl]), + {curr,c} + end + end, + ReturnVal = case ReturnVal0 of + identity -> fun(Val) -> Val() end; + _ -> ReturnVal0 + end, + case Constr of + [] when ReturnVal0 =:= identity -> + %% No constraint, no complications. + call(F, Args); + [] -> + %% No constraint, but the return value could consist + %% of more than one statement. + emit(["begin",nl]), + ReturnVal(fun() -> call(F, Args) end), + emit([nl, + "end",nl]); + _ -> + %% There is a constraint. + asn1ct_name:new(val), + emit(["begin",nl, + {curr,val}," = ",{call,ber,F,Args},com,nl]), + PreVal0 = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + PreVal = PreConstr(PreVal0), + emit("if "), + case Constr of + {Min,Max} -> + emit([{asis,Min}," =< ",PreVal,", ", + PreVal," =< ",{asis,Max}]); + Sv when is_integer(Sv) -> + emit([PreVal," =:= ",{asis,Sv}]) + end, + emit([" ->",nl]), + ReturnVal(fun() -> emit(PreVal0) end), + emit([";",nl, + "true ->",nl, + "exit({error,{asn1,bad_range}})",nl, + "end",nl, + "end"]) end. +gen_dec_enumerated(BytesVar, NNL0, TagStr) -> + asn1ct_name:new(enum), + emit(["case ", + {call,ber,decode_integer,[BytesVar,TagStr]}, + " of",nl]), + NNL = case NNL0 of + {L1,L2} -> + L1 ++ L2 ++ [accept]; + [_|_] -> + NNL0 ++ [error] + end, + gen_dec_enumerated_1(NNL), + emit("end"). + +gen_dec_enumerated_1([accept]) -> + asn1ct_name:new(default), + emit([{curr,default}," -> {asn1_enum,",{curr,default},"}",nl]); +gen_dec_enumerated_1([error]) -> + asn1ct_name:new(default), + emit([{curr,default}," -> exit({error,{asn1,{illegal_enumerated,", + {curr,default},"}}})",nl]); +gen_dec_enumerated_1([{V,K}|T]) -> + emit([{asis,K}," -> ",{asis,V},";",nl]), + gen_dec_enumerated_1(T). + %% Object code generating for encoding and decoding %% ------------------------------------------------ @@ -986,9 +1065,8 @@ gen_decode_field_call(ObjName,FieldName,Bytes,Type) -> Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- OTag], case Type#typedef.name of - {primitive,bif} -> %%tag should be the primitive tag - gen_dec_prim(ber,Def,Bytes,Tag,"TagIn",?PRIMITIVE, - opt_or_default), + {primitive,bif} -> + gen_dec_prim(Def, Bytes, Tag), []; {constructed,bif} -> emit({" 'dec_",ObjName,'_',FieldName, @@ -1016,8 +1094,7 @@ gen_decode_default_call(ClassName,FieldName,Bytes,Type) -> FieldName])), typespec=Type}]; {primitive,bif} -> - gen_dec_prim(ber,Type,Bytes,Tag,"TagIn", - ?PRIMITIVE,opt_or_default), + gen_dec_prim(Type, Bytes, Tag), []; #'Externaltypereference'{module=CurrentMod,type=Etype} -> emit([" 'dec_",Etype,"'(",Bytes, " ,",{asis,Tag},")",nl]), @@ -1386,7 +1463,7 @@ emit_dec_open_type(I) -> end, emit(S). -emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},Prop, +emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type}, _Prop, InternalDefFunName) -> OTag = Type#type.tag, %% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], @@ -1394,8 +1471,7 @@ emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},Prop, case {ExtName,Name} of {primitive,bif} -> emit(indent(12)), - gen_dec_prim(ber,Type,"Bytes",Tag,"TagIn", - ?PRIMITIVE,Prop), + gen_dec_prim(Type, "Bytes", Tag), 0; {constructed,bif} -> emit([indent(12),"'dec_", @@ -1412,7 +1488,7 @@ emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},Prop, emit_inner_of_decfun(#typedef{name=Name},_Prop,_) -> emit([indent(12),"'dec_",Name,"'(Bytes)"]), 0; -emit_inner_of_decfun(Type,Prop,_) when is_record(Type,type) -> +emit_inner_of_decfun(#type{}=Type, _Prop, _) -> OTag = Type#type.tag, %% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- OTag], @@ -1423,8 +1499,7 @@ emit_inner_of_decfun(Type,Prop,_) when is_record(Type,type) -> case WhatKind of {primitive,bif} -> emit([indent(9),Def," ->",nl,indent(12)]), - gen_dec_prim(ber,Type,"Bytes",Tag,"TagIn", - ?PRIMITIVE,Prop); + gen_dec_prim(Type, "Bytes", Tag); #'Externaltypereference'{module=CurrMod,type=T} -> emit([indent(9),T," ->",nl,indent(12),"'dec_",T, % "'(Bytes, ",Prop,")"]); @@ -1561,6 +1636,3 @@ extaddgroup2sequence(ExtList) when is_list(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_check.erl b/lib/asn1/src/asn1ct_gen_check.erl new file mode 100644 index 0000000000..d80a02dfbf --- /dev/null +++ b/lib/asn1/src/asn1ct_gen_check.erl @@ -0,0 +1,271 @@ +%% vim: tabstop=8:shiftwidth=4 +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(asn1ct_gen_check). +-export([emit/3]). + +-import(asn1ct_gen, [emit/1]). +-include("asn1_records.hrl"). + +emit(Type, Default, Value) -> + Key = {Type,Default}, + Gen = fun(Fd, Name) -> + file:write(Fd, gen(Name, Type, Default)) + end, + emit(" case "), + asn1ct_func:call_gen("is_default_", Key, Gen, [Value]), + emit([" of",nl, + "true -> {[],0};",nl, + "false ->",nl]). + +gen(Name, #type{def=T}, Default) -> + NameStr = atom_to_list(Name), + [NameStr,"(asn1_DEFAULT) ->\n", + "true;\n"|case do_gen(T, Default) of + {literal,Literal} -> + [NameStr,"(",term2str(Literal),") ->\n","true;\n", + NameStr,"(_) ->\n","false.\n\n"]; + {exception,Func,Args} -> + [NameStr,"(Value) ->\n", + "try ",Func,"(Value",arg2str(Args),") of\n", + "_ -> true\n" + "catch throw:false -> false\n" + "end.\n\n"] + end]. + +do_gen(_, asn1_NOVALUE) -> + {literal,asn1_NOVALUE}; +do_gen(#'Externaltypereference'{module=M,type=T}, Default) -> + #typedef{typespec=#type{def=Td}} = asn1_db:dbget(M, T), + do_gen(Td, Default); +do_gen('BOOLEAN', Default) -> + {literal,Default}; +do_gen({'BIT STRING',[]}, Default) -> + true = is_bitstring(Default), %Assertion. + case asn1ct:use_legacy_types() of + false -> + {literal,Default}; + true -> + {exception,need(check_legacy_bitstring, 2),[Default]} + end; +do_gen({'BIT STRING',[_|_]=NBL}, Default) -> + do_named_bitstring(NBL, Default); +do_gen({'ENUMERATED',_}, Default) -> + {literal,Default}; +do_gen('INTEGER', Default) -> + {literal,Default}; +do_gen({'INTEGER',NNL}, Default) -> + {exception,need(check_int, 3),[Default,NNL]}; +do_gen('NULL', Default) -> + {literal,Default}; +do_gen('OCTET STRING', Default) -> + true = is_binary(Default), %Assertion. + case asn1ct:use_legacy_types() of + false -> + {literal,Default}; + true -> + {exception,need(check_octetstring, 2),[Default]} + end; +do_gen('OBJECT IDENTIFIER', Default0) -> + Default = pre_process_oid(Default0), + {exception,need(check_objectidentifier, 2),[Default]}; +do_gen({'CHOICE',Cs}, Default) -> + {Tag,Value} = Default, + [Type] = [Type || #'ComponentType'{name=T,typespec=Type} <- Cs, + T =:= Tag], + case do_gen(Type#type.def, Value) of + {literal,Lit} -> + {literal,{Tag,Lit}}; + {exception,Func0,Args} -> + Key = {Tag,Func0,Args}, + Gen = fun(Fd, Name) -> + S = gen_choice(Name, Tag, Func0, Args), + ok = file:write(Fd, S) + end, + Func = asn1ct_func:call_gen("is_default_choice", Key, Gen), + {exception,atom_to_list(Func),[]} + end; +do_gen(#'SEQUENCE'{components=Cs}, Default) -> + do_seq_set(Cs, Default); +do_gen({'SEQUENCE OF',Type}, Default) -> + do_sof(Type, Default); +do_gen(#'SET'{components=Cs}, Default) -> + do_seq_set(Cs, Default); +do_gen({'SET OF',Type}, Default) -> + do_sof(Type, Default); +do_gen(Type, Default) -> + case asn1ct_gen:unify_if_string(Type) of + restrictedstring -> + {exception,need(check_restrictedstring, 2),[Default]}; + _ -> + %% Open type. Do our best. + {literal,Default} + end. + +do_named_bitstring(NBL, Default0) when is_list(Default0) -> + Default = lists:sort(Default0), + Bs = asn1ct_gen:named_bitstring_value(Default, NBL), + Func = case asn1ct:use_legacy_types() of + false -> check_named_bitstring; + true -> check_legacy_named_bitstring + end, + {exception,need(Func, 4),[Default,Bs,bit_size(Bs)]}; +do_named_bitstring(_, Default) when is_bitstring(Default) -> + Func = case asn1ct:use_legacy_types() of + false -> check_named_bitstring; + true -> check_legacy_named_bitstring + end, + {exception,need(Func, 3),[Default,bit_size(Default)]}. + +do_seq_set(Cs0, Default) -> + Tag = element(1, Default), + Cs1 = [T || #'ComponentType'{typespec=T} <- Cs0], + Cs = components(Cs1, tl(tuple_to_list(Default))), + case are_all_literals(Cs) of + true -> + Literal = list_to_tuple([Tag|[L || {literal,L} <- Cs]]), + {literal,Literal}; + false -> + Key = {Cs,Default}, + Gen = fun(Fd, Name) -> + S = gen_components(Name, Tag, Cs), + ok = file:write(Fd, S) + end, + Func = asn1ct_func:call_gen("is_default_cs_", Key, Gen), + {exception,atom_to_list(Func),[]} + end. + +do_sof(Type, Default0) -> + Default = lists:sort(Default0), + Cs0 = lists:duplicate(length(Default), Type), + Cs = components(Cs0, Default), + case are_all_literals(Cs) of + true -> + Literal = [Lit || {literal,Lit} <- Cs], + {exception,need(check_literal_sof, 2),[Literal]}; + false -> + Key = Cs, + Gen = fun(Fd, Name) -> + S = gen_sof(Name, Cs), + ok = file:write(Fd, S) + end, + Func = asn1ct_func:call_gen("is_default_sof", Key, Gen), + {exception,atom_to_list(Func),[]} + end. + +are_all_literals([{literal,_}|T]) -> + are_all_literals(T); +are_all_literals([_|_]) -> + false; +are_all_literals([]) -> true. + +gen_components(Name, Tag, Cs) -> + [atom_to_list(Name),"(Value) ->\n", + "case Value of\n", + "{",term2str(Tag)|gen_cs_1(Cs, 1, [])]. + +gen_cs_1([{literal,Lit}|T], I, Acc) -> + [",\n",term2str(Lit)|gen_cs_1(T, I, Acc)]; +gen_cs_1([H|T], I, Acc) -> + Var = "E"++integer_to_list(I), + [",\n",Var|gen_cs_1(T, I+1, [{Var,H}|Acc])]; +gen_cs_1([], _, Acc) -> + ["} ->\n"|gen_cs_2(Acc, "")]. + +gen_cs_2([{Var,{exception,Func,Args}}|T], Sep) -> + [Sep,Func,"(",Var,arg2str(Args),")"|gen_cs_2(T, ",\n")]; +gen_cs_2([], _) -> + [";\n", + "_ ->\n" + "throw(false)\n" + "end.\n"]. + +gen_sof(Name, Cs) -> + [atom_to_list(Name),"(Value) ->\n", + "case length(Value) of\n", + integer_to_list(length(Cs))," -> ok;\n" + "_ -> throw(false)\n" + "end,\n" + "T0 = lists:sort(Value)"|gen_sof_1(Cs, 1)]. + +gen_sof_1([{exception,Func,Args}|Cs], I) -> + NumStr = integer_to_list(I), + H = "H" ++ NumStr, + T = "T" ++ NumStr, + Prev = "T" ++ integer_to_list(I-1), + [",\n", + "[",H,case Cs of + [] -> []; + [_|_] -> ["|",T] + end,"] = ",Prev,",\n", + Func,"(",H,arg2str(Args),")"|gen_sof_1(Cs, I+1)]; +gen_sof_1([], _) -> + ".\n". + +components([#type{def=Def}|Ts], [V|Vs]) -> + [do_gen(Def, V)|components(Ts, Vs)]; +components([], []) -> []. + +gen_choice(Name, Tag, Func, Args) -> + NameStr = atom_to_list(Name), + [NameStr,"({",term2str(Tag),",Value}) ->\n" + " ",Func,"(Value",arg2str(Args),");\n", + NameStr,"(_) ->\n" + " throw(false).\n"]. + +pre_process_oid(Oid) -> + Reserved = reserved_oid(), + pre_process_oid(tuple_to_list(Oid), Reserved, []). + +pre_process_oid([H|T]=Tail, Res0, Acc) -> + case lists:keyfind(H, 2, Res0) of + false -> + {lists:reverse(Acc),Tail}; + {Names0,H,Res} -> + Names = case is_list(Names0) of + false -> [Names0]; + true -> Names0 + end, + Keys = [H|Names], + pre_process_oid(T, Res, [Keys|Acc]) + end. + +reserved_oid() -> + [{['itu-t',ccitt],0, + [{recommendation,0,[]}, + {question,1,[]}, + {administration,2,[]}, + {'network-operator',3,[]}, + {'identified-organization',4,[]}]}, + {iso,1,[{standard,0,[]}, + {'member-body',2,[]}, + {'identified-organization',3,[]}]}, + {['joint-iso-itu-t','joint-iso-ccitt'],2,[]}]. + +arg2str(Args) -> + [", "++term2str(Arg) || Arg <- Args]. + +term2str(T) -> + io_lib:format("~w", [T]). + +need(F, A) -> + asn1ct_func:need({check,F,A}), + atom_to_list(F). diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 519ce9f054..39cc0536f8 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -32,6 +32,7 @@ -export([gen_encode/2, gen_encode/3]). -export([gen_dec_external/2]). -export([extaddgroup2sequence/1]). +-export([dialyzer_suppressions/1]). -import(asn1ct_gen, [emit/1,demit/1]). -import(asn1ct_func, [call/3]). @@ -40,6 +41,15 @@ %% Generate ENCODING ****************************** %%****************************************x +dialyzer_suppressions(Erules) -> + case asn1ct_func:is_used({Erules,complete,1}) of + false -> + ok; + true -> + emit([" _ = complete(Arg),",nl]) + end, + emit([" ok.",nl]). + gen_encode(Erules,Type) when is_record(Type,typedef) -> gen_encode_user(Erules,Type). diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index fde39c674e..bdd14871d1 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -82,15 +82,8 @@ per_dec_enumerated(NamedList0, Aligned) -> Ub = length(NamedList0) - 1, Constraint = [{'ValueRange',{0,Ub}}], Int = per_dec_integer(Constraint, Aligned), - EnumTail = case matched_range(Int) of - {0,Ub} -> - %% The error case can never happen. - []; - _ -> - [enum_error] - end, - NamedList = per_dec_enumerated_fix_list(NamedList0, EnumTail, 0), - {map,Int,NamedList}. + NamedList = per_dec_enumerated_fix_list(NamedList0, [enum_error], 0), + {map,Int,opt_map(NamedList, Int)}. per_dec_enumerated(BaseNamedList, NamedListExt0, Aligned) -> Base = per_dec_enumerated(BaseNamedList, Aligned), @@ -124,7 +117,7 @@ per_dec_length(no, AllowZero, Aligned) -> per_dec_named_integer(Constraint, NamedList0, Aligned) -> Int = per_dec_integer(Constraint, Aligned), NamedList = [{K,V} || {V,K} <- NamedList0] ++ [integer_default], - {map,Int,NamedList}. + {map,Int,opt_map(NamedList, Int)}. per_dec_k_m_string(StringType, Constraint, Aligned) -> SzConstr = effective_constraint(bitstring, Constraint), @@ -175,6 +168,8 @@ per_enc_bit_string(Val0, NNL0, Constraint0, Aligned) -> ToBs = case ExtraArgs of [] -> {call,per_common,bs_drop_trailing_zeroes,[Val]}; + [0] -> + {call,per_common,bs_drop_trailing_zeroes,[Val]}; [Lower] -> {call,per_common,adjust_trailing_zeroes,[Val,Lower]} end, @@ -203,6 +198,7 @@ per_enc_legacy_bit_string(Val0, NNL0, Constraint0, Aligned) -> Constraint = effective_constraint(bitstring, Constraint0), ExtraArgs = case constr_min_size(Constraint) of no -> []; + 0 -> []; Lb -> [Lb] end, B ++ [{'try', @@ -265,10 +261,6 @@ per_enc_k_m_string(Val0, StringType, Constraint, Aligned) -> SzConstraint = effective_constraint(bitstring, Constraint), Unit = string_num_bits(StringType, Constraint, Aligned), Chars0 = char_tab(Constraint, StringType, Unit), - Args = case enc_char_tab(Chars0) of - notab -> [Val,Unit]; - Chars -> [Val,Unit,Chars] - end, Enc = case Unit of 16 -> {call,per_common,encode_chars_16bit,[Val],Bin}; @@ -277,7 +269,15 @@ per_enc_k_m_string(Val0, StringType, Constraint, Aligned) -> 8 -> {call,erlang,list_to_binary,[Val],Bin}; _ -> - {call,per_common,encode_chars,Args,Bin} + case enc_char_tab(Chars0) of + notab -> + {call,per_common,encode_chars,[Val,Unit],Bin}; + {tab,Tab} -> + {call,per_common,encode_chars,[Val,Unit,Tab],Bin}; + {compact_map,Map} -> + {call,per_common,encode_chars_compact_map, + [Val,Unit,Map],Bin} + end end, case Unit of 8 -> @@ -581,14 +581,42 @@ per_num_bits(N) when N =< 64 -> 6; per_num_bits(N) when N =< 128 -> 7; per_num_bits(N) when N =< 255 -> 8. +opt_map(Map, Imm) -> + case matched_range(Imm) of + unknown -> Map; + {Lb,Ub} -> opt_map_1(Map, Lb, Ub) + end. + +opt_map_1([{I,_}=Pair|T], Lb, Ub) -> + if + I =:= Lb, I =< Ub -> + [Pair|opt_map_1(T, Lb+1, Ub)]; + Lb < I, I =< Ub -> + [Pair|opt_map_1(T, Lb, Ub)]; + true -> + opt_map_1(T, Lb, Ub) + end; +opt_map_1(Map, Lb, Ub) -> + if + Lb =< Ub -> + Map; + true -> + [] + end. + matched_range({get_bits,Bits0,[U|Flags]}) when is_integer(U) -> - case lists:member(signed, Flags) of - false -> + case not lists:member(signed, Flags) andalso is_integer(Bits0) of + true -> Bits = U*Bits0, {0,(1 bsl Bits) - 1}; - true -> + false -> unknown end; +matched_range({add,Imm,Add}) -> + case matched_range(Imm) of + unknown -> unknown; + {Lb,Ub} -> {Lb+Add,Ub+Add} + end; matched_range(_Op) -> unknown. string_num_bits(StringType, Constraint, Aligned) -> @@ -1289,6 +1317,8 @@ eval_cond_1({eq,[],[]}) -> true; eval_cond_1({eq,I,N}) when is_integer(I), is_integer(N) -> I =:= N; +eval_cond_1({ge,I,N}) when is_integer(I), is_integer(N) -> + I >= N; eval_cond_1({lt,I,N}) when is_integer(I), is_integer(N) -> I < N; eval_cond_1(_) -> maybe. @@ -1303,9 +1333,15 @@ prepend_to_cond_1([Check|T], Code) -> enc_char_tab(notab) -> notab; enc_char_tab(Tab0) -> - Tab = tuple_to_list(Tab0), - First = hd(Tab), - {First-1,list_to_tuple(enc_char_tab_1(Tab, First, 0))}. + Tab1 = tuple_to_list(Tab0), + First = hd(Tab1), + Tab = enc_char_tab_1(Tab1, First, 0), + case lists:member(ill, Tab) of + false -> + {compact_map,{First,tuple_size(Tab0)}}; + true -> + {tab,{First-1,list_to_tuple(Tab)}} + end. enc_char_tab_1([H|T], H, I) -> [I|enc_char_tab_1(T, H+1, I+1)]; diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 283616b157..3891fce8d3 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -25,7 +25,8 @@ %% Only used internally within this module. -record(typereference, {pos,val}). --record(constraint,{c,e}). +-record(constraint, {c,e}). +-record(identifier, {pos,val}). %% parse all types in module parse(Tokens) -> @@ -112,6 +113,9 @@ parse_ModuleDefinition(Tokens) -> parse_Exports([{'EXPORTS',_L1},{';',_L2}|Rest]) -> {{exports,[]},Rest}; +parse_Exports([{'EXPORTS',_},{'ALL',_},{';',_}|Rest]) -> + %% Same as no exports definition. + {{exports,all},Rest}; parse_Exports([{'EXPORTS',_L1}|Rest]) -> {SymbolList,Rest2} = parse_SymbolList(Rest), case Rest2 of @@ -1037,10 +1041,6 @@ parse_DefinedObjectClass([{typereference,_,_ModName},{'.',_},Tr={typereference,_ parse_DefinedObjectClass([Tr={typereference,_,_ObjClName}|Rest]) -> % {{objectclassname,tref2Exttref(Tr)},Rest}; {tref2Exttref(Tr),Rest}; -parse_DefinedObjectClass([{'TYPE-IDENTIFIER',_}|Rest]) -> - {'TYPE-IDENTIFIER',Rest}; -parse_DefinedObjectClass([{'ABSTRACT-SYNTAX',_}|Rest]) -> - {'ABSTRACT-SYNTAX',Rest}; parse_DefinedObjectClass(Tokens) -> throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), [got,get_token(hd(Tokens)),expected, @@ -1051,7 +1051,8 @@ parse_DefinedObjectClass(Tokens) -> parse_ObjectClassAssignment([{typereference,L1,ObjClName},{'::=',_}|Rest]) -> {Type,Rest2} = parse_ObjectClass(Rest), - {#classdef{pos=L1,name=ObjClName,typespec=Type},Rest2}; + {#classdef{pos=L1,name=ObjClName,module=resolve_module(Type), + typespec=Type},Rest2}; parse_ObjectClassAssignment(Tokens) -> throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), [got,get_token(hd(Tokens)),expected, @@ -2134,8 +2135,7 @@ parse_ParameterizedObjectSetAssignment(Tokens) -> %% Parameter = {Governor,Reference} | Reference %% Governor = Type | DefinedObjectClass %% Type = #type{} -%% DefinedObjectClass = #'Externaltypereference'{} | -%% 'ABSTRACT-SYNTAX' | 'TYPE-IDENTIFIER' +%% DefinedObjectClass = #'Externaltypereference'{} %% Reference = #'Externaltypereference'{} | #'Externalvaluereference'{} parse_ParameterList([{'{',_}|Rest]) -> parse_ParameterList(Rest,[]); @@ -2863,13 +2863,14 @@ parse_SequenceValue(Tokens) -> throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), [got,get_token(hd(Tokens)),expected,'{']}}). -parse_SequenceValue([{identifier,_,IdName}|Rest],Acc) -> +parse_SequenceValue([{identifier,Pos,IdName}|Rest],Acc) -> {Value,Rest2} = parse_Value(Rest), + SeqTag = #seqtag{pos=Pos,module=get(asn1_module),val=IdName}, case Rest2 of [{',',_}|Rest3] -> - parse_SequenceValue(Rest3,[{IdName,Value}|Acc]); + parse_SequenceValue(Rest3, [{SeqTag,Value}|Acc]); [{'}',_}|Rest3] -> - {lists:reverse([{IdName,Value}|Acc]),Rest3}; + {lists:reverse(Acc, [{SeqTag,Value}]),Rest3}; _ -> throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), [got,get_token(hd(Rest2)),expected,'}']}}) diff --git a/lib/asn1/src/asn1ct_tok.erl b/lib/asn1/src/asn1ct_tok.erl index 33f4379173..8687ed955c 100644 --- a/lib/asn1/src/asn1ct_tok.erl +++ b/lib/asn1/src/asn1ct_tok.erl @@ -309,7 +309,6 @@ check_hex(_) -> %% returns rstrtype if A is a reserved word in the group %% RestrictedCharacterStringType reserved_word('ABSENT') -> true; -%reserved_word('ABSTRACT-SYNTAX') -> true; % impl as predef item reserved_word('ALL') -> true; reserved_word('ANY') -> true; reserved_word('APPLICATION') -> true; @@ -380,7 +379,6 @@ reserved_word('T61String') -> rstrtype; reserved_word('TAGS') -> true; reserved_word('TeletexString') -> rstrtype; reserved_word('TRUE') -> true; -%% reserved_word('TYPE-IDENTIFIER') -> true; % impl as predef item reserved_word('UNION') -> true; reserved_word('UNIQUE') -> true; reserved_word('UNIVERSAL') -> true; diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl index 4bd814769f..c4cd872368 100644 --- a/lib/asn1/src/asn1rtt_ber.erl +++ b/lib/asn1/src/asn1rtt_ber.erl @@ -26,25 +26,24 @@ skip_ExtensionAdditions/2]). -export([encode_boolean/2,decode_boolean/2, encode_integer/2,encode_integer/3, - decode_integer/2,decode_integer/3, - decode_named_integer/3,decode_named_integer/4, - encode_enumerated/2,decode_enumerated/3, + decode_integer/2, + number2name/2, encode_unnamed_bit_string/2,encode_unnamed_bit_string/3, encode_named_bit_string/3,encode_named_bit_string/4, encode_bit_string/4, decode_named_bit_string/3, - decode_compact_bit_string/3, - decode_legacy_bit_string/3, - decode_native_bit_string/3, + decode_compact_bit_string/2,compact_bit_string_size/1, + decode_native_bit_string/2, + native_to_legacy_bit_string/1, 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_octet_string/2,decode_octet_string/3, - decode_restricted_string/2,decode_restricted_string/3, - encode_universal_string/2,decode_universal_string/3, + decode_octet_string/2, + decode_restricted_string/2, + encode_universal_string/2,decode_universal_string/2, encode_UTF8_string/2,decode_UTF8_string/2, - encode_BMP_string/2,decode_BMP_string/3]). + encode_BMP_string/2,decode_BMP_string/2]). -export([encode_open_type/2,decode_open_type/2, decode_open_type_as_binary/2]). @@ -591,8 +590,6 @@ encode_tags(TagIn, {BytesSoFar,LenSoFar}) -> 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)). @@ -697,41 +694,14 @@ encode_integer_neg(N, Acc) -> %%=============================================================================== %% decode integer -%% (Buffer, Range, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} -%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} %%=============================================================================== -decode_named_integer(Tlv, NamedNumberList, TagIn) -> - V = match_tags(Tlv, TagIn), - Int = decode_integer(V), - number2name(Int, NamedNumberList). - -decode_named_integer(Tlv, Range, NamedNumberList, TagIn) -> - V = match_tags(Tlv, TagIn), - Int = range_check_integer(decode_integer(V), Range), - number2name(Int, NamedNumberList). - decode_integer(Tlv, TagIn) -> - V = match_tags(Tlv, TagIn), - decode_integer(V). - -decode_integer(Tlv, Range, TagIn) -> - V = match_tags(Tlv, TagIn), - Int = decode_integer(V), - range_check_integer(Int, Range). - -decode_integer(Bin) -> + Bin = match_tags(Tlv, TagIn), Len = byte_size(Bin), <<Int:Len/signed-unit:8>> = Bin, Int. -range_check_integer(Int, {Lb,Ub}) when Lb =< Int, Int =< Ub -> - Int; -range_check_integer(Int, Range) -> - exit({error,{asn1,{integer_range,Range,Int}}}). - -number2name(Int, []) -> - Int; number2name(Int, NamedNumberList) -> case lists:keyfind(Int, 2, NamedNumberList) of {NamedVal,_} -> @@ -740,49 +710,6 @@ number2name(Int, NamedNumberList) -> 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 %% @@ -794,45 +721,46 @@ encode_unnamed_bit_string(Bits, TagIn) -> Bin = <<Unused,Bits/bitstring,0:Unused>>, encode_tags(TagIn, Bin, byte_size(Bin)). -encode_unnamed_bit_string(C, Bits, TagIn) -> +encode_unnamed_bit_string(MaxBits, Bits, TagIn) -> NumBits = bit_size(Bits), Unused = (8 - (NumBits band 7)) band 7, Bin = <<Unused,Bits/bitstring,0:Unused>>, - case C of - {_Min,Max} -> - if - NumBits > Max -> - exit({error,{asn1, - {bitstring_length, - {{was,NumBits},{maximum,Max}}}}}); - true -> - ok - end; - Size -> - if NumBits =< Size -> - ok; - true -> - exit({error,{asn1, - {bitstring_length, - {{was,NumBits},{should_be,Size}}}}}) - end - end, - encode_tags(TagIn, Bin, byte_size(Bin)). + if + NumBits > MaxBits -> + exit({error,{asn1, + {bitstring_length, + {{was,NumBits},{maximum,MaxBits}}}}}); + true -> + encode_tags(TagIn, Bin, byte_size(Bin)) + end. encode_named_bit_string([H|_]=Bits, NamedBitList, TagIn) when is_atom(H) -> - encode_bit_string_named([], Bits, NamedBitList, TagIn); + do_encode_named_bit_string(Bits, NamedBitList, TagIn); encode_named_bit_string([{bit,_}|_]=Bits, NamedBitList, TagIn) -> - encode_bit_string_named([], Bits, NamedBitList, TagIn); + do_encode_named_bit_string(Bits, NamedBitList, TagIn); encode_named_bit_string(Bits, _NamedBitList, TagIn) when is_bitstring(Bits) -> encode_unnamed_bit_string(Bits, TagIn). encode_named_bit_string(C, [H|_]=Bits, NamedBitList, TagIn) when is_atom(H) -> - encode_bit_string_named(C, Bits, NamedBitList, TagIn); + do_encode_named_bit_string(C, Bits, NamedBitList, TagIn); encode_named_bit_string(C, [{bit,_}|_]=Bits, NamedBitList, TagIn) -> - encode_bit_string_named(C, Bits, NamedBitList, TagIn); + do_encode_named_bit_string(C, Bits, NamedBitList, TagIn); encode_named_bit_string(C, Bits, _NamedBitList, TagIn) when is_bitstring(Bits) -> encode_unnamed_bit_string(C, Bits, TagIn). +do_encode_named_bit_string([FirstVal | RestVal], NamedBitList, TagIn) -> + ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []), + Size = lists:max(ToSetPos) + 1, + BitList = make_and_set_list(Size, ToSetPos, 0), + {Len,Unused,OctetList} = encode_bitstring(BitList), + encode_tags(TagIn, [Unused|OctetList],Len+1). + +do_encode_named_bit_string(Size, [FirstVal | RestVal], NamedBitList, TagIn) -> + ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []), + BitList = make_and_set_list(Size, ToSetPos, 0), + {Len, Unused, OctetList} = encode_bitstring(BitList), + encode_tags(TagIn, [Unused|OctetList], Len+1). + %%============================================================================ %% Bitstring value, ITU_T X.690 Chapter 8.6 %% @@ -932,15 +860,14 @@ remove_unused_then_dotag(TagIn,Unused,BinBits) -> encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn) -> ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []), - Size = - case C of - [] -> - lists:max(ToSetPos)+1; - {_Min,Max} -> - Max; - TSize -> - TSize - end, + Size = case C of + [] -> + 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). @@ -1098,33 +1025,23 @@ unused_bitlist([Bit | Rest], Trail, Ack) -> %% decode bitstring value %%============================================================================ -decode_compact_bit_string(Buffer, Range, Tags) -> +decode_compact_bit_string(Buffer, Tags) -> case match_and_collect(Buffer, Tags) of - <<0>> -> - check_restricted_string({0,<<>>}, 0, Range); - <<Unused,Bits/binary>> -> - Val = {Unused,Bits}, - Len = bit_size(Bits) - Unused, - check_restricted_string(Val, Len, Range) + <<0>> -> {0,<<>>}; + <<Unused,Bits/binary>> -> {Unused,Bits} end. -decode_legacy_bit_string(Buffer, Range, Tags) -> - Val = case match_and_collect(Buffer, Tags) of - <<0>> -> - []; - <<Unused,Bits/binary>> -> - decode_bitstring2(byte_size(Bits), Unused, Bits) - end, - check_restricted_string(Val, length(Val), Range). +compact_bit_string_size({Unused,Bits}) -> + bit_size(Bits) - Unused. -decode_native_bit_string(Buffer, Range, Tags) -> +decode_native_bit_string(Buffer, Tags) -> case match_and_collect(Buffer, Tags) of <<0>> -> - check_restricted_string(<<>>, 0, Range); + <<>>; <<Unused,Bits/binary>> -> Size = bit_size(Bits) - Unused, <<Val:Size/bitstring,_:Unused/bitstring>> = Bits, - check_restricted_string(Val, Size, Range) + Val end. decode_named_bit_string(Buffer, NamedNumberList, Tags) -> @@ -1147,6 +1064,9 @@ decode_bitstring2(Len, Unused, [B7,B6,B5,B4,B3,B2,B1,B0| decode_bitstring2(Len - 1, Unused, Buffer)]. +native_to_legacy_bit_string(Bits) -> + [B || <<B:1>> <= Bits]. + %%---------------------------------------- %% Decode the bitlist to names %%---------------------------------------- @@ -1310,31 +1230,12 @@ decode_octet_string(Tlv, TagsIn) -> Bin = match_and_collect(Tlv, TagsIn), binary:copy(Bin). -decode_octet_string(Tlv, Range, TagsIn) -> - Bin0 = match_and_collect(Tlv, TagsIn), - Bin = binary:copy(Bin0), - check_restricted_string(Bin, byte_size(Bin), Range). - %%============================================================================ %% decode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings %%============================================================================ decode_restricted_string(Tlv, TagsIn) -> - Bin = match_and_collect(Tlv, TagsIn), - binary_to_list(Bin). - -decode_restricted_string(Tlv, Range, TagsIn) -> - Bin = match_and_collect(Tlv, TagsIn), - check_restricted_string(binary_to_list(Bin), byte_size(Bin), Range). - -check_restricted_string(Val, _Len, []) -> - Val; -check_restricted_string(Val, Len, {Lb,Ub}) when Lb =< Len, Len =< Ub -> - Val; -check_restricted_string(Val, Len, Len) -> - Val; -check_restricted_string(Val, _Len, Range) -> - exit({error,{asn1,{length,Range,Val}}}). + match_and_collect(Tlv, TagsIn). %%============================================================================ %% encode Universal string @@ -1360,10 +1261,9 @@ mk_uni_list([H|T],List) -> %% {String, Remain, RemovedBytes} %%=========================================================================== -decode_universal_string(Buffer, Range, Tags) -> +decode_universal_string(Buffer, Tags) -> Bin = match_and_collect(Buffer, Tags), - Val = mk_universal_string(binary_to_list(Bin)), - check_restricted_string(Val, length(Val), Range). + mk_universal_string(binary_to_list(Bin)). mk_universal_string(In) -> mk_universal_string(In, []). @@ -1423,10 +1323,9 @@ mk_BMP_list([H|T], List) -> %% (Buffer, Range, StringType, HasTag, TotalLen) -> %% {String, Remain, RemovedBytes} %%============================================================================ -decode_BMP_string(Buffer, Range, Tags) -> +decode_BMP_string(Buffer, Tags) -> Bin = match_and_collect(Buffer, Tags), - Val = mk_BMP_string(binary_to_list(Bin)), - check_restricted_string(Val, length(Val), Range). + mk_BMP_string(binary_to_list(Bin)). mk_BMP_string(In) -> mk_BMP_string(In,[]). diff --git a/lib/asn1/src/asn1rtt_check.erl b/lib/asn1/src/asn1rtt_check.erl index be4f9c8bff..0083867a10 100644 --- a/lib/asn1/src/asn1rtt_check.erl +++ b/lib/asn1/src/asn1rtt_check.erl @@ -18,43 +18,41 @@ %% -module(asn1rtt_check). --export([check_bool/2, +-export([check_fail/1, check_int/3, - check_bitstring/2,check_named_bitstring/3, + check_legacy_bitstring/2, + check_legacy_named_bitstring/3, + check_legacy_named_bitstring/4, + check_named_bitstring/3, + check_named_bitstring/4, + check_literal_sof/2, check_octetstring/2, - check_null/2, check_objectidentifier/2, check_objectdescriptor/2, check_real/2, - check_enum/3, check_restrictedstring/2]). -check_bool(_Bool, asn1_DEFAULT) -> - true; -check_bool(Bool, Bool) when is_boolean(Bool) -> - true; -check_bool(_Bool1, Bool2) -> - throw({error,Bool2}). +check_fail(_) -> + throw(false). -check_int(_, asn1_DEFAULT, _) -> - true; check_int(Value, Value, _) when is_integer(Value) -> true; -check_int(DefValue, Value, NNL) when is_atom(Value) -> +check_int(Value, DefValue, NNL) when is_atom(Value) -> case lists:keyfind(Value, 1, NNL) of {_,DefValue} -> true; _ -> - throw({error,DefValue}) + throw(false) end; -check_int(DefaultValue, _Value, _) -> - throw({error,DefaultValue}). +check_int(_, _, _) -> + throw(false). + +check_legacy_bitstring(Value, Default) -> + check_bitstring(Default, Value). %% check_bitstring(Default, UserBitstring) -> true|false %% Default = bitstring() %% UserBitstring = integeger() | list(0|1) | {Unused,binary()} | bitstring() -check_bitstring(_, asn1_DEFAULT) -> - true; check_bitstring(DefVal, {Unused,Binary}) -> %% User value in compact format. Sz = bit_size(Binary) - Unused, @@ -62,7 +60,7 @@ check_bitstring(DefVal, {Unused,Binary}) -> check_bitstring(DefVal, Val); check_bitstring(DefVal, Val) when is_bitstring(Val) -> case Val =:= DefVal of - false -> throw(error); + false -> throw(false); true -> true end; check_bitstring(Def, Val) when is_list(Val) -> @@ -75,178 +73,95 @@ check_bitstring_list(<<H:1,T1/bitstring>>, [H|T2]) -> check_bitstring_list(<<>>, []) -> true; check_bitstring_list(_, _) -> - throw(error). + throw(false). check_bitstring_integer(<<H:1,T1/bitstring>>, Int) when H =:= Int band 1 -> check_bitstring_integer(T1, Int bsr 1); check_bitstring_integer(<<>>, 0) -> true; check_bitstring_integer(_, _) -> - throw(error). - -check_named_bitstring(_, asn1_DEFAULT, _) -> - true; -check_named_bitstring(V, V, _) -> - true; -%% Default value and user value as lists of ones and zeros -check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL=[_H|_T]) when is_integer(H1), is_integer(H2) -> - L2new = remove_trailing_zeros(L2), - check_named_bitstring(L1, L2new, NBL); -%% Default value as a list of 1 and 0 and user value as a list of atoms -check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_integer(H1), is_atom(H2) -> - L3 = bit_list_to_nbl(L1, NBL, 0, []), - check_named_bitstring(L3, L2, NBL); -%% Both default value and user value as a list of atoms -check_named_bitstring(L1=[H1|T1], L2=[H2|_T2], _) - when is_atom(H1), is_atom(H2), length(L1) =:= length(L2) -> - case lists:member(H1, L2) of - true -> - check_bitstring1(T1, L2); - false -> throw({error,L2}) - end; -%% Default value as a list of atoms and user value as a list of 1 and 0 -check_named_bitstring(L1=[H1|_T1], L2=[H2|_T2], NBL) when is_atom(H1), is_integer(H2) -> - L3 = bit_list_to_nbl(L2, NBL, 0, []), - check_named_bitstring(L1, L3, NBL); -%% User value in compact format -check_named_bitstring(DefVal,CBS={_,_}, NBL) -> - NewVal = cbs_to_bit_list(CBS), - check_named_bitstring(DefVal, NewVal, NBL); -%% User value as a binary -check_named_bitstring(DefVal, CBS, NBL) when is_binary(CBS) -> - NewVal = cbs_to_bit_list({0,CBS}), - check_named_bitstring(DefVal, NewVal, NBL); -%% User value as a bitstring -check_named_bitstring(DefVal, CBS, NBL) when is_bitstring(CBS) -> - BitSize = bit_size(CBS), - Unused = 8 - (BitSize band 7), - NewVal = cbs_to_bit_list({Unused,<<CBS:BitSize/bits,0:Unused>>}), - check_named_bitstring(DefVal, NewVal, NBL); -check_named_bitstring(DV, V, _) -> - throw({error,DV,V}). - -int_to_bit_list(0, Acc, 0) -> - Acc; -int_to_bit_list(Int, Acc, Len) when Len > 0 -> - int_to_bit_list(Int bsr 1, [Int band 1|Acc], Len - 1). - -bit_list_to_nbl([0|T], NBL, Pos, Acc) -> - bit_list_to_nbl(T, NBL, Pos+1, Acc); -bit_list_to_nbl([1|T], NBL, Pos, Acc) -> - case lists:keyfind(Pos, 2, NBL) of - {N,_} -> - bit_list_to_nbl(T, NBL, Pos+1, [N|Acc]); + throw(false). + +check_legacy_named_bitstring([Int|_]=Val, Bs, BsSize) when is_integer(Int) -> + check_named_bitstring(<< <<B:1>> || B <- Val >>, Bs, BsSize); +check_legacy_named_bitstring({Unused,Val0}, Bs, BsSize) -> + Sz = bit_size(Val0) - Unused, + <<Val:Sz/bits,_/bits>> = Val0, + check_named_bitstring(Val, Bs, BsSize); +check_legacy_named_bitstring(Val, Bs, BsSize) when is_integer(Val) -> + L = legacy_int_to_bitlist(Val), + check_named_bitstring(<< <<B:1>> || B <- L >>, Bs, BsSize); +check_legacy_named_bitstring(Val, Bs, BsSize) -> + check_named_bitstring(Val, Bs, BsSize). + +check_legacy_named_bitstring([Int|_]=Val, Names, Bs, BsSize) when is_integer(Int) -> + check_named_bitstring(<< <<B:1>> || B <- Val >>, Names, Bs, BsSize); +check_legacy_named_bitstring({Unused,Val0}, Names, Bs, BsSize) -> + Sz = bit_size(Val0) - Unused, + <<Val:Sz/bits,_/bits>> = Val0, + check_named_bitstring(Val, Names, Bs, BsSize); +check_legacy_named_bitstring(Val, Names, Bs, BsSize) when is_integer(Val) -> + L = legacy_int_to_bitlist(Val), + check_named_bitstring(<< <<B:1>> || B <- L >>, Names, Bs, BsSize); +check_legacy_named_bitstring(Val, Names, Bs, BsSize) -> + check_named_bitstring(Val, Names, Bs, BsSize). + +legacy_int_to_bitlist(0) -> + []; +legacy_int_to_bitlist(Int) -> + [Int band 1|legacy_int_to_bitlist(Int bsr 1)]. + +check_named_bitstring(Bs, Bs, _) -> + true; +check_named_bitstring(Val, Bs, BsSize) -> + Rest = bit_size(Val) - BsSize, + case Val of + <<Bs:BsSize/bits,0:Rest>> -> + true; _ -> - throw({error,{no,named,element,at,pos,Pos}}) - end; -bit_list_to_nbl([], _, _, Acc) -> - Acc. - -remove_trailing_zeros(L2) -> - remove_trailing_zeros1(lists:reverse(L2)). -remove_trailing_zeros1(L) -> - lists:reverse(lists:dropwhile(fun(0)->true; - (_) ->false - end, - L)). - -check_bitstring1([H|T], NBL) -> - case lists:member(H, NBL) of - true -> check_bitstring1(T, NBL); - V -> throw({error,V}) - end; -check_bitstring1([], _) -> - true. - -cbs_to_bit_list({Unused, <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,Rest/binary>>}) when byte_size(Rest) >= 1 -> - [B7,B6,B5,B4,B3,B2,B1,B0|cbs_to_bit_list({Unused,Rest})]; -cbs_to_bit_list({0,<<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1>>}) -> - [B7,B6,B5,B4,B3,B2,B1,B0]; -cbs_to_bit_list({Unused,Bin}) when byte_size(Bin) =:= 1 -> - Used = 8-Unused, - <<Int:Used,_:Unused>> = Bin, - int_to_bit_list(Int, [], Used). - + throw(false) + end. -check_octetstring(_, asn1_DEFAULT) -> - true; -check_octetstring(L, L) -> - true; -check_octetstring(L, Int) when is_list(L), is_integer(Int) -> - case integer_to_octetlist(Int) of - L -> true; - V -> throw({error,V}) +check_named_bitstring([_|_]=Val, Names, _, _) -> + case lists:sort(Val) of + Names -> true; + _ -> throw(false) end; -check_octetstring(_, V) -> - throw({error,V}). - -integer_to_octetlist(Int) -> - integer_to_octetlist(Int, []). -integer_to_octetlist(0, Acc) -> - Acc; -integer_to_octetlist(Int, Acc) -> - integer_to_octetlist(Int bsr 8, [(Int band 255)|Acc]). - -check_null(_, asn1_DEFAULT) -> +check_named_bitstring(Bs, _, Bs, _) -> true; -check_null('NULL', 'NULL') -> - true; -check_null(_, V) -> - throw({error,V}). +check_named_bitstring(Val, _, Bs, BsSize) -> + Rest = bit_size(Val) - BsSize, + case Val of + <<Bs:BsSize/bits,0:Rest>> -> + true; + _ -> + throw(false) + end. -check_objectidentifier(_, asn1_DEFAULT) -> - true; -check_objectidentifier(OI, OI) -> +check_octetstring(V, V) -> true; -check_objectidentifier(DOI, OI) when is_tuple(DOI), is_tuple(OI) -> - check_objectidentifier1(tuple_to_list(DOI), tuple_to_list(OI)); -check_objectidentifier(_, OI) -> - throw({error,OI}). - -check_objectidentifier1([V|Rest1], [V|Rest2]) -> - check_objectidentifier1(Rest1, Rest2, V); -check_objectidentifier1([V1|Rest1], [V2|Rest2]) -> - case reserved_objectid(V2, []) of - V1 -> - check_objectidentifier1(Rest1, Rest2, [V1]); - V -> - throw({error,V}) - end. -check_objectidentifier1([V|Rest1], [V|Rest2], Above) -> - check_objectidentifier1(Rest1, Rest2, [V|Above]); -check_objectidentifier1([V1|Rest1], [V2|Rest2], Above) -> - case reserved_objectid(V2, Above) of - V1 -> - check_objectidentifier1(Rest1, Rest2, [V1|Above]); - V -> - throw({error,V}) +check_octetstring(V, Def) when is_list(V) -> + case list_to_binary(V) of + Def -> true; + _ -> throw(false) + end; +check_octetstring(_, _) -> + throw(false). + +check_objectidentifier(Value, {Prefix,Tail}) when is_tuple(Value) -> + check_oid(tuple_to_list(Value), Prefix, Tail); +check_objectidentifier(_, _) -> + throw(false). + +check_oid([H|T], [K|Ks], Tail) -> + case lists:member(H, K) of + false -> throw(false); + true -> check_oid(T, Ks, Tail) end; -check_objectidentifier1([], [], _) -> +check_oid(Tail, [], Tail) -> true; -check_objectidentifier1(_, V, _) -> - throw({error,object,identifier,V}). - -%% ITU-T Rec. X.680 Annex B - D -reserved_objectid('itu-t', []) -> 0; -reserved_objectid('ccitt', []) -> 0; -%% arcs below "itu-t" -reserved_objectid('recommendation', [0]) -> 0; -reserved_objectid('question', [0]) -> 1; -reserved_objectid('administration', [0]) -> 2; -reserved_objectid('network-operator', [0]) -> 3; -reserved_objectid('identified-organization', [0]) -> 4; - -reserved_objectid(iso, []) -> 1; -%% arcs below "iso", note that number 1 is not used -reserved_objectid('standard', [1]) -> 0; -reserved_objectid('member-body', [1]) -> 2; -reserved_objectid('identified-organization', [1]) -> 3; - -reserved_objectid('joint-iso-itu-t', []) -> 2; -reserved_objectid('joint-iso-ccitt', []) -> 2; - -reserved_objectid(_, _) -> false. - +check_oid(_, _, _) -> + throw(false). check_objectdescriptor(_, asn1_DEFAULT) -> true; @@ -262,21 +177,6 @@ check_real(R, R) -> check_real(_, _) -> throw({error,{not_implemented_yet,check_real}}). -check_enum(_, asn1_DEFAULT, _) -> - true; -check_enum(Val, Val, _) -> - true; -check_enum(Int, Atom, Enumerations) when is_integer(Int), is_atom(Atom) -> - case lists:keyfind(Atom, 1, Enumerations) of - {_,Int} -> true; - _ -> throw({error,{enumerated,Int,Atom}}) - end; -check_enum(DefVal, Val, _) -> - throw({error,{enumerated,DefVal,Val}}). - - -check_restrictedstring(_, asn1_DEFAULT) -> - true; check_restrictedstring(Val, Val) -> true; check_restrictedstring([V|Rest1], [V|Rest2]) -> @@ -295,7 +195,15 @@ check_restrictedstring({V1,V2,V3,V4}, [V1,V2,V3,V4]) -> check_restrictedstring([V1,V2,V3,V4], {V1,V2,V3,V4}) -> true; %% character string list -check_restrictedstring(V1, V2) when is_list(V1), is_tuple(V2) -> - check_restrictedstring(V1, tuple_to_list(V2)); -check_restrictedstring(V1, V2) -> - throw({error,{restricted,string,V1,V2}}). +check_restrictedstring(V1, V2) when is_tuple(V1) -> + check_restrictedstring(tuple_to_list(V1), V2); +check_restrictedstring(_, _) -> + throw(false). + +check_literal_sof(Value, Default) -> + case lists:sort(Value) of + Default -> + true; + _ -> + throw(false) + end. diff --git a/lib/asn1/src/asn1rtt_per_common.erl b/lib/asn1/src/asn1rtt_per_common.erl index 71fec411a0..0290c75a28 100644 --- a/lib/asn1/src/asn1rtt_per_common.erl +++ b/lib/asn1/src/asn1rtt_per_common.erl @@ -30,6 +30,7 @@ decode_big_chars/2, decode_oid/1,decode_relative_oid/1, encode_chars/2,encode_chars/3, + encode_chars_compact_map/3, encode_chars_16bit/1,encode_big_chars/1, encode_fragmented/2, encode_oid/1,encode_relative_oid/1, @@ -108,6 +109,9 @@ encode_chars(Val, NumBits) -> encode_chars(Val, NumBits, {Lb,Tab}) -> << <<(enc_char(C, Lb, Tab)):NumBits>> || C <- Val >>. +encode_chars_compact_map(Val, NumBits, {Lb,Limit}) -> + << <<(enc_char_cm(C, Lb, Limit)):NumBits>> || C <- Val >>. + encode_chars_16bit(Val) -> L = [case C of {0,0,A,B} -> [A,B]; @@ -383,6 +387,15 @@ enc_char(C0, Lb, Tab) -> illegal_char_error() end. +enc_char_cm(C0, Lb, Limit) -> + C = C0 - Lb, + if + 0 =< C, C < Limit -> + C; + true -> + illegal_char_error() + end. + illegal_char_error() -> error({error,{asn1,"value forbidden by FROM constraint"}}). |