asn1ct_gen.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 1,973 行 · 第 1/4 页

%% ``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 via the world wide web at http://www.erlang.org/.
%% 
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%% 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id$
%%
-module(asn1ct_gen).

-include("asn1_records.hrl").
%%-compile(export_all).
-export([pgen_exports/3,
	 pgen_hrl/4,
	 gen_head/3,
	 demit/1,
	 emit/1,
	 fopen/2,
	 get_inner/1,type/1,def_to_tag/1,prim_bif/1,
	 type_from_object/1,
	 get_typefromobject/1,get_fieldcategory/2,
	 get_classfieldcategory/2,
	 list2name/1,
	 list2rname/1,
	 constructed_suffix/2,
	 unify_if_string/1,
	 gen_check_call/7,
	 get_constraint/2,
	 insert_once/2,
	 rt2ct_suffix/1,rt2ct_suffix/0,index2suffix/1]).
-export([pgen/4,pgen_module/5,mk_var/1, un_hyphen_var/1]).
-export([gen_encode_constructed/4,gen_decode_constructed/4]).

%% pgen(Erules, Module, TypeOrVal)
%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module
%% .hrl file is only generated if necessary
%% Erules = per | ber | ber_bin | per_bin
%% Module = atom()
%% TypeOrVal = {TypeList,ValueList}
%% TypeList = ValueList = [atom()]

pgen(OutFile,Erules,Module,TypeOrVal) ->
    pgen_module(OutFile,Erules,Module,TypeOrVal,true).


pgen_module(OutFile,Erules,Module,TypeOrVal,Indent) ->
    put(outfile,OutFile),
    HrlGenerated = asn1ct_gen:pgen_hrl(Erules,Module,TypeOrVal,Indent),
    asn1ct_name:start(),
    ErlFile = lists:concat([OutFile,".erl"]),
    Fid = asn1ct_gen:fopen(ErlFile,write),
    put(gen_file_out,Fid),
    asn1ct_gen:gen_head(Erules,Module,HrlGenerated),
    pgen_exports(Erules,Module,TypeOrVal),
    pgen_dispatcher(Erules,Module,TypeOrVal),
    pgen_info(),
    pgen_typeorval(wrap_ber(Erules),Module,TypeOrVal),
    pgen_partial_incomplete_decode(Erules),
% gen_vars(asn1_db:mod_to_vars(Module)),
% gen_tag_table(AllTypes),
    file:close(Fid),
    io:format("--~p--~n",[{generated,ErlFile}]).


pgen_typeorval(Erules,Module,{Types,Values,_Ptypes,_Classes,Objects,ObjectSets}) ->
    pgen_types(Erules,Module,Types),
    pgen_values(Erules,Module,Values),
    pgen_objects(Erules,Module,Objects),
    pgen_objectsets(Erules,Module,ObjectSets),
    case catch lists:member(der,get(encoding_options)) of
	true ->
	    pgen_check_defaultval(Erules,Module);
	_ -> ok
    end,
    pgen_partial_decode(Erules,Module).

pgen_values(_,_,[]) ->
    true;
pgen_values(Erules,Module,[H|T]) ->
    Valuedef = asn1_db:dbget(Module,H),
    gen_value(Valuedef),
    pgen_values(Erules,Module,T).

pgen_types(_,Module,[]) ->
    gen_value_match(Module),
    true;
pgen_types(Erules,Module,[H|T]) ->
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
				       rt2ct_suffix(Erules)])),
    asn1ct_name:clear(),
    Typedef = asn1_db:dbget(Module,H),
    Rtmod:gen_encode(Erules,Typedef),
    asn1ct_name:clear(),
    Rtmod:gen_decode(Erules,Typedef),
    pgen_types(Erules,Module,T).

pgen_objects(_,_,[]) ->
    true;
pgen_objects(Erules,Module,[H|T]) ->
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
				       rt2ct_suffix(Erules)])),
    asn1ct_name:clear(),
    Typedef = asn1_db:dbget(Module,H),
    Rtmod:gen_obj_code(Erules,Module,Typedef),
    pgen_objects(Erules,Module,T).

pgen_objectsets(_,_,[]) ->
    true;
pgen_objectsets(Erules,Module,[H|T]) ->
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
				       rt2ct_suffix(Erules)])),
    asn1ct_name:clear(),
    TypeDef = asn1_db:dbget(Module,H),
    Rtmod:gen_objectset_code(Erules,TypeDef),
    pgen_objectsets(Erules,Module,T).

pgen_check_defaultval(Erules,Module) ->
    CheckObjects = ets:tab2list(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),
	    file:close(IoDevice);
	_ -> ok
    end,
    gen_check_defaultval(Erules,Module,CheckObjects).

pgen_partial_decode(Erule,Module) when Erule == ber_bin_v2 ->
    pgen_partial_inc_dec(Erule,Module),
    pgen_partial_dec(Erule,Module);
pgen_partial_decode(_,_) ->
    ok.

pgen_partial_inc_dec(Erules,Module) ->
%    io:format("Start partial incomplete decode gen?~n"),
    case asn1ct:get_gen_state_field(inc_type_pattern) of
	undefined ->
%	    io:format("Partial incomplete decode gen not started:爚w~n",[asn1ct:get_gen_state_field(active)]),
	    ok;
%	[] ->
%	    ok;
	ConfList -> 
	    PatternLists=lists:map(fun({_,P}) -> P end,ConfList),
	    pgen_partial_inc_dec1(Erules,Module,PatternLists),
	    gen_partial_inc_dec_refed_funcs(Erules)
    end.
    
%% pgen_partial_inc_dec1 generates a function of the toptype in each
%% of the partial incomplete decoded types.
pgen_partial_inc_dec1(Erules,Module,[P|Ps]) ->
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
				       rt2ct_suffix(Erules)])),
    TopTypeName = asn1ct:partial_inc_dec_toptype(P),
    TypeDef=asn1_db:dbget(Module,TopTypeName),
    asn1ct_name:clear(),
    asn1ct:update_gen_state(namelist,P),
    asn1ct:update_gen_state(active,true),
    asn1ct:update_gen_state(prefix,"dec-inc-"),
    case asn1ct:maybe_saved_sindex(TopTypeName,P) of
	I when integer(I),I > 0 ->
%	    io:format("Index:~p~n",[I]),
	    asn1ct:set_current_sindex(I);
	_I ->
	    asn1ct:set_current_sindex(0),
%	    io:format("Index=~p~n",[_I]),
	    ok
    end,
    Rtmod:gen_decode(Erules,TypeDef),
    gen_dec_part_inner_constr(Erules,TypeDef,[TopTypeName]),
    pgen_partial_inc_dec1(Erules,Module,Ps);
pgen_partial_inc_dec1(_,_,[]) ->
    ok.

gen_partial_inc_dec_refed_funcs(Erule) when Erule == ber_bin_v2 ->
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erule),
				       rt2ct_suffix(Erule)])),
    case asn1ct:next_refed_func() of
	[] ->
	    ok;
	{#'Externaltypereference'{module=M,type=Name},Sindex,Pattern} ->
	    TypeDef = asn1_db:dbget(M,Name),
	    asn1ct:update_gen_state(namelist,Pattern),
	    asn1ct:set_current_sindex(Sindex),
	    Rtmod:gen_inc_decode(Erule,TypeDef),
	    gen_dec_part_inner_constr(Erule,TypeDef,[Name]),
	    gen_partial_inc_dec_refed_funcs(Erule);
	{Name,Sindex,Pattern,Type} ->
	    TypeDef=#typedef{name=asn1ct_gen:list2name(Name),typespec=Type},
	    asn1ct:update_gen_state(namelist,Pattern),
	    asn1ct:set_current_sindex(Sindex),
	    Rtmod:gen_inc_decode(Erule,TypeDef),
	    gen_dec_part_inner_constr(Erule,TypeDef,Name),
	    gen_partial_inc_dec_refed_funcs(Erule)
    end;
gen_partial_inc_dec_refed_funcs(_) ->
    ok.

pgen_partial_dec(Erules,_Module) ->
    Type_pattern = asn1ct:get_gen_state_field(type_pattern),
%    io:format("Type_pattern: ~w~n",[Type_pattern]),
    %% Get the typedef of the top type and follow into the choosen components until the last type/component.
    pgen_partial_types(Erules,Type_pattern),
    ok.

pgen_partial_types(Erules,Type_pattern)  ->
    % until this functionality works on all back-ends
    Options = get(encoding_options),
    case lists:member(asn1config,Options) of
	true ->
	    pgen_partial_types1(Erules,Type_pattern);
	_ -> ok
    end.

    
pgen_partial_types1(Erules,[{FuncName,[TopType|RestTypes]}|Rest]) ->
%    emit([FuncName,"(Bytes) ->",nl]),
    CurrMod = get(currmod),
    TypeDef = asn1_db:dbget(CurrMod,TopType),
    traverse_type_structure(Erules,TypeDef,RestTypes,FuncName,
			    TypeDef#typedef.name),
    pgen_partial_types1(Erules,Rest);
pgen_partial_types1(_,[]) ->
    ok;
pgen_partial_types1(_,undefined) ->
    ok.

%% traverse_type_structure searches the structure of TypeDef for next
%% type/component in TypeList until the last one. For the last type in
%% TypeList a decode function will be generated.
traverse_type_structure(Erules,Type,[],FuncName,TopTypeName) ->
    %% this is the selected type
    Ctmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
					       rt2ct_suffix(Erules)])),
    TypeDef =
	case Type of
	    #type{} ->
		#typedef{name=TopTypeName,typespec=Type};
	    #typedef{} -> Type
	end,
    Ctmod:gen_decode_selected(Erules,TypeDef,FuncName); % kolla vad g鰎a om Type 鋜 #type{}
traverse_type_structure(Erules,#type{def=Def},[[N]],FuncName,TopTypeName) 
  when integer(N) -> % this case a decode of one of the elements in
                      % the SEQUENCE OF is required.
    InnerType = asn1ct_gen:get_inner(Def),
    case InnerType of
	'SEQUENCE OF' ->
	    {_,Type} = Def,
	    traverse_type_structure(Erules,Type,[],FuncName,TopTypeName);
	WrongType ->
	    exit({error,{configuration_file_error,[N],"only for SEQUENCE OF components",WrongType}})
    end;
traverse_type_structure(Erules,Type,[[N]|Ts],FuncName,TopTypeName) 
  when integer(N)  ->
    traverse_type_structure(Erules,Type,Ts,FuncName,TopTypeName);
traverse_type_structure(Erules,#type{def=Def},[T|Ts],FuncName,TopTypeName)  ->
    InnerType = asn1ct_gen:get_inner(Def),
    case InnerType of
	'SET' ->
	    #'SET'{components=Components} = Def,
	    C = get_component(T,Components),
	    traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts,
				    FuncName,[T|TopTypeName]);
	'SEQUENCE' ->
	    #'SEQUENCE'{components=Components} = Def,
	    C = get_component(T,Components),
	    traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts,
				    FuncName,[T|TopTypeName]);
	'CHOICE' ->
	    {_,Components} = Def,
	    C = get_component(T,Components),
	    traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts,
				    FuncName,[T|TopTypeName]);
	'SEQUENCE OF' ->
	    {_,Type} = Def,
	    traverse_SO_type_structure(Erules,Type,[T|Ts],FuncName,
				       TopTypeName);
	'SET OF' ->
	    {_,Type} = Def,
	    traverse_SO_type_structure(Erules,Type,[T|Ts],FuncName,
				       TopTypeName);
	#'Externaltypereference'{module=M,type=TName} ->
	    TypeDef = asn1_db:dbget(M,TName),
	    traverse_type_structure(Erules,TypeDef,[T|Ts],FuncName,
				    [TypeDef#typedef.name]);
	_ ->
	    traverse_type_structure(Erules,Def,Ts,FuncName,[T|TopTypeName])
    end;
traverse_type_structure(Erules,#typedef{typespec=Def},[T|Ts],FuncName,
			TopTypeName)  ->
    InnerType = asn1ct_gen:get_inner(Def#type.def),
    case InnerType of
	'SET' ->
	    #'SET'{components=Components} = Def#type.def,
	    C = get_component(T,Components),
	    traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts,
				    FuncName,[T|TopTypeName]);
	'SEQUENCE' ->
	    #'SEQUENCE'{components=Components} = Def#type.def,
	    C = get_component(T,Components),
	    traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts,
				    FuncName,[T|TopTypeName]);
	'CHOICE' ->
	    {_,Components} = Def#type.def,
	    C = get_component(T,Components),
	    traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts,
				    FuncName,[T|TopTypeName]);
	'SEQUENCE OF' ->
	    {_,Type} = Def#type.def,
	    traverse_SO_type_structure(Erules,Type,[T|Ts],FuncName,
				       TopTypeName);
	'SET OF' ->
	    {_,Type} = Def#type.def,
	    traverse_SO_type_structure(Erules,Type,[T|Ts],FuncName,
				       TopTypeName);
	#'Externaltypereference'{module=M,type=TName} ->
	    TypeDef = asn1_db:dbget(M,TName),
	    traverse_type_structure(Erules,TypeDef,[T|Ts],FuncName,
				    [TypeDef#typedef.name]);
	_ -> %this may be a referenced type that shall be traversed or
             %the selected type
	    traverse_type_structure(Erules,Def,Ts,FuncName,[T|TopTypeName])
    end.
	    
traverse_SO_type_structure(Erules,Type,[N|Rest],FuncName,TopTypeName)
  when integer(N) ->
    traverse_type_structure(Erules,Type,Rest,FuncName,TopTypeName);
traverse_SO_type_structure(Erules,Type,TypeList,FuncName,TopTypeName) ->
    traverse_type_structure(Erules,Type,TypeList,FuncName,TopTypeName).

get_component(Name,{C1,C2}) when list(C1),list(C2) ->
    get_component(Name,C1++C2);
get_component(Name,[C=#'ComponentType'{name=Name}|_Cs]) ->
    C;
get_component(Name,[_C|Cs]) ->
    get_component(Name,Cs);
get_component(Name,_) ->
    throw({error,{asn1,{internal_error,Name}}}).

%% generate code for all inner types that are called from the top type
%% of the partial incomplete decode and are defined within the top
%% type.Constructed subtypes deeper in the structure will be generated
%% in turn after all top types have been generated.
gen_dec_part_inner_constr(Erules,TypeDef,TypeName) ->
    Def = TypeDef#typedef.typespec,
    InnerType = asn1ct_gen:get_inner(Def#type.def),
    case InnerType of
	'SET' ->
	    #'SET'{components=Components} = Def#type.def,
	    gen_dec_part_inner_types(Erules,Components,TypeName);
	%%  Continue generate the inner of each component
	'SEQUENCE' ->
	    #'SEQUENCE'{components=Components} = Def#type.def,
	    gen_dec_part_inner_types(Erules,Components,TypeName);
	'CHOICE' ->
	    {_,Components} = Def#type.def,
	    gen_dec_part_inner_types(Erules,Components,TypeName);
	'SEQUENCE OF' ->
	    %% this and next case must be the last component in the
	    %% partial decode chain here. Not likely that this occur.
	    {_,Type} = Def#type.def,
	    NameSuffix = constructed_suffix(InnerType,Type#type.def),
	    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
					       rt2ct_suffix(Erules)])),
	    asn1ct_name:clear(),
	    Rtmod:gen_decode(Erules,[NameSuffix|TypeName],Type);
%%	    gen_types(Erules,[NameSuffix|Typename],Type);
	'SET OF' ->
	    {_,Type} = Def#type.def,
	    NameSuffix = constructed_suffix(InnerType,Type#type.def),
	    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
					       rt2ct_suffix(Erules)])),
	    asn1ct_name:clear(),
	    Rtmod:gen_decode(Erules,[NameSuffix|TypeName],Type);
	_ ->
	    ok
    end.

gen_dec_part_inner_types(Erules,[ComponentType|Rest],TypeName) ->
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
				       rt2ct_suffix(Erules)])),
    asn1ct_name:clear(),
    Rtmod:gen_decode(Erules,TypeName,ComponentType),
    gen_dec_part_inner_types(Erules,Rest,TypeName);
gen_dec_part_inner_types(Erules,{Comps1,Comps2},TypeName)
  when list(Comps1),list(Comps2) ->
    gen_dec_part_inner_types(Erules,Comps1 ++ Comps2,TypeName);
gen_dec_part_inner_types(_,[],_) ->
    ok.


pgen_partial_incomplete_decode(Erule) ->
    case asn1ct:get_gen_state_field(active) of
	true ->
	    pgen_partial_incomplete_decode1(Erule),
	    asn1ct:reset_gen_state();
	_ ->
	    ok
    end.
pgen_partial_incomplete_decode1(ber_bin_v2) ->
    case asn1ct:read_config_data(partial_incomplete_decode) of
	undefined ->
	    ok;
	Data ->
	    lists:foreach(fun emit_partial_incomplete_decode/1,Data)
    end,
    GeneratedFs= asn1ct:get_gen_state_field(gen_refed_funcs),
%    io:format("GeneratedFs :~n~p~n",[GeneratedFs]),
    gen_part_decode_funcs(GeneratedFs,0);
pgen_partial_incomplete_decode1(_) -> ok.

emit_partial_incomplete_decode({FuncName,TopType,Pattern}) ->
    TypePattern = asn1ct:get_gen_state_field(inc_type_pattern),
    TPattern =
	case lists:keysearch(FuncName,1,TypePattern) of
	    {value,{_,TP}} -> TP;
	    _ -> exit({error,{asn1_internal_error,exclusive_decode}})
	end,
    TopTypeName =
	case asn1ct:maybe_saved_sindex(TopType,TPattern) of
	    I when integer(I),I>0 ->
		lists:concat([TopType,"_",I]);
	    _ ->
		atom_to_list(TopType)
	end,
    emit([{asis,FuncName},"(Bytes) ->",nl,
	  "  decode_partial_incomplete('",TopTypeName,"',Bytes,",{asis,Pattern},").",nl]);
emit_partial_incomplete_decode(D) ->
    throw({error,{asn1,{"bad data in asn1config file",D}}}).

gen_part_decode_funcs([Data={Name,_,_,Type}|GeneratedFs],N) ->
    InnerType = 
	case Type#type.def of
	    #'ObjectClassFieldType'{type=OCFTType} ->
		OCFTType;
	    _ ->
		get_inner(Type#type.def)
	end,
    WhatKind = type(InnerType),
    TypeName=list2name(Name),
    if
	N > 0 -> emit([";",nl]);
	true -> ok
    end,
    emit(["decode_inc_disp('",TypeName,"',Data) ->",nl]),
    gen_part_decode_funcs(WhatKind,TypeName,Data),
    gen_part_decode_funcs(GeneratedFs,N+1);
gen_part_decode_funcs([_H|T],N) ->
    gen_part_decode_funcs(T,N);
gen_part_decode_funcs([],N) ->
    if
	N > 0 ->
	    emit([".",nl]);
	true ->
	    ok
    end.

gen_part_decode_funcs(#'Externaltypereference'{module=M,type=T},
		      _TypeName,Data) ->
    #typedef{typespec=TS} = asn1_db:dbget(M,T),
    InnerType = 
	case TS#type.def of
	    #'ObjectClassFieldType'{type=OCFTType} ->
		OCFTType;
	    _ ->
		get_inner(TS#type.def)
	end,
    WhatKind = type(InnerType),
    gen_part_decode_funcs(WhatKind,[T],Data);
gen_part_decode_funcs({constructed,bif},TypeName,
		      {_Name,parts,Tag,_Type}) ->
    emit(["  case Data of",nl,
	  "    L when list(L) ->",nl,
	  "      'dec_",TypeName,"'(lists:map(fun(X)->element(1,?RT_BER:decode(X)) end,L),",{asis,Tag},");",nl,
	  "    _ ->",nl,
	  "      [Res] = 'dec_",TypeName,"'([Data],",{asis,Tag},"),",nl,
	  "      Res",nl,
	  "  end"]);
gen_part_decode_funcs(WhatKind,_TypeName,{_Name,parts,_Tag,_Type}) ->
    throw({error,{asn1,{"only SEQUENCE OF/SET OF may have the partial incomplete directive 'parts'.",WhatKind}}});