asn1ct_check.erl

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

%% ``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_check).

%% Main Module for ASN.1 compile time functions

%-compile(export_all).
-export([check/2,storeindb/1]).
%-define(debug,1).
-include("asn1_records.hrl").
%%% The tag-number for universal types
-define(N_BOOLEAN, 1). 
-define(N_INTEGER, 2). 
-define(N_BIT_STRING, 3).
-define(N_OCTET_STRING, 4).
-define(N_NULL, 5). 
-define(N_OBJECT_IDENTIFIER, 6). 
-define(N_OBJECT_DESCRIPTOR, 7). 
-define(N_EXTERNAL, 8). % constructed
-define(N_INSTANCE_OF,8).
-define(N_REAL, 9). 
-define(N_ENUMERATED, 10).   
-define(N_EMBEDDED_PDV, 11). % constructed
-define(N_UTF8String, 12).
-define(N_SEQUENCE, 16). 
-define(N_SET, 17). 
-define(N_NumericString, 18).
-define(N_PrintableString, 19).
-define(N_TeletexString, 20).
-define(N_VideotexString, 21).
-define(N_IA5String, 22).
-define(N_UTCTime, 23). 
-define(N_GeneralizedTime, 24). 
-define(N_GraphicString, 25).
-define(N_VisibleString, 26).
-define(N_GeneralString, 27).
-define(N_UniversalString, 28).
-define(N_CHARACTER_STRING, 29). % constructed
-define(N_BMPString, 30).

-define(TAG_PRIMITIVE(Num),
	case S#state.erule of
	    ber_bin_v2 ->
		#tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0};
	    _ -> []
	end).
-define(TAG_CONSTRUCTED(Num),
	case S#state.erule of
	    ber_bin_v2 ->
		#tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32};
	    _ -> []
	end).

-record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag
-record(newv,{type=unchanged,value=unchanged}). % used in check_value to update type and value
 
check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
    %%Predicates used to filter errors
    TupleIs = fun({T,_},T) -> true;
		 (_,_) -> false
	      end,
    IsClass = fun(X) -> TupleIs(X,asn1_class) end,
    IsObjSet = fun(X) -> TupleIs(X,objectsetdef) end,
    IsPObjSet = fun(X) -> TupleIs(X,pobjectsetdef) end,
    IsObject = fun(X) -> TupleIs(X,objectdef) end,
    IsValueSet = fun(X) -> TupleIs(X,valueset) end,
    Element2 = fun(X) -> element(2,X) end,
    Element1 = fun(X) -> element(1,X) end,

    %% initialize internal book keeping
    save_asn1db_uptodate(S,S#state.erule,S#state.mname),

    _Perror = checkp(S,ParameterizedTypes,[]), % must do this before the templates are used
    
    %% table to save instances of parameterized objects,object sets
    asn1ct:create_ets_table(parameterized_objects,[named_table]),

    Terror = checkt(S,Types,[]),
    ?dbg("checkt finished with errors:~n~p~n~n",[Terror]),

    %% get parameterized object sets sent to checkt/3
    %% and update Terror

    {PObjSetNames1,Terror2} = filter_errors(IsPObjSet,Terror),

    Verror = checkv(S,Values ++ ObjectSets,[]), %value sets may be parsed as object sets
    ?dbg("checkv finished with errors:~n~p~n~n",[Verror]),
     %% get information object classes wrongly sent to checkt/3
     %% and update Terror2

    {AddClasses,Terror3} = filter_errors(IsClass,Terror2),

    NewClasses = Classes++AddClasses,

    Cerror = checkc(S,NewClasses,[]),
    ?dbg("checkc finished with errors:~n~p~n~n",[Cerror]),
     %% get object sets incorrectly sent to checkv/3
     %% and update Verror

    {ObjSetNames,Verror2} = filter_errors(IsObjSet,Verror),

     %% get parameterized object sets incorrectly sent to checkv/3
     %% and update Verror2

    {PObjSetNames,Verror3} = filter_errors(IsPObjSet,Verror2),

     %% get objects incorrectly sent to checkv/3
     %% and update Verror3

    {ObjectNames,Verror4} = filter_errors(IsObject,Verror3),

    NewObjects = Objects++ObjectNames,
    NewObjectSets = ObjSetNames ++ PObjSetNames ++ PObjSetNames1,

     %% get value sets
     %% and update Verror4

    {ValueSetNames,Verror5} = filter_errors(IsValueSet,Verror4),

    asn1ct:create_ets_table(inlined_objects,[named_table]),

    {Oerror,ExclO,ExclOS} = checko(S,NewObjects ++
				   NewObjectSets,
				   [],[],[]),
    ?dbg("checko finished with errors:~n~p~n~n",[Oerror]),
    InlinedObjTuples = ets:tab2list(inlined_objects),
    InlinedObjects = lists:map(Element2,InlinedObjTuples),
    ets:delete(inlined_objects),
    ParameterizedElems = ets:tab2list(parameterized_objects),
    ParObjectSets = lists:filter(fun({_OSName,objectset,_}) -> true;
				    (_)-> false end,ParameterizedElems),
    ParObjectSetNames = lists:map(Element1,ParObjectSets),
    ParTypes = lists:filter(fun({_TypeName,type,_}) -> true;
			       (_) -> false end, ParameterizedElems),
    ParTypesNames = lists:map(Element1,ParTypes),
    ets:delete(parameterized_objects),

    Exporterror = check_exports(S,S#state.module),
    case {Terror3,Verror5,Cerror,Oerror,Exporterror} of
	{[],[],[],[],[]} -> 
	    ContextSwitchTs = context_switch_in_spec(),
	    InstanceOf = instance_of_in_spec(S#state.mname),
	    NewTypes = lists:subtract(Types,AddClasses) ++ ContextSwitchTs
		++ InstanceOf ++ ParTypesNames,
	    NewValues = lists:subtract(Values,PObjSetNames++ObjectNames++
				       ValueSetNames),
	    {ok,
	     {NewTypes,NewValues,ParameterizedTypes,
	      NewClasses,NewObjects,NewObjectSets},
	     {NewTypes,NewValues,ParameterizedTypes,NewClasses,
	      lists:subtract(NewObjects,ExclO)++InlinedObjects,
	      lists:subtract(NewObjectSets,ExclOS)++ParObjectSetNames}};
	_ ->{error,{asn1,lists:flatten([Terror3,Verror5,Cerror,
					Oerror,Exporterror])}}
    end.

context_switch_in_spec() ->
    L = [{external,'EXTERNAL'},
	 {embedded_pdv,'EMBEDDED PDV'},
	 {character_string,'CHARACTER STRING'}],
    F = fun({T,TName},Acc) ->
		case get(T) of
		    generate -> erase(T),
				[TName|Acc];
		    _ -> Acc
		end
	end,
    lists:foldl(F,[],L).

instance_of_in_spec(ModName) ->
    case get(instance_of) of
	L when is_list(L) ->
	    case lists:member(ModName,L) of
		true ->
		    erase(instance_of),
		    ['INSTANCE OF'];
		_ ->
		    erase(instance_of),
		    []
	    end;
	_ ->
	    []
    end.
instance_of_decl(ModName) ->
    Mods = get_instance_of(),
    case lists:member(ModName,Mods) of
	true ->
	    ok;
	_ ->
	    put(instance_of,[ModName|Mods])
    end.
get_instance_of() ->
    case get(instance_of) of
	undefined ->
	    [];
	L ->
	    L
    end.

filter_errors(Pred,ErrorList) ->
    Element2 = fun(X) -> element(2,X) end,
    RemovedTupleElements = lists:filter(Pred,ErrorList),
    RemovedNames = lists:map(Element2,RemovedTupleElements),
    %% remove value set name tuples from Verror
    RestErrors = lists:subtract(ErrorList,RemovedTupleElements),
    {RemovedNames,RestErrors}.

    
check_exports(S,Module = #module{}) ->
    case Module#module.exports of
	{exports,[]} ->
	    [];
	{exports,all} ->
	    [];
	{exports,ExportList} when list(ExportList) ->
	    IsNotDefined = 
		fun(X) ->
			case catch get_referenced_type(S,X) of
			    {error,{asn1,_}} ->
				true;
			    _ -> false
			end
		end,
	    case lists:filter(IsNotDefined,ExportList) of
		[] ->
		    [];
		NoDefExp ->
		    GetName =
			fun(T = #'Externaltypereference'{type=N})-> 
				%%{exported,undefined,entity,N} 
				NewS=S#state{type=T,tname=N},
				error({export,"exported undefined entity",NewS})
			end,
		    lists:map(GetName,NoDefExp)
	    end
    end.
			  
checkt(S,[Name|T],Acc) ->
    ?dbg("Checking type ~p~n",[Name]),
    Result = 
	case asn1_db:dbget(S#state.mname,Name) of
	    undefined ->
		error({type,{internal_error,'???'},S});
	    Type when record(Type,typedef) ->
		NewS = S#state{type=Type,tname=Name},
		case catch(check_type(NewS,Type,Type#typedef.typespec)) of
		    {error,Reason} ->
			error({type,Reason,NewS});
		    {'EXIT',Reason} ->
			error({type,{internal_error,Reason},NewS});
		    {asn1_class,_ClassDef} ->
			{asn1_class,Name};
		    pobjectsetdef ->
			{pobjectsetdef,Name};
		    pvalueset ->
			{pvalueset,Name};
		    Ts ->
			case Type#typedef.checked of
			    true -> % already checked and updated
				ok;
			    _ ->
				NewTypeDef = Type#typedef{checked=true,typespec = Ts},
				
				asn1_db:dbput(NewS#state.mname,Name,NewTypeDef), % update the type

				ok
			end
		end
	end,
    case Result of
	ok ->
	    checkt(S,T,Acc);
	_ ->
	    checkt(S,T,[Result|Acc])
    end;
checkt(S,[],Acc) ->
    case check_contextswitchingtypes(S,[]) of
	[] ->
	    lists:reverse(Acc);
	L ->
	    checkt(S,L,Acc)
    end.

check_contextswitchingtypes(S,Acc) ->
    CSTList=[{external,'EXTERNAL'},
	     {embedded_pdv,'EMBEDDED PDV'},
	     {character_string,'CHARACTER STRING'}],
    check_contextswitchingtypes(S,CSTList,Acc).

check_contextswitchingtypes(S,[{T,TName}|Ts],Acc) ->
     case get(T) of
	unchecked ->
	    put(T,generate),
	    check_contextswitchingtypes(S,Ts,[TName|Acc]);
	_ ->
	    check_contextswitchingtypes(S,Ts,Acc)
     end;
check_contextswitchingtypes(_,[],Acc) ->
    Acc.

checkv(S,[Name|T],Acc) ->
    ?dbg("Checking valuedef ~p~n",[Name]),
    Result = case asn1_db:dbget(S#state.mname,Name) of
		 undefined -> error({value,{internal_error,'???'},S});
		 Value when record(Value,valuedef);
			    record(Value,typedef); %Value set may be parsed as object set.
			    record(Value,pvaluedef);
			    record(Value,pvaluesetdef) ->
		     NewS = S#state{value=Value},
		     case catch(check_value(NewS,Value)) of
			 {error,Reason} ->
			     error({value,Reason,NewS});
			 {'EXIT',Reason} ->
			     error({value,{internal_error,Reason},NewS});
			 {pobjectsetdef} ->
			     {pobjectsetdef,Name};
			 {objectsetdef} ->
			     {objectsetdef,Name};
			 {objectdef} ->
			     %% this is an object, save as typedef
			     #valuedef{checked=C,pos=Pos,name=N,type=Type,
				       value=Def}=Value,
%			     Currmod = S#state.mname,
%			     #type{def=
%				   #'Externaltypereference'{module=Mod,
%							    type=CName}} = Type,
			     ClassName =
				 Type#type.def,
% 				 case Mod of
% 				     Currmod ->
% 					 {objectclassname,CName};
% 				     _ ->
% 					 {objectclassname,Mod,CName}
% 				 end,
			     NewSpec = #'Object'{classname=ClassName,
						 def=Def},
			     NewDef = #typedef{checked=C,pos=Pos,name=N,
					       typespec=NewSpec},
			     asn1_db:dbput(NewS#state.mname,Name,NewDef),
			     {objectdef,Name};
			 {valueset,VSet} ->
			     Pos = asn1ct:get_pos_of_def(Value),
			     CheckedVSDef = #typedef{checked=true,pos=Pos,
						     name=Name,typespec=VSet},
			     asn1_db:dbput(NewS#state.mname,Name,CheckedVSDef),
			     {valueset,Name};
			 V ->
			     %% update the valuedef
			     asn1_db:dbput(NewS#state.mname,Name,V), 
			     ok
		     end
	     end,
    case Result of
	ok ->
	    checkv(S,T,Acc);
	_ ->
	    checkv(S,T,[Result|Acc])
    end;
checkv(_S,[],Acc) ->
    lists:reverse(Acc).


checkp(S,[Name|T],Acc) ->
    %io:format("check_ptypedef:~p~n",[Name]),
    Result = case asn1_db:dbget(S#state.mname,Name) of
	undefined ->
	    error({type,{internal_error,'???'},S});
	Type when record(Type,ptypedef) ->
	    NewS = S#state{type=Type,tname=Name},
	    case catch(check_ptype(NewS,Type,Type#ptypedef.typespec)) of
		{error,Reason} ->
		    error({type,Reason,NewS});
		{'EXIT',Reason} ->
		    error({type,{internal_error,Reason},NewS});