diff options
Diffstat (limited to 'lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1')
33 files changed, 0 insertions, 37608 deletions
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/Makefile b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/Makefile deleted file mode 100644 index b539e88108..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/Makefile +++ /dev/null @@ -1,151 +0,0 @@ -# -# Copyright (C) 1997, Ericsson Telecommunications -# Author: Kenneth Lundin -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(ASN1_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/asn1-$(VSN) - - - - -# -# Common Macros -# -# PARSER_SRC = \ -# asn1ct_parser.yrl - -# PARSER_MODULE=$(PARSER_SRC:%.yrl=%) - -EBIN = ../ebin -CT_MODULES= \ - asn1ct \ - asn1ct_check \ - asn1_db \ - asn1ct_pretty_format \ - asn1ct_gen \ - asn1ct_gen_per \ - asn1ct_gen_per_rt2ct \ - asn1ct_name \ - asn1ct_constructed_per \ - asn1ct_constructed_ber \ - asn1ct_gen_ber \ - asn1ct_constructed_ber_bin_v2 \ - asn1ct_gen_ber_bin_v2 \ - asn1ct_value \ - asn1ct_tok \ - asn1ct_parser2 - -RT_MODULES= \ - asn1rt \ - asn1rt_per \ - asn1rt_per_bin \ - asn1rt_per_v1 \ - asn1rt_ber_bin \ - asn1rt_ber_bin_v2 \ - asn1rt_per_bin_rt2ct \ - asn1rt_driver_handler \ - asn1rt_check - -# asn1rt_ber_v1 \ -# asn1rt_ber \ -# the rt module to use is defined in asn1_records.hrl -# and must be updated when an incompatible change is done in the rt modules - - -MODULES= $(CT_MODULES) $(RT_MODULES) - -ERL_FILES = $(MODULES:%=%.erl) - -TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -GENERATED_PARSER = $(PARSER_MODULE:%=%.erl) - -# internal hrl file -HRL_FILES = asn1_records.hrl - -APP_FILE = asn1.app -APPUP_FILE = asn1.appup - -APP_SRC = $(APP_FILE).src -APP_TARGET = $(EBIN)/$(APP_FILE) - -APPUP_SRC = $(APPUP_FILE).src -APPUP_TARGET = $(EBIN)/$(APPUP_FILE) - -EXAMPLES = \ - ../examples/P-Record.asn - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_FLAGS += -ERL_COMPILE_FLAGS += \ - -I$(ERL_TOP)/lib/stdlib \ - +warn_unused_vars -YRL_FLAGS = -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) - - -clean: - rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) $(GENERATED_PARSER) - rm -f core *~ - -docs: - - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -$(EBIN)/asn1ct.$(EMULATOR):asn1ct.erl - $(ERLC) -b$(EMULATOR) -o$(EBIN) $(ERL_COMPILE_FLAGS) -Dvsn=\"$(VSN)\" $< - -$(APP_TARGET): $(APP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - -$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) $(RELSYSDIR)/ebin - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(PARSER_SRC) $(ERL_FILES) $(HRL_FILES) $(APP_SRC) $(APPUP_SRC) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/examples - $(INSTALL_DATA) $(EXAMPLES) $(RELSYSDIR)/examples - -# there are no include files to be used by the user -#$(INSTALL_DIR) $(RELSYSDIR)/include -#$(INSTALL_DATA) $(HRL_FILES) $(RELSYSDIR)/include - -release_docs_spec: - - - - - - - - - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/Restrictions.txt b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/Restrictions.txt deleted file mode 100644 index 73b725245d..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/Restrictions.txt +++ /dev/null @@ -1,55 +0,0 @@ -The following restrictions apply to this implementation of the ASN.1 compiler: - -Supported encoding rules are: -BER -PER (aligned) - -PER (unaligned) IS NOT SUPPORTED - -Supported types are: - -INTEGER -BOOLEAN -ENUMERATION -SEQUENCE -SEQUENCE OF -SET -SET OF -CHOICE -OBJECT IDENTIFIER -RestrictedCharacterStringTypes -UnrestrictedCharacterStringTypes - - -NOT SUPPORTED types are: -ANY IS (IS NOT IN THE STANDARD ANY MORE) -ANY DEFINED BY (IS NOT IN THE STANDARD ANY MORE) -EXTERNAL -EMBEDDED-PDV -REAL - -The support for value definitions in the ASN.1 notation is very limited. - -The support for constraints is limited to: -SizeConstraint SIZE(X) -SingleValue (1) -ValueRange (X..Y) -PermittedAlpabet FROM - -The only supported value-notation for SEQUENCE and SET in Erlang is -the record variant. -The list notation with named components used by the old ASN.1 compiler -was supported in the first versions of this compiler both are no longer -supported. - -The decode functions always return a symbolic value if they can. - - -Files with ASN.1 source must have a suffix .asn1 the suffix .py used by the -old ASN.1 compiler is supported in this version but will not be supported in the future. - -Generated files: -X.asn1db % the intermediate format of a compiled ASN.1 module -X.hrl % generated Erlang include file for module X -X.erl % generated Erlang module with encode decode functions for - % ASN.1 module X diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1.app.src b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1.app.src deleted file mode 100644 index 2ec06ff4db..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1.app.src +++ /dev/null @@ -1,20 +0,0 @@ -{application, asn1, - [{description, "The Erlang ASN1 compiler version %VSN%"}, - {vsn, "%VSN%"}, - {modules, [ - asn1rt, - asn1rt_per, - asn1rt_per_v1, - asn1rt_per_bin, - asn1rt_per_bin_rt2ct, - asn1rt_ber_bin, - asn1rt_ber_bin_v2, - asn1rt_check, - asn1rt_driver_handler - ]}, - {registered, [ - asn1_driver_owner - ]}, - {env, []}, - {applications, [kernel, stdlib]} - ]}. diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1.appup.src b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1.appup.src deleted file mode 100644 index 255dec709e..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1.appup.src +++ /dev/null @@ -1,166 +0,0 @@ -{"%VSN%", - [ - {"1.3", - [ - {load_module, asn1rt_per_v1, soft_purge, soft_purge, []}, - {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt, soft_purge, soft_purge, []}, - {add_module, asn1rt_per_bin}, - {add_module, asn1rt_check} - {add_module, asn1rt_per_bin_rt2ct}, - {add_module, asn1rt_ber_bin_v2}, - {add_module, asn1rt_driver_handler} - {remove, {asn1rt_ber_v1, soft_purge, soft_purge}}, - ] - }, - {"1.3.1", - [ - {load_module, asn1rt_per_v1, soft_purge, soft_purge, []}, - {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt, soft_purge, soft_purge, []}, - {add_module, asn1rt_per_bin}, - {add_module, asn1rt_check} - {add_module, asn1rt_per_bin_rt2ct}, - {add_module, asn1rt_ber_bin_v2}, - {add_module, asn1rt_driver_handler} - {remove, {asn1rt_ber_v1, soft_purge, soft_purge}}, - ] - }, - {"1.3.1.1", - [ - {load_module, asn1rt_per_v1, soft_purge, soft_purge, []}, - {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt, soft_purge, soft_purge, []}, - {add_module, asn1rt_per_bin}, - {add_module, asn1rt_check} - {add_module, asn1rt_per_bin_rt2ct}, - {add_module, asn1rt_ber_bin_v2}, - {add_module, asn1rt_driver_handler} - {remove, {asn1rt_ber_v1, soft_purge, soft_purge}}, - ] - }, - {"1.3.2", - [ - {load_module, asn1rt_per_v1, soft_purge, soft_purge, []}, - {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt, soft_purge, soft_purge, []}, - {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt_check, soft_purge, soft_purge, []}, - {add_module, asn1rt_per_bin_rt2ct}, - {add_module, asn1rt_ber_bin_v2}, - {add_module, asn1rt_driver_handler} - {remove, {asn1rt_ber_v1, soft_purge, soft_purge}}, - ] - }, - {"1.3.3", - [ - {load_module, asn1rt_per_v1, soft_purge, soft_purge, []}, - {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt, soft_purge, soft_purge, []}, - {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt_check, soft_purge, soft_purge, []}, - {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []}, - {add_module, asn1rt_ber_bin_v2}, - {add_module, asn1rt_driver_handler} - {remove, {asn1rt_ber_v1, soft_purge, soft_purge}}, - ] - }, - {"1.3.3.1", - [ - {load_module, asn1rt_per_v1, soft_purge, soft_purge, []}, - {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt, soft_purge, soft_purge, []}, - {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt_check, soft_purge, soft_purge, []}, - {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []}, - {add_module, asn1rt_ber_bin_v2}, - {add_module, asn1rt_driver_handler} - {remove, {asn1rt_ber_v1, soft_purge, soft_purge}}, - ] - } - ], - [ - {"1.3", - [ - {load_module, asn1rt_per_v1, soft_purge, soft_purge, []}, - {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt, soft_purge, soft_purge, []}, - {add_module, asn1rt_ber_v1}, - {remove, {asn1rt_per_bin, soft_purge, soft_purge}}, - {remove, {asn1rt_check, soft_purge, soft_purge}} - {remove, {asn1rt_per_bin_rt2ct, soft_purge, soft_purge}}, - {remove, {asn1rt_ber_bin_v2, soft_purge, soft_purge}}, - {remove, {asn1rt_driver_handler, soft_purge, soft_purge}} - ] - }, - {"1.3.1", - [ - {load_module, asn1rt_per_v1, soft_purge, soft_purge, []}, - {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt, soft_purge, soft_purge, []}, - {add_module, asn1rt_ber_v1}, - {remove, {asn1rt_per_bin, soft_purge, soft_purge}}, - {remove, {asn1rt_check, soft_purge, soft_purge}} - {remove, {asn1rt_per_bin_rt2ct, soft_purge, soft_purge}}, - {remove, {asn1rt_ber_bin_v2, soft_purge, soft_purge}}, - {remove, {asn1rt_driver_handler, soft_purge, soft_purge}} - ] - }, - {"1.3.1.1", - [ - {load_module, asn1rt_per_v1, soft_purge, soft_purge, []}, - {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt, soft_purge, soft_purge, []}, - {add_module, asn1rt_ber_v1}, - {remove, {asn1rt_per_bin, soft_purge, soft_purge}}, - {remove, {asn1rt_check, soft_purge, soft_purge}} - {remove, {asn1rt_per_bin_rt2ct, soft_purge, soft_purge}}, - {remove, {asn1rt_ber_bin_v2, soft_purge, soft_purge}}, - {remove, {asn1rt_driver_handler, soft_purge, soft_purge}} - ] - }, - {"1.3.2", - [ - {load_module, asn1rt_per_v1, soft_purge, soft_purge, []}, - {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt, soft_purge, soft_purge, []}, - {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt_check, soft_purge, soft_purge, []}, - {add_module, asn1rt_ber_v1}, - {remove, {asn1rt_per_bin_rt2ct, soft_purge, soft_purge}}, - {remove, {asn1rt_ber_bin_v2, soft_purge, soft_purge}}, - {remove, {asn1rt_driver_handler, soft_purge, soft_purge}} - ] - }, - {"1.3.3", - [ - {load_module, asn1rt_per_v1, soft_purge, soft_purge, []}, - {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt, soft_purge, soft_purge, []}, - {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt_check, soft_purge, soft_purge, []}, - {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []}, - {add_module, asn1rt_ber_v1}, - {remove, {asn1rt_ber_bin_v2, soft_purge, soft_purge}}, - {remove, {asn1rt_driver_handler, soft_purge, soft_purge}} - ] - }, - {"1.3.3.1", - [ - {load_module, asn1rt_per_v1, soft_purge, soft_purge, []}, - {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt, soft_purge, soft_purge, []}, - {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, - {load_module, asn1rt_check, soft_purge, soft_purge, []}, - {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []}, - {add_module, asn1rt_ber_v1}, - {remove, {asn1rt_ber_bin_v2, soft_purge, soft_purge}}, - {remove, {asn1rt_driver_handler, soft_purge, soft_purge}} - ] - } - - ]}. - - - - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1_db.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1_db.erl deleted file mode 100644 index cf01e39fed..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1_db.erl +++ /dev/null @@ -1,162 +0,0 @@ -%% ``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: asn1_db.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ -%% --module(asn1_db). -%-compile(export_all). --export([dbnew/1,dbsave/2,dbload/1,dbput/3,dbget/2,dbget_all/1]). --export([dbget_all_mod/1,dbstop/0,dbclear/0,dberase_module/1,dbstart/1,stop_server/1]). -%% internal exports --export([dbloop0/1,dbloop/2]). - -%% Db stuff -dbstart(Includes) -> - start_server(asn1db, asn1_db, dbloop0, [Includes]). - -dbloop0(Includes) -> - dbloop(Includes, ets:new(asn1, [set,named_table])). - -opentab(Tab,Mod,[]) -> - opentab(Tab,Mod,["."]); -opentab(Tab,Mod,Includes) -> - Base = lists:concat([Mod,".asn1db"]), - opentab2(Tab,Base,Mod,Includes,ok). - -opentab2(_Tab,_Base,_Mod,[],Error) -> - Error; -opentab2(Tab,Base,Mod,[Ih|It],_Error) -> - File = filename:join(Ih,Base), - case ets:file2tab(File) of - {ok,Modtab} -> - ets:insert(Tab,{Mod, Modtab}), - {ok,Modtab}; - NewErr -> - opentab2(Tab,Base,Mod,It,NewErr) - end. - - -dbloop(Includes, Tab) -> - receive - {From,{set, Mod, K2, V}} -> - [{_,Modtab}] = ets:lookup(Tab,Mod), - ets:insert(Modtab,{K2, V}), - From ! {asn1db, ok}, - dbloop(Includes, Tab); - {From, {get, Mod, K2}} -> - Result = case ets:lookup(Tab,Mod) of - [] -> - opentab(Tab,Mod,Includes); - [{_,Modtab}] -> {ok,Modtab} - end, - case Result of - {ok,Newtab} -> - From ! {asn1db, lookup(Newtab, K2)}; - _Error -> - From ! {asn1db, undefined} - end, - dbloop(Includes, Tab); - {From, {all_mod, Mod}} -> - [{_,Modtab}] = ets:lookup(Tab,Mod), - From ! {asn1db, ets:tab2list(Modtab)}, - dbloop(Includes, Tab); - {From, {delete_mod, Mod}} -> - [{_,Modtab}] = ets:lookup(Tab,Mod), - ets:delete(Modtab), - ets:delete(Tab,Mod), - From ! {asn1db, ok}, - dbloop(Includes, Tab); - {From, {save, OutFile,Mod}} -> - [{_,Mtab}] = ets:lookup(Tab,Mod), - {From ! {asn1db, ets:tab2file(Mtab,OutFile)}}, - dbloop(Includes,Tab); - {From, {load, Mod}} -> - Result = case ets:lookup(Tab,Mod) of - [] -> - opentab(Tab,Mod,Includes); - [{_,Modtab}] -> {ok,Modtab} - end, - {From, {asn1db,Result}}, - dbloop(Includes,Tab); - {From, {new, Mod}} -> - case ets:lookup(Tab,Mod) of - [{_,Modtab}] -> - ets:delete(Modtab); - _ -> - true - end, - Tabname = list_to_atom(lists:concat(["asn1_",Mod])), - ets:new(Tabname, [set,named_table]), - ets:insert(Tab,{Mod,Tabname}), - From ! {asn1db, ok}, - dbloop(Includes,Tab); - {From, stop} -> - From ! {asn1db, ok}; %% nothing to store - {From, clear} -> - ModTabList = [Mt||{_,Mt} <- ets:tab2list(Tab)], - lists:foreach(fun(T) -> ets:delete(T) end,ModTabList), - ets:delete(Tab), - From ! {asn1db, cleared}, - dbloop(Includes, ets:new(asn1, [set])) - end. - - -%%all(Tab, K) -> -%% pickup(K, ets:match(Tab, {{K, '$1'}, '$2'})). -%%pickup(K, []) -> []; -%%pickup(K, [[V1,V2] |T]) -> -%% [{{K,V1},V2} | pickup(K, T)]. - -lookup(Tab, K) -> - case ets:lookup(Tab, K) of - [] -> undefined; - [{K,V}] -> V - end. - - -dbnew(Module) -> req({new,Module}). -dbsave(OutFile,Module) -> req({save,OutFile,Module}). -dbload(Module) -> req({load,Module}). - -dbput(Module,K,V) -> req({set, Module, K, V}). -dbget(Module,K) -> req({get, Module, K}). -dbget_all(K) -> req({get_all, K}). -dbget_all_mod(Mod) -> req({all_mod,Mod}). -dbstop() -> stop_server(asn1db). -dbclear() -> req(clear). -dberase_module({module,M})-> - req({delete_mod, M}). - -req(R) -> - asn1db ! {self(), R}, - receive {asn1db, Reply} -> Reply end. - -stop_server(Name) -> - stop_server(Name, whereis(Name)). -stop_server(_, undefined) -> stopped; -stop_server(Name, _Pid) -> - Name ! {self(), stop}, - receive {Name, _} -> stopped end. - - -start_server(Name,Mod,Fun,Args) -> - case whereis(Name) of - undefined -> - register(Name, spawn(Mod,Fun, Args)); - _Pid -> - already_started - end. - - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1_records.hrl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1_records.hrl deleted file mode 100644 index 07ca8cccf3..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1_records.hrl +++ /dev/null @@ -1,96 +0,0 @@ -%% ``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: asn1_records.hrl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ -%% --define('RT_BER',"asn1rt_ber_v1"). --define('RT_BER_BIN',"asn1rt_ber_bin"). --define('RT_PER',"asn1rt_per_v1"). -%% change to this when we have this module -define('RT_PER_BIN',"asn1rt_per_bin"). --define('RT_PER_BIN',"asn1rt_per_bin"). - --record(module,{pos,name,defid,tagdefault='EXPLICIT',exports={exports,[]},imports={imports,[]}, extensiondefault=empty,typeorval}). - --record('SEQUENCE',{pname=false,tablecinf=false,components=[]}). --record('SET',{pname=false,sorted=false,tablecinf=false,components=[]}). --record('ComponentType',{pos,name,typespec,prop,tags}). --record('ObjectClassFieldType',{classname,class,fieldname,type}). - --record(typedef,{checked=false,pos,name,typespec}). --record(classdef,{checked=false,pos,name,typespec}). --record(valuedef,{checked=false,pos,name,type,value}). --record(ptypedef,{checked=false,pos,name,args,typespec}). --record(pvaluedef,{checked=false,pos,name,args,type,value}). --record(pvaluesetdef,{checked=false,pos,name,args,type,valueset}). --record(pobjectdef,{checked=false,pos,name,args,class,def}). --record(pobjectsetdef,{checked=false,pos,name,args,class,def}). - --record(typereference,{pos,val}). --record(identifier,{pos,val}). --record(constraint,{c,e}). --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, - uniqueclassfield,valueindex}). --record(type,{tag=[],def,constraint=[],tablecinf=[],inlined=no}). - --record(objectclass,{fields=[],syntax}). --record('Object',{classname,gen=true,def}). --record('ObjectSet',{class,gen=true,uniquefname,set}). - --record(tag,{class,number,type,form=32}). % form = ?CONSTRUCTED -% This record holds information about allowed constraint types per type --record(cmap,{single_value=no,contained_subtype=no,value_range=no, - size=no,permitted_alphabet=no,type_constraint=no, - inner_subtyping=no}). - - --record('EXTENSIONMARK',{pos,val}). - -% each IMPORT contains a list of 'SymbolsFromModule' --record('SymbolsFromModule',{symbols,module,objid}). - -% Externaltypereference -> modulename '.' typename --record('Externaltypereference',{pos,module,type}). -% Externalvaluereference -> modulename '.' typename --record('Externalvaluereference',{pos,module,value}). - --record(state,{module,mname,type,tname,value,vname,erule,parameters=[], - inputmodules,abscomppath=[],recordtopname=[],options}). - -%% state record used by backend at partial decode -%% active is set to 'yes' when a partial decode function is generated. -%% prefix is set to 'dec-inc-' or 'dec-partial-' is for -%% incomplete partial decode or partial decode respectively -%% inc_tag_pattern holds the tags of the significant types/components -%% for incomplete partial decode. -%% tag_pattern holds the tags for partial decode. -%% inc_type_pattern and type_pattern holds the names of the -%% significant types/components. -%% func_name holds the name of the function for the toptype. -%% namelist holds the list of names of types/components that still -%% haven't been generated. -%% tobe_refed_funcs is a list of tuples {function names -%% (Types),namelist of incomplete decode spec}, with function names -%% that are referenced within other generated partial incomplete -%% decode functions. They shall be generated as partial incomplete -%% decode functions. - -%% gen_refed_funcs is as list of function names. Unlike -%% tobe_refed_funcs these have been generated. --record(gen_state,{active=false,prefix,inc_tag_pattern, - tag_pattern,inc_type_pattern, - type_pattern,func_name,namelist, - tobe_refed_funcs=[],gen_refed_funcs=[]}). diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct.erl deleted file mode 100644 index 37189e3780..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct.erl +++ /dev/null @@ -1,1904 +0,0 @@ -%% ``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: asn1ct.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ -%% --module(asn1ct). - -%% Compile Time functions for ASN.1 (e.g ASN.1 compiler). - -%%-compile(export_all). -%% Public exports --export([compile/1, compile/2]). --export([start/0, start/1, stop/0]). --export([encode/2, encode/3, decode/3]). --export([test/1, test/2, test/3, value/2]). -%% Application internal exports --export([compile_asn/3,compile_asn1/3,compile_py/3,compile/3,value/1,vsn/0, - create_ets_table/2,get_name_of_def/1,get_pos_of_def/1]). --export([read_config_data/1,get_gen_state_field/1,get_gen_state/0, - partial_inc_dec_toptype/1,save_gen_state/1,update_gen_state/2, - get_tobe_refed_func/1,reset_gen_state/0,is_function_generated/1, - generated_refed_func/1,next_refed_func/0,pop_namelist/0, - next_namelist_el/0,update_namelist/1,step_in_constructed/0, - add_tobe_refed_func/1,add_generated_refed_func/1]). - --include("asn1_records.hrl"). --include_lib("stdlib/include/erl_compile.hrl"). - --import(asn1ct_gen_ber_bin_v2,[encode_tag_val/3,decode_class/1]). - --define(unique_names,0). --define(dupl_uniquedefs,1). --define(dupl_equaldefs,2). --define(dupl_eqdefs_uniquedefs,?dupl_equaldefs bor ?dupl_uniquedefs). - --define(CONSTRUCTED, 2#00100000). - -%% macros used for partial decode commands --define(CHOOSEN,choosen). --define(SKIP,skip). --define(SKIP_OPTIONAL,skip_optional). - -%% macros used for partial incomplete decode commands --define(MANDATORY,mandatory). --define(DEFAULT,default). --define(OPTIONAL,opt). --define(PARTS,parts). --define(UNDECODED,undec). --define(ALTERNATIVE,alt). --define(ALTERNATIVE_UNDECODED,alt_undec). --define(ALTERNATIVE_PARTS,alt_parts). -%-define(BINARY,bin). - -%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% This is the interface to the compiler -%% -%% - - -compile(File) -> - compile(File,[]). - -compile(File,Options) when list(Options) -> - Options1 = - case {lists:member(optimize,Options),lists:member(ber_bin,Options)} of - {true,true} -> - [ber_bin_v2|Options--[ber_bin]]; - _ -> Options - end, - case (catch input_file_type(File)) of - {single_file,PrefixedFile} -> - (catch compile1(PrefixedFile,Options1)); - {multiple_files_file,SetBase,FileName} -> - FileList = get_file_list(FileName), - (catch compile_set(SetBase,filename:dirname(FileName), - FileList,Options1)); - Err = {input_file_error,_Reason} -> - {error,Err} - end. - - -compile1(File,Options) when list(Options) -> - io:format("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,File]), - io:format("Compiler Options: ~p~n",[Options]), - Ext = filename:extension(File), - Base = filename:basename(File,Ext), - OutFile = outfile(Base,"",Options), - DbFile = outfile(Base,"asn1db",Options), - Includes = [I || {i,I} <- Options], - EncodingRule = get_rule(Options), - create_ets_table(asn1_functab,[named_table]), - Continue1 = scan({true,true},File,Options), - Continue2 = parse(Continue1,File,Options), - Continue3 = check(Continue2,File,OutFile,Includes,EncodingRule, - DbFile,Options,[]), - Continue4 = generate(Continue3,OutFile,EncodingRule,Options), - delete_tables([asn1_functab]), - compile_erl(Continue4,OutFile,Options). - -%%****************************************************************************%% -%% functions dealing with compiling of several input files to one output file %% -%%****************************************************************************%% -compile_set(SetBase,DirName,Files,Options) when list(hd(Files)),list(Options) -> - %% case when there are several input files in a list - io:format("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,Files]), - io:format("Compiler Options: ~p~n",[Options]), - OutFile = outfile(SetBase,"",Options), - DbFile = outfile(SetBase,"asn1db",Options), - Includes = [I || {i,I} <- Options], - EncodingRule = get_rule(Options), - create_ets_table(asn1_functab,[named_table]), - ScanRes = scan_set(DirName,Files,Options), - ParseRes = parse_set(ScanRes,Options), - Result = - case [X||X <- ParseRes,element(1,X)==true] of - [] -> %% all were false, time to quit - lists:map(fun(X)->element(2,X) end,ParseRes); - ParseRes -> %% all were true, continue with check - InputModules = - lists:map( - fun(F)-> - E = filename:extension(F), - B = filename:basename(F,E), - if - list(B) -> list_to_atom(B); - true -> B - end - end, - Files), - check_set(ParseRes,SetBase,OutFile,Includes, - EncodingRule,DbFile,Options,InputModules); - Other -> - {error,{'unexpected error in scan/parse phase', - lists:map(fun(X)->element(3,X) end,Other)}} - end, - delete_tables([asn1_functab]), - Result. - -check_set(ParseRes,SetBase,OutFile,Includes,EncRule,DbFile, - Options,InputModules) -> - lists:foreach(fun({_T,M,File})-> - cmp(M#module.name,File) - end, - ParseRes), - MergedModule = merge_modules(ParseRes,SetBase), - SetM = MergedModule#module{name=SetBase}, - Continue1 = check({true,SetM},SetBase,OutFile,Includes,EncRule,DbFile, - Options,InputModules), - Continue2 = generate(Continue1,OutFile,EncRule,Options), - - delete_tables([renamed_defs,original_imports,automatic_tags]), - - compile_erl(Continue2,OutFile,Options). - -%% merge_modules/2 -> returns a module record where the typeorval lists are merged, -%% the exports lists are merged, the imports lists are merged when the -%% elements come from other modules than the merge set, the tagdefault -%% field gets the shared value if all modules have same tagging scheme, -%% otherwise a tagging_error exception is thrown, -%% the extensiondefault ...(not handled yet). -merge_modules(ParseRes,CommonName) -> - ModuleList = lists:map(fun(X)->element(2,X) end,ParseRes), - NewModuleList = remove_name_collisions(ModuleList), - case ets:info(renamed_defs,size) of - 0 -> ets:delete(renamed_defs); - _ -> ok - end, - save_imports(NewModuleList), -% io:format("~p~n~p~n~p~n~n",[ets:lookup(original_imports,'M1'),ets:lookup(original_imports,'M2'),ets:tab2list(original_imports)]), - TypeOrVal = lists:append(lists:map(fun(X)->X#module.typeorval end, - NewModuleList)), - InputMNameList = lists:map(fun(X)->X#module.name end, - NewModuleList), - CExports = common_exports(NewModuleList), - - ImportsModuleNameList = lists:map(fun(X)-> - {X#module.imports, - X#module.name} end, - NewModuleList), - %% ImportsModuleNameList: [{Imports,ModuleName},...] - %% Imports is a tuple {imports,[#'SymbolsFromModule'{},...]} - CImports = common_imports(ImportsModuleNameList,InputMNameList), - TagDefault = check_tagdefault(NewModuleList), - #module{name=CommonName,tagdefault=TagDefault,exports=CExports, - imports=CImports,typeorval=TypeOrVal}. - -%% causes an exit if duplicate definition names exist in a module -remove_name_collisions(Modules) -> - create_ets_table(renamed_defs,[named_table]), - %% Name duplicates in the same module is not allowed. - lists:foreach(fun exit_if_nameduplicate/1,Modules), - %% Then remove duplicates in different modules and return the - %% new list of modules. - remove_name_collisions2(Modules,[]). - -%% For each definition in the first module in module list, find -%% all definitons with same name and rename both definitions in -%% the first module and in rest of modules -remove_name_collisions2([M|Ms],Acc) -> - TypeOrVal = M#module.typeorval, - MName = M#module.name, - %% Test each name in TypeOrVal on all modules in Ms - {NewM,NewMs} = remove_name_collisions2(MName,TypeOrVal,Ms,[]), - remove_name_collisions2(NewMs,[M#module{typeorval=NewM}|Acc]); -remove_name_collisions2([],Acc) -> - finished_warn_prints(), - Acc. - -%% For each definition in list of defs find definitions in (rest of) -%% modules that have same name. If duplicate was found rename def. -%% Test each name in [T|Ts] on all modules in Ms -remove_name_collisions2(ModName,[T|Ts],Ms,Acc) -> - Name = get_name_of_def(T), - case discover_dupl_in_mods(Name,T,Ms,[],?unique_names) of - {_,?unique_names} -> % there was no name collision - remove_name_collisions2(ModName,Ts,Ms,[T|Acc]); - {NewMs,?dupl_uniquedefs} -> % renamed defs in NewMs - %% rename T - NewT = set_name_of_def(ModName,Name,T), %rename def - warn_renamed_def(ModName,get_name_of_def(NewT),Name), - ets:insert(renamed_defs,{get_name_of_def(NewT),Name,ModName}), - remove_name_collisions2(ModName,Ts,NewMs,[NewT|Acc]); - {NewMs,?dupl_equaldefs} -> % name duplicates, but identical defs - %% keep name of T - warn_kept_def(ModName,Name), - remove_name_collisions2(ModName,Ts,NewMs,[T|Acc]); - {NewMs,?dupl_eqdefs_uniquedefs} -> - %% keep name of T, renamed defs in NewMs - warn_kept_def(ModName,Name), - remove_name_collisions2(ModName,Ts,NewMs,[T|Acc]) - end; -remove_name_collisions2(_,[],Ms,Acc) -> - {Acc,Ms}. - -%% Name is the name of a definition. If a definition with the same name -%% is found in the modules Ms the definition will be renamed and returned. -discover_dupl_in_mods(Name,Def,[M=#module{name=N,typeorval=TorV}|Ms], - Acc,AnyRenamed) -> - Fun = fun(T,RenamedOrDupl)-> - case {get_name_of_def(T),compare_defs(Def,T)} of - {Name,not_equal} -> - %% rename def - NewT=set_name_of_def(N,Name,T), - warn_renamed_def(N,get_name_of_def(NewT),Name), - ets:insert(renamed_defs,{get_name_of_def(NewT), - Name,N}), - {NewT,?dupl_uniquedefs bor RenamedOrDupl}; - {Name,equal} -> - %% delete def - warn_deleted_def(N,Name), - {[],?dupl_equaldefs bor RenamedOrDupl}; - _ -> - {T,RenamedOrDupl} - end - end, - {NewTorV,NewAnyRenamed} = lists:mapfoldl(Fun,AnyRenamed,TorV), - %% have to flatten the NewTorV to remove any empty list elements - discover_dupl_in_mods(Name,Def,Ms, - [M#module{typeorval=lists:flatten(NewTorV)}|Acc], - NewAnyRenamed); -discover_dupl_in_mods(_,_,[],Acc,AnyRenamed) -> - {Acc,AnyRenamed}. - -warn_renamed_def(ModName,NewName,OldName) -> - maybe_first_warn_print(), - io:format("NOTICE: The ASN.1 definition in module ~p with name ~p has been renamed in generated module. New name is ~p.~n",[ModName,OldName,NewName]). - -warn_deleted_def(ModName,DefName) -> - maybe_first_warn_print(), - io:format("NOTICE: The ASN.1 definition in module ~p with name ~p has been deleted in generated module.~n",[ModName,DefName]). - -warn_kept_def(ModName,DefName) -> - maybe_first_warn_print(), - io:format("NOTICE: The ASN.1 definition in module ~p with name ~p has kept its name due to equal definition as duplicate.~n",[ModName,DefName]). - -maybe_first_warn_print() -> - case get(warn_duplicate_defs) of - undefined -> - put(warn_duplicate_defs,true), - io:format("~nDue to multiple occurrences of a definition name in " - "multi-file compiled files:~n"); - _ -> - ok - end. -finished_warn_prints() -> - put(warn_duplicate_defs,undefined). - - -exit_if_nameduplicate(#module{typeorval=TorV}) -> - exit_if_nameduplicate(TorV); -exit_if_nameduplicate([]) -> - ok; -exit_if_nameduplicate([Def|Rest]) -> - Name=get_name_of_def(Def), - exit_if_nameduplicate2(Name,Rest), - exit_if_nameduplicate(Rest). - -exit_if_nameduplicate2(Name,Rest) -> - Pred=fun(Def)-> - case get_name_of_def(Def) of - Name -> true; - _ -> false - end - end, - case lists:any(Pred,Rest) of - true -> - throw({error,{"more than one definition with same name",Name}}); - _ -> - ok - end. - -compare_defs(D1,D2) -> - compare_defs2(unset_pos(D1),unset_pos(D2)). -compare_defs2(D,D) -> - equal; -compare_defs2(_,_) -> - not_equal. - -unset_pos(Def) when record(Def,typedef) -> - Def#typedef{pos=undefined}; -unset_pos(Def) when record(Def,classdef) -> - Def#classdef{pos=undefined}; -unset_pos(Def) when record(Def,valuedef) -> - Def#valuedef{pos=undefined}; -unset_pos(Def) when record(Def,ptypedef) -> - Def#ptypedef{pos=undefined}; -unset_pos(Def) when record(Def,pvaluedef) -> - Def#pvaluedef{pos=undefined}; -unset_pos(Def) when record(Def,pvaluesetdef) -> - Def#pvaluesetdef{pos=undefined}; -unset_pos(Def) when record(Def,pobjectdef) -> - Def#pobjectdef{pos=undefined}; -unset_pos(Def) when record(Def,pobjectsetdef) -> - Def#pobjectsetdef{pos=undefined}. - -get_pos_of_def(#typedef{pos=Pos}) -> - Pos; -get_pos_of_def(#classdef{pos=Pos}) -> - Pos; -get_pos_of_def(#valuedef{pos=Pos}) -> - Pos; -get_pos_of_def(#ptypedef{pos=Pos}) -> - Pos; -get_pos_of_def(#pvaluedef{pos=Pos}) -> - Pos; -get_pos_of_def(#pvaluesetdef{pos=Pos}) -> - Pos; -get_pos_of_def(#pobjectdef{pos=Pos}) -> - Pos; -get_pos_of_def(#pobjectsetdef{pos=Pos}) -> - Pos. - - -get_name_of_def(#typedef{name=Name}) -> - Name; -get_name_of_def(#classdef{name=Name}) -> - Name; -get_name_of_def(#valuedef{name=Name}) -> - Name; -get_name_of_def(#ptypedef{name=Name}) -> - Name; -get_name_of_def(#pvaluedef{name=Name}) -> - Name; -get_name_of_def(#pvaluesetdef{name=Name}) -> - Name; -get_name_of_def(#pobjectdef{name=Name}) -> - Name; -get_name_of_def(#pobjectsetdef{name=Name}) -> - Name. - -set_name_of_def(ModName,Name,OldDef) -> - NewName = list_to_atom(lists:concat([Name,ModName])), - case OldDef of - #typedef{} -> OldDef#typedef{name=NewName}; - #classdef{} -> OldDef#classdef{name=NewName}; - #valuedef{} -> OldDef#valuedef{name=NewName}; - #ptypedef{} -> OldDef#ptypedef{name=NewName}; - #pvaluedef{} -> OldDef#pvaluedef{name=NewName}; - #pvaluesetdef{} -> OldDef#pvaluesetdef{name=NewName}; - #pobjectdef{} -> OldDef#pobjectdef{name=NewName}; - #pobjectsetdef{} -> OldDef#pobjectsetdef{name=NewName} - end. - -save_imports(ModuleList)-> - Fun = fun(M) -> - case M#module.imports of - {_,[]} -> []; - {_,I} -> - {M#module.name,I} - end - end, - ImportsList = lists:map(Fun,ModuleList), - case lists:flatten(ImportsList) of - [] -> - ok; - ImportsList2 -> - create_ets_table(original_imports,[named_table]), - ets:insert(original_imports,ImportsList2) - end. - - -common_exports(ModuleList) -> - %% if all modules exports 'all' then export 'all', - %% otherwise export each typeorval name - case lists:filter(fun(X)-> - element(2,X#module.exports) /= all - end, - ModuleList) of - []-> - {exports,all}; - ModsWithExpList -> - CExports1 = - lists:append(lists:map(fun(X)->element(2,X#module.exports) end, - ModsWithExpList)), - CExports2 = export_all(lists:subtract(ModuleList,ModsWithExpList)), - {exports,CExports1++CExports2} - end. - -export_all([])->[]; -export_all(ModuleList) -> - ExpList = - lists:map( - fun(M)-> - TorVL=M#module.typeorval, - MName = M#module.name, - lists:map( - fun(Def)-> - case Def of - T when record(T,typedef)-> - #'Externaltypereference'{pos=0, - module=MName, - type=T#typedef.name}; - V when record(V,valuedef) -> - #'Externalvaluereference'{pos=0, - module=MName, - value=V#valuedef.name}; - C when record(C,classdef) -> - #'Externaltypereference'{pos=0, - module=MName, - type=C#classdef.name}; - P when record(P,ptypedef) -> - #'Externaltypereference'{pos=0, - module=MName, - type=P#ptypedef.name}; - PV when record(PV,pvaluesetdef) -> - #'Externaltypereference'{pos=0, - module=MName, - type=PV#pvaluesetdef.name}; - PO when record(PO,pobjectdef) -> - #'Externalvaluereference'{pos=0, - module=MName, - value=PO#pobjectdef.name} - end - end, - TorVL) - end, - ModuleList), - lists:append(ExpList). - -%% common_imports/2 -%% IList is a list of tuples, {Imports,MName}, where Imports is the imports of -%% the module with name MName. -%% InputMNameL holds the names of all merged modules. -%% Returns an import tuple with a list of imports that are external the merged -%% set of modules. -common_imports(IList,InputMNameL) -> - SetExternalImportsList = remove_in_set_imports(IList,InputMNameL,[]), - {imports,remove_import_doubles(SetExternalImportsList)}. - -check_tagdefault(ModList) -> - case have_same_tagdefault(ModList) of - {true,TagDefault} -> TagDefault; - {false,TagDefault} -> - create_ets_table(automatic_tags,[named_table]), - save_automatic_tagged_types(ModList), - TagDefault - end. - -have_same_tagdefault([#module{tagdefault=T}|Ms]) -> - have_same_tagdefault(Ms,{true,T}). - -have_same_tagdefault([],TagDefault) -> - TagDefault; -have_same_tagdefault([#module{tagdefault=T}|Ms],TDefault={_,T}) -> - have_same_tagdefault(Ms,TDefault); -have_same_tagdefault([#module{tagdefault=T1}|Ms],{_,T2}) -> - have_same_tagdefault(Ms,{false,rank_tagdef([T1,T2])}). - -rank_tagdef(L) -> - case lists:member('EXPLICIT',L) of - true -> 'EXPLICIT'; - _ -> 'IMPLICIT' - end. - -save_automatic_tagged_types([])-> - done; -save_automatic_tagged_types([#module{tagdefault='AUTOMATIC', - typeorval=TorV}|Ms]) -> - Fun = - fun(T) -> - ets:insert(automatic_tags,{get_name_of_def(T)}) - end, - lists:foreach(Fun,TorV), - save_automatic_tagged_types(Ms); -save_automatic_tagged_types([_M|Ms]) -> - save_automatic_tagged_types(Ms). - -%% remove_in_set_imports/3 : -%% input: list with tuples of each module's imports and module name -%% respectively. -%% output: one list with same format but each occured import from a -%% module in the input set (IMNameL) is removed. -remove_in_set_imports([{{imports,ImpL},_ModName}|Rest],InputMNameL,Acc) -> - NewImpL = remove_in_set_imports1(ImpL,InputMNameL,[]), - remove_in_set_imports(Rest,InputMNameL,NewImpL++Acc); -remove_in_set_imports([],_,Acc) -> - lists:reverse(Acc). - -remove_in_set_imports1([I|Is],InputMNameL,Acc) -> - case I#'SymbolsFromModule'.module of - #'Externaltypereference'{type=MName} -> - case lists:member(MName,InputMNameL) of - true -> - remove_in_set_imports1(Is,InputMNameL,Acc); - false -> - remove_in_set_imports1(Is,InputMNameL,[I|Acc]) - end; - _ -> - remove_in_set_imports1(Is,InputMNameL,[I|Acc]) - end; -remove_in_set_imports1([],_,Acc) -> - lists:reverse(Acc). - -remove_import_doubles([]) -> - []; -%% If several modules in the merge set imports symbols from -%% the same external module it might be doubled. -%% ImportList has #'SymbolsFromModule' elements -remove_import_doubles(ImportList) -> - MergedImportList = - merge_symbols_from_module(ImportList,[]), -%% io:format("MergedImportList: ~p~n",[MergedImportList]), - delete_double_of_symbol(MergedImportList,[]). - -merge_symbols_from_module([Imp|Imps],Acc) -> - #'Externaltypereference'{type=ModName} = Imp#'SymbolsFromModule'.module, - IfromModName = - lists:filter( - fun(I)-> - case I#'SymbolsFromModule'.module of - #'Externaltypereference'{type=ModName} -> - true; - #'Externalvaluereference'{value=ModName} -> - true; - _ -> false - end - end, - Imps), - NewImps = lists:subtract(Imps,IfromModName), -%% io:format("Imp: ~p~nIfromModName: ~p~n",[Imp,IfromModName]), - NewImp = - Imp#'SymbolsFromModule'{ - symbols = lists:append( - lists:map(fun(SL)-> - SL#'SymbolsFromModule'.symbols - end,[Imp|IfromModName]))}, - merge_symbols_from_module(NewImps,[NewImp|Acc]); -merge_symbols_from_module([],Acc) -> - lists:reverse(Acc). - -delete_double_of_symbol([I|Is],Acc) -> - SymL=I#'SymbolsFromModule'.symbols, - NewSymL = delete_double_of_symbol1(SymL,[]), - delete_double_of_symbol(Is,[I#'SymbolsFromModule'{symbols=NewSymL}|Acc]); -delete_double_of_symbol([],Acc) -> - Acc. - -delete_double_of_symbol1([TRef=#'Externaltypereference'{type=TrefName}|Rest],Acc)-> - NewRest = - lists:filter(fun(S)-> - case S of - #'Externaltypereference'{type=TrefName}-> - false; - _ -> true - end - end, - Rest), - delete_double_of_symbol1(NewRest,[TRef|Acc]); -delete_double_of_symbol1([VRef=#'Externalvaluereference'{value=VName}|Rest],Acc) -> - NewRest = - lists:filter(fun(S)-> - case S of - #'Externalvaluereference'{value=VName}-> - false; - _ -> true - end - end, - Rest), - delete_double_of_symbol1(NewRest,[VRef|Acc]); -delete_double_of_symbol1([TRef={#'Externaltypereference'{type=MRef}, - #'Externaltypereference'{type=TRef}}|Rest], - Acc)-> - NewRest = - lists:filter( - fun(S)-> - case S of - {#'Externaltypereference'{type=MRef}, - #'Externaltypereference'{type=TRef}}-> - false; - _ -> true - end - end, - Rest), - delete_double_of_symbol1(NewRest,[TRef|Acc]); -delete_double_of_symbol1([],Acc) -> - Acc. - - -scan_set(DirName,Files,Options) -> - lists:map( - fun(F)-> - case scan({true,true},filename:join([DirName,F]),Options) of - {false,{error,Reason}} -> - throw({error,{'scan error in file:',F,Reason}}); - {TrueOrFalse,Res} -> - {TrueOrFalse,Res,F} - end - end, - Files). - -parse_set(ScanRes,Options) -> - lists:map( - fun({TorF,Toks,F})-> - case parse({TorF,Toks},F,Options) of - {false,{error,Reason}} -> - throw({error,{'parse error in file:',F,Reason}}); - {TrueOrFalse,Res} -> - {TrueOrFalse,Res,F} - end - end, - ScanRes). - - -%%*********************************** - - -scan({true,_}, File,Options) -> - case asn1ct_tok:file(File) of - {error,Reason} -> - io:format("~p~n",[Reason]), - {false,{error,Reason}}; - Tokens -> - case lists:member(ss,Options) of - true -> % we terminate after scan - {false,Tokens}; - false -> % continue with next pass - {true,Tokens} - end - end; -scan({false,Result},_,_) -> - Result. - - -parse({true,Tokens},File,Options) -> - %Presult = asn1ct_parser2:parse(Tokens), - %%case lists:member(p1,Options) of - %% true -> - %% asn1ct_parser:parse(Tokens); - %% _ -> - %% asn1ct_parser2:parse(Tokens) - %% end, - case catch asn1ct_parser2:parse(Tokens) of - {error,{{Line,_Mod,Message},_TokTup}} -> - if - integer(Line) -> - BaseName = filename:basename(File), - io:format("syntax error at line ~p in module ~s:~n", - [Line,BaseName]); - true -> - io:format("syntax error in module ~p:~n",[File]) - end, - print_error_message(Message), - {false,{error,Message}}; - {error,{Line,_Mod,[Message,Token]}} -> - io:format("syntax error: ~p ~p at line ~p~n", - [Message,Token,Line]), - {false,{error,{Line,[Message,Token]}}}; - {ok,M} -> - case lists:member(sp,Options) of - true -> % terminate after parse - {false,M}; - false -> % continue with next pass - {true,M} - end; - OtherError -> - io:format("~p~n",[OtherError]) - end; -parse({false,Tokens},_,_) -> - {false,Tokens}. - -check({true,M},File,OutFile,Includes,EncodingRule,DbFile,Options,InputMods) -> - cmp(M#module.name,File), - start(["."|Includes]), - case asn1ct_check:storeindb(M) of - ok -> - Module = asn1_db:dbget(M#module.name,'MODULE'), - State = #state{mname=Module#module.name, - module=Module#module{typeorval=[]}, - erule=EncodingRule, - inputmodules=InputMods, - options=Options}, - Check = asn1ct_check:check(State,Module#module.typeorval), - case {Check,lists:member(abs,Options)} of - {{error,Reason},_} -> - {false,{error,Reason}}; - {{ok,NewTypeOrVal,_},true} -> - NewM = Module#module{typeorval=NewTypeOrVal}, - asn1_db:dbput(NewM#module.name,'MODULE',NewM), - pretty2(M#module.name,lists:concat([OutFile,".abs"])), - {false,ok}; - {{ok,NewTypeOrVal,GenTypeOrVal},_} -> - NewM = Module#module{typeorval=NewTypeOrVal}, - asn1_db:dbput(NewM#module.name,'MODULE',NewM), - asn1_db:dbsave(DbFile,M#module.name), - io:format("--~p--~n",[{generated,DbFile}]), - {true,{M,NewM,GenTypeOrVal}} - end - end; -check({false,M},_,_,_,_,_,_,_) -> - {false,M}. - -generate({true,{M,_Module,GenTOrV}},OutFile,EncodingRule,Options) -> - debug_on(Options), - case lists:member(compact_bit_string,Options) of - true -> put(compact_bit_string,true); - _ -> ok - end, - put(encoding_options,Options), - create_ets_table(check_functions,[named_table]), - - %% create decoding function names and taglists for partial decode - %% For the time being leave errors unnoticed !!!!!!!!! -% io:format("Options: ~p~n",[Options]), - case catch specialized_decode_prepare(EncodingRule,M,GenTOrV,Options) of - {error, enoent} -> ok; - {error, Reason} -> io:format("WARNING: Error in configuration" - "file: ~n~p~n",[Reason]); - {'EXIT',Reason} -> io:format("WARNING: Internal error when " - "analyzing configuration" - "file: ~n~p~n",[Reason]); - _ -> ok - end, - - asn1ct_gen:pgen(OutFile,EncodingRule,M#module.name,GenTOrV), - debug_off(Options), - put(compact_bit_string,false), - erase(encoding_options), - erase(tlv_format), % used in ber_bin, optimize - erase(class_default_type),% used in ber_bin, optimize - ets:delete(check_functions), - case lists:member(sg,Options) of - true -> % terminate here , with .erl file generated - {false,true}; - false -> - {true,true} - end; -generate({false,M},_,_,_) -> - {false,M}. - -compile_erl({true,_},OutFile,Options) -> - erl_compile(OutFile,Options); -compile_erl({false,true},_,_) -> - ok; -compile_erl({false,Result},_,_) -> - Result. - -input_file_type([]) -> - {empty_name,[]}; -input_file_type(File) -> - case filename:extension(File) of - [] -> - case file:read_file_info(lists:concat([File,".asn1"])) of - {ok,_FileInfo} -> - {single_file, lists:concat([File,".asn1"])}; - _Error -> - case file:read_file_info(lists:concat([File,".asn"])) of - {ok,_FileInfo} -> - {single_file, lists:concat([File,".asn"])}; - _Error -> - {single_file, lists:concat([File,".py"])} - end - end; - ".asn1config" -> - case read_config_file(File,asn1_module) of - {ok,Asn1Module} -> - put(asn1_config_file,File), - input_file_type(Asn1Module); - Error -> - Error - end; - Asn1PFix -> - Base = filename:basename(File,Asn1PFix), - case filename:extension(Base) of - [] -> - {single_file,File}; - SetPFix when (SetPFix == ".set") -> - {multiple_files_file, - filename:basename(Base,SetPFix), - File}; - _Error -> - throw({input_file_error,{'Bad input file',File}}) - end - end. - -get_file_list(File) -> - case file:open(File, [read]) of - {error,Reason} -> - {error,{File,file:format_error(Reason)}}; - {ok,Stream} -> - get_file_list1(Stream,[]) - end. - -get_file_list1(Stream,Acc) -> - Ret = io:get_line(Stream,''), - case Ret of - eof -> - file:close(Stream), - lists:reverse(Acc); - FileName -> - PrefixedNameList = - case (catch input_file_type(lists:delete($\n,FileName))) of - {empty_name,[]} -> []; - {single_file,Name} -> [Name]; - {multiple_files_file,Name} -> - get_file_list(Name); - Err = {input_file_error,_Reason} -> - throw(Err) - end, - get_file_list1(Stream,PrefixedNameList++Acc) - end. - -get_rule(Options) -> - case [Rule ||Rule <-[per,ber,ber_bin,ber_bin_v2,per_bin], - Opt <- Options, - Rule==Opt] of - [Rule] -> - Rule; - [Rule|_] -> - Rule; - [] -> - ber - end. - -erl_compile(OutFile,Options) -> -% io:format("Options:~n~p~n",[Options]), - case lists:member(noobj,Options) of - true -> - ok; - _ -> - ErlOptions = remove_asn_flags(Options), - case c:c(OutFile,ErlOptions) of - {ok,_Module} -> - ok; - _ -> - {error,'no_compilation'} - end - end. - -remove_asn_flags(Options) -> - [X || X <- Options, - X /= get_rule(Options), - X /= optimize, - X /= compact_bit_string, - X /= debug, - X /= keyed_list]. - -debug_on(Options) -> - case lists:member(debug,Options) of - true -> - put(asndebug,true); - _ -> - true - end, - case lists:member(keyed_list,Options) of - true -> - put(asn_keyed_list,true); - _ -> - true - end. - - -debug_off(_Options) -> - erase(asndebug), - erase(asn_keyed_list). - - -outfile(Base, Ext, Opts) when atom(Ext) -> - outfile(Base, atom_to_list(Ext), Opts); -outfile(Base, Ext, Opts) -> - Obase = case lists:keysearch(outdir, 1, Opts) of - {value, {outdir, Odir}} -> filename:join(Odir, Base); - _NotFound -> Base % Not found or bad format - end, - case Ext of - [] -> - Obase; - _ -> - Obase++"."++Ext - end. - -%% compile(AbsFileName, Options) -%% Compile entry point for erl_compile. - -compile_asn(File,OutFile,Options) -> - compile(lists:concat([File,".asn"]),OutFile,Options). - -compile_asn1(File,OutFile,Options) -> - compile(lists:concat([File,".asn1"]),OutFile,Options). - -compile_py(File,OutFile,Options) -> - compile(lists:concat([File,".py"]),OutFile,Options). - -compile(File, _OutFile, Options) -> - case catch compile(File, make_erl_options(Options)) of - Exit = {'EXIT',_Reason} -> - io:format("~p~n~s~n",[Exit,"error"]), - error; - {error,_Reason} -> - %% case occurs due to error in asn1ct_parser2,asn1ct_check -%% io:format("~p~n",[_Reason]), -%% io:format("~p~n~s~n",[_Reason,"error"]), - error; - ok -> - io:format("ok~n"), - ok; - ParseRes when tuple(ParseRes) -> - io:format("~p~n",[ParseRes]), - ok; - ScanRes when list(ScanRes) -> - io:format("~p~n",[ScanRes]), - ok; - Unknown -> - io:format("~p~n~s~n",[Unknown,"error"]), - error - end. - -%% Converts generic compiler options to specific options. - -make_erl_options(Opts) -> - - %% This way of extracting will work even if the record passed - %% has more fields than known during compilation. - - Includes = Opts#options.includes, - Defines = Opts#options.defines, - Outdir = Opts#options.outdir, -%% Warning = Opts#options.warning, - Verbose = Opts#options.verbose, - Specific = Opts#options.specific, - Optimize = Opts#options.optimize, - OutputType = Opts#options.output_type, - Cwd = Opts#options.cwd, - - Options = - case Verbose of - true -> [verbose]; - false -> [] - end ++ -%%% case Warning of -%%% 0 -> []; -%%% _ -> [report_warnings] -%%% end ++ - [] ++ - case Optimize of - 1 -> [optimize]; - 999 -> []; - _ -> [{optimize,Optimize}] - end ++ - lists:map( - fun ({Name, Value}) -> - {d, Name, Value}; - (Name) -> - {d, Name} - end, - Defines) ++ - case OutputType of - undefined -> [ber]; % temporary default (ber when it's ready) - ber -> [ber]; - ber_bin -> [ber_bin]; - ber_bin_v2 -> [ber_bin_v2]; - per -> [per]; - per_bin -> [per_bin] - end, - - Options++[report_errors, {cwd, Cwd}, {outdir, Outdir}| - lists:map(fun(Dir) -> {i, Dir} end, Includes)]++Specific. - -pretty2(Module,AbsFile) -> - start(), - {ok,F} = file:open(AbsFile, [write]), - M = asn1_db:dbget(Module,'MODULE'), - io:format(F,"%%%%%%%%%%%%%%%%%%% ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), - io:format(F,"~s\n",[asn1ct_pretty_format:term(M#module.defid)]), - io:format(F,"~s\n",[asn1ct_pretty_format:term(M#module.tagdefault)]), - io:format(F,"~s\n",[asn1ct_pretty_format:term(M#module.exports)]), - io:format(F,"~s\n",[asn1ct_pretty_format:term(M#module.imports)]), - io:format(F,"~s\n\n",[asn1ct_pretty_format:term(M#module.extensiondefault)]), - - {Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets} = M#module.typeorval, - io:format(F,"%%%%%%%%%%%%%%%%%%% TYPES in ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), - lists:foreach(fun(T)-> io:format(F,"~s\n", - [asn1ct_pretty_format:term(asn1_db:dbget(Module,T))]) - end,Types), - io:format(F,"%%%%%%%%%%%%%%%%%%% VALUES in ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), - lists:foreach(fun(T)-> io:format(F,"~s\n", - [asn1ct_pretty_format:term(asn1_db:dbget(Module,T))]) - end,Values), - io:format(F,"%%%%%%%%%%%%%%%%%%% Parameterized Types in ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), - lists:foreach(fun(T)-> io:format(F,"~s\n", - [asn1ct_pretty_format:term(asn1_db:dbget(Module,T))]) - end,ParameterizedTypes), - io:format(F,"%%%%%%%%%%%%%%%%%%% Classes in ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), - lists:foreach(fun(T)-> io:format(F,"~s\n", - [asn1ct_pretty_format:term(asn1_db:dbget(Module,T))]) - end,Classes), - io:format(F,"%%%%%%%%%%%%%%%%%%% Objects in ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), - lists:foreach(fun(T)-> io:format(F,"~s\n", - [asn1ct_pretty_format:term(asn1_db:dbget(Module,T))]) - end,Objects), - io:format(F,"%%%%%%%%%%%%%%%%%%% Object Sets in ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), - lists:foreach(fun(T)-> io:format(F,"~s\n", - [asn1ct_pretty_format:term(asn1_db:dbget(Module,T))]) - end,ObjectSets). -start() -> - Includes = ["."], - start(Includes). - - -start(Includes) when list(Includes) -> - asn1_db:dbstart(Includes). - -stop() -> - save(), - asn1_db:stop_server(ns), - asn1_db:stop_server(rand), - stopped. - -save() -> - asn1_db:dbstop(). - -%%clear() -> -%% asn1_db:dbclear(). - -encode(Module,Term) -> - asn1rt:encode(Module,Term). - -encode(Module,Type,Term) when list(Module) -> - asn1rt:encode(list_to_atom(Module),Type,Term); -encode(Module,Type,Term) -> - asn1rt:encode(Module,Type,Term). - -decode(Module,Type,Bytes) when list(Module) -> - asn1rt:decode(list_to_atom(Module),Type,Bytes); -decode(Module,Type,Bytes) -> - asn1rt:decode(Module,Type,Bytes). - - -test(Module) -> - start(), - M = asn1_db:dbget(Module,'MODULE'), - {Types,_Values,_Ptypes,_Classes,_Objects,_ObjectSets} = M#module.typeorval, - test_each(Module,Types). - -test_each(Module,[Type | Rest]) -> - case test(Module,Type) of - {ok,_Result} -> - test_each(Module,Rest); - Error -> - Error - end; -test_each(_,[]) -> - ok. - -test(Module,Type) -> - io:format("~p:~p~n",[Module,Type]), - case (catch value(Module,Type)) of - {ok,Val} -> - %% io:format("asn1ct:test/2: ~w~n",[Val]), - test(Module,Type,Val); - {'EXIT',Reason} -> - {error,{asn1,{value,Reason}}} - end. - - -test(Module,Type,Value) -> - case catch encode(Module,Type,Value) of - {ok,Bytes} -> - %% io:format("test 1: ~p~n",[{Bytes}]), - M = if - list(Module) -> - list_to_atom(Module); - true -> - Module - end, - NewBytes = - case M:encoding_rule() of - ber -> - lists:flatten(Bytes); - ber_bin when binary(Bytes) -> - Bytes; - ber_bin -> - list_to_binary(Bytes); - ber_bin_v2 when binary(Bytes) -> - Bytes; - ber_bin_v2 -> - list_to_binary(Bytes); - per -> - lists:flatten(Bytes); - per_bin when binary(Bytes) -> - Bytes; - per_bin -> - list_to_binary(Bytes) - end, - case decode(Module,Type,NewBytes) of - {ok,Value} -> - {ok,{Module,Type,Value}}; - {ok,Res} -> - {error,{asn1,{encode_decode_mismatch, - {{Module,Type,Value},Res}}}}; - Error -> - {error,{asn1,{{decode, - {Module,Type,Value},Error}}}} - end; - Error -> - {error,{asn1,{encode,{{Module,Type,Value},Error}}}} - end. - -value(Module) -> - start(), - M = asn1_db:dbget(Module,'MODULE'), - {Types,_Values,_Ptypes,_Classes,_Objects,_ObjectSets} = M#module.typeorval, - lists:map(fun(A) ->value(Module,A) end,Types). - -value(Module,Type) -> - start(), - case catch asn1ct_value:get_type(Module,Type,no) of - {error,Reason} -> - {error,Reason}; - {'EXIT',Reason} -> - {error,Reason}; - Result -> - {ok,Result} - end. - -cmp(Module,InFile) -> - Base = filename:basename(InFile), - Dir = filename:dirname(InFile), - Ext = filename:extension(Base), - Finfo = file:read_file_info(InFile), - Minfo = file:read_file_info(filename:join(Dir,lists:concat([Module,Ext]))), - case Finfo of - Minfo -> - ok; - _ -> - io:format("asn1error: Modulename and filename must be equal~n",[]), - throw(error) - end. - -vsn() -> - ?vsn. - -print_error_message([got,H|T]) when list(H) -> - io:format(" got:"), - print_listing(H,"and"), - print_error_message(T); -print_error_message([expected,H|T]) when list(H) -> - io:format(" expected one of:"), - print_listing(H,"or"), - print_error_message(T); -print_error_message([H|T]) -> - io:format(" ~p",[H]), - print_error_message(T); -print_error_message([]) -> - io:format("~n"). - -print_listing([H1,H2|[]],AndOr) -> - io:format(" ~p ~s ~p",[H1,AndOr,H2]); -print_listing([H1,H2|T],AndOr) -> - io:format(" ~p,",[H1]), - print_listing([H2|T],AndOr); -print_listing([H],_AndOr) -> - io:format(" ~p",[H]); -print_listing([],_) -> - ok. - - -%% functions to administer ets tables - -%% Always creates a new table -create_ets_table(Name,Options) when atom(Name) -> - case ets:info(Name) of - undefined -> - ets:new(Name,Options); - _ -> - ets:delete(Name), - ets:new(Name,Options) - end. - -%% Creates a new ets table only if no table exists -create_if_no_table(Name,Options) -> - case ets:info(Name) of - undefined -> - %% create a new table - create_ets_table(Name,Options); - _ -> ok - end. - - -delete_tables([Table|Ts]) -> - case ets:info(Table) of - undefined -> ok; - _ -> ets:delete(Table) - end, - delete_tables(Ts); -delete_tables([]) -> - ok. - - -specialized_decode_prepare(Erule,M,TsAndVs,Options) -> -% Asn1confMember = -% fun([{asn1config,File}|_],_) -> -% {true,File}; -% ([],_) -> false; -% ([_H|T],Fun) -> -% Fun(T,Fun) -% end, -% case Asn1confMember(Options,Asn1confMember) of -% {true,File} -> - case lists:member(asn1config,Options) of - true -> - partial_decode_prepare(Erule,M,TsAndVs,Options); - _ -> - ok - end. -%% Reads the configuration file if it exists and stores information -%% about partial decode and incomplete decode -partial_decode_prepare(ber_bin_v2,M,TsAndVs,Options) when tuple(TsAndVs) -> - %% read configure file -% Types = element(1,TsAndVs), - CfgList = read_config_file(M#module.name), - SelectedDecode = get_config_info(CfgList,partial_decode), - ExclusiveDecode = get_config_info(CfgList,exclusive_decode), - CommandList = - create_partial_decode_gen_info(M#module.name,SelectedDecode), -% io:format("partial_decode = ~p~n",[CommandList]), - - save_config(partial_decode,CommandList), - CommandList2 = - create_partial_inc_decode_gen_info(M#module.name,ExclusiveDecode), -% io:format("partial_incomplete_decode = ~p~n",[CommandList2]), - Part_inc_tlv_tags = tag_format(ber_bin_v2,Options,CommandList2), -% io:format("partial_incomplete_decode: tlv_tags = ~p~n",[Part_inc_tlv_tags]), - save_config(partial_incomplete_decode,Part_inc_tlv_tags), - save_gen_state(ExclusiveDecode,Part_inc_tlv_tags); -partial_decode_prepare(_,_,_,_) -> - ok. - - - -%% create_partial_inc_decode_gen_info/2 -%% -%% Creats a list of tags out of the information in TypeNameList that -%% tells which value will be incomplete decoded, i.e. each end -%% component/type in TypeNameList. The significant types/components in -%% the path from the toptype must be specified in the -%% TypeNameList. Significant elements are all constructed types that -%% branches the path to the leaf and the leaf it selfs. -%% -%% Returns a list of elements, where an element may be one of -%% mandatory|[opt,Tag]|[bin,Tag]. mandatory correspond to a mandatory -%% element that shall be decoded as usual. [opt,Tag] matches an -%% OPTIONAL or DEFAULT element that shall be decoded as -%% usual. [bin,Tag] corresponds to an element, mandatory, OPTIONAL or -%% DEFAULT, that shall be left encoded (incomplete decoded). -create_partial_inc_decode_gen_info(ModName,{Mod,[{Name,L}|Ls]}) when list(L) -> - TopTypeName = partial_inc_dec_toptype(L), - [{Name,TopTypeName, - create_partial_inc_decode_gen_info1(ModName,TopTypeName,{Mod,L})}| - create_partial_inc_decode_gen_info(ModName,{Mod,Ls})]; -create_partial_inc_decode_gen_info(_,{_,[]}) -> - []; -create_partial_inc_decode_gen_info(_,[]) -> - []. - -create_partial_inc_decode_gen_info1(ModName,TopTypeName,{ModName, - [_TopType|Rest]}) -> - case asn1_db:dbget(ModName,TopTypeName) of - #typedef{typespec=TS} -> - TagCommand = get_tag_command(TS,?MANDATORY,mandatory), - create_pdec_inc_command(ModName,get_components(TS#type.def), - Rest,[TagCommand]); - _ -> - throw({error,{"wrong type list in asn1 config file", - TopTypeName}}) - end; -create_partial_inc_decode_gen_info1(M1,_,{M2,_}) when M1 /= M2 -> - throw({error,{"wrong module name in asn1 config file", - M2}}); -create_partial_inc_decode_gen_info1(_,_,TNL) -> - throw({error,{"wrong type list in asn1 config file", - TNL}}). - -%% -%% Only when there is a 'ComponentType' the config data C1 may be a -%% list, where the incomplete decode is branched. So, C1 may be a -%% list, a "binary tuple", a "parts tuple" or an atom. The second -%% element of a binary tuple and a parts tuple is an atom. -create_pdec_inc_command(_ModName,_,[],Acc) -> - lists:reverse(Acc); -create_pdec_inc_command(ModName,{Comps1,Comps2},TNL,Acc) - when list(Comps1),list(Comps2) -> - create_pdec_inc_command(ModName,Comps1 ++ Comps2,TNL,Acc); -create_pdec_inc_command(ModN,Clist,[CL|_Rest],Acc) when list(CL) -> - create_pdec_inc_command(ModN,Clist,CL,Acc); -create_pdec_inc_command(ModName, - CList=[#'ComponentType'{name=Name,typespec=TS, - prop=Prop}|Comps], - TNL=[C1|Cs],Acc) -> - case C1 of -% Name -> -% %% In this case C1 is an atom -% TagCommand = get_tag_command(TS,?MANDATORY,Prop), -% create_pdec_inc_command(ModName,get_components(TS#type.def),Cs,[TagCommand|Acc]); - {Name,undecoded} -> - TagCommand = get_tag_command(TS,?UNDECODED,Prop), - create_pdec_inc_command(ModName,Comps,Cs,[TagCommand|Acc]); - {Name,parts} -> - TagCommand = get_tag_command(TS,?PARTS,Prop), - create_pdec_inc_command(ModName,Comps,Cs,[TagCommand|Acc]); - L when list(L) -> - %% This case is only possible as the first element after - %% the top type element, when top type is SEGUENCE or SET. - %% Follow each element in L. Must note every tag on the - %% way until the last command is reached, but it ought to - %% be enough to have a "complete" or "complete optional" - %% command for each component that is not specified in the - %% config file. Then in the TLV decode the components with - %% a "complete" command will be decoded by an ordinary TLV - %% decode. - create_pdec_inc_command(ModName,CList,L,Acc); - {Name,RestPartsList} when list(RestPartsList) -> - %% Same as previous, but this may occur at any place in - %% the structure. The previous is only possible as the - %% second element. - case get_tag_command(TS,?MANDATORY,Prop) of - ?MANDATORY -> - InnerDirectives= - create_pdec_inc_command(ModName,TS#type.def, - RestPartsList,[]), - create_pdec_inc_command(ModName,Comps,Cs, - [[?MANDATORY,InnerDirectives]|Acc]); -% create_pdec_inc_command(ModName,Comps,Cs, -% [InnerDirectives,?MANDATORY|Acc]); - [Opt,EncTag] -> - InnerDirectives = - create_pdec_inc_command(ModName,TS#type.def, - RestPartsList,[]), - create_pdec_inc_command(ModName,Comps,Cs, - [[Opt,EncTag,InnerDirectives]|Acc]) - end; -% create_pdec_inc_command(ModName,CList,RestPartsList,Acc); -%% create_pdec_inc_command(ModName,TS#type.def,RestPartsList,Acc); - _ -> %% this component may not be in the config list - TagCommand = get_tag_command(TS,?MANDATORY,Prop), - create_pdec_inc_command(ModName,Comps,TNL,[TagCommand|Acc]) - end; -create_pdec_inc_command(ModName, - {'CHOICE',[#'ComponentType'{name=C1, - typespec=TS, - prop=Prop}|Comps]}, - [{C1,Directive}|Rest],Acc) -> - case Directive of - List when list(List) -> - [Command,Tag] = get_tag_command(TS,?ALTERNATIVE,Prop), - CompAcc = create_pdec_inc_command(ModName,TS#type.def,List,[]), - create_pdec_inc_command(ModName,{'CHOICE',Comps},Rest, - [[Command,Tag,CompAcc]|Acc]); - undecoded -> - TagCommand = get_tag_command(TS,?ALTERNATIVE_UNDECODED,Prop), - create_pdec_inc_command(ModName,{'CHOICE',Comps},Rest, - [TagCommand|Acc]); - parts -> - TagCommand = get_tag_command(TS,?ALTERNATIVE_PARTS,Prop), - create_pdec_inc_command(ModName,{'CHOICE',Comps},Rest, - [TagCommand|Acc]) - end; -create_pdec_inc_command(ModName, - {'CHOICE',[#'ComponentType'{typespec=TS, - prop=Prop}|Comps]}, - TNL,Acc) -> - TagCommand = get_tag_command(TS,?ALTERNATIVE,Prop), - create_pdec_inc_command(ModName,{'CHOICE',Comps},TNL,[TagCommand|Acc]); -create_pdec_inc_command(M,{'CHOICE',{Cs1,Cs2}},TNL,Acc) - when list(Cs1),list(Cs2) -> - create_pdec_inc_command(M,{'CHOICE',Cs1 ++ Cs2},TNL,Acc); -create_pdec_inc_command(ModName,#'Externaltypereference'{module=M,type=Name}, - TNL,Acc) -> - #type{def=Def} = get_referenced_type(M,Name), - create_pdec_inc_command(ModName,get_components(Def),TNL,Acc); -create_pdec_inc_command(_,_,TNL,_) -> - throw({error,{"unexpected error when creating partial " - "decode command",TNL}}). - -partial_inc_dec_toptype([T|_]) when atom(T) -> - T; -partial_inc_dec_toptype([{T,_}|_]) when atom(T) -> - T; -partial_inc_dec_toptype([L|_]) when list(L) -> - partial_inc_dec_toptype(L); -partial_inc_dec_toptype(_) -> - throw({error,{"no top type found for partial incomplete decode"}}). - - -%% Creats a list of tags out of the information in TypeList and Types -%% that tells which value will be decoded. Each constructed type that -%% is in the TypeList will get a "choosen" command. Only the last -%% type/component in the TypeList may be a primitive type. Components -%% "on the way" to the final element may get the "skip" or the -%% "skip_optional" command. -%% CommandList = [Elements] -%% Elements = {choosen,Tag}|{skip_optional,Tag}|skip -%% Tag is a binary with the tag BER encoded. -create_partial_decode_gen_info(ModName,{{_,ModName},TypeList}) -> - case TypeList of - [TopType|Rest] -> - case asn1_db:dbget(ModName,TopType) of - #typedef{typespec=TS} -> - TagCommand = get_tag_command(TS,?CHOOSEN), - create_pdec_command(ModName,get_components(TS#type.def), - Rest,[TagCommand]); - _ -> - throw({error,{"wrong type list in asn1 config file", - TypeList}}) - end; - _ -> - [] - end; -create_partial_decode_gen_info(_,[]) -> - []; -create_partial_decode_gen_info(_M1,{{_,M2},_}) -> - throw({error,{"wrong module name in asn1 config file", - M2}}). - -%% create_pdec_command/4 for each name (type or component) in the -%% third argument, TypeNameList, a command is created. The command has -%% information whether the component/type shall be skipped, looked -%% into or returned. The list of commands is returned. -create_pdec_command(_ModName,_,[],Acc) -> - lists:reverse(Acc); -create_pdec_command(ModName,[#'ComponentType'{name=C1,typespec=TS}|_Comps], - [C1|Cs],Acc) -> - %% this component is a constructed type or the last in the - %% TypeNameList otherwise the config spec is wrong - TagCommand = get_tag_command(TS,?CHOOSEN), - create_pdec_command(ModName,get_components(TS#type.def), - Cs,[TagCommand|Acc]); -create_pdec_command(ModName,[#'ComponentType'{typespec=TS, - prop=Prop}|Comps], - [C2|Cs],Acc) -> - TagCommand = - case Prop of - mandatory -> - get_tag_command(TS,?SKIP); - _ -> - get_tag_command(TS,?SKIP_OPTIONAL) - end, - create_pdec_command(ModName,Comps,[C2|Cs],[TagCommand|Acc]); -create_pdec_command(ModName,{'CHOICE',[Comp=#'ComponentType'{name=C1}|_]},TNL=[C1|_Cs],Acc) -> - create_pdec_command(ModName,[Comp],TNL,Acc); -create_pdec_command(ModName,{'CHOICE',[#'ComponentType'{}|Comps]},TNL,Acc) -> - create_pdec_command(ModName,{'CHOICE',Comps},TNL,Acc); -create_pdec_command(ModName,#'Externaltypereference'{module=M,type=C1}, - TypeNameList,Acc) -> - case get_referenced_type(M,C1) of - #type{def=Def} -> - create_pdec_command(ModName,get_components(Def),TypeNameList, - Acc); - Err -> - throw({error,{"unexpected result when fetching " - "referenced element",Err}}) - end; -create_pdec_command(ModName,TS=#type{def=Def},[C1|Cs],Acc) -> - %% This case when we got the "components" of a SEQUENCE/SET OF - case C1 of - [1] -> - %% A list with an integer is the only valid option in a 'S - %% OF', the other valid option would be an empty - %% TypeNameList saying that the entire 'S OF' will be - %% decoded. - TagCommand = get_tag_command(TS,?CHOOSEN), - create_pdec_command(ModName,Def,Cs,[TagCommand|Acc]); - [N] when integer(N) -> - TagCommand = get_tag_command(TS,?SKIP), - create_pdec_command(ModName,Def,[[N-1]|Cs],[TagCommand|Acc]); - Err -> - throw({error,{"unexpected error when creating partial " - "decode command",Err}}) - end; -create_pdec_command(_,_,TNL,_) -> - throw({error,{"unexpected error when creating partial " - "decode command",TNL}}). - -% get_components({'CHOICE',Components}) -> -% Components; -get_components(#'SEQUENCE'{components=Components}) -> - Components; -get_components(#'SET'{components=Components}) -> - Components; -get_components({'SEQUENCE OF',Components}) -> - Components; -get_components({'SET OF',Components}) -> - Components; -get_components(Def) -> - Def. - -%% get_tag_command(Type,Command) - -%% Type is the type that has information about the tag Command tells -%% what to do with the encoded value with the tag of Type when -%% decoding. -get_tag_command(#type{tag=[]},_) -> - []; -get_tag_command(#type{tag=[_Tag]},?SKIP) -> - ?SKIP; -get_tag_command(#type{tag=[Tag]},Command) -> - %% encode the tag according to BER - [Command,encode_tag_val(decode_class(Tag#tag.class),Tag#tag.form, - Tag#tag.number)]; -get_tag_command(T=#type{tag=[Tag|Tags]},Command) -> - [get_tag_command(T#type{tag=Tag},Command)| - get_tag_command(T#type{tag=Tags},Command)]. - -%% get_tag_command/3 used by create_pdec_inc_command -get_tag_command(#type{tag=[]},_,_) -> - []; -get_tag_command(#type{tag=[Tag]},?MANDATORY,Prop) -> - case Prop of - mandatory -> - ?MANDATORY; - {'DEFAULT',_} -> - [?DEFAULT,encode_tag_val(decode_class(Tag#tag.class), - Tag#tag.form,Tag#tag.number)]; - _ -> [?OPTIONAL,encode_tag_val(decode_class(Tag#tag.class), - Tag#tag.form,Tag#tag.number)] - end; -get_tag_command(#type{tag=[Tag]},Command,_) -> - [Command,encode_tag_val(decode_class(Tag#tag.class),Tag#tag.form, - Tag#tag.number)]. - - -get_referenced_type(M,Name) -> - case asn1_db:dbget(M,Name) of - #typedef{typespec=TS} -> - case TS of - #type{def=#'Externaltypereference'{module=M2,type=Name2}} -> - %% The tags have already been taken care of in the - %% first reference where they were gathered in a - %% list of tags. - get_referenced_type(M2,Name2); - #type{} -> TS; - _ -> - throw({error,{"unexpected element when" - " fetching referenced type",TS}}) - end; - T -> - throw({error,{"unexpected element when fetching " - "referenced type",T}}) - end. - -tag_format(EncRule,_Options,CommandList) -> - case EncRule of - ber_bin_v2 -> - tlv_tags(CommandList); - _ -> - CommandList - end. - -tlv_tags([]) -> - []; -tlv_tags([mandatory|Rest]) -> - [mandatory|tlv_tags(Rest)]; -tlv_tags([[Command,Tag]|Rest]) when atom(Command),binary(Tag) -> - [[Command,tlv_tag(Tag)]|tlv_tags(Rest)]; -tlv_tags([[Command,Directives]|Rest]) when atom(Command),list(Directives) -> - [[Command,tlv_tags(Directives)]|tlv_tags(Rest)]; -%% remove all empty lists -tlv_tags([[]|Rest]) -> - tlv_tags(Rest); -tlv_tags([{Name,TopType,L1}|Rest]) when list(L1),atom(TopType) -> - [{Name,TopType,tlv_tags(L1)}|tlv_tags(Rest)]; -tlv_tags([[Command,Tag,L1]|Rest]) when list(L1),binary(Tag) -> - [[Command,tlv_tag(Tag),tlv_tags(L1)]|tlv_tags(Rest)]; -tlv_tags([L=[L1|_]|Rest]) when list(L1) -> - [tlv_tags(L)|tlv_tags(Rest)]. - -tlv_tag(<<Cl:2,_:1,TagNo:5>>) when TagNo < 31 -> - (Cl bsl 16) + TagNo; -tlv_tag(<<Cl:2,_:1,31:5,0:1,TagNo:7>>) -> - (Cl bsl 16) + TagNo; -tlv_tag(<<Cl:2,_:1,31:5,Buffer/binary>>) -> - TagNo = tlv_tag1(Buffer,0), - (Cl bsl 16) + TagNo. -tlv_tag1(<<0:1,PartialTag:7>>,Acc) -> - (Acc bsl 7) bor PartialTag; -tlv_tag1(<<1:1,PartialTag:7,Buffer/binary>>,Acc) -> - tlv_tag1(Buffer,(Acc bsl 7) bor PartialTag). - -%% reads the content from the configuration file and returns the -%% selected part choosen by InfoType. Assumes that the config file -%% content is an Erlang term. -read_config_file(ModuleName,InfoType) when atom(InfoType) -> - CfgList = read_config_file(ModuleName), - get_config_info(CfgList,InfoType). - - -read_config_file(ModuleName) -> - case file:consult(lists:concat([ModuleName,'.asn1config'])) of -% case file:consult(ModuleName) of - {ok,CfgList} -> - CfgList; - {error,enoent} -> - Options = get(encoding_options), - Includes = [I || {i,I} <- Options], - read_config_file1(ModuleName,Includes); - {error,Reason} -> - file:format_error(Reason), - throw({error,{"error reading asn1 config file",Reason}}) - end. -read_config_file1(ModuleName,[]) -> - case filename:extension(ModuleName) of - ".asn1config" -> - throw({error,enoent}); - _ -> - read_config_file(lists:concat([ModuleName,".asn1config"])) - end; -read_config_file1(ModuleName,[H|T]) -> -% File = filename:join([H,lists:concat([ModuleName,'.asn1config'])]), - File = filename:join([H,ModuleName]), - case file:consult(File) of - {ok,CfgList} -> - CfgList; - {error,enoent} -> - read_config_file1(ModuleName,T); - {error,Reason} -> - file:format_error(Reason), - throw({error,{"error reading asn1 config file",Reason}}) - end. - -get_config_info(CfgList,InfoType) -> - case InfoType of - all -> - CfgList; - _ -> - case lists:keysearch(InfoType,1,CfgList) of - {value,{InfoType,Value}} -> - Value; - false -> - [] - end - end. - -%% save_config/2 saves the Info with the key Key -%% Before saving anything check if a table exists -save_config(Key,Info) -> - create_if_no_table(asn1_general,[named_table]), - ets:insert(asn1_general,{{asn1_config,Key},Info}). - -read_config_data(Key) -> - case ets:info(asn1_general) of - undefined -> undefined; - _ -> - case ets:lookup(asn1_general,{asn1_config,Key}) of - [{_,Data}] -> Data; - Err -> - io:format("strange data from config file ~w~n",[Err]), - Err - end - end. - - -%% -%% Functions to manipulate the gen_state record saved in the -%% asn1_general ets table. -%% - -%% saves input data in a new gen_state record -save_gen_state({_,ConfList},PartIncTlvTagList) -> - %ConfList=[{FunctionName,PatternList}|Rest] - StateRec = #gen_state{inc_tag_pattern=PartIncTlvTagList, - inc_type_pattern=ConfList}, - save_config(gen_state,StateRec); -save_gen_state(_,_) -> -%% ok. - save_config(gen_state,#gen_state{}). - -save_gen_state(GenState) when record(GenState,gen_state) -> - save_config(gen_state,GenState). - - -%% get_gen_state_field returns undefined if no gen_state exists or if -%% Field is undefined or the data at the field. -get_gen_state_field(Field) -> - case read_config_data(gen_state) of - undefined -> - undefined; - GenState -> - get_gen_state_field(GenState,Field) - end. -get_gen_state_field(#gen_state{active=Active},active) -> - Active; -get_gen_state_field(_,active) -> - false; -get_gen_state_field(GS,prefix) -> - GS#gen_state.prefix; -get_gen_state_field(GS,inc_tag_pattern) -> - GS#gen_state.inc_tag_pattern; -get_gen_state_field(GS,tag_pattern) -> - GS#gen_state.tag_pattern; -get_gen_state_field(GS,inc_type_pattern) -> - GS#gen_state.inc_type_pattern; -get_gen_state_field(GS,type_pattern) -> - GS#gen_state.type_pattern; -get_gen_state_field(GS,func_name) -> - GS#gen_state.func_name; -get_gen_state_field(GS,namelist) -> - GS#gen_state.namelist; -get_gen_state_field(GS,tobe_refed_funcs) -> - GS#gen_state.tobe_refed_funcs; -get_gen_state_field(GS,gen_refed_funcs) -> - GS#gen_state.gen_refed_funcs. - - -get_gen_state() -> - read_config_data(gen_state). - - -update_gen_state(Field,Data) -> - case get_gen_state() of - State when record(State,gen_state) -> - update_gen_state(Field,State,Data); - _ -> - exit({error,{asn1,{internal, - "tried to update nonexistent gen_state",Field,Data}}}) - end. -update_gen_state(active,State,Data) -> - save_gen_state(State#gen_state{active=Data}); -update_gen_state(prefix,State,Data) -> - save_gen_state(State#gen_state{prefix=Data}); -update_gen_state(inc_tag_pattern,State,Data) -> - save_gen_state(State#gen_state{inc_tag_pattern=Data}); -update_gen_state(tag_pattern,State,Data) -> - save_gen_state(State#gen_state{tag_pattern=Data}); -update_gen_state(inc_type_pattern,State,Data) -> - save_gen_state(State#gen_state{inc_type_pattern=Data}); -update_gen_state(type_pattern,State,Data) -> - save_gen_state(State#gen_state{type_pattern=Data}); -update_gen_state(func_name,State,Data) -> - save_gen_state(State#gen_state{func_name=Data}); -update_gen_state(namelist,State,Data) -> -% SData = -% case Data of -% [D] when list(D) -> D; -% _ -> Data -% end, - save_gen_state(State#gen_state{namelist=Data}); -update_gen_state(tobe_refed_funcs,State,Data) -> - save_gen_state(State#gen_state{tobe_refed_funcs=Data}); -update_gen_state(gen_refed_funcs,State,Data) -> - save_gen_state(State#gen_state{gen_refed_funcs=Data}). - -update_namelist(Name) -> - case get_gen_state_field(namelist) of - [Name,Rest] -> update_gen_state(namelist,Rest); - [Name|Rest] -> update_gen_state(namelist,Rest); - [{Name,List}] when list(List) -> update_gen_state(namelist,List); - [{Name,Atom}|Rest] when atom(Atom) -> update_gen_state(namelist,Rest); - Other -> Other - end. - -pop_namelist() -> - DeepTail = %% removes next element in order - fun([[{_,A}]|T],_Fun) when atom(A) -> T; - ([{_N,L}|T],_Fun) when list(L) -> [L|T]; - ([[]|T],Fun) -> Fun(T,Fun); - ([L1|L2],Fun) when list(L1) -> - case lists:flatten(L1) of - [] -> Fun([L2],Fun); - _ -> [Fun(L1,Fun)|L2] - end; - ([_H|T],_Fun) -> T - end, - {Pop,NewNL} = - case get_gen_state_field(namelist) of - [] -> {[],[]}; - L -> - {next_namelist_el(L), - DeepTail(L,DeepTail)} - end, - update_gen_state(namelist,NewNL), - Pop. - -%% next_namelist_el fetches the next type/component name in turn in -%% the namelist, without changing the namelist. -next_namelist_el() -> - case get_gen_state_field(namelist) of - undefined -> undefined; - L when list(L) -> next_namelist_el(L) - end. - -next_namelist_el([]) -> - []; -next_namelist_el([L]) when list(L) -> - next_namelist_el(L); -next_namelist_el([H|_]) when atom(H) -> - H; -next_namelist_el([L|T]) when list(L) -> - case next_namelist_el(L) of - [] -> - next_namelist_el([T]); - R -> - R - end; -next_namelist_el([H={_,A}|_]) when atom(A) -> - H. - -%% removes a bracket from the namelist -step_in_constructed() -> - case get_gen_state_field(namelist) of - [L] when list(L) -> - update_gen_state(namelist,L); - _ -> ok - end. - -is_function_generated(Name) -> - case get_gen_state_field(gen_refed_funcs) of - L when list(L) -> - lists:member(Name,L); - _ -> - false - end. - -get_tobe_refed_func(Name) -> - case get_gen_state_field(tobe_refed_funcs) of - L when list(L) -> - case lists:keysearch(Name,1,L) of - {_,Element} -> - Element; - _ -> - undefined - end; - _ -> - undefined - end. - -add_tobe_refed_func(Data) -> - L = get_gen_state_field(tobe_refed_funcs), - update_gen_state(tobe_refed_funcs,[Data|L]). - -%% moves Name from the to be list to the generated list. -generated_refed_func(Name) -> - L = get_gen_state_field(tobe_refed_funcs), - NewL = lists:keydelete(Name,1,L), - update_gen_state(tobe_refed_funcs,NewL), - L2 = get_gen_state_field(gen_refed_funcs), - update_gen_state(gen_refed_funcs,[Name|L2]). - -add_generated_refed_func(Data) -> - L = get_gen_state_field(gen_refed_funcs), - update_gen_state(gen_refed_funcs,[Data|L]). - - -next_refed_func() -> - case get_gen_state_field(tobe_refed_funcs) of - [] -> - []; - [H|T] -> - update_gen_state(tobe_refed_funcs,T), - H - end. - -reset_gen_state() -> - save_gen_state(#gen_state{}). diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_check.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_check.erl deleted file mode 100644 index 9da6611dba..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_check.erl +++ /dev/null @@ -1,5567 +0,0 @@ -%% ``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: asn1ct_check.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ -%% --module(asn1ct_check). - -%% Main Module for ASN.1 compile time functions - -%-compile(export_all). --export([check/2,storeindb/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_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, - - _Perror = checkp(S,ParameterizedTypes,[]), % must do this before the templates are used - Terror = checkt(S,Types,[]), - - %% 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 - - %% 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,[]), - - %% 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, - [],[],[]), - InlinedObjTuples = ets:tab2list(inlined_objects), - InlinedObjects = lists:map(Element2,InlinedObjTuples), - ets:delete(inlined_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(), - NewTypes = lists:subtract(Types,AddClasses) ++ ContextSwitchTs - ++ InstanceOf, - 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)}}; - _ ->{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() -> - case get(instance_of) of - generate -> - erase(instance_of), - ['INSTANCE OF']; - _ -> - [] - 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) -> - %%io:format("check_typedef:~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}, - %io:format("checkt:dbput:~p, ~p~n",[S#state.mname,NewTypeDef#typedef.name]), - 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) -> - %%io:format("check_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}); - {asn1_class,_ClassDef} -> - {asn1_class,Name}; - Ts -> - NewType = Type#ptypedef{checked=true,typespec = Ts}, - asn1_db:dbput(NewS#state.mname,Name,NewType), % update the type - ok - end - end, - case Result of - ok -> - checkp(S,T,Acc); - _ -> - checkp(S,T,[Result|Acc]) - end; -checkp(_S,[],Acc) -> - lists:reverse(Acc). - - - - -checkc(S,[Name|Cs],Acc) -> - Result = - case asn1_db:dbget(S#state.mname,Name) of - undefined -> - error({class,{internal_error,'???'},S}); - Class -> - ClassSpec = if - record(Class,classdef) -> - Class#classdef.typespec; - record(Class,typedef) -> - Class#typedef.typespec - end, - NewS = S#state{type=Class,tname=Name}, - case catch(check_class(NewS,ClassSpec)) of - {error,Reason} -> - error({class,Reason,NewS}); - {'EXIT',Reason} -> - error({class,{internal_error,Reason},NewS}); - C -> - %% update the classdef - NewClass = - if - record(Class,classdef) -> - Class#classdef{checked=true,typespec=C}; - record(Class,typedef) -> - #classdef{checked=true,name=Name,typespec=C} - end, - asn1_db:dbput(NewS#state.mname,Name,NewClass), - ok - end - end, - case Result of - ok -> - checkc(S,Cs,Acc); - _ -> - checkc(S,Cs,[Result|Acc]) - end; -checkc(_S,[],Acc) -> -%% include_default_class(S#state.mname), - lists:reverse(Acc). - -checko(S,[Name|Os],Acc,ExclO,ExclOS) -> - Result = - case asn1_db:dbget(S#state.mname,Name) of - undefined -> - error({type,{internal_error,'???'},S}); - Object when record(Object,typedef) -> - NewS = S#state{type=Object,tname=Name}, - case catch(check_object(NewS,Object,Object#typedef.typespec)) of - {error,Reason} -> - error({type,Reason,NewS}); - {'EXIT',Reason} -> - error({type,{internal_error,Reason},NewS}); - {asn1,Reason} -> - error({type,Reason,NewS}); - O -> - NewObj = Object#typedef{checked=true,typespec=O}, - asn1_db:dbput(NewS#state.mname,Name,NewObj), - if - record(O,'Object') -> - case O#'Object'.gen of - true -> - {ok,ExclO,ExclOS}; - false -> - {ok,[Name|ExclO],ExclOS} - end; - record(O,'ObjectSet') -> - case O#'ObjectSet'.gen of - true -> - {ok,ExclO,ExclOS}; - false -> - {ok,ExclO,[Name|ExclOS]} - end - end - end; - PObject when record(PObject,pobjectdef) -> - NewS = S#state{type=PObject,tname=Name}, - case (catch check_pobject(NewS,PObject)) of - {error,Reason} -> - error({type,Reason,NewS}); - {'EXIT',Reason} -> - error({type,{internal_error,Reason},NewS}); - {asn1,Reason} -> - error({type,Reason,NewS}); - PO -> - NewPObj = PObject#pobjectdef{def=PO}, - asn1_db:dbput(NewS#state.mname,Name,NewPObj), - {ok,[Name|ExclO],ExclOS} - end; - PObjSet when record(PObjSet,pvaluesetdef) -> - %% this is a parameterized object set. Might be a parameterized - %% value set, couldn't it? - NewS = S#state{type=PObjSet,tname=Name}, - case (catch check_pobjectset(NewS,PObjSet)) of - {error,Reason} -> - error({type,Reason,NewS}); - {'EXIT',Reason} -> - error({type,{internal_error,Reason},NewS}); - {asn1,Reason} -> - error({type,Reason,NewS}); - POS -> - %%NewPObjSet = PObjSet#pvaluesetdef{valueset=POS}, - asn1_db:dbput(NewS#state.mname,Name,POS), - {ok,ExclO,[Name|ExclOS]} - end - end, - case Result of - {ok,NewExclO,NewExclOS} -> - checko(S,Os,Acc,NewExclO,NewExclOS); - _ -> - checko(S,Os,[Result|Acc],ExclO,ExclOS) - end; -checko(_S,[],Acc,ExclO,ExclOS) -> - {lists:reverse(Acc),lists:reverse(ExclO),lists:reverse(ExclOS)}. - -check_class(S,CDef=#classdef{checked=Ch,name=Name,typespec=TS}) -> - case Ch of - true -> TS; - idle -> TS; - _ -> - NewCDef = CDef#classdef{checked=idle}, - asn1_db:dbput(S#state.mname,Name,NewCDef), - CheckedTS = check_class(S,TS), - asn1_db:dbput(S#state.mname,Name, - NewCDef#classdef{checked=true, - typespec=CheckedTS}), - CheckedTS - end; -check_class(S = #state{mname=M,tname=T},ClassSpec) - when record(ClassSpec,type) -> - Def = ClassSpec#type.def, - case Def of - #'Externaltypereference'{module=M,type=T} -> - #objectclass{fields=Def}; % in case of recursive definitions - Tref when record(Tref,'Externaltypereference') -> - {_,RefType} = get_referenced_type(S,Tref), -% case RefType of -% RefClass when record(RefClass,classdef) -> -% check_class(S,RefClass#classdef.typespec) -% end - case is_class(S,RefType) of - true -> - check_class(S,get_class_def(S,RefType)); - _ -> - error({class,{internal_error,RefType},S}) - end - end; -% check_class(S,{objectclassname,ModuleName,ClassName}) when atom(ModuleName),atom(ClassName) -> -% 'fix this'; -check_class(S,C) when record(C,objectclass) -> - NewFieldSpec = check_class_fields(S,C#objectclass.fields), - C#objectclass{fields=NewFieldSpec}; -%check_class(S,{objectclassname,ClassName}) -> -check_class(S,ClassName) -> - {_,Def} = get_referenced_type(S,ClassName), - case Def of - ClassDef when record(ClassDef,classdef) -> - case ClassDef#classdef.checked of - true -> - ClassDef#classdef.typespec; - idle -> - ClassDef#classdef.typespec; - false -> - check_class(S,ClassDef#classdef.typespec) - end; - TypeDef when record(TypeDef,typedef) -> - %% this case may occur when a definition is a reference - %% to a class definition. - case TypeDef#typedef.typespec of - #type{def=Ext} when record(Ext,'Externaltypereference') -> - check_class(S,Ext) - end - end; -check_class(_S,{poc,_ObjSet,_Params}) -> - 'fix this later'. - -check_class_fields(S,Fields) -> - check_class_fields(S,Fields,[]). - -check_class_fields(S,[F|Fields],Acc) -> - NewField = - case element(1,F) of - fixedtypevaluefield -> - {_,Name,Type,Unique,OSpec} = F, - RefType = check_type(S,#typedef{typespec=Type},Type), - {fixedtypevaluefield,Name,RefType,Unique,OSpec}; - object_or_fixedtypevalue_field -> - {_,Name,Type,Unique,OSpec} = F, - Cat = - case asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def)) of - Def when record(Def,typereference); - record(Def,'Externaltypereference') -> - {_,D} = get_referenced_type(S,Def), - D; - {undefined,user} -> - %% neither of {primitive,bif} or {constructed,bif} -%% {_,D} = get_referenced_type(S,#typereference{val=Type#type.def}), - {_,D} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Type#type.def}), - D; - _ -> - Type - end, - case Cat of - Class when record(Class,classdef) -> - {objectfield,Name,Type,Unique,OSpec}; - _ -> - RefType = check_type(S,#typedef{typespec=Type},Type), - {fixedtypevaluefield,Name,RefType,Unique,OSpec} - end; - objectset_or_fixedtypevalueset_field -> - {_,Name,Type,OSpec} = F, -%% RefType = check_type(S,#typedef{typespec=Type},Type), - RefType = - case (catch check_type(S,#typedef{typespec=Type},Type)) of - {asn1_class,_ClassDef} -> - case if_current_checked_type(S,Type) of - true -> - Type#type.def; - _ -> - check_class(S,Type) - end; - CheckedType when record(CheckedType,type) -> - CheckedType; - _ -> - error({class,"internal error, check_class_fields",S}) - end, - if - record(RefType,'Externaltypereference') -> - {objectsetfield,Name,Type,OSpec}; - record(RefType,classdef) -> - {objectsetfield,Name,Type,OSpec}; - record(RefType,objectclass) -> - {objectsetfield,Name,Type,OSpec}; - true -> - {fixedtypevaluesetfield,Name,RefType,OSpec} - end; - typefield -> - case F of - {TF,Name,{'DEFAULT',Type}} -> - {TF,Name,{'DEFAULT',check_type(S,#typedef{typespec=Type},Type)}}; - _ -> F - end; - _ -> F - end, - check_class_fields(S,Fields,[NewField|Acc]); -check_class_fields(_S,[],Acc) -> - lists:reverse(Acc). - -if_current_checked_type(S,#type{def=Def}) -> - CurrentCheckedName = S#state.tname, - MergedModules = S#state.inputmodules, - % CurrentCheckedModule = S#state.mname, - case Def of - #'Externaltypereference'{module=CurrentCheckedName, - type=CurrentCheckedName} -> - true; - #'Externaltypereference'{module=ModuleName, - type=CurrentCheckedName} -> - case MergedModules of - undefined -> - false; - _ -> - lists:member(ModuleName,MergedModules) - end; - _ -> - false - end. - - - -check_pobject(_S,PObject) when record(PObject,pobjectdef) -> - Def = PObject#pobjectdef.def, - Def. - - -check_pobjectset(S,PObjSet) -> - #pvaluesetdef{pos=Pos,name=Name,args=Args,type=Type, - valueset=ValueSet}=PObjSet, - {Mod,Def} = get_referenced_type(S,Type#type.def), - case Def of - #classdef{} -> - ClassName = #'Externaltypereference'{module=Mod, - type=Def#classdef.name}, - {valueset,Set} = ValueSet, -% ObjectSet = #'ObjectSet'{class={objectclassname,ClassName}, - ObjectSet = #'ObjectSet'{class=ClassName, - set=Set}, - #pobjectsetdef{pos=Pos,name=Name,args=Args,class=Type#type.def, - def=ObjectSet}; - _ -> - PObjSet - end. - -check_object(_S,ObjDef,ObjSpec) when (ObjDef#typedef.checked == true) -> - ObjSpec; -check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> - {_,_ClassDef} = get_referenced_type(S,ClassRef), - NewClassRef = check_externaltypereference(S,ClassRef), - ClassDef = - case _ClassDef#classdef.checked of - false -> - #classdef{checked=true, - typespec=check_class(S,_ClassDef#classdef.typespec)}; - _ -> - _ClassDef - end, - NewObj = - case ObjectDef of - Def when tuple(Def), (element(1,Def)==object) -> - NewSettingList = check_objectdefn(S,Def,ClassDef), - #'Object'{def=NewSettingList}; -% Def when tuple(Def), (element(1,Def)=='ObjectFromObject') -> -% fixa; - {po,{object,DefObj},ArgsList} -> - {_,Object} = get_referenced_type(S,DefObj),%DefObj is a - %%#'Externalvaluereference' or a #'Externaltypereference' - %% Maybe this call should be catched and in case of an exception - %% an nonallocated parameterized object should be returned. - instantiate_po(S,ClassDef,Object,ArgsList); - #'Externalvaluereference'{} -> - {_,Object} = get_referenced_type(S,ObjectDef), - check_object(S,Object,Object#typedef.typespec); - _ -> - exit({error,{no_object,ObjectDef},S}) - end, - Gen = gen_incl(S,NewObj#'Object'.def, - (ClassDef#classdef.typespec)#objectclass.fields), - NewObj#'Object'{classname=NewClassRef,gen=Gen}; - -%%check_object(S,ObjSetDef,ObjSet=#type{def={pt,ObjSetRef,Args}}) -> - %% A parameterized - -check_object(S, - _ObjSetDef, - ObjSet=#'ObjectSet'{class=ClassRef}) -> - {_,ClassDef} = get_referenced_type(S,ClassRef), - NewClassRef = check_externaltypereference(S,ClassRef), - UniqueFieldName = - case (catch get_unique_fieldname(ClassDef)) of - {error,'__undefined_'} -> {unique,undefined}; - {asn1,Msg,_} -> error({class,Msg,S}); - Other -> Other - end, - NewObjSet= - case ObjSet#'ObjectSet'.set of - {'SingleValue',Set} when list(Set) -> - CheckedSet = check_object_list(S,NewClassRef,Set), - NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet}; - {'SingleValue',{definedvalue,ObjName}} -> - {_,ObjDef} = get_referenced_type(S,#identifier{val=ObjName}), - #'Object'{def=CheckedObj} = - check_object(S,ObjDef,ObjDef#typedef.typespec), - NewSet = get_unique_valuelist(S,[{ObjDef#typedef.name, - CheckedObj}], - UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet}; - {'SingleValue',#'Externalvaluereference'{value=ObjName}} -> - {_,ObjDef} = get_referenced_type(S,#identifier{val=ObjName}), - #'Object'{def=CheckedObj} = - check_object(S,ObjDef,ObjDef#typedef.typespec), - NewSet = get_unique_valuelist(S,[{ObjDef#typedef.name, - CheckedObj}], - UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet}; - ['EXTENSIONMARK'] -> - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=['EXTENSIONMARK']}; - Set when list(Set) -> - CheckedSet = check_object_list(S,NewClassRef,Set), - NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet}; - {Set,Ext} when list(Set) -> - CheckedSet = check_object_list(S,NewClassRef,Set++Ext), - NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet++['EXTENSIONMARK']}; - {{'SingleValue',Set},Ext} -> - CheckedSet = check_object_list(S,NewClassRef, - merge_sets(Set,Ext)), - NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet++['EXTENSIONMARK']}; - {Type,{'EXCEPT',Exclusion}} when record(Type,type) -> - {_,TDef} = get_referenced_type(S,Type#type.def), - OS = TDef#typedef.typespec, - NewSet = reduce_objectset(OS#'ObjectSet'.set,Exclusion), - NewOS = OS#'ObjectSet'{set=NewSet}, - check_object(S,TDef#typedef{typespec=NewOS}, - NewOS); - #type{def={pt,DefinedObjSet,ParamList}} -> - {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet), - instantiate_pos(S,ClassDef,PObjSetDef,ParamList); - {ObjDef={object,definedsyntax,_ObjFields},_Ext} -> - CheckedSet = check_object_list(S,NewClassRef,[ObjDef]), - NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet++['EXTENSIONMARK']} - end, - Gen = gen_incl_set(S,NewObjSet#'ObjectSet'.set, - ClassDef), - NewObjSet#'ObjectSet'{class=NewClassRef,gen=Gen}. - - -merge_sets(Set,Ext) when list(Set),list(Ext) -> - Set ++ Ext; -merge_sets(Set,Ext) when list(Ext) -> - [Set|Ext]; -merge_sets(Set,{'SingleValue',Ext}) when list(Set) -> - Set ++ [Ext]; -merge_sets(Set,{'SingleValue',Ext}) -> - [Set] ++ [Ext]. - -reduce_objectset(ObjectSet,Exclusion) -> - case Exclusion of - {'SingleValue',#'Externalvaluereference'{value=Name}} -> - case lists:keysearch(Name,1,ObjectSet) of - {value,El} -> - lists:subtract(ObjectSet,[El]); - _ -> - ObjectSet - end - end. - -%% Checks a list of objects or object sets and returns a list of selected -%% information for the code generation. -check_object_list(S,ClassRef,ObjectList) -> - check_object_list(S,ClassRef,ObjectList,[]). - -check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> - case ObjOrSet of - ObjDef when tuple(ObjDef),(element(1,ObjDef)==object) -> - Def = - check_object(S,#typedef{typespec=ObjDef}, -% #'Object'{classname={objectclassname,ClassRef}, - #'Object'{classname=ClassRef, - def=ObjDef}), - check_object_list(S,ClassRef,Objs,[{no_name,Def#'Object'.def}|Acc]); - {'SingleValue',{definedvalue,ObjName}} -> - {_,ObjectDef} = get_referenced_type(S,#identifier{val=ObjName}), - #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec), - check_object_list(S,ClassRef,Objs,[{ObjectDef#typedef.name,Def}|Acc]); - {'SingleValue',Ref = #'Externalvaluereference'{}} -> - {_,ObjectDef} = get_referenced_type(S,Ref), - #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec), - check_object_list(S,ClassRef,Objs,[{ObjectDef#typedef.name,Def}|Acc]); - ObjRef when record(ObjRef,'Externalvaluereference') -> - {_,ObjectDef} = get_referenced_type(S,ObjRef), - #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec), - check_object_list(S,ClassRef,Objs, -%% [{ObjRef#'Externalvaluereference'.value,Def}|Acc]); - [{ObjectDef#typedef.name,Def}|Acc]); - {'ValueFromObject',{_,Object},FieldName} -> - {_,Def} = get_referenced_type(S,Object), -%% TypeOrVal = get_fieldname_element(S,Def,FieldName);%% this must result in an object set - TypeDef = get_fieldname_element(S,Def,FieldName), - (TypeDef#typedef.typespec)#'ObjectSet'.set; - ObjSet when record(ObjSet,type) -> - ObjSetDef = - case ObjSet#type.def of - Ref when record(Ref,typereference); - record(Ref,'Externaltypereference') -> - {_,D} = get_referenced_type(S,ObjSet#type.def), - D; - Other -> - throw({asn1_error,{'unknown objecset',Other,S}}) - end, - #'ObjectSet'{set=ObjectsInSet} = - check_object(S,ObjSetDef,ObjSetDef#typedef.typespec), - AccList = transform_set_to_object_list(ObjectsInSet,[]), - check_object_list(S,ClassRef,Objs,AccList++Acc); - union -> - check_object_list(S,ClassRef,Objs,Acc); - Other -> - exit({error,{'unknown object',Other},S}) - end; -%% Finally reverse the accumulated list and if there are any extension -%% marks in the object set put one indicator of that in the end of the -%% list. -check_object_list(_,_,[],Acc) -> - lists:reverse(Acc). -%% case lists:member('EXTENSIONMARK',RevAcc) of -%% true -> -%% ExclRevAcc = lists:filter(fun(X)->X /= 'EXTENSIONMARK' end, -%% RevAcc), -%% ExclRevAcc ++ ['EXTENSIONMARK']; -%% false -> -%% RevAcc -%% end. - - -%% get_fieldname_element/3 -%% gets the type/value/object/... of the referenced element in FieldName -%% FieldName is a list and may have more than one element. -%% Each element in FieldName can be either {typefieldreference,AnyFieldName} -%% or {valuefieldreference,AnyFieldName} -%% Def is the def of the first object referenced by FieldName -get_fieldname_element(S,Def,[{_RefType,FieldName}]) when record(Def,typedef) -> - {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def, - case lists:keysearch(FieldName,1,ObjComps) of - {value,{_,TDef}} when record(TDef,typedef) -> - %% ORec = TDef#typedef.typespec, %% XXX This must be made general -% case TDef#typedef.typespec of -% ObjSetRec when record(ObjSetRec,'ObjectSet') -> -% ObjSet = ObjSetRec#'ObjectSet'.set; -% ObjRec when record(ObjRec,'Object') -> -% %% now get the field in ObjRec that RestFName points out -% %ObjRec -% TDef -% end; - TDef; - {value,{_,VDef}} when record(VDef,valuedef) -> - check_value(S,VDef); - _ -> - throw({assigned_object_error,"not_assigned_object",S}) - end; -get_fieldname_element(_S,Def,[{_RefType,_FieldName}|_RestFName]) - when record(Def,typedef) -> - ok. - -transform_set_to_object_list([{Name,_UVal,Fields}|Objs],Acc) -> - transform_set_to_object_list(Objs,[{Name,{object,generatesyntax,Fields}}|Acc]); -transform_set_to_object_list(['EXTENSIONMARK'|Objs],Acc) -> -%% transform_set_to_object_list(Objs,['EXTENSIONMARK'|Acc]); - transform_set_to_object_list(Objs,Acc); -transform_set_to_object_list([],Acc) -> - Acc. - -get_unique_valuelist(_S,ObjSet,{unique,undefined}) -> % no unique field in object - lists:map(fun({N,{_,_,F}})->{N,F}; - (V={_,_,_}) ->V end, ObjSet); -get_unique_valuelist(S,ObjSet,UFN) -> - get_unique_vlist(S,ObjSet,UFN,[]). - -get_unique_vlist(S,[],_,Acc) -> - case catch check_uniqueness(Acc) of - {asn1_error,_} -> -% exit({error,Reason,S}); - error({'ObjectSet',"not unique objects in object set",S}); - true -> - lists:reverse(Acc) - end; -get_unique_vlist(S,[{ObjName,Obj}|Rest],UniqueFieldName,Acc) -> - {_,_,Fields} = Obj, - VDef = get_unique_value(S,Fields,UniqueFieldName), - get_unique_vlist(S,Rest,UniqueFieldName, - [{ObjName,VDef#valuedef.value,Fields}|Acc]); -get_unique_vlist(S,[V={_,_,_}|Rest],UniqueFieldName,Acc) -> - get_unique_vlist(S,Rest,UniqueFieldName,[V|Acc]). - -get_unique_value(S,Fields,UniqueFieldName) -> - Module = S#state.mname, - case lists:keysearch(UniqueFieldName,1,Fields) of - {value,Field} -> - case element(2,Field) of - VDef when record(VDef,valuedef) -> - VDef; - {definedvalue,ValName} -> - ValueDef = asn1_db:dbget(Module,ValName), - case ValueDef of - VDef when record(VDef,valuedef) -> - ValueDef; - undefined -> - #valuedef{value=ValName} - end; - {'ValueFromObject',Object,Name} -> - case Object of - {object,Ext} when record(Ext,'Externaltypereference') -> - OtherModule = Ext#'Externaltypereference'.module, - ExtObjName = Ext#'Externaltypereference'.type, - ObjDef = asn1_db:dbget(OtherModule,ExtObjName), - ObjSpec = ObjDef#typedef.typespec, - get_unique_value(OtherModule,element(3,ObjSpec),Name); - {object,{_,_,ObjName}} -> - ObjDef = asn1_db:dbget(Module,ObjName), - ObjSpec = ObjDef#typedef.typespec, - get_unique_value(Module,element(3,ObjSpec),Name); - {po,Object,_Params} -> - exit({error,{'parameterized object not implemented yet', - Object},S}) - end; - Value when atom(Value);number(Value) -> - #valuedef{value=Value}; - {'CHOICE',{_,Value}} when atom(Value);number(Value) -> - #valuedef{value=Value} - end; - false -> - exit({error,{'no unique value',Fields,UniqueFieldName},S}) -%% io:format("WARNING: no unique value in object"), -%% exit(uniqueFieldName) - end. - -check_uniqueness(NameValueList) -> - check_uniqueness1(lists:keysort(2,NameValueList)). - -check_uniqueness1([]) -> - true; -check_uniqueness1([_]) -> - true; -check_uniqueness1([{_,N,_},{_,N,_}|_Rest]) -> - throw({asn1_error,{'objects in set must have unique values in UNIQUE fields',N}}); -check_uniqueness1([_|Rest]) -> - check_uniqueness1(Rest). - -%% instantiate_po/4 -%% ClassDef is the class of Object, -%% Object is the Parameterized object, which is referenced, -%% ArgsList is the list of actual parameters -%% returns an #'Object' record. -instantiate_po(S,_ClassDef,Object,ArgsList) when record(Object,pobjectdef) -> - FormalParams = get_pt_args(Object), - MatchedArgs = match_args(FormalParams,ArgsList,[]), - NewS = S#state{type=Object,parameters=MatchedArgs}, - check_object(NewS,Object,#'Object'{classname=Object#pobjectdef.class, - def=Object#pobjectdef.def}). - -%% instantiate_pos/4 -%% ClassDef is the class of ObjectSetDef, -%% ObjectSetDef is the Parameterized object set, which is referenced -%% on the right side of the assignment, -%% ArgsList is the list of actual parameters, i.e. real objects -instantiate_pos(S,ClassDef,ObjectSetDef,ArgsList) -> - ClassName = ClassDef#classdef.name, - FormalParams = get_pt_args(ObjectSetDef), - Set = case get_pt_spec(ObjectSetDef) of - {valueset,_Set} -> _Set; - _Set -> _Set - end, - MatchedArgs = match_args(FormalParams,ArgsList,[]), - NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs}, - check_object(NewS,ObjectSetDef, - #'ObjectSet'{class=name2Extref(S#state.mname,ClassName), - set=Set}). - - -%% gen_incl -> boolean() -%% If object with Fields has any of the corresponding class' typefields -%% then return value is true otherwise it is false. -%% If an object lacks a typefield but the class has a type field that -%% is OPTIONAL then we want gen to be true -gen_incl(S,{_,_,Fields},CFields)-> - gen_incl1(S,Fields,CFields). - -gen_incl1(_,_,[]) -> - false; -gen_incl1(S,Fields,[C|CFields]) -> - case element(1,C) of - typefield -> -% case lists:keymember(element(2,C),1,Fields) of -% true -> -% true; -% false -> -% gen_incl1(S,Fields,CFields) -% end; - true; %% should check that field is OPTIONAL or DEFUALT if - %% the object lacks this field - objectfield -> - case lists:keysearch(element(2,C),1,Fields) of - {value,Field} -> - Type = element(3,C), - {_,ClassDef} = get_referenced_type(S,Type#type.def), -% {_,ClassFields,_} = ClassDef#classdef.typespec, - #objectclass{fields=ClassFields} = - ClassDef#classdef.typespec, - ObjTDef = element(2,Field), - case gen_incl(S,(ObjTDef#typedef.typespec)#'Object'.def, - ClassFields) of - true -> - true; - _ -> - gen_incl1(S,Fields,CFields) - end; - _ -> - gen_incl1(S,Fields,CFields) - end; - _ -> - gen_incl1(S,Fields,CFields) - end. - -%% first if no unique field in the class return false.(don't generate code) -gen_incl_set(S,Fields,ClassDef) -> - case catch get_unique_fieldname(ClassDef) of - Tuple when tuple(Tuple) -> - false; - _ -> - gen_incl_set1(S,Fields, - (ClassDef#classdef.typespec)#objectclass.fields) - end. - -%% if any of the existing or potentially existing objects has a typefield -%% then return true. -gen_incl_set1(_,[],_CFields)-> - false; -gen_incl_set1(_,['EXTENSIONMARK'],_) -> - true; -%% Fields are the fields of an object in the object set. -%% CFields are the fields of the class of the object set. -gen_incl_set1(S,[Object|Rest],CFields)-> - Fields = element(size(Object),Object), - case gen_incl1(S,Fields,CFields) of - true -> - true; - false -> - gen_incl_set1(S,Rest,CFields) - end. - -check_objectdefn(S,Def,CDef) when record(CDef,classdef) -> - WithSyntax = (CDef#classdef.typespec)#objectclass.syntax, - ClassFields = (CDef#classdef.typespec)#objectclass.fields, - case Def of - {object,defaultsyntax,Fields} -> - check_defaultfields(S,Fields,ClassFields); - {object,definedsyntax,Fields} -> - {_,WSSpec} = WithSyntax, - NewFields = - case catch( convert_definedsyntax(S,Fields,WSSpec, - ClassFields,[])) of - {asn1,{_ErrorType,ObjToken,ClassToken}} -> - throw({asn1,{'match error in object',ObjToken, - 'found in object',ClassToken,'found in class'}}); - Err={asn1,_} -> throw(Err); - Err={'EXIT',_} -> throw(Err); - DefaultFields when list(DefaultFields) -> - DefaultFields - end, - {object,defaultsyntax,NewFields}; - {object,_ObjectId} -> % This is a DefinedObject - fixa; - Other -> - exit({error,{objectdefn,Other}}) - end. - -check_defaultfields(S,Fields,ClassFields) -> - check_defaultfields(S,Fields,ClassFields,[]). - -check_defaultfields(_S,[],_ClassFields,Acc) -> - {object,defaultsyntax,lists:reverse(Acc)}; -check_defaultfields(S,[{FName,Spec}|Fields],ClassFields,Acc) -> - case lists:keysearch(FName,2,ClassFields) of - {value,CField} -> - NewField = convert_to_defaultfield(S,FName,Spec,CField), - check_defaultfields(S,Fields,ClassFields,[NewField|Acc]); - _ -> - throw({error,{asn1,{'unvalid field in object',FName}}}) - end. -%% {object,defaultsyntax,Fields}. - -convert_definedsyntax(_S,[],[],_ClassFields,Acc) -> - lists:reverse(Acc); -convert_definedsyntax(S,Fields,WithSyntax,ClassFields,Acc) -> - case match_field(S,Fields,WithSyntax,ClassFields) of - {MatchedField,RestFields,RestWS} -> - if - list(MatchedField) -> - convert_definedsyntax(S,RestFields,RestWS,ClassFields, - lists:append(MatchedField,Acc)); - true -> - convert_definedsyntax(S,RestFields,RestWS,ClassFields, - [MatchedField|Acc]) - end -%% throw({error,{asn1,{'unvalid syntax in object',WorS}}}) - end. - -match_field(S,Fields,WithSyntax,ClassFields) -> - match_field(S,Fields,WithSyntax,ClassFields,[]). - -match_field(S,Fields,[W|Ws],ClassFields,Acc) when list(W) -> - case catch(match_optional_field(S,Fields,W,ClassFields,[])) of - {'EXIT',_} -> - match_field(Fields,Ws,ClassFields,Acc); %% add S -%% {[Result],RestFields} -> -%% {Result,RestFields,Ws}; - {Result,RestFields} when list(Result) -> - {Result,RestFields,Ws}; - _ -> - match_field(S,Fields,Ws,ClassFields,Acc) - end; -match_field(S,Fields,WithSyntax,ClassFields,_Acc) -> - match_mandatory_field(S,Fields,WithSyntax,ClassFields,[]). - -match_optional_field(_S,RestFields,[],_,Ret) -> - {Ret,RestFields}; -%% An additional optional field within an optional field -match_optional_field(S,Fields,[W|Ws],ClassFields,Ret) when list(W) -> - case catch match_optional_field(S,Fields,W,ClassFields,[]) of - {'EXIT',_} -> - {Ret,Fields}; - {asn1,{optional_matcherror,_,_}} -> - {Ret,Fields}; - {OptionalField,RestFields} -> - match_optional_field(S,RestFields,Ws,ClassFields, - lists:append(OptionalField,Ret)) - end; -%% identify and skip word -%match_optional_field(S,[#'Externaltypereference'{type=WorS}|Rest], -match_optional_field(S,[{_,_,WorS}|Rest], - [WorS|Ws],ClassFields,Ret) -> - match_optional_field(S,Rest,Ws,ClassFields,Ret); -match_optional_field(S,[],_,ClassFields,Ret) -> - match_optional_field(S,[],[],ClassFields,Ret); -%% identify and skip comma -match_optional_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) -> - match_optional_field(S,Rest,Ws,ClassFields,Ret); -%% identify and save field data -match_optional_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Ret) -> - WorS = - case Setting of - Type when record(Type,type) -> Type; -%% #'Externalvaluereference'{value=WordOrSetting} -> WordOrSetting; - {'ValueFromObject',_,_} -> Setting; - {object,_,_} -> Setting; - {_,_,WordOrSetting} -> WordOrSetting; -%% Atom when atom(Atom) -> Atom - Other -> Other - end, - case lists:keysearch(W,2,ClassFields) of - false -> - throw({asn1,{optional_matcherror,WorS,W}}); - {value,CField} -> - NewField = convert_to_defaultfield(S,W,WorS,CField), - match_optional_field(S,Rest,Ws,ClassFields,[NewField|Ret]) - end; -match_optional_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Ret) -> - throw({asn1,{optional_matcherror,WorS,W}}). - -match_mandatory_field(_S,[],[],_,[Acc]) -> - {Acc,[],[]}; -match_mandatory_field(_S,[],[],_,Acc) -> - {Acc,[],[]}; -match_mandatory_field(S,[],[H|T],CF,Acc) when list(H) -> - match_mandatory_field(S,[],T,CF,Acc); -match_mandatory_field(_S,[],WithSyntax,_,_Acc) -> - throw({asn1,{mandatory_matcherror,[],WithSyntax}}); -%match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,[Acc]) when list(W) -> -match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,Acc) when list(W), length(Acc) >= 1 -> - {Acc,Fields,WithSyntax}; -%% identify and skip word -match_mandatory_field(S,[{_,_,WorS}|Rest], - [WorS|Ws],ClassFields,Acc) -> - match_mandatory_field(S,Rest,Ws,ClassFields,Acc); -%% identify and skip comma -match_mandatory_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) -> - match_mandatory_field(S,Rest,Ws,ClassFields,Ret); -%% identify and save field data -match_mandatory_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Acc) -> - WorS = - case Setting of -%% Atom when atom(Atom) -> Atom; -%% #'Externalvaluereference'{value=WordOrSetting} -> WordOrSetting; - {object,_,_} -> Setting; - {_,_,WordOrSetting} -> WordOrSetting; - Type when record(Type,type) -> Type; - Other -> Other - end, - case lists:keysearch(W,2,ClassFields) of - false -> - throw({asn1,{mandatory_matcherror,WorS,W}}); - {value,CField} -> - NewField = convert_to_defaultfield(S,W,WorS,CField), - match_mandatory_field(S,Rest,Ws,ClassFields,[NewField|Acc]) - end; - -match_mandatory_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Acc) -> - throw({asn1,{mandatory_matcherror,WorS,W}}). - -%% Converts a field of an object from defined syntax to default syntax -convert_to_defaultfield(S,ObjFieldName,ObjFieldSetting,CField)-> - CurrMod = S#state.mname, - case element(1,CField) of - typefield -> - TypeDef= - case ObjFieldSetting of - TypeRec when record(TypeRec,type) -> TypeRec#type.def; - TDef when record(TDef,typedef) -> - TDef#typedef{typespec=check_type(S,TDef, - TDef#typedef.typespec)}; - _ -> ObjFieldSetting - end, - Type = - if - record(TypeDef,typedef) -> TypeDef; - true -> - case asn1ct_gen:type(asn1ct_gen:get_inner(TypeDef)) of - ERef = #'Externaltypereference'{module=CurrMod} -> - {_,T} = get_referenced_type(S,ERef), - T#typedef{checked=true, - typespec=check_type(S,T, - T#typedef.typespec)}; - ERef = #'Externaltypereference'{module=ExtMod} -> - {_,T} = get_referenced_type(S,ERef), - #typedef{name=Name} = T, - check_type(S,T,T#typedef.typespec), - #typedef{checked=true, - name={ExtMod,Name}, - typespec=ERef}; - Bif when Bif=={primitive,bif};Bif=={constructed,bif} -> - T = check_type(S,#typedef{typespec=ObjFieldSetting}, - ObjFieldSetting), - #typedef{checked=true,name=Bif,typespec=T}; - _ -> - {Mod,T} = - %% get_referenced_type(S,#typereference{val=ObjFieldSetting}), - get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}), - case Mod of - CurrMod -> - T; - ExtMod -> - #typedef{name=Name} = T, - T#typedef{name={ExtMod,Name}} - end - end - end, - {ObjFieldName,Type}; - fixedtypevaluefield -> - case ObjFieldName of - Val when atom(Val) -> - %% ObjFieldSetting can be a value,an objectidentifiervalue, - %% an element in an enumeration or namednumberlist etc. - ValRef = - case ObjFieldSetting of - #'Externalvaluereference'{} -> ObjFieldSetting; - {'ValueFromObject',{_,ObjRef},FieldName} -> - {_,Object} = get_referenced_type(S,ObjRef), - ChObject = check_object(S,Object, - Object#typedef.typespec), - get_fieldname_element(S,Object#typedef{typespec=ChObject}, - FieldName); - #valuedef{} -> - ObjFieldSetting; - _ -> - #identifier{val=ObjFieldSetting} - end, - case ValRef of - #valuedef{} -> - {ObjFieldName,check_value(S,ValRef)}; - _ -> - ValDef = - case catch get_referenced_type(S,ValRef) of - {error,_} -> - check_value(S,#valuedef{name=Val, - type=element(3,CField), - value=ObjFieldSetting}); - {_,VDef} when record(VDef,valuedef) -> - check_value(S,VDef);%% XXX - {_,VDef} -> - check_value(S,#valuedef{name=Val, - type=element(3,CField), - value=VDef}) - end, - {ObjFieldName,ValDef} - end; - Val -> - {ObjFieldName,Val} - end; - fixedtypevaluesetfield -> - {ObjFieldName,ObjFieldSetting}; - objectfield -> - ObjectSpec = - case ObjFieldSetting of - Ref when record(Ref,typereference);record(Ref,identifier); - record(Ref,'Externaltypereference'); - record(Ref,'Externalvaluereference') -> - {_,R} = get_referenced_type(S,ObjFieldSetting), - R; - {'ValueFromObject',{_,ObjRef},FieldName} -> - %% This is an ObjectFromObject - {_,Object} = get_referenced_type(S,ObjRef), - ChObject = check_object(S,Object, - Object#typedef.typespec), - _ObjFromObj= - get_fieldname_element(S,Object#typedef{ - typespec=ChObject}, - FieldName); - %%ClassName = ObjFromObj#'Object'.classname, - %%#typedef{name=, - %% typespec= - %% ObjFromObj#'Object'{classname= - %% {objectclassname,ClassName}}}; - {object,_,_} -> - %% An object defined inlined in another object - #type{def=Ref} = element(3,CField), -% CRef = case Ref of -% #'Externaltypereference'{module=CurrMod, -% type=CName} -> -% CName; -% #'Externaltypereference'{module=ExtMod, -% type=CName} -> -% {ExtMod,CName} -% end, - InlinedObjName= - list_to_atom(lists:concat([S#state.tname]++ - ['_',ObjFieldName])), -% ObjSpec = #'Object'{classname={objectclassname,CRef}, - ObjSpec = #'Object'{classname=Ref, - def=ObjFieldSetting}, - CheckedObj= - check_object(S,#typedef{typespec=ObjSpec},ObjSpec), - InlObj = #typedef{checked=true,name=InlinedObjName, - typespec=CheckedObj}, - asn1ct_gen:insert_once(inlined_objects,{InlinedObjName, - InlinedObjName}), - asn1_db:dbput(S#state.mname,InlinedObjName,InlObj), - InlObj; - #type{def=Eref} when record(Eref,'Externaltypereference') -> - {_,R} = get_referenced_type(S,Eref), - R; - _ -> -%% {_,R} = get_referenced_type(S,#typereference{val=ObjFieldSetting}), - {_,R} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}), - R - end, - {ObjFieldName, - ObjectSpec#typedef{checked=true, - typespec=check_object(S,ObjectSpec, - ObjectSpec#typedef.typespec)}}; - variabletypevaluefield -> - {ObjFieldName,ObjFieldSetting}; - variabletypevaluesetfield -> - {ObjFieldName,ObjFieldSetting}; - objectsetfield -> - {_,ObjSetSpec} = - case ObjFieldSetting of - Ref when record(Ref,'Externaltypereference'); - record(Ref,'Externalvaluereference') -> - get_referenced_type(S,ObjFieldSetting); - ObjectList when list(ObjectList) -> - %% an objctset defined in the object,though maybe - %% parsed as a SequenceOfValue - %% The ObjectList may be a list of references to - %% objects, a ValueFromObject - {_,_,Type,_} = CField, - ClassDef = Type#type.def, - case ClassDef#'Externaltypereference'.module of - CurrMod -> - ClassDef#'Externaltypereference'.type; - ExtMod -> - {ExtMod, - ClassDef#'Externaltypereference'.type} - end, - {no_name, - #typedef{typespec= - #'ObjectSet'{class= -% {objectclassname,ClassRef}, - ClassDef, - set=ObjectList}}}; - ObjectSet={'SingleValue',_} -> - %% a Union of defined objects - {_,_,Type,_} = CField, - ClassDef = Type#type.def, -% ClassRef = -% case ClassDef#'Externaltypereference'.module of -% CurrMod -> -% ClassDef#'Externaltypereference'.type; -% ExtMod -> -% {ExtMod, -% ClassDef#'Externaltypereference'.type} -% end, - {no_name, -% #typedef{typespec=#'ObjectSet'{class={objectclassname,ClassRef}, - #typedef{typespec=#'ObjectSet'{class=ClassDef, - set=ObjectSet}}}; - {object,_,[#type{def={'TypeFromObject', - {object,RefedObj}, - FieldName}}]} -> - %% This case occurs when an ObjectSetFromObjects - %% production is used - {M,Def} = get_referenced_type(S,RefedObj), - {M,get_fieldname_element(S,Def,FieldName)}; - #type{def=Eref} when - record(Eref,'Externaltypereference') -> - get_referenced_type(S,Eref); - _ -> -%% get_referenced_type(S,#typereference{val=ObjFieldSetting}) - get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}) - end, - {ObjFieldName, - ObjSetSpec#typedef{checked=true, - typespec=check_object(S,ObjSetSpec, - ObjSetSpec#typedef.typespec)}} - end. - -check_value(OldS,V) when record(V,pvaluesetdef) -> - #pvaluesetdef{checked=Checked,type=Type} = V, - case Checked of - true -> V; - {error,_} -> V; - false -> - case get_referenced_type(OldS,Type#type.def) of - {_,Class} when record(Class,classdef) -> - throw({pobjectsetdef}); - _ -> continue - end - end; -check_value(_OldS,V) when record(V,pvaluedef) -> - %% Fix this case later - V; -check_value(OldS,V) when record(V,typedef) -> - %% This case when a value set has been parsed as an object set. - %% It may be a value set - #typedef{typespec=TS} = V, - case TS of - #'ObjectSet'{class=ClassRef} -> - {_,TSDef} = get_referenced_type(OldS,ClassRef), - %%IsObjectSet(TSDef); - case TSDef of - #classdef{} -> throw({objectsetdef}); - #typedef{typespec=#type{def=Eref}} when - record(Eref,'Externaltypereference') -> - %% This case if the class reference is a defined - %% reference to class - check_value(OldS,V#typedef{typespec=TS#'ObjectSet'{class=Eref}}); - #typedef{} -> - % an ordinary value set with a type in #typedef.typespec - ValueSet = TS#'ObjectSet'.set, - Type=check_type(OldS,TSDef,TSDef#typedef.typespec), - Value = check_value(OldS,#valuedef{type=Type, - value=ValueSet}), - {valueset,Type#type{constraint=Value#valuedef.value}} - end; - _ -> - throw({objectsetdef}) - end; -check_value(S,#valuedef{pos=Pos,name=Name,type=Type, - value={valueset,Constr}}) -> - NewType = Type#type{constraint=[Constr]}, - {valueset, - check_type(S,#typedef{pos=Pos,name=Name,typespec=NewType},NewType)}; -check_value(OldS=#state{recordtopname=TopName},V) when record(V,valuedef) -> - #valuedef{name=Name,checked=Checked,type=Vtype,value=Value} = V, - case Checked of - true -> - V; - {error,_} -> - V; - false -> - Def = Vtype#type.def, - Constr = Vtype#type.constraint, - S = OldS#state{type=Vtype,tname=Def,value=V,vname=Name}, - NewDef = - case Def of - Ext when record(Ext,'Externaltypereference') -> - RecName = Ext#'Externaltypereference'.type, - {_,Type} = get_referenced_type(S,Ext), - %% If V isn't a value but an object Type is a #classdef{} - case Type of - #classdef{} -> - throw({objectdef}); - #typedef{} -> - case is_contextswitchtype(Type) of - true -> - #valuedef{value=CheckedVal}= - check_value(S,V#valuedef{type=Type#typedef.typespec}), - #newv{value=CheckedVal}; - _ -> - #valuedef{value=CheckedVal}= - check_value(S#state{recordtopname=[RecName|TopName]}, - V#valuedef{type=Type#typedef.typespec}), - #newv{value=CheckedVal} - end - end; - 'ANY' -> - throw({error,{asn1,{'cant check value of type',Def}}}); - 'INTEGER' -> - validate_integer(S,Value,[],Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - {'INTEGER',NamedNumberList} -> - validate_integer(S,Value,NamedNumberList,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - {'BIT STRING',NamedNumberList} -> - validate_bitstring(S,Value,NamedNumberList,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'NULL' -> - validate_null(S,Value,Constr), - #newv{}; - 'OBJECT IDENTIFIER' -> - validate_objectidentifier(S,Value,Constr), - #newv{value = normalize_value(S,Vtype,Value,[])}; - 'ObjectDescriptor' -> - validate_objectdescriptor(S,Value,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - {'ENUMERATED',NamedNumberList} -> - validate_enumerated(S,Value,NamedNumberList,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'BOOLEAN'-> - validate_boolean(S,Value,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'OCTET STRING' -> - validate_octetstring(S,Value,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'NumericString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'TeletexString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'VideotexString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'UTCTime' -> - #newv{value=normalize_value(S,Vtype,Value,[])}; -% exit({'cant check value of type' ,Def}); - 'GeneralizedTime' -> - #newv{value=normalize_value(S,Vtype,Value,[])}; -% exit({'cant check value of type' ,Def}); - 'GraphicString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'VisibleString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'GeneralString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'PrintableString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'IA5String' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'BMPString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; -%% 'UniversalString' -> %added 6/12 -00 -%% #newv{value=validate_restrictedstring(S,Value,Def,Constr)}; - Seq when record(Seq,'SEQUENCE') -> - SeqVal = validate_sequence(S,Value, - Seq#'SEQUENCE'.components, - Constr), - #newv{value=normalize_value(S,Vtype,SeqVal,TopName)}; - {'SEQUENCE OF',Components} -> - validate_sequenceof(S,Value,Components,Constr), - #newv{value=normalize_value(S,Vtype,Value,TopName)}; - {'CHOICE',Components} -> - validate_choice(S,Value,Components,Constr), - #newv{value=normalize_value(S,Vtype,Value,TopName)}; - Set when record(Set,'SET') -> - validate_set(S,Value,Set#'SET'.components, - Constr), - #newv{value=normalize_value(S,Vtype,Value,TopName)}; - {'SET OF',Components} -> - validate_setof(S,Value,Components,Constr), - #newv{value=normalize_value(S,Vtype,Value,TopName)}; - Other -> - exit({'cant check value of type' ,Other}) - end, - case NewDef#newv.value of - unchanged -> - V#valuedef{checked=true,value=Value}; - ok -> - V#valuedef{checked=true,value=Value}; - {error,Reason} -> - V#valuedef{checked={error,Reason},value=Value}; - _V -> - V#valuedef{checked=true,value=_V} - end - end. - -is_contextswitchtype(#typedef{name='EXTERNAL'})-> - true; -is_contextswitchtype(#typedef{name='EMBEDDED PDV'}) -> - true; -is_contextswitchtype(#typedef{name='CHARACTER STRING'}) -> - true; -is_contextswitchtype(_) -> - false. - -% validate_integer(S,{identifier,Pos,Id},NamedNumberList,Constr) -> -% case lists:keysearch(Id,1,NamedNumberList) of -% {value,_} -> ok; -% false -> error({value,"unknown NamedNumber",S}) -% end; -%% This case occurs when there is a valuereference -validate_integer(S=#state{mname=M}, - #'Externalvaluereference'{module=M,value=Id}, - NamedNumberList,_Constr) -> - case lists:keysearch(Id,1,NamedNumberList) of - {value,_} -> ok; - false -> error({value,"unknown NamedNumber",S}) - end; -validate_integer(S,Id,NamedNumberList,_Constr) when atom(Id) -> - case lists:keysearch(Id,1,NamedNumberList) of - {value,_} -> ok; - false -> error({value,"unknown NamedNumber",S}) - end; -validate_integer(_S,Value,_NamedNumberList,Constr) when integer(Value) -> - check_integer_range(Value,Constr). - -check_integer_range(Int,Constr) when list(Constr) -> - NewConstr = [X || #constraint{c=X} <- Constr], - check_constr(Int,NewConstr); - -check_integer_range(_Int,_Constr) -> - %%io:format("~p~n",[Constr]), - ok. - -check_constr(Int,[{'ValueRange',Lb,Ub}|T]) when Int >= Lb, Int =< Ub -> - check_constr(Int,T); -check_constr(_Int,[]) -> - ok. - -validate_bitstring(_S,_Value,_NamedNumberList,_Constr) -> - ok. - -validate_null(_S,'NULL',_Constr) -> - ok. - -%%------------ -%% This can be removed when the old parser is removed -%% The function removes 'space' atoms from the list - -is_space_list([H],Acc) -> - lists:reverse([H|Acc]); -is_space_list([H,space|T],Acc) -> - is_space_list(T,[H|Acc]); -is_space_list([],Acc) -> - lists:reverse(Acc); -is_space_list([H|T],Acc) -> - is_space_list(T,[H|Acc]). - -validate_objectidentifier(S,L,_) -> - case is_space_list(L,[]) of - NewL when list(NewL) -> - case validate_objectidentifier1(S,NewL) of - NewL2 when list(NewL2) -> - list_to_tuple(NewL2); - Other -> Other - end; - {error,_} -> - error({value, "illegal OBJECT IDENTIFIER", S}) - end. - -validate_objectidentifier1(S, [Id|T]) when record(Id,'Externalvaluereference') -> - case catch get_referenced_type(S,Id) of - {_,V} when record(V,valuedef) -> - case check_value(S,V) of - #valuedef{type=#type{def='OBJECT IDENTIFIER'}, - checked=true,value=Value} when tuple(Value) -> - validate_objectid(S, T, lists:reverse(tuple_to_list(Value))); - _ -> - error({value, "illegal OBJECT IDENTIFIER", S}) - end; - _ -> - validate_objectid(S, [Id|T], []) - end; -validate_objectidentifier1(S,V) -> - validate_objectid(S,V,[]). - -validate_objectid(_, [], Acc) -> - lists:reverse(Acc); -validate_objectid(S, [Value|Vrest], Acc) when integer(Value) -> - validate_objectid(S, Vrest, [Value|Acc]); -validate_objectid(S, [{'NamedNumber',_Name,Value}|Vrest], Acc) - when integer(Value) -> - validate_objectid(S, Vrest, [Value|Acc]); -validate_objectid(S, [Id|Vrest], Acc) - when record(Id,'Externalvaluereference') -> - case catch get_referenced_type(S, Id) of - {_,V} when record(V,valuedef) -> - case check_value(S, V) of - #valuedef{checked=true,value=Value} when integer(Value) -> - validate_objectid(S, Vrest, [Value|Acc]); - _ -> - error({value, "illegal OBJECT IDENTIFIER", S}) - end; - _ -> - case reserved_objectid(Id#'Externalvaluereference'.value, Acc) of - Value when integer(Value) -> - validate_objectid(S, Vrest, [Value|Acc]); - false -> - error({value, "illegal OBJECT IDENTIFIER", S}) - end - end; -validate_objectid(S, [{Atom,Value}],[]) when atom(Atom),integer(Value) -> - %% this case when an OBJECT IDENTIFIER value has been parsed as a - %% SEQUENCE value - Rec = #'Externalvaluereference'{module=S#state.mname, - value=Atom}, - validate_objectidentifier1(S,[Rec,Value]); -validate_objectid(S, [{Atom,EVRef}],[]) - when atom(Atom),record(EVRef,'Externalvaluereference') -> - %% this case when an OBJECT IDENTIFIER value has been parsed as a - %% SEQUENCE value OTP-4354 - Rec = #'Externalvaluereference'{module=S#state.mname, - value=Atom}, - validate_objectidentifier1(S,[Rec,EVRef]); -validate_objectid(S, _V, _Acc) -> - error({value, "illegal OBJECT IDENTIFIER",S}). - - -%% 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; -%% arcs below "recommendation" -reserved_objectid('a',[0,0]) -> 1; -reserved_objectid('b',[0,0]) -> 2; -reserved_objectid('c',[0,0]) -> 3; -reserved_objectid('d',[0,0]) -> 4; -reserved_objectid('e',[0,0]) -> 5; -reserved_objectid('f',[0,0]) -> 6; -reserved_objectid('g',[0,0]) -> 7; -reserved_objectid('h',[0,0]) -> 8; -reserved_objectid('i',[0,0]) -> 9; -reserved_objectid('j',[0,0]) -> 10; -reserved_objectid('k',[0,0]) -> 11; -reserved_objectid('l',[0,0]) -> 12; -reserved_objectid('m',[0,0]) -> 13; -reserved_objectid('n',[0,0]) -> 14; -reserved_objectid('o',[0,0]) -> 15; -reserved_objectid('p',[0,0]) -> 16; -reserved_objectid('q',[0,0]) -> 17; -reserved_objectid('r',[0,0]) -> 18; -reserved_objectid('s',[0,0]) -> 19; -reserved_objectid('t',[0,0]) -> 20; -reserved_objectid('u',[0,0]) -> 21; -reserved_objectid('v',[0,0]) -> 22; -reserved_objectid('w',[0,0]) -> 23; -reserved_objectid('x',[0,0]) -> 24; -reserved_objectid('y',[0,0]) -> 25; -reserved_objectid('z',[0,0]) -> 26; - - -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. - - - - - -validate_objectdescriptor(_S,_Value,_Constr) -> - ok. - -validate_enumerated(S,Id,NamedNumberList,_Constr) when atom(Id) -> - case lists:keysearch(Id,1,NamedNumberList) of - {value,_} -> ok; - false -> error({value,"unknown ENUMERATED",S}) - end; -validate_enumerated(S,{identifier,_Pos,Id},NamedNumberList,_Constr) -> - case lists:keysearch(Id,1,NamedNumberList) of - {value,_} -> ok; - false -> error({value,"unknown ENUMERATED",S}) - end; -validate_enumerated(S,#'Externalvaluereference'{value=Id}, - NamedNumberList,_Constr) -> - case lists:keysearch(Id,1,NamedNumberList) of - {value,_} -> ok; - false -> error({value,"unknown ENUMERATED",S}) - end. - -validate_boolean(_S,_Value,_Constr) -> - ok. - -validate_octetstring(_S,_Value,_Constr) -> - ok. - -validate_restrictedstring(_S,_Value,_Def,_Constr) -> - ok. - -validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) -> - case Vtype of - #type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} -> - %% this is an 'EXTERNAL' (or INSTANCE OF) - case Value of - [{identification,_}|_RestVal] -> - to_EXTERNAL1990(S,Value); - _ -> - Value - end; - _ -> - Value - end. - -validate_sequenceof(_S,_Value,_Components,_Constr) -> - ok. - -validate_choice(_S,_Value,_Components,_Constr) -> - ok. - -validate_set(_S,_Value,_Components,_Constr) -> - ok. - -validate_setof(_S,_Value,_Components,_Constr) -> - ok. - -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,_) -> - 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}}}, - lists:reverse([Encoding|Acc]); -to_EXTERNAL1990(S,_,_) -> - error({value,"illegal value in EXTERNAL type",S}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Functions to normalize the default values of SEQUENCE -%% and SET components into Erlang valid format -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -normalize_value(_,_,mandatory,_) -> - mandatory; -normalize_value(_,_,'OPTIONAL',_) -> - 'OPTIONAL'; -normalize_value(S,Type,{'DEFAULT',Value},NameList) -> - case catch get_canonic_type(S,Type,NameList) of - {'BOOLEAN',CType,_} -> - normalize_boolean(S,Value,CType); - {'INTEGER',CType,_} -> - normalize_integer(S,Value,CType); - {'BIT STRING',CType,_} -> - normalize_bitstring(S,Value,CType); - {'OCTET STRING',CType,_} -> - normalize_octetstring(S,Value,CType); - {'NULL',_CType,_} -> - %%normalize_null(Value); - 'NULL'; - {'OBJECT IDENTIFIER',_,_} -> - normalize_objectidentifier(S,Value); - {'ObjectDescriptor',_,_} -> - normalize_objectdescriptor(Value); - {'REAL',_,_} -> - normalize_real(Value); - {'ENUMERATED',CType,_} -> - normalize_enumerated(Value,CType); - {'CHOICE',CType,NewNameList} -> - normalize_choice(S,Value,CType,NewNameList); - {'SEQUENCE',CType,NewNameList} -> - normalize_sequence(S,Value,CType,NewNameList); - {'SEQUENCE OF',CType,NewNameList} -> - normalize_seqof(S,Value,CType,NewNameList); - {'SET',CType,NewNameList} -> - normalize_set(S,Value,CType,NewNameList); - {'SET OF',CType,NewNameList} -> - normalize_setof(S,Value,CType,NewNameList); - {restrictedstring,CType,_} -> - normalize_restrictedstring(S,Value,CType); - _ -> - io:format("WARNING: could not check default value ~p~n",[Value]), - Value - end; -normalize_value(S,Type,Val,NameList) -> - normalize_value(S,Type,{'DEFAULT',Val},NameList). - -normalize_boolean(S,{Name,Bool},CType) when atom(Name) -> - normalize_boolean(S,Bool,CType); -normalize_boolean(_,true,_) -> - true; -normalize_boolean(_,false,_) -> - false; -normalize_boolean(S,Bool=#'Externalvaluereference'{},CType) -> - get_normalized_value(S,Bool,CType,fun normalize_boolean/3,[]); -normalize_boolean(_,Other,_) -> - throw({error,{asn1,{'invalid default value',Other}}}). - -normalize_integer(_S,Int,_) when integer(Int) -> - Int; -normalize_integer(_S,{Name,Int},_) when atom(Name),integer(Int) -> - Int; -normalize_integer(S,{Name,Int=#'Externalvaluereference'{}}, - Type) when atom(Name) -> - normalize_integer(S,Int,Type); -normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) -> - case Type of - NNL when list(NNL) -> - case lists:keysearch(Name,1,NNL) of - {value,{Name,Val}} -> - Val; - false -> - get_normalized_value(S,Int,Type, - fun normalize_integer/3,[]) - end; - _ -> - get_normalized_value(S,Int,Type,fun normalize_integer/3,[]) - end; -normalize_integer(_,Int,_) -> - exit({'Unknown INTEGER value',Int}). - -normalize_bitstring(S,Value,Type)-> - %% There are four different Erlang formats of BIT STRING: - %% 1 - a list of ones and zeros. - %% 2 - a list of atoms. - %% 3 - as an integer, for instance in hexadecimal form. - %% 4 - as a tuple {Unused, Binary} where Unused is an integer - %% and tells how many bits of Binary are unused. - %% - %% normalize_bitstring/3 transforms Value according to: - %% A to 3, - %% B to 1, - %% C to 1 or 3 - %% D to 2, - %% Value can be on format: - %% A - {hstring, String}, where String is a hexadecimal string. - %% B - {bstring, String}, where String is a string on bit format - %% C - #'Externalvaluereference'{value=V}, where V is a defined value - %% D - list of #'Externalvaluereference', where each value component - %% is an identifier corresponing to NamedBits in Type. - case Value of - {hstring,String} when list(String) -> - hstring_to_int(String); - {bstring,String} when list(String) -> - bstring_to_bitlist(String); - Rec when record(Rec,'Externalvaluereference') -> - get_normalized_value(S,Value,Type, - fun normalize_bitstring/3,[]); - RecList when list(RecList) -> - case Type of - NBL when list(NBL) -> - F = fun(#'Externalvaluereference'{value=Name}) -> - case lists:keysearch(Name,1,NBL) of - {value,{Name,_}} -> - Name; - Other -> - throw({error,Other}) - end; - (Other) -> - throw({error,Other}) - end, - case catch lists:map(F,RecList) of - {error,Reason} -> - io:format("WARNING: default value not " - "compatible with type definition ~p~n", - [Reason]), - Value; - NewList -> - NewList - end; - _ -> - io:format("WARNING: default value not " - "compatible with type definition ~p~n", - [RecList]), - Value - end; - {Name,String} when atom(Name) -> - normalize_bitstring(S,String,Type); - Other -> - io:format("WARNING: illegal default value ~p~n",[Other]), - Value - end. - -hstring_to_int(L) when list(L) -> - hstring_to_int(L,0). -hstring_to_int([H|T],Acc) when H >= $A, H =< $F -> - hstring_to_int(T,(Acc bsl 4) + (H - $A + 10) ) ; -hstring_to_int([H|T],Acc) when H >= $0, H =< $9 -> - hstring_to_int(T,(Acc bsl 4) + (H - $0)); -hstring_to_int([],Acc) -> - Acc. - -bstring_to_bitlist([H|T]) when H == $0; H == $1 -> - [H - $0 | bstring_to_bitlist(T)]; -bstring_to_bitlist([]) -> - []. - -%% normalize_octetstring/1 changes representation of input Value to a -%% list of octets. -%% Format of Value is one of: -%% {bstring,String} each element in String corresponds to one bit in an octet -%% {hstring,String} each element in String corresponds to one byte in an octet -%% #'Externalvaluereference' -normalize_octetstring(S,Value,CType) -> - case Value of - {bstring,String} -> - bstring_to_octetlist(String); - {hstring,String} -> - hstring_to_octetlist(String); - Rec when record(Rec,'Externalvaluereference') -> - get_normalized_value(S,Value,CType, - fun normalize_octetstring/3,[]); - {Name,String} when atom(Name) -> - normalize_octetstring(S,String,CType); - List when list(List) -> - %% check if list elements are valid octet values - lists:map(fun([])-> ok; - (H)when H > 255-> - io:format("WARNING: not legal octet value ~p in OCTET STRING, ~p~n",[H,List]); - (_)-> ok - end, List), - List; - Other -> - io:format("WARNING: unknown default value ~p~n",[Other]), - Value - end. - - -bstring_to_octetlist([]) -> - []; -bstring_to_octetlist([H|T]) when H == $0 ; H == $1 -> - bstring_to_octetlist(T,6,[(H - $0) bsl 7]). -bstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H == $0; H == $1 -> - bstring_to_octetlist(T, 7, [0,Hacc + (H -$0)| Tacc]); -bstring_to_octetlist([H|T],BSL,[Hacc|Tacc]) when H == $0; H == $1 -> - bstring_to_octetlist(T, BSL-1, [Hacc + ((H - $0) bsl BSL)| Tacc]); -bstring_to_octetlist([],7,[0|Acc]) -> - lists:reverse(Acc); -bstring_to_octetlist([],_,Acc) -> - lists:reverse(Acc). - -hstring_to_octetlist([]) -> - []; -hstring_to_octetlist(L) -> - hstring_to_octetlist(L,4,[]). -hstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H >= $A, H =< $F -> - hstring_to_octetlist(T,4,[Hacc + (H - $A + 10)|Tacc]); -hstring_to_octetlist([H|T],BSL,Acc) when H >= $A, H =< $F -> - hstring_to_octetlist(T,0,[(H - $A + 10) bsl BSL|Acc]); -hstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H >= $0; H =< $9 -> - hstring_to_octetlist(T,4,[Hacc + (H - $0)|Tacc]); -hstring_to_octetlist([H|T],BSL,Acc) when H >= $0; H =< $9 -> - hstring_to_octetlist(T,0,[(H - $0) bsl BSL|Acc]); -hstring_to_octetlist([],_,Acc) -> - lists:reverse(Acc). - -normalize_objectidentifier(S,Value) -> - validate_objectidentifier(S,Value,[]). - -normalize_objectdescriptor(Value) -> - Value. - -normalize_real(Value) -> - Value. - -normalize_enumerated(#'Externalvaluereference'{value=V},CType) - when list(CType) -> - normalize_enumerated2(V,CType); -normalize_enumerated(Value,CType) when atom(Value),list(CType) -> - normalize_enumerated2(Value,CType); -normalize_enumerated({Name,EnumV},CType) when atom(Name) -> - normalize_enumerated(EnumV,CType); -normalize_enumerated(Value,{CType1,CType2}) when list(CType1), list(CType2)-> - normalize_enumerated(Value,CType1++CType2); -normalize_enumerated(V,CType) -> - io:format("WARNING: Enumerated unknown type ~p~n",[CType]), - V. -normalize_enumerated2(V,Enum) -> - case lists:keysearch(V,1,Enum) of - {value,{Val,_}} -> Val; - _ -> - io:format("WARNING: Enumerated value is not correct ~p~n",[V]), - V - end. - -normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when atom(C) -> - Value = - case V of - Rec when record(Rec,'Externalvaluereference') -> - get_normalized_value(S,V,CType, - fun normalize_choice/4, - [NameList]); - _ -> V - end, - case catch lists:keysearch(C,#'ComponentType'.name,CType) of - {value,#'ComponentType'{typespec=CT,name=Name}} -> - {C,normalize_value(S,CT,{'DEFAULT',Value}, - [Name|NameList])}; - Other -> - io:format("WARNING: Wrong format of type/value ~p/~p~n", - [Other,Value]), - {C,Value} - end; -normalize_choice(S,{'DEFAULT',ValueList},CType,NameList) -> - lists:map(fun(X)-> normalize_choice(S,X,CType,NameList) end, ValueList); -normalize_choice(S,Val=#'Externalvaluereference'{},CType,NameList) -> - {_,#valuedef{value=V}}=get_referenced_type(S,Val), - normalize_choice(S,{'CHOICE',V},CType,NameList); -% get_normalized_value(S,Val,CType,fun normalize_choice/4,[NameList]); -normalize_choice(S,{Name,ChoiceVal},CType,NameList) - when atom(Name) -> - normalize_choice(S,ChoiceVal,CType,NameList). - -normalize_sequence(S,{Name,Value},Components,NameList) - when atom(Name),list(Value) -> - normalize_sequence(S,Value,Components,NameList); -normalize_sequence(S,Value,Components,NameList) -> - normalized_record('SEQUENCE',S,Value,Components,NameList). - -normalize_set(S,{Name,Value},Components,NameList) - when atom(Name),list(Value) -> - normalized_record('SET',S,Value,Components,NameList); -normalize_set(S,Value,Components,NameList) -> - normalized_record('SET',S,Value,Components,NameList). - -normalized_record(SorS,S,Value,Components,NameList) -> - NewName = list_to_atom(asn1ct_gen:list2name(NameList)), - NoComps = length(Components), - case normalize_seq_or_set(SorS,S,Value,Components,NameList,[]) of - ListOfVals when length(ListOfVals) == NoComps -> - list_to_tuple([NewName|ListOfVals]); - _ -> - error({type,{illegal,default,value,Value},S}) - end. - -normalize_seq_or_set(SorS,S,[{Cname,V}|Vs], - [#'ComponentType'{name=Cname,typespec=TS}|Cs], - NameList,Acc) -> - NewNameList = - case TS#type.def of - #'Externaltypereference'{type=TName} -> - [TName]; - _ -> [Cname|NameList] - end, - NVal = normalize_value(S,TS,{'DEFAULT',V},NewNameList), - normalize_seq_or_set(SorS,S,Vs,Cs,NameList,[NVal|Acc]); -normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs], - [#'ComponentType'{prop='OPTIONAL'}|Cs], - NameList,Acc) -> - normalize_seq_or_set(SorS,S,Values,Cs,NameList,[asn1_NOVALUE|Acc]); -normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs], - [#'ComponentType'{name=Cname2,typespec=TS, - prop={'DEFAULT',Value}}|Cs], - NameList,Acc) -> - NewNameList = - case TS#type.def of - #'Externaltypereference'{type=TName} -> - [TName]; - _ -> [Cname2|NameList] - end, - NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList), - normalize_seq_or_set(SorS,S,Values,Cs,NameList,[NVal|Acc]); -normalize_seq_or_set(_SorS,_S,[],[],_,Acc) -> - lists:reverse(Acc); -%% If default value is {} ComponentTypes in SEQUENCE are marked DEFAULT -%% or OPTIONAL (or the type is defined SEQUENCE{}, which is handled by -%% the previous case). -normalize_seq_or_set(SorS,S,[], - [#'ComponentType'{name=Name,typespec=TS, - prop={'DEFAULT',Value}}|Cs], - NameList,Acc) -> - NewNameList = - case TS#type.def of - #'Externaltypereference'{type=TName} -> - [TName]; - _ -> [Name|NameList] - end, - NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList), - normalize_seq_or_set(SorS,S,[],Cs,NameList,[NVal|Acc]); -normalize_seq_or_set(SorS,S,[],[#'ComponentType'{prop='OPTIONAL'}|Cs], - NameList,Acc) -> - normalize_seq_or_set(SorS,S,[],Cs,NameList,[asn1_NOVALUE|Acc]); -normalize_seq_or_set(SorS,S,Value=#'Externalvaluereference'{}, - Cs,NameList,Acc) -> - get_normalized_value(S,Value,Cs,fun normalize_seq_or_set/6, - [SorS,NameList,Acc]); -normalize_seq_or_set(_SorS,S,V,_,_,_) -> - error({type,{illegal,default,value,V},S}). - -normalize_seqof(S,Value,Type,NameList) -> - normalize_s_of('SEQUENCE OF',S,Value,Type,NameList). - -normalize_setof(S,Value,Type,NameList) -> - normalize_s_of('SET OF',S,Value,Type,NameList). - -normalize_s_of(SorS,S,Value,Type,NameList) when list(Value) -> - DefValueList = lists:map(fun(X) -> {'DEFAULT',X} end,Value), - Suffix = asn1ct_gen:constructed_suffix(SorS,Type), - Def = Type#type.def, - InnerType = asn1ct_gen:get_inner(Def), - WhatKind = asn1ct_gen:type(InnerType), - NewNameList = - case WhatKind of - {constructed,bif} -> - [Suffix|NameList]; - #'Externaltypereference'{type=Name} -> - [Name]; - _ -> [] - end, - NormFun = fun (X) -> normalize_value(S,Type,X, - NewNameList) end, - case catch lists:map(NormFun, DefValueList) of - List when list(List) -> - List; - _ -> - io:format("WARNING: ~p could not handle value ~p~n", - [SorS,Value]), - Value - end; -normalize_s_of(SorS,S,Value,Type,NameList) - when record(Value,'Externalvaluereference') -> - get_normalized_value(S,Value,Type,fun normalize_s_of/5, - [SorS,NameList]). -% case catch get_referenced_type(S,Value) of -% {_,#valuedef{value=V}} -> -% normalize_s_of(SorS,S,V,Type); -% {error,Reason} -> -% io:format("WARNING: ~p could not handle value ~p~n", -% [SorS,Value]), -% Value; -% {_,NewVal} -> -% normalize_s_of(SorS,S,NewVal,Type); -% _ -> -% io:format("WARNING: ~p could not handle value ~p~n", -% [SorS,Value]), -% Value -% end. - - -%% normalize_restrictedstring handles all format of restricted strings. -%% tuple case -normalize_restrictedstring(_S,[Int1,Int2],_) when integer(Int1),integer(Int2) -> - {Int1,Int2}; -%% quadruple case -normalize_restrictedstring(_S,[Int1,Int2,Int3,Int4],_) when integer(Int1), - integer(Int2), - integer(Int3), - integer(Int4) -> - {Int1,Int2,Int3,Int4}; -%% character string list case -normalize_restrictedstring(S,[H|T],CType) when list(H);tuple(H) -> - [normalize_restrictedstring(S,H,CType)|normalize_restrictedstring(S,T,CType)]; -%% character sting case -normalize_restrictedstring(_S,CString,_) when list(CString) -> - Fun = - fun(X) -> - if - $X =< 255, $X >= 0 -> - ok; - true -> - io:format("WARNING: illegal character in string" - " ~p~n",[X]) - end - end, - lists:foreach(Fun,CString), - CString; -%% definedvalue case or argument in a parameterized type -normalize_restrictedstring(S,ERef,CType) when record(ERef,'Externalvaluereference') -> - get_normalized_value(S,ERef,CType, - fun normalize_restrictedstring/3,[]); -%% -normalize_restrictedstring(S,{Name,Val},CType) when atom(Name) -> - normalize_restrictedstring(S,Val,CType). - - -get_normalized_value(S,Val,Type,Func,AddArg) -> - case catch get_referenced_type(S,Val) of - {_,#valuedef{type=_T,value=V}} -> - %% should check that Type and T equals - call_Func(S,V,Type,Func,AddArg); - {error,_} -> - io:format("WARNING: default value not " - "comparable ~p~n",[Val]), - Val; - {_,NewVal} -> - call_Func(S,NewVal,Type,Func,AddArg); - _ -> - io:format("WARNING: default value not " - "comparable ~p~n",[Val]), - Val - end. - -call_Func(S,Val,Type,Func,ArgList) -> - case ArgList of - [] -> - Func(S,Val,Type); - [LastArg] -> - Func(S,Val,Type,LastArg); - [Arg1,LastArg1] -> - Func(Arg1,S,Val,Type,LastArg1); - [Arg1,LastArg1,LastArg2] -> - Func(Arg1,S,Val,Type,LastArg1,LastArg2) - end. - - -get_canonic_type(S,Type,NameList) -> - {InnerType,NewType,NewNameList} = - case Type#type.def of - Name when atom(Name) -> - {Name,Type,NameList}; - Ref when record(Ref,'Externaltypereference') -> - {_,#typedef{name=Name,typespec=RefedType}} = - get_referenced_type(S,Ref), - get_canonic_type(S,RefedType,[Name]); - {Name,T} when atom(Name) -> - {Name,T,NameList}; - Seq when record(Seq,'SEQUENCE') -> - {'SEQUENCE',Seq#'SEQUENCE'.components,NameList}; - Set when record(Set,'SET') -> - {'SET',Set#'SET'.components,NameList} - end, - {asn1ct_gen:unify_if_string(InnerType),NewType,NewNameList}. - - - -check_ptype(_S,Type,Ts) when record(Ts,type) -> - %Tag = Ts#type.tag, - %Constr = Ts#type.constraint, - Def = Ts#type.def, - NewDef= - case Def of - Seq when record(Seq,'SEQUENCE') -> - #newt{type=Seq#'SEQUENCE'{pname=Type#ptypedef.name}}; - Set when record(Set,'SET') -> - #newt{type=Set#'SET'{pname=Type#ptypedef.name}}; - _Other -> - #newt{} - end, - Ts2 = case NewDef of - #newt{type=unchanged} -> - Ts; - #newt{type=TDef}-> - Ts#type{def=TDef} - end, - Ts2. - - -% check_type(S,Type,ObjSpec={{objectclassname,_},_}) -> -% check_class(S,ObjSpec); -check_type(_S,Type,Ts) when record(Type,typedef), - (Type#typedef.checked==true) -> - Ts; -check_type(_S,Type,Ts) when record(Type,typedef), - (Type#typedef.checked==idle) -> % the check is going on - Ts; -check_type(S=#state{recordtopname=TopName},Type,Ts) when record(Ts,type) -> - {Def,Tag,Constr} = - case match_parameters(Ts#type.def,S#state.parameters) of - #type{constraint=_Ctmp,def=Dtmp} -> - {Dtmp,Ts#type.tag,Ts#type.constraint}; - Dtmp -> - {Dtmp,Ts#type.tag,Ts#type.constraint} - end, - TempNewDef = #newt{type=Def,tag=Tag,constraint=Constr}, - TestFun = - fun(Tref) -> - {_,MaybeChoice} = get_referenced_type(S,Tref), - case catch((MaybeChoice#typedef.typespec)#type.def) of - {'CHOICE',_} -> - maybe_illicit_implicit_tag(choice,Tag); - 'ANY' -> - maybe_illicit_implicit_tag(open_type,Tag); - 'ANY DEFINED BY' -> - maybe_illicit_implicit_tag(open_type,Tag); - 'ASN1_OPEN_TYPE' -> - maybe_illicit_implicit_tag(open_type,Tag); - _ -> - Tag - end - end, - NewDef= - case Def of - Ext when record(Ext,'Externaltypereference') -> - {_,RefTypeDef} = get_referenced_type(S,Ext), -% case RefTypeDef of -% Class when record(Class,classdef) -> -% throw({asn1_class,Class}); -% _ -> ok -% end, - case is_class(S,RefTypeDef) of - true -> throw({asn1_class,RefTypeDef}); - _ -> ok - end, - Ct = TestFun(Ext), - RefType = -%case S#state.erule of -% ber_bin_v2 -> - case RefTypeDef#typedef.checked of - true -> - RefTypeDef#typedef.typespec; - _ -> - NewRefTypeDef1 = RefTypeDef#typedef{checked=idle}, - asn1_db:dbput(S#state.mname, - NewRefTypeDef1#typedef.name,NewRefTypeDef1), - RefType1 = - check_type(S,RefTypeDef,RefTypeDef#typedef.typespec), - NewRefTypeDef2 = - RefTypeDef#typedef{checked=true,typespec = RefType1}, - asn1_db:dbput(S#state.mname, - NewRefTypeDef2#typedef.name,NewRefTypeDef2), - %% update the type and mark as checked - RefType1 - end, -% _ -> RefTypeDef#typedef.typespec -% end, - - case asn1ct_gen:prim_bif(asn1ct_gen:get_inner(RefType#type.def)) of - true -> - %% Here we expand to a built in type and inline it - TempNewDef#newt{ - type= - RefType#type.def, - tag= - merge_tags(Ct,RefType#type.tag), - constraint= - merge_constraints(check_constraints(S,Constr), - RefType#type.constraint)}; - _ -> - %% Here we only expand the tags and keep the ext ref - - TempNewDef#newt{ - type= - check_externaltypereference(S,Ext), - tag = - case S#state.erule of - ber_bin_v2 -> - merge_tags(Ct,RefType#type.tag); - _ -> - Ct - end - } - end; - 'ANY' -> - Ct=maybe_illicit_implicit_tag(open_type,Tag), - TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; - {'ANY_DEFINED_BY',_} -> - Ct=maybe_illicit_implicit_tag(open_type,Tag), - TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; - 'INTEGER' -> - check_integer(S,[],Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; - - {'INTEGER',NamedNumberList} -> - TempNewDef#newt{type={'INTEGER',check_integer(S,NamedNumberList,Constr)}, - tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; - {'BIT STRING',NamedNumberList} -> - NewL = check_bitstring(S,NamedNumberList,Constr), -%% erlang:display({asn1ct_check,NamedNumberList,NewL}), - TempNewDef#newt{type={'BIT STRING',NewL}, - tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_BIT_STRING))}; - 'NULL' -> - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_NULL))}; - 'OBJECT IDENTIFIER' -> - check_objectidentifier(S,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER))}; - 'ObjectDescriptor' -> - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_DESCRIPTOR))}; - 'EXTERNAL' -> -%% AssociatedType = asn1_db:dbget(S#state.mname,'EXTERNAL'), -%% #newt{type=check_type(S,Type,AssociatedType)}; - put(external,unchecked), - TempNewDef#newt{type= - #'Externaltypereference'{module=S#state.mname, - type='EXTERNAL'}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_EXTERNAL))}; - {'INSTANCE OF',DefinedObjectClass,Constraint} -> - %% check that DefinedObjectClass is of TYPE-IDENTIFIER class - %% If Constraint is empty make it the general INSTANCE OF type - %% If Constraint is not empty make an inlined type - %% convert INSTANCE OF to the associated type - IOFDef=check_instance_of(S,DefinedObjectClass,Constraint), - TempNewDef#newt{type=IOFDef, - tag=merge_tags(Tag,?TAG_CONSTRUCTED(?N_INSTANCE_OF))}; - {'ENUMERATED',NamedNumberList} -> - TempNewDef#newt{type= - {'ENUMERATED', - check_enumerated(S,NamedNumberList,Constr)}, - tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_ENUMERATED))}; - 'EMBEDDED PDV' -> -% AssociatedType = asn1_db:dbget(S#state.mname,'EMBEDDED PDV'), -% CheckedType = check_type(S,Type, -% AssociatedType#typedef.typespec), - put(embedded_pdv,unchecked), - TempNewDef#newt{type= - #'Externaltypereference'{module=S#state.mname, - type='EMBEDDED PDV'}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_EMBEDDED_PDV))}; - 'BOOLEAN'-> - check_boolean(S,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_BOOLEAN))}; - 'OCTET STRING' -> - check_octetstring(S,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_OCTET_STRING))}; - 'NumericString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_NumericString))}; - 'TeletexString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_TeletexString))}; - 'VideotexString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_VideotexString))}; - 'UTCTime' -> - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_UTCTime))}; - 'GeneralizedTime' -> - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralizedTime))}; - 'GraphicString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_GraphicString))}; - 'VisibleString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_VisibleString))}; - 'GeneralString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralString))}; - 'PrintableString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_PrintableString))}; - 'IA5String' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_IA5String))}; - 'BMPString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_BMPString))}; - 'UniversalString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_UniversalString))}; - 'CHARACTER STRING' -> -% AssociatedType = asn1_db:dbget(S#state.mname, -% 'CHARACTER STRING'), -% CheckedType = check_type(S,Type, -% AssociatedType#typedef.typespec), - put(character_string,unchecked), - TempNewDef#newt{type= - #'Externaltypereference'{module=S#state.mname, - type='CHARACTER STRING'}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_CHARACTER_STRING))}; - Seq when record(Seq,'SEQUENCE') -> - RecordName = - case TopName of - [] -> - [Type#typedef.name]; - _ -> - TopName - end, - {TableCInf,Components} = - check_sequence(S#state{recordtopname= - RecordName}, - Type,Seq#'SEQUENCE'.components), - TempNewDef#newt{type=Seq#'SEQUENCE'{tablecinf=TableCInf, - components=Components}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))}; - {'SEQUENCE OF',Components} -> - TempNewDef#newt{type={'SEQUENCE OF',check_sequenceof(S,Type,Components)}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))}; - {'CHOICE',Components} -> - Ct = maybe_illicit_implicit_tag(choice,Tag), - TempNewDef#newt{type={'CHOICE',check_choice(S,Type,Components)},tag=Ct}; - Set when record(Set,'SET') -> - RecordName= - case TopName of - [] -> - [Type#typedef.name]; - _ -> - TopName - end, - {Sorted,TableCInf,Components} = - check_set(S#state{recordtopname=RecordName}, - Type,Set#'SET'.components), - TempNewDef#newt{type=Set#'SET'{sorted=Sorted, - tablecinf=TableCInf, - components=Components}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))}; - {'SET OF',Components} -> - TempNewDef#newt{type={'SET OF',check_setof(S,Type,Components)}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))}; - %% This is a temporary hack until the full Information Obj Spec - %% in X.681 is supported - {{typereference,_,'TYPE-IDENTIFIER'},[{typefieldreference,_,'Type'}]} -> - Ct=maybe_illicit_implicit_tag(open_type,Tag), - TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; - - {#'Externaltypereference'{type='TYPE-IDENTIFIER'}, - [{typefieldreference,_,'Type'}]} -> - Ct=maybe_illicit_implicit_tag(open_type,Tag), - TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; - - {pt,Ptype,ParaList} -> - %% Ptype might be a parameterized - type, object set or - %% value set. If it isn't a parameterized type notify the - %% calling function. - {_,Ptypedef} = get_referenced_type(S,Ptype), - notify_if_not_ptype(S,Ptypedef), - NewParaList = [match_parameters(TmpParam,S#state.parameters)|| - TmpParam <- ParaList], - Instance = instantiate_ptype(S,Ptypedef,NewParaList), - TempNewDef#newt{type=Instance#type.def, - tag=merge_tags(Tag,Instance#type.tag), - constraint=Instance#type.constraint, - inlined=yes}; - -% {ClRef,FieldRefList} when record(ClRef,'Externaltypereference') -> - OCFT=#'ObjectClassFieldType'{class=ClRef} -> - %% this case occures in a SEQUENCE when - %% the type of the component is a ObjectClassFieldType - ClassSpec = check_class(S,ClRef), - NewTypeDef = maybe_open_type(S,ClassSpec,OCFT,Constr), - InnerTag = get_innertag(S,NewTypeDef), - MergedTag = merge_tags(Tag,InnerTag), - Ct = - case is_open_type(NewTypeDef) of - true -> - maybe_illicit_implicit_tag(open_type,MergedTag); - _ -> - MergedTag - end, - TempNewDef#newt{type=NewTypeDef,tag=Ct}; - {valueset,Vtype} -> - TempNewDef#newt{type={valueset,check_type(S,Type,Vtype)}}; - Other -> - exit({'cant check' ,Other}) - end, - Ts2 = case NewDef of - #newt{type=unchanged} -> - Ts#type{def=Def}; - #newt{type=TDef}-> - Ts#type{def=TDef} - end, - NewTag = case NewDef of - #newt{tag=unchanged} -> - Tag; - #newt{tag=TT} -> - TT - end, - T3 = Ts2#type{tag = lists:map(fun(TempTag = #tag{type={default,TTx}}) -> - TempTag#tag{type=TTx}; - (Else) -> Else end, NewTag)}, - T4 = case NewDef of - #newt{constraint=unchanged} -> - T3#type{constraint=Constr}; - #newt{constraint=NewConstr} -> - T3#type{constraint=NewConstr} - end, - T5 = T4#type{inlined=NewDef#newt.inlined}, - T5#type{constraint=check_constraints(S,T5#type.constraint)}. - - -get_innertag(_S,#'ObjectClassFieldType'{type=Type}) -> - case Type of - #type{tag=Tag} -> Tag; - {fixedtypevaluefield,_,#type{tag=Tag}} -> Tag; - {TypeFieldName,_} when atom(TypeFieldName) -> []; - _ -> [] - end; -get_innertag(_S,_) -> - []. - -is_class(_S,#classdef{}) -> - true; -is_class(S,#typedef{typespec=#type{def=Eref}}) - when record(Eref,'Externaltypereference')-> - {_,NextDef} = get_referenced_type(S,Eref), - is_class(S,NextDef); -is_class(_,_) -> - false. - -get_class_def(_S,CD=#classdef{}) -> - CD; -get_class_def(S,#typedef{typespec=#type{def=Eref}}) - when record(Eref,'Externaltypereference') -> - {_,NextDef} = get_referenced_type(S,Eref), - get_class_def(S,NextDef). - -maybe_illicit_implicit_tag(Kind,Tag) -> - case Tag of - [#tag{type='IMPLICIT'}|_T] -> - throw({error,{asn1,{implicit_tag_before,Kind}}}); - [ChTag = #tag{type={default,_}}|T] -> - case Kind of - open_type -> - [ChTag#tag{type='EXPLICIT',form=32}|T]; %X.680 30.6c, X.690 8.14.2 - choice -> - [ChTag#tag{type='EXPLICIT',form=32}|T] % X.680 28.6 c, 30.6c - end; - _ -> - Tag % unchanged - end. - -%% maybe_open_type/2 -> {ClassSpec,FieldRefList} | 'ASN1_OPEN_TYPE' -%% if the FieldRefList points out a typefield and the class don't have -%% any UNIQUE field, so that a component relation constraint cannot specify -%% the type of a typefield, return 'ASN1_OPEN_TYPE', otherwise return -%% {ClassSpec,FieldRefList}. -maybe_open_type(S,ClassSpec=#objectclass{fields=Fs}, - OCFT=#'ObjectClassFieldType'{fieldname=FieldRefList}, - Constr) -> - Type = get_ObjectClassFieldType(S,Fs,FieldRefList), - FieldNames=get_referenced_fieldname(FieldRefList), - case lists:last(FieldRefList) of - {valuefieldreference,_} -> - OCFT#'ObjectClassFieldType'{class=ClassSpec, - fieldname=FieldNames, - type=Type}; - {typefieldreference,_} -> - case {catch get_unique_fieldname(#classdef{typespec=ClassSpec}), - asn1ct_gen:get_constraint(Constr,componentrelation)}of - {Tuple,_} when tuple(Tuple) -> - OCFT#'ObjectClassFieldType'{class=ClassSpec, - fieldname=FieldNames, - type='ASN1_OPEN_TYPE'}; - {_,no} -> - OCFT#'ObjectClassFieldType'{class=ClassSpec, - fieldname=FieldNames, - type='ASN1_OPEN_TYPE'}; - _ -> - OCFT#'ObjectClassFieldType'{class=ClassSpec, - fieldname=FieldNames, - type=Type} - end - end. - -is_open_type(#'ObjectClassFieldType'{type='ASN1_OPEN_TYPE'}) -> - true; -is_open_type(#'ObjectClassFieldType'{}) -> - false. - - -notify_if_not_ptype(S,#pvaluesetdef{type=Type}) -> - case Type#type.def of - Ref when record(Ref,'Externaltypereference') -> - case get_referenced_type(S,Ref) of - {_,#classdef{}} -> - throw(pobjectsetdef); - {_,#typedef{}} -> - throw(pvalueset) - end; - T when record(T,type) -> % this must be a value set - throw(pvalueset) - end; -notify_if_not_ptype(_S,#ptypedef{}) -> - ok. - -% fix me -instantiate_ptype(S,Ptypedef,ParaList) -> - #ptypedef{args=Args,typespec=Type} = Ptypedef, -% Args = get_pt_args(Ptypedef), -% Type = get_pt_spec(Ptypedef), - MatchedArgs = match_args(Args, ParaList, []), - NewS = S#state{type=Type,parameters=MatchedArgs,abscomppath=[]}, - %The abscomppath must be empty since a table constraint in a - %parameterized type only can refer to components within the type - check_type(NewS, Ptypedef, Type). - -get_pt_args(#ptypedef{args=Args}) -> - Args; -get_pt_args(#pvaluesetdef{args=Args}) -> - Args; -get_pt_args(#pvaluedef{args=Args}) -> - Args; -get_pt_args(#pobjectdef{args=Args}) -> - Args; -get_pt_args(#pobjectsetdef{args=Args}) -> - Args. - -get_pt_spec(#ptypedef{typespec=Type}) -> - Type; -get_pt_spec(#pvaluedef{value=Value}) -> - Value; -get_pt_spec(#pvaluesetdef{valueset=VS}) -> - VS; -get_pt_spec(#pobjectdef{def=Def}) -> - Def; -get_pt_spec(#pobjectsetdef{def=Def}) -> - Def. - - - -match_args([FormArg|Ft], [ActArg|At], Acc) -> - match_args(Ft, At, [{FormArg,ActArg}|Acc]); -match_args([], [], Acc) -> - lists:reverse(Acc); -match_args(_, _, _) -> - throw({error,{asn1,{wrong_number_of_arguments}}}). - -check_constraints(S,C) when list(C) -> - check_constraints(S, C, []); -check_constraints(S,C) when record(C,constraint) -> - check_constraints(S, C#constraint.c, []). - - -resolv_tuple_or_list(S,List) when list(List) -> - lists:map(fun(X)->resolv_value(S,X) end, List); -resolv_tuple_or_list(S,{Lb,Ub}) -> - {resolv_value(S,Lb),resolv_value(S,Ub)}. - -%%%----------------------------------------- -%% If the constraint value is a defined value the valuename -%% is replaced by the actual value -%% -resolv_value(S,Val) -> - case match_parameters(Val, S#state.parameters) of - Id -> % unchanged - resolv_value1(S,Id); - Other -> - resolv_value(S,Other) - end. - -resolv_value1(S = #state{mname=M,inputmodules=InpMods}, - V=#'Externalvaluereference'{pos=Pos,module=ExtM,value=Name}) -> - case ExtM of - M -> resolv_value2(S,M,Name,Pos); - _ -> - case lists:member(ExtM,InpMods) of - true -> - resolv_value2(S,M,Name,Pos); - false -> - V - end - end; -resolv_value1(S,{gt,V}) -> - case V of - Int when integer(Int) -> - V + 1; - #valuedef{value=Int} -> - 1 + resolv_value(S,Int); - Other -> - throw({error,{asn1,{undefined_type_or_value,Other}}}) - end; -resolv_value1(S,{lt,V}) -> - case V of - Int when integer(Int) -> - V - 1; - #valuedef{value=Int} -> - resolv_value(S,Int) - 1; - Other -> - throw({error,{asn1,{undefined_type_or_value,Other}}}) - end; -resolv_value1(S,{'ValueFromObject',{object,Object},[{valuefieldreference, - FieldName}]}) -> - %% FieldName can hold either a fixed-type value or a variable-type value - %% Object is a DefinedObject, i.e. a #'Externaltypereference' - {_,ObjTDef} = get_referenced_type(S,Object), - TS = check_object(S,ObjTDef,ObjTDef#typedef.typespec), - {_,_,Components} = TS#'Object'.def, - case lists:keysearch(FieldName,1,Components) of - {value,{_,#valuedef{value=Val}}} -> - Val; - _ -> - error({value,"illegal value in constraint",S}) - end; -% resolv_value1(S,{'ValueFromObject',{po,Object,Params},FieldName}) -> -% %% FieldName can hold either a fixed-type value or a variable-type value -% %% Object is a ParameterizedObject -resolv_value1(_,V) -> - V. - -resolv_value2(S,ModuleName,Name,Pos) -> - case asn1_db:dbget(ModuleName,Name) of - undefined -> - case imported(S,Name) of - {ok,Imodule} -> - {_,V2} = get_referenced(S,Imodule,Name,Pos), - V2#valuedef.value; - _ -> - throw({error,{asn1,{undefined_type_or_value,Name}}}) - end; - Val -> - Val#valuedef.value - end. - -check_constraints(S,[{'ContainedSubtype',Type} | Rest], Acc) -> - {_,CTDef} = get_referenced_type(S,Type#type.def), - CType = check_type(S,S#state.tname,CTDef#typedef.typespec), - check_constraints(S,Rest,CType#type.constraint ++ Acc); -check_constraints(S,[C | Rest], Acc) -> - check_constraints(S,Rest,[check_constraint(S,C) | Acc]); -check_constraints(S,[],Acc) -> -% io:format("Acc: ~p~n",[Acc]), - C = constraint_merge(S,lists:reverse(Acc)), -% io:format("C: ~p~n",[C]), - lists:flatten(C). - - -range_check(F={FixV,FixV}) -> -% FixV; - F; -range_check(VR={Lb,Ub}) when Lb < Ub -> - VR; -range_check(Err={_,_}) -> - throw({error,{asn1,{illegal_size_constraint,Err}}}); -range_check(Value) -> - Value. - -check_constraint(S,Ext) when record(Ext,'Externaltypereference') -> - check_externaltypereference(S,Ext); - - -check_constraint(S,{'SizeConstraint',{Lb,Ub}}) - when list(Lb);tuple(Lb),size(Lb)==2 -> - case Lb of - #'Externalvaluereference'{} -> - check_constraint(S,{'SizeConstraint',{resolv_value(S,Lb),Ub}}); - _ -> - NewLb = range_check(resolv_tuple_or_list(S,Lb)), - NewUb = range_check(resolv_tuple_or_list(S,Ub)), - {'SizeConstraint',{NewLb,NewUb}} - end; -check_constraint(S,{'SizeConstraint',{Lb,Ub}}) -> - case {resolv_value(S,Lb),resolv_value(S,Ub)} of - {FixV,FixV} -> - {'SizeConstraint',FixV}; - {Low,High} when Low < High -> - {'SizeConstraint',{Low,High}}; - Err -> - throw({error,{asn1,{illegal_size_constraint,Err}}}) - end; -check_constraint(S,{'SizeConstraint',Lb}) -> - {'SizeConstraint',resolv_value(S,Lb)}; - -check_constraint(S,{'SingleValue', L}) when list(L) -> - F = fun(A) -> resolv_value(S,A) end, - {'SingleValue',lists:map(F,L)}; - -check_constraint(S,{'SingleValue', V}) when integer(V) -> - Val = resolv_value(S,V), -%% [{'SingleValue',Val},{'ValueRange',{Val,Val}}]; % Why adding value range? - {'SingleValue',Val}; -check_constraint(S,{'SingleValue', V}) -> - {'SingleValue',resolv_value(S,V)}; - -check_constraint(S,{'ValueRange', {Lb, Ub}}) -> - {'ValueRange',{resolv_value(S,Lb),resolv_value(S,Ub)}}; - -%%check_constraint(S,{'ContainedSubtype',Type}) -> -%% #typedef{typespec=TSpec} = -%% check_type(S,S#state.tname,get_referenced_type(S,Type#type.def)), -%% [C] = TSpec#type.constraint, -%% C; - -check_constraint(S,{valueset,Type}) -> - {valueset,check_type(S,S#state.tname,Type)}; - -check_constraint(S,{simpletable,Type}) -> - OSName = (Type#type.def)#'Externaltypereference'.type, - C = match_parameters(Type#type.def,S#state.parameters), - case C of - #'Externaltypereference'{} -> - Type#type{def=check_externaltypereference(S,C)}, - {simpletable,OSName}; - _ -> - check_type(S,S#state.tname,Type), - {simpletable,OSName} - end; - -check_constraint(S,{componentrelation,{objectset,Opos,Objset},Id}) -> - %% Objset is an 'Externaltypereference' record, since Objset is - %% a DefinedObjectSet. - RealObjset = match_parameters(Objset,S#state.parameters), - Ext = check_externaltypereference(S,RealObjset), - {componentrelation,{objectset,Opos,Ext},Id}; - -check_constraint(S,Type) when record(Type,type) -> - #type{def=Def} = check_type(S,S#state.tname,Type), - Def; - -check_constraint(S,C) when list(C) -> - lists:map(fun(X)->check_constraint(S,X) end,C); -% else keep the constraint unchanged -check_constraint(_S,Any) -> -% io:format("Constraint = ~p~n",[Any]), - Any. - -%% constraint_merge/2 -%% Compute the intersection of the outermost level of the constraint list. -%% See Dubuisson second paragraph and fotnote on page 285. -%% If constraints with extension are included in combined constraints. The -%% resulting combination will have the extension of the last constraint. Thus, -%% there will be no extension if the last constraint is without extension. -%% The rootset of all constraints are considered in the "outermoust -%% intersection". See section 13.1.2 in Dubuisson. -constraint_merge(_S,C=[H])when tuple(H) -> - C; -constraint_merge(_S,[]) -> - []; -constraint_merge(S,C) -> - %% skip all extension but the last - C1 = filter_extensions(C), - %% perform all internal level intersections, intersections first - %% since they have precedence over unions - C2 = lists:map(fun(X)when list(X)->constraint_intersection(S,X); - (X) -> X end, - C1), - %% perform all internal level unions - C3 = lists:map(fun(X)when list(X)->constraint_union(S,X); - (X) -> X end, - C2), - - %% now get intersection of the outermost level - %% get the least common single value constraint - SVs = get_constraints(C3,'SingleValue'), - CombSV = intersection_of_sv(S,SVs), - %% get the least common value range constraint - VRs = get_constraints(C3,'ValueRange'), - CombVR = intersection_of_vr(S,VRs), - %% get the least common size constraint - SZs = get_constraints(C3,'SizeConstraint'), - CombSZ = intersection_of_size(S,SZs), - CminusSVs=ordsets:subtract(ordsets:from_list(C3),ordsets:from_list(SVs)), - % CminusSVsVRs = ordsets:subtract(ordsets:from_list(CminusSVs), -% ordsets:from_list(VRs)), - RestC = ordsets:subtract(ordsets:from_list(CminusSVs), - ordsets:from_list(SZs)), - %% get the least common combined constraint. That is the union of each - %% deep costraint and merge of single value and value range constraints - combine_constraints(S,CombSV,CombVR,CombSZ++RestC). - -%% constraint_union(S,C) takes a list of constraints as input and -%% merge them to a union. Unions are performed when two -%% constraints is found with an atom union between. -%% The list may be nested. Fix that later !!! -constraint_union(_S,[]) -> - []; -constraint_union(_S,C=[_E]) -> - C; -constraint_union(S,C) when list(C) -> - case lists:member(union,C) of - true -> - constraint_union1(S,C,[]); - _ -> - C - end; -% SV = get_constraints(C,'SingleValue'), -% SV1 = constraint_union_sv(S,SV), -% VR = get_constraints(C,'ValueRange'), -% VR1 = constraint_union_vr(VR), -% RestC = ordsets:filter(fun({'SingleValue',_})->false; -% ({'ValueRange',_})->false; -% (_) -> true end,ordsets:from_list(C)), -% SV1++VR1++RestC; -constraint_union(_S,C) -> - [C]. - -constraint_union1(S,[A={'ValueRange',_},union,B={'ValueRange',_}|Rest],Acc) -> - AunionB = constraint_union_vr([A,B]), - constraint_union1(S,Rest,AunionB++Acc); -constraint_union1(S,[A={'SingleValue',_},union,B={'SingleValue',_}|Rest],Acc) -> - AunionB = constraint_union_sv(S,[A,B]), - constraint_union1(S,Rest,AunionB++Acc); -constraint_union1(S,[A={'SingleValue',_},union,B={'ValueRange',_}|Rest],Acc) -> - AunionB = union_sv_vr(S,A,B), - constraint_union1(S,Rest,AunionB++Acc); -constraint_union1(S,[A={'ValueRange',_},union,B={'SingleValue',_}|Rest],Acc) -> - AunionB = union_sv_vr(S,B,A), - constraint_union1(S,Rest,AunionB++Acc); -constraint_union1(S,[union|Rest],Acc) -> %skip when unsupported constraints - constraint_union1(S,Rest,Acc); -constraint_union1(S,[A|Rest],Acc) -> - constraint_union1(S,Rest,[A|Acc]); -constraint_union1(_S,[],Acc) -> - lists:reverse(Acc). - -constraint_union_sv(_S,SV) -> - Values=lists:map(fun({_,V})->V end,SV), - case ordsets:from_list(Values) of - [] -> []; - [N] -> [{'SingleValue',N}]; - L -> [{'SingleValue',L}] - end. - -%% REMOVE???? -%%constraint_union(S,VR,'ValueRange') -> -%% constraint_union_vr(VR). - -%% constraint_union_vr(VR) -%% VR = [{'ValueRange',{Lb,Ub}},...] -%% Lb = 'MIN' | integer() -%% Ub = 'MAX' | integer() -%% Returns if possible only one ValueRange tuple with a range that -%% is a union of all ranges in VR. -constraint_union_vr(VR) -> - %% Sort VR by Lb in first hand and by Ub in second hand - Fun=fun({_,{'MIN',_B1}},{_,{A2,_B2}}) when integer(A2)->true; - ({_,{A1,_B1}},{_,{'MAX',_B2}}) when integer(A1) -> true; - ({_,{A1,_B1}},{_,{A2,_B2}}) when integer(A1),integer(A2),A1<A2 -> true; - ({_,{A,B1}},{_,{A,B2}}) when B1=<B2->true; - (_,_)->false end, - constraint_union_vr(lists:usort(Fun,VR),[]). - -constraint_union_vr([],Acc) -> - lists:reverse(Acc); -constraint_union_vr([C|Rest],[]) -> - constraint_union_vr(Rest,[C]); -constraint_union_vr([{_,{Lb,Ub2}}|Rest],[{_,{Lb,_Ub1}}|Acc]) -> %Ub2 > Ub1 - constraint_union_vr(Rest,[{'ValueRange',{Lb,Ub2}}|Acc]); -constraint_union_vr([{_,{_,Ub}}|Rest],A=[{_,{_,Ub}}|_Acc]) -> - constraint_union_vr(Rest,A); -constraint_union_vr([{_,{Lb2,Ub2}}|Rest],[{_,{Lb1,Ub1}}|Acc]) when Lb2=<Ub1, - Ub2>Ub1-> - constraint_union_vr(Rest,[{'ValueRange',{Lb1,Ub2}}|Acc]); -constraint_union_vr([{_,{_,Ub2}}|Rest],A=[{_,{_,Ub1}}|_Acc]) when Ub2=<Ub1-> - constraint_union_vr(Rest,A); -constraint_union_vr([VR|Rest],Acc) -> - constraint_union_vr(Rest,[VR|Acc]). - -union_sv_vr(_S,[],B) -> - [B]; -union_sv_vr(_S,A,[]) -> - [A]; -union_sv_vr(_S,C1={'SingleValue',SV},C2={'ValueRange',VR={Lb,Ub}}) - when integer(SV) -> - case is_int_in_vr(SV,C2) of - true -> [C2]; - _ -> - case VR of - {'MIN',Ub} when SV==Ub+1 -> [{'ValueRange',{'MIN',SV}}]; - {Lb,'MAX'} when SV==Lb-1 -> [{'ValueRange',{SV,'MAX'}}]; - {Lb,Ub} when SV==Ub+1 -> [{'ValueRange',{Lb,SV}}]; - {Lb,Ub} when SV==Lb-1 -> [{'ValueRange',{SV,Ub}}]; - _ -> - [C1,C2] - end - end; -union_sv_vr(_S,C1={'SingleValue',SV},C2={'ValueRange',{_Lb,_Ub}}) - when list(SV) -> - case lists:filter(fun(X)->is_int_in_vr(X,C2) end,SV) of - [] -> [C2]; - L -> - case expand_vr(L,C2) of - {[],C3} -> [C3]; - {L,C2} -> [C1,C2]; - {[Val],C3} -> [{'SingleValue',Val},C3]; - {L2,C3} -> [{'SingleValue',L2},C3] - end - end. - -expand_vr(L,VR={_,{Lb,Ub}}) -> - case lower_Lb(L,Lb) of - false -> - case higher_Ub(L,Ub) of - false -> - {L,VR}; - {L1,UbNew} -> - expand_vr(L1,{'ValueRange',{Lb,UbNew}}) - end; - {L1,LbNew} -> - expand_vr(L1,{'ValueRange',{LbNew,Ub}}) - end. - -lower_Lb(_,'MIN') -> - false; -lower_Lb(L,Lb) -> - remove_val_from_list(Lb - 1,L). - -higher_Ub(_,'MAX') -> - false; -higher_Ub(L,Ub) -> - remove_val_from_list(Ub + 1,L). - -remove_val_from_list(List,Val) -> - case lists:member(Val,List) of - true -> - {lists:delete(Val,List),Val}; - false -> - false - end. - -%% get_constraints/2 -%% Arguments are a list of constraints, which has the format {key,value}, -%% and a constraint type -%% Returns a list of constraints only of the requested type or the atom -%% 'no' if no such constraints were found -get_constraints(L=[{CType,_}],CType) -> - L; -get_constraints(C,CType) -> - keysearch_allwithkey(CType,1,C). - -%% keysearch_allwithkey(Key,Ix,L) -%% Types: -%% Key = atom() -%% Ix = integer() -%% L = [TwoTuple] -%% TwoTuple = [{atom(),term()}|...] -%% Returns a List that contains all -%% elements from L that has a key Key as element Ix -keysearch_allwithkey(Key,Ix,L) -> - lists:filter(fun(X) when tuple(X) -> - case element(Ix,X) of - Key -> true; - _ -> false - end; - (_) -> false - end, L). - - -%% filter_extensions(C) -%% takes a list of constraints as input and -%% returns a list with the intersection of all extension roots -%% and only the extension of the last constraint kept if any -%% extension in the last constraint -filter_extensions([]) -> - []; -filter_extensions(C=[_H]) -> - C; -filter_extensions(C) when list(C) -> - filter_extensions(C,[]). - -filter_extensions([C],Acc) -> - lists:reverse([C|Acc]); -filter_extensions([{C,_E},H2|T],Acc) when tuple(C) -> - filter_extensions([H2|T],[C|Acc]); -filter_extensions([{'SizeConstraint',{A,_B}},H2|T],Acc) - when list(A);tuple(A) -> - filter_extensions([H2|T],[{'SizeConstraint',A}|Acc]); -filter_extensions([H1,H2|T],Acc) -> - filter_extensions([H2|T],[H1|Acc]). - -%% constraint_intersection(S,C) takes a list of constraints as input and -%% performs intersections. Intersecions are performed when an -%% atom intersection is found between two constraints. -%% The list may be nested. Fix that later !!! -constraint_intersection(_S,[]) -> - []; -constraint_intersection(_S,C=[_E]) -> - C; -constraint_intersection(S,C) when list(C) -> -% io:format("constraint_intersection: ~p~n",[C]), - case lists:member(intersection,C) of - true -> - constraint_intersection1(S,C,[]); - _ -> - C - end; -constraint_intersection(_S,C) -> - [C]. - -constraint_intersection1(S,[A,intersection,B|Rest],Acc) -> - AisecB = c_intersect(S,A,B), - constraint_intersection1(S,Rest,AisecB++Acc); -constraint_intersection1(S,[A|Rest],Acc) -> - constraint_intersection1(S,Rest,[A|Acc]); -constraint_intersection1(_,[],Acc) -> - lists:reverse(Acc). - -c_intersect(S,C1={'SingleValue',_},C2={'SingleValue',_}) -> - intersection_of_sv(S,[C1,C2]); -c_intersect(S,C1={'ValueRange',_},C2={'ValueRange',_}) -> - intersection_of_vr(S,[C1,C2]); -c_intersect(S,C1={'ValueRange',_},C2={'SingleValue',_}) -> - intersection_sv_vr(S,[C2],[C1]); -c_intersect(S,C1={'SingleValue',_},C2={'ValueRange',_}) -> - intersection_sv_vr(S,[C1],[C2]); -c_intersect(_S,C1,C2) -> - [C1,C2]. - -%% combine_constraints(S,SV,VR,CComb) -%% Types: -%% S = record(state,S) -%% SV = [] | [SVC] -%% VR = [] | [VRC] -%% CComb = [] | [Lists] -%% SVC = {'SingleValue',integer()} | {'SingleValue',[integer(),...]} -%% VRC = {'ValueRange',{Lb,Ub}} -%% Lists = List of lists containing any constraint combination -%% Lb = 'MIN' | integer() -%% Ub = 'MAX' | integer() -%% Returns a combination of the least common constraint among SV,VR and all -%% elements in CComb -combine_constraints(_S,[],VR,CComb) -> - VR ++ CComb; -% combine_combined_cnstr(S,VR,CComb); -combine_constraints(_S,SV,[],CComb) -> - SV ++ CComb; -% combine_combined_cnstr(S,SV,CComb); -combine_constraints(S,SV,VR,CComb) -> - C=intersection_sv_vr(S,SV,VR), - C ++ CComb. -% combine_combined_cnstr(S,C,CComb). - -intersection_sv_vr(_,[],_VR) -> - []; -intersection_sv_vr(_,_SV,[]) -> - []; -intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2={'ValueRange',{_Lb,_Ub}}]) - when integer(SV) -> - case is_int_in_vr(SV,C2) of - true -> [C1]; - _ -> %%error({type,{"asn1 illegal constraint",C1,C2},S}) - throw({error,{"asn1 illegal constraint",C1,C2}}) - end; -intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2]) - when list(SV) -> - case lists:filter(fun(X)->is_int_in_vr(X,C2) end,SV) of - [] -> - %%error({type,{"asn1 illegal constraint",C1,C2},S}); - throw({error,{"asn1 illegal constraint",C1,C2}}); - [V] -> [{'SingleValue',V}]; - L -> [{'SingleValue',L}] - end. - - - -intersection_of_size(_,[]) -> - []; -intersection_of_size(_,C=[_SZ]) -> - C; -intersection_of_size(S,[SZ,SZ|Rest]) -> - intersection_of_size(S,[SZ|Rest]); -intersection_of_size(S,C=[C1={_,Int},{_,Range}|Rest]) - when integer(Int),tuple(Range) -> - case Range of - {Lb,Ub} when Int >= Lb, - Int =< Ub -> - intersection_of_size(S,[C1|Rest]); - _ -> - throw({error,{asn1,{illegal_size_constraint,C}}}) - end; -intersection_of_size(S,[C1={_,Range},C2={_,Int}|Rest]) - when integer(Int),tuple(Range) -> - intersection_of_size(S,[C2,C1|Rest]); -intersection_of_size(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) -> - Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])), - Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])), - intersection_of_size(S,[{'SizeConstraint',{Lb,Ub}}|Rest]); -intersection_of_size(_,SZ) -> - throw({error,{asn1,{illegal_size_constraint,SZ}}}). - -intersection_of_vr(_,[]) -> - []; -intersection_of_vr(_,VR=[_C]) -> - VR; -intersection_of_vr(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) -> - Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])), - Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])), - intersection_of_vr(S,[{'ValueRange',{Lb,Ub}}|Rest]); -intersection_of_vr(_S,VR) -> - %%error({type,{asn1,{illegal_value_range_constraint,VR}},S}); - throw({error,{asn1,{illegal_value_range_constraint,VR}}}). - -intersection_of_sv(_,[]) -> - []; -intersection_of_sv(_,SV=[_C]) -> - SV; -intersection_of_sv(S,[SV,SV|Rest]) -> - intersection_of_sv(S,[SV|Rest]); -intersection_of_sv(S,[{_,Int},{_,SV}|Rest]) when integer(Int), - list(SV) -> - SV2=intersection_of_sv1(S,Int,SV), - intersection_of_sv(S,[SV2|Rest]); -intersection_of_sv(S,[{_,SV},{_,Int}|Rest]) when integer(Int), - list(SV) -> - SV2=intersection_of_sv1(S,Int,SV), - intersection_of_sv(S,[SV2|Rest]); -intersection_of_sv(S,[{_,SV1},{_,SV2}|Rest]) when list(SV1), - list(SV2) -> - SV3=common_set(SV1,SV2), - intersection_of_sv(S,[SV3|Rest]); -intersection_of_sv(_S,SV) -> - %%error({type,{asn1,{illegal_single_value_constraint,SV}},S}). - throw({error,{asn1,{illegal_single_value_constraint,SV}}}). - -intersection_of_sv1(_S,Int,SV) when integer(Int),list(SV) -> - case lists:member(Int,SV) of - true -> {'SingleValue',Int}; - _ -> - %%error({type,{asn1,{illegal_single_value_constraint,Int,SV}},S}) - throw({error,{asn1,{illegal_single_value_constraint,Int,SV}}}) - end; -intersection_of_sv1(_S,SV1,SV2) -> - %%error({type,{asn1,{illegal_single_value_constraint,SV1,SV2}},S}). - throw({error,{asn1,{illegal_single_value_constraint,SV1,SV2}}}). - -greatest_LB([H]) -> - H; -greatest_LB(L) -> - greatest_LB1(lists:reverse(L)). -greatest_LB1(['MIN',H2|_T])-> - H2; -greatest_LB1([H|_T]) -> - H. -smallest_UB(L) -> - hd(L). - -common_set(SV1,SV2) -> - lists:filter(fun(X)->lists:member(X,SV1) end,SV2). - -is_int_in_vr(Int,{_,{'MIN','MAX'}}) when integer(Int) -> - true; -is_int_in_vr(Int,{_,{'MIN',Ub}}) when integer(Int),Int =< Ub -> - true; -is_int_in_vr(Int,{_,{Lb,'MAX'}}) when integer(Int),Int >= Lb -> - true; -is_int_in_vr(Int,{_,{Lb,Ub}}) when integer(Int),Int >= Lb,Int =< Ub -> - true; -is_int_in_vr(_,_) -> - false. - - - -check_imported(_S,Imodule,Name) -> - case asn1_db:dbget(Imodule,'MODULE') of - undefined -> - io:format("~s.asn1db not found~n",[Imodule]), - io:format("Type ~s imported from non existing module ~s~n",[Name,Imodule]); - Im when record(Im,module) -> - case is_exported(Im,Name) of - false -> - io:format("Imported type ~s not exported from module ~s~n",[Name,Imodule]); - _ -> - ok - end - end, - ok. - -is_exported(Module,Name) when record(Module,module) -> - {exports,Exports} = Module#module.exports, - case Exports of - all -> - true; - [] -> - false; - L when list(L) -> - case lists:keysearch(Name,#'Externaltypereference'.type,Exports) of - false -> false; - _ -> true - end - end. - - - -check_externaltypereference(S,Etref=#'Externaltypereference'{module=Emod})-> - Currmod = S#state.mname, - MergedMods = S#state.inputmodules, - case Emod of - Currmod -> - %% reference to current module or to imported reference - check_reference(S,Etref); - _ -> - %% io:format("Type ~s IMPORTED FROM ~s~n",[Etype,Emod]), - case lists:member(Emod,MergedMods) of - true -> - check_reference(S,Etref); - false -> - Etref - end - end. - -check_reference(S,#'Externaltypereference'{pos=Pos,module=Emod,type=Name}) -> - ModName = S#state.mname, - case asn1_db:dbget(ModName,Name) of - undefined -> - case imported(S,Name) of - {ok,Imodule} -> - check_imported(S,Imodule,Name), - #'Externaltypereference'{module=Imodule,type=Name}; - _ -> - %may be a renamed type in multi file compiling! - {_,T}=renamed_reference(S,Name,Emod), - NewName = asn1ct:get_name_of_def(T), - NewPos = asn1ct:get_pos_of_def(T), - #'Externaltypereference'{pos=NewPos, - module=ModName, - type=NewName} - end; - _ -> - %% cannot do check_type here due to recursive definitions, like - %% S ::= SEQUENCE {a INTEGER, b S}. This implies that references - %% that appear before the definition will be an - %% Externaltypereference in the abstract syntax tree - #'Externaltypereference'{pos=Pos,module=ModName,type=Name} - end. - - -name2Extref(_Mod,Name) when record(Name,'Externaltypereference') -> - Name; -name2Extref(Mod,Name) -> - #'Externaltypereference'{module=Mod,type=Name}. - -get_referenced_type(S,Ext) when record(Ext,'Externaltypereference') -> - case match_parameters(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; - Other -> - {undefined,Other} - end; -get_referenced_type(S=#state{mname=Emod}, - ERef=#'Externalvaluereference'{pos=P,module=Emod, - value=Eval}) -> - case match_parameters(ERef,S#state.parameters) of - ERef -> - get_referenced1(S,Emod,Eval,P); - OtherERef when 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(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}. - -%% get_referenced/3 -%% The referenced entity Ename may in case of an imported parameterized -%% type reference imported entities in the other module, which implies that -%% asn1_db:dbget will fail even though the referenced entity exists. Thus -%% Emod may be the module that imports the entity Ename and not holds the -%% data about Ename. -get_referenced(S,Emod,Ename,Pos) -> - case asn1_db:dbget(Emod,Ename) of - undefined -> - %% May be an imported entity in module Emod -% throw({error,{asn1,{undefined_type_or_value,{Emod,Ename}}}}); - NewS = S#state{module=asn1_db:dbget(Emod,'MODULE')}, - get_imported(NewS,Ename,Emod,Pos); - T when record(T,typedef) -> - Spec = T#typedef.typespec, - case Spec#type.def of - Tref when record(Tref,typereference) -> - Def = #'Externaltypereference'{module=Emod, - type=Tref#typereference.val, - pos=Tref#typereference.pos}, - - - {Emod,T#typedef{typespec=Spec#type{def=Def}}}; - _ -> - {Emod,T} % should add check that T is exported here - end; - V -> {Emod,V} - end. - -get_referenced1(S,ModuleName,Name,Pos) -> - case asn1_db:dbget(S#state.mname,Name) of - undefined -> - %% ModuleName may be other than S#state.mname when - %% multi file compiling is used. - get_imported(S,Name,ModuleName,Pos); - T -> - {S#state.mname,T} - end. - -get_imported(S,Name,Module,Pos) -> - case imported(S,Name) of - {ok,Imodule} -> - case asn1_db:dbget(Imodule,'MODULE') of - undefined -> - throw({error,{asn1,{module_not_found,Imodule}}}); - Im when record(Im,module) -> - case is_exported(Im,Name) of - false -> - throw({error, - {asn1,{not_exported,{Im,Name}}}}); - _ -> - get_referenced_type(S, - #'Externaltypereference' - {module=Imodule, - type=Name,pos=Pos}) - end - end; - _ -> - renamed_reference(S,Name,Module) - end. - -renamed_reference(S,Name,Module) -> - %% first check if there is a renamed type in this module - %% second check if any type was imported with this name - case ets:info(renamed_defs) of - undefined -> throw({error,{asn1,{undefined_type,Name}}}); - _ -> - case ets:match(renamed_defs,{'$1',Name,Module}) of - [] -> - case ets:info(original_imports) of - undefined -> - throw({error,{asn1,{undefined_type,Name}}}); - _ -> - case ets:match(original_imports,{Module,'$1'}) of - [] -> - throw({error,{asn1,{undefined_type,Name}}}); - [[ImportsList]] -> - case get_importmoduleoftype(ImportsList,Name) of - undefined -> - throw({error,{asn1,{undefined_type,Name}}}); - NextMod -> - renamed_reference(S,Name,NextMod) - end - end - end; - [[NewTypeName]] -> - get_referenced1(S,Module,NewTypeName,undefined) - end - end. - -get_importmoduleoftype([I|Is],Name) -> - Index = #'Externaltypereference'.type, - case lists:keysearch(Name,Index,I#'SymbolsFromModule'.symbols) of - {value,_Ref} -> - (I#'SymbolsFromModule'.module)#'Externaltypereference'.type; - _ -> - get_importmoduleoftype(Is,Name) - end; -get_importmoduleoftype([],_) -> - undefined. - - -match_parameters(Name,[]) -> - Name; - -match_parameters(#'Externaltypereference'{type=Name},[{#'Externaltypereference'{type=Name},NewName}|_T]) -> - NewName; -match_parameters(#'Externaltypereference'{type=Name},[{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> - NewName; -% match_parameters(#'Externaltypereference'{type=Name},[{#typereference{val=Name},NewName}|T]) -> -% NewName; -% match_parameters(#'Externaltypereference'{type=Name},[{{_,#typereference{val=Name}},NewName}|T]) -> -% NewName; -%match_parameters(#typereference{val=Name},[{#typereference{val=Name},NewName}|T]) -> -% NewName; -match_parameters(#'Externalvaluereference'{value=Name},[{#'Externalvaluereference'{value=Name},NewName}|_T]) -> - NewName; -match_parameters(#'Externalvaluereference'{value=Name},[{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) -> - NewName; -% match_parameters(#identifier{val=Name},[{#identifier{val=Name},NewName}|T]) -> -% NewName; -% match_parameters(#identifier{val=Name},[{{_,#identifier{val=Name}},NewName}|T]) -> -% NewName; -match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}}, - [{{_,#'Externaltypereference'{type=Name}},{valueset,#type{def=NewName}}}|_T]) -> - NewName; -match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}}, - [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> - NewName; -% match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}}, -% [{{_,#typereference{val=Name}},{valueset,#type{def=NewName}}}|T]) -> -% NewName; -% match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}}, -% [{{_,#typereference{val=Name}},NewName}|T]) -> -% NewName; - -match_parameters(Name, [_H|T]) -> - %%io:format("match_parameters(~p,~p)~n",[Name,[H|T]]), - match_parameters(Name,T). - -imported(S,Name) -> - {imports,Ilist} = (S#state.module)#module.imports, - imported1(Name,Ilist). - -imported1(Name, - [#'SymbolsFromModule'{symbols=Symlist, - module=#'Externaltypereference'{type=ModuleName}}|T]) -> - case lists:keysearch(Name,#'Externaltypereference'.type,Symlist) of - {value,_V} -> - {ok,ModuleName}; - _ -> - imported1(Name,T) - end; -imported1(_Name,[]) -> - false. - - -check_integer(_S,[],_C) -> - ok; -check_integer(S,NamedNumberList,_C) -> - case check_unique(NamedNumberList,2) of - [] -> - check_int(S,NamedNumberList,[]); - L when list(L) -> - error({type,{duplicates,L},S}), - unchanged - - end. - -check_int(S,[{'NamedNumber',Id,Num}|T],Acc) when 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,[],Acc) -> - lists:keysort(2,Acc). - - - -check_bitstring(_S,[],_Constr) -> - []; -check_bitstring(S,NamedNumberList,_Constr) -> - case check_unique(NamedNumberList,2) of - [] -> - check_bitstr(S,NamedNumberList,[]); - L when list(L) -> - error({type,{duplicates,L},S}), - unchanged - end. - -check_bitstr(S,[{'NamedNumber',Id,Num}|T],Acc)when integer(Num) -> - check_bitstr(S,T,[{Id,Num}|Acc]); -check_bitstr(S,[{'NamedNumber',Id,Name}|T],Acc) when 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 list(L) -> - error({type,{duplicate_values,L},S}), - unchanged - end. - -%%check_bitstring(S,NamedNumberList,Constr) -> -%% NamedNumberList. - -%% Check INSTANCE OF -%% check that DefinedObjectClass is of TYPE-IDENTIFIER class -%% If Constraint is empty make it the general INSTANCE OF type -%% If Constraint is not empty make an inlined type -%% convert INSTANCE OF to the associated type -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; - {_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} -> - check_type_identifier(S,(TD#typedef.typespec)#type.def); - _ -> - error({type,{"object set in type INSTANCE OF " - "not of class TYPE-IDENTIFIER",Eref},S}) - end. - -iof_associated_type(S,[]) -> - %% in this case encode/decode functions for INSTANCE OF must be - %% generated - case get(instance_of) of - undefined -> - AssociateSeq = iof_associated_type1(S,[]), - Tag = - case S#state.erule of - ber_bin_v2 -> - [?TAG_CONSTRUCTED(?N_INSTANCE_OF)]; - _ -> [] - end, - TypeDef=#typedef{checked=true, - name='INSTANCE OF', - typespec=#type{tag=Tag, - def=AssociateSeq}}, - asn1_db:dbput(S#state.mname,'INSTANCE OF',TypeDef), - put(instance_of,generate); - _ -> - ok - end, - #'Externaltypereference'{module=S#state.mname,type='INSTANCE OF'}; -iof_associated_type(S,C) -> - iof_associated_type1(S,C). - -iof_associated_type1(S,C) -> - {TableCInf,Comp1Cnstr,Comp2Cnstr,Comp2tablecinf}= - instance_of_constraints(S,C), - - ModuleName = S#state.mname, - Typefield_type= - case C of - [] -> 'ASN1_OPEN_TYPE'; - _ -> {typefield,'Type'} - end, - {ObjIdTag,C1TypeTag}= - case S#state.erule of - ber_bin_v2 -> - {[{'UNIVERSAL',8}], - [#tag{class='UNIVERSAL', - number=6, - type='IMPLICIT', - form=0}]}; - _ -> {[{'UNIVERSAL','INTEGER'}],[]} - end, - TypeIdentifierRef=#'Externaltypereference'{module=ModuleName, - type='TYPE-IDENTIFIER'}, - ObjectIdentifier = - #'ObjectClassFieldType'{classname=TypeIdentifierRef, - class=[], - fieldname={id,[]}, - type={fixedtypevaluefield,id, - #type{def='OBJECT IDENTIFIER'}}}, - Typefield = - #'ObjectClassFieldType'{classname=TypeIdentifierRef, - class=[], - fieldname={'Type',[]}, - type=Typefield_type}, - IOFComponents = - [#'ComponentType'{name='type-id', - typespec=#type{tag=C1TypeTag, - def=ObjectIdentifier, - constraint=Comp1Cnstr}, - prop=mandatory, - tags=ObjIdTag}, - #'ComponentType'{name=value, - typespec=#type{tag=[#tag{class='CONTEXT', - number=0, - type='EXPLICIT', - form=32}], - def=Typefield, - constraint=Comp2Cnstr, - tablecinf=Comp2tablecinf}, - prop=mandatory, - tags=[{'CONTEXT',0}]}], - #'SEQUENCE'{tablecinf=TableCInf, - components=IOFComponents}. - - -%% returns the leading attribute, the constraint of the components and -%% the tablecinf value for the second component. -instance_of_constraints(_,[]) -> - {false,[],[],[]}; -instance_of_constraints(S,#constraint{c={simpletable,Type}}) -> - #type{def=#'Externaltypereference'{type=Name}} = Type, - ModuleName = S#state.mname, - ObjectSetRef=#'Externaltypereference'{module=ModuleName, - type=Name}, - CRel=[{componentrelation,{objectset, - undefined, %% pos - ObjectSetRef}, - [{innermost, - [#'Externalvaluereference'{module=ModuleName, - value=type}]}]}], - TableCInf=#simpletableattributes{objectsetname=Name, - c_name='type-id', - c_index=1, - usedclassfield=id, - uniqueclassfield=id, - valueindex=[]}, - {TableCInf,[{simpletable,Name}],CRel,[{objfun,ObjectSetRef}]}. - -%% Check ENUMERATED -%% **************************************** -%% Check that all values are unique -%% assign values to un-numbered identifiers -%% check that the constraints are allowed and correct -%% put the updated info back into database -check_enumerated(_S,[{Name,Number}|Rest],_Constr) when atom(Name), integer(Number)-> - %% already checked , just return the same list - [{Name,Number}|Rest]; -check_enumerated(S,NamedNumberList,_Constr) -> - check_enum(S,NamedNumberList,[],[]). - -%% identifiers are put in Acc2 -%% returns either [{Name,Number}] or {[{Name,Number}],[{ExtName,ExtNumber}]} -%% the latter is returned if the ENUMERATION contains EXTENSIONMARK -check_enum(S,[{'NamedNumber',Id,Num}|T],Acc1,Acc2) when integer(Num) -> - check_enum(S,T,[{Id,Num}|Acc1],Acc2); -check_enum(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc1,Acc2) -> - Val = dbget_ex(S,S#state.mname,Name), - check_enum(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc1,Acc2); -check_enum(S,['EXTENSIONMARK'|T],Acc1,Acc2) -> - NewAcc2 = lists:keysort(2,Acc1), - NewList = enum_number(lists:reverse(Acc2),NewAcc2,0,[]), - { NewList, check_enum(S,T,[],[])}; -check_enum(S,[Id|T],Acc1,Acc2) when atom(Id) -> - check_enum(S,T,Acc1,[Id|Acc2]); -check_enum(_S,[],Acc1,Acc2) -> - NewAcc2 = lists:keysort(2,Acc1), - enum_number(lists:reverse(Acc2),NewAcc2,0,[]). - - -% assign numbers to identifiers , numbers from 0 ... but must not -% be the same as already assigned to NamedNumbers -enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num > Cnt -> - enum_number(T,[{Id,Num}|T2],Cnt+1,[{H,Cnt}|Acc]); -enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num < Cnt -> % negative Num - enum_number(T,T2,Cnt+1,[{H,Cnt},{Id,Num}|Acc]); -enum_number([],L2,_Cnt,Acc) -> - lists:concat([lists:reverse(Acc),L2]); -enum_number(L,[{Id,Num}|T2],Cnt,Acc) -> % Num == Cnt - enum_number(L,T2,Cnt+1,[{Id,Num}|Acc]); -enum_number([H|T],[],Cnt,Acc) -> - enum_number(T,[],Cnt+1,[{H,Cnt}|Acc]). - - -check_boolean(_S,_Constr) -> - ok. - -check_octetstring(_S,_Constr) -> - ok. - -% check all aspects of a SEQUENCE -% - that all component names are unique -% - that all TAGS are ok (when TAG default is applied) -% - that each component is of a valid type -% - that the extension marks are valid - -check_sequence(S,Type,Comps) -> - Components = expand_components(S,Comps), - case check_unique([C||C <- Components ,record(C,'ComponentType')] - ,#'ComponentType'.name) of - [] -> - %% sort_canonical(Components), - Components2 = maybe_automatic_tags(S,Components), - %% check the table constraints from here. The outermost type - %% is Type, the innermost is Comps (the list of components) - NewComps = - case check_each_component(S,Type,Components2) of - NewComponents when list(NewComponents) -> - check_unique_sequence_tags(S,NewComponents), - NewComponents; - Ret = {NewComponents,NewEcomps} -> - TagComps = NewComponents ++ - [Comp#'ComponentType'{prop='OPTIONAL'}|| Comp <- NewEcomps], - %% extension components are like optionals when it comes to tagging - check_unique_sequence_tags(S,TagComps), - Ret - end, - %% CRelInf is the "leading attribute" information - %% necessary for code generating of the look up in the - %% object set table, - %% i.e. getenc_ObjectSet/getdec_ObjectSet. - %% {objfun,ERef} tuple added in NewComps2 in tablecinf - %% field in type record of component relation constrained - %% type -% io:format("NewComps: ~p~n",[NewComps]), - {CRelInf,NewComps2} = componentrelation_leadingattr(S,NewComps), -% io:format("CRelInf: ~p~n",[CRelInf]), -% io:format("NewComps2: ~p~n",[NewComps2]), - %% CompListWithTblInf has got a lot unecessary info about - %% the involved class removed, as the class of the object - %% set. - CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2), -% io:format("CompListWithTblInf: ~p~n",[CompListWithTblInf]), - {CRelInf,CompListWithTblInf}; - Dupl -> - throw({error,{asn1,{duplicate_components,Dupl}}}) - end. - -expand_components(S, [{'COMPONENTS OF',Type}|T]) -> - CompList = - case get_referenced_type(S,Type#type.def) of - {_,#typedef{typespec=#type{def=Seq}}} when record(Seq,'SEQUENCE') -> - case Seq#'SEQUENCE'.components of - {Root,_Ext} -> Root; - Root -> Root - end; - Err -> throw({error,{asn1,{illegal_COMPONENTS_OF,Err}}}) - end, - expand_components(S,CompList) ++ expand_components(S,T); -expand_components(S,[H|T]) -> - [H|expand_components(S,T)]; -expand_components(_,[]) -> - []. - -check_unique_sequence_tags(S,[#'ComponentType'{prop=mandatory}|Rest]) -> - check_unique_sequence_tags(S,Rest); -check_unique_sequence_tags(S,[C|Rest]) when record(C,'ComponentType') -> - check_unique_sequence_tags1(S,Rest,[C]);% optional or default -check_unique_sequence_tags(S,[_ExtensionMarker|Rest]) -> - check_unique_sequence_tags(S,Rest); -check_unique_sequence_tags(_S,[]) -> - true. - -check_unique_sequence_tags1(S,[C|Rest],Acc) when record(C,'ComponentType') -> - case C#'ComponentType'.prop of - mandatory -> - check_unique_tags(S,lists:reverse([C|Acc])), - check_unique_sequence_tags(S,Rest); - _ -> - check_unique_sequence_tags1(S,Rest,[C|Acc]) % default or optional - end; -check_unique_sequence_tags1(S,[H|Rest],Acc) -> - check_unique_sequence_tags1(S,Rest,[H|Acc]); -check_unique_sequence_tags1(S,[],Acc) -> - check_unique_tags(S,lists:reverse(Acc)). - -check_sequenceof(S,Type,Component) when record(Component,type) -> - check_type(S,Type,Component). - -check_set(S,Type,Components) -> - {TableCInf,NewComponents} = check_sequence(S,Type,Components), - case lists:member(der,S#state.options) of - true when S#state.erule == ber; - S#state.erule == ber_bin -> - {Sorted,SortedComponents} = - sort_components(S#state.tname, - (S#state.module)#module.tagdefault, - NewComponents), - {Sorted,TableCInf,SortedComponents}; - _ -> - {false,TableCInf,NewComponents} - end. - -sort_components(_TypeName,'AUTOMATIC',Components) -> - {true,Components}; -sort_components(TypeName,_TagDefault,Components) -> - case untagged_choice(Components) of - false -> - {true,sort_components1(TypeName,Components,[],[],[],[])}; - true -> - {dynamic,Components} % sort in run-time - end. - -sort_components1(TypeName,[C=#'ComponentType'{tags=[{'UNIVERSAL',_}|_R]}|Cs], - UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - sort_components1(TypeName,Cs,[C|UnivAcc],ApplAcc,ContAcc,PrivAcc); -sort_components1(TypeName,[C=#'ComponentType'{tags=[{'APPLICATION',_}|_R]}|Cs], - UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - sort_components1(TypeName,Cs,UnivAcc,[C|ApplAcc],ContAcc,PrivAcc); -sort_components1(TypeName,[C=#'ComponentType'{tags=[{'CONTEXT',_}|_R]}|Cs], - UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - sort_components1(TypeName,Cs,UnivAcc,ApplAcc,[C|ContAcc],PrivAcc); -sort_components1(TypeName,[C=#'ComponentType'{tags=[{'PRIVATE',_}|_R]}|Cs], - UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - sort_components1(TypeName,Cs,UnivAcc,ApplAcc,ContAcc,[C|PrivAcc]); -sort_components1(TypeName,[],UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - I = #'ComponentType'.tags, - ascending_order_check(TypeName,sort_universal_type(UnivAcc)) ++ - ascending_order_check(TypeName,lists:keysort(I,ApplAcc)) ++ - ascending_order_check(TypeName,lists:keysort(I,ContAcc)) ++ - ascending_order_check(TypeName,lists:keysort(I,PrivAcc)). - -ascending_order_check(TypeName,Components) -> - ascending_order_check1(TypeName,Components), - Components. - -ascending_order_check1(TypeName, - [C1 = #'ComponentType'{tags=[{_,T}|_]}, - C2 = #'ComponentType'{tags=[{_,T}|_]}|Rest]) -> - io:format("WARNING: Indistinct tag ~p in SET ~p, components ~p and ~p~n", - [T,TypeName,C1#'ComponentType'.name,C2#'ComponentType'.name]), - ascending_order_check1(TypeName,[C2|Rest]); -ascending_order_check1(TypeName, - [C1 = #'ComponentType'{tags=[{'UNIVERSAL',T1}|_]}, - C2 = #'ComponentType'{tags=[{'UNIVERSAL',T2}|_]}|Rest]) -> - case (asn1ct_gen_ber:decode_type(T1) == asn1ct_gen_ber:decode_type(T2)) of - true -> - io:format("WARNING: Indistinct tags ~p and ~p in" - " SET ~p, components ~p and ~p~n", - [T1,T2,TypeName,C1#'ComponentType'.name, - C2#'ComponentType'.name]), - ascending_order_check1(TypeName,[C2|Rest]); - _ -> - ascending_order_check1(TypeName,[C2|Rest]) - end; -ascending_order_check1(N,[_|Rest]) -> - ascending_order_check1(N,Rest); -ascending_order_check1(_,[_]) -> - ok; -ascending_order_check1(_,[]) -> - ok. - -sort_universal_type(Components) -> - List = lists:map(fun(C) -> - #'ComponentType'{tags=[{_,T}|_]} = C, - {asn1ct_gen_ber:decode_type(T),C} - end, - Components), - SortedList = lists:keysort(1,List), - lists:map(fun(X)->element(2,X) end,SortedList). - -untagged_choice([#'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|_Rest]) -> - true; -untagged_choice([_|Rest]) -> - untagged_choice(Rest); -untagged_choice([]) -> - false. - -check_setof(S,Type,Component) when record(Component,type) -> - check_type(S,Type,Component). - -check_restrictedstring(_S,_Def,_Constr) -> - ok. - -check_objectidentifier(_S,_Constr) -> - ok. - -% check all aspects of a CHOICE -% - that all alternative names are unique -% - that all TAGS are ok (when TAG default is applied) -% - that each alternative is of a valid type -% - that the extension marks are valid -check_choice(S,Type,Components) when list(Components) -> - case check_unique([C||C <- Components, - record(C,'ComponentType')],#'ComponentType'.name) of - [] -> - %% sort_canonical(Components), - Components2 = maybe_automatic_tags(S,Components), - %NewComps = - case check_each_alternative(S,Type,Components2) of - {NewComponents,NewEcomps} -> - check_unique_tags(S,NewComponents ++ NewEcomps), - {NewComponents,NewEcomps}; - NewComponents -> - check_unique_tags(S,NewComponents), - NewComponents - end; -%% CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps); - Dupl -> - throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}}) - end; -check_choice(_S,_,[]) -> - []. - -%% probably dead code that should be removed -%%maybe_automatic_tags(S,{Rc,Ec}) -> -%% {maybe_automatic_tags1(S,Rc,0),maybe_automatic_tags1(S,Ec,length(Rc))}; -maybe_automatic_tags(#state{erule=per},C) -> - C; -maybe_automatic_tags(#state{erule=per_bin},C) -> - C; -maybe_automatic_tags(S,C) -> - maybe_automatic_tags1(S,C,0). - -maybe_automatic_tags1(S,C,TagNo) -> - case (S#state.module)#module.tagdefault of - 'AUTOMATIC' -> - generate_automatic_tags(S,C,TagNo); - _ -> - %% maybe is the module a multi file module were only some of - %% the modules have defaulttag AUTOMATIC TAGS then the names - %% of those types are saved in the table automatic_tags - Name= S#state.tname, - case is_automatic_tagged_in_multi_file(Name) of - true -> - generate_automatic_tags(S,C,TagNo); - false -> - C - end - end. - -is_automatic_tagged_in_multi_file(Name) -> - case ets:info(automatic_tags) of - undefined -> - %% this case when not multifile compilation - false; - _ -> - case ets:member(automatic_tags,Name) of - true -> - true; - _ -> - false - end - end. - -generate_automatic_tags(_S,C,TagNo) -> - case any_manual_tag(C) of - true -> - C; - false -> - generate_automatic_tags1(C,TagNo) - end. - -generate_automatic_tags1([H|T],TagNo) when record(H,'ComponentType') -> - #'ComponentType'{typespec=Ts} = H, - NewTs = Ts#type{tag=[#tag{class='CONTEXT', - number=TagNo, - type={default,'IMPLICIT'}, - form= 0 }]}, % PRIMITIVE - [H#'ComponentType'{typespec=NewTs}|generate_automatic_tags1(T,TagNo+1)]; -generate_automatic_tags1([ExtMark|T],TagNo) -> % EXTENSIONMARK - [ExtMark | generate_automatic_tags1(T,TagNo)]; -generate_automatic_tags1([],_) -> - []. - -any_manual_tag([#'ComponentType'{typespec=#type{tag=[]}}|Rest]) -> - any_manual_tag(Rest); -any_manual_tag([{'EXTENSIONMARK',_,_}|Rest]) -> - any_manual_tag(Rest); -any_manual_tag([_|_Rest]) -> - true; -any_manual_tag([]) -> - false. - - -check_unique_tags(S,C) -> - case (S#state.module)#module.tagdefault of - 'AUTOMATIC' -> - case any_manual_tag(C) of - false -> true; - _ -> collect_and_sort_tags(C,[]) - end; - _ -> - collect_and_sort_tags(C,[]) - end. - -collect_and_sort_tags([C|Rest],Acc) when record(C,'ComponentType') -> - collect_and_sort_tags(Rest,C#'ComponentType'.tags ++ Acc); -collect_and_sort_tags([_|Rest],Acc) -> - collect_and_sort_tags(Rest,Acc); -collect_and_sort_tags([],Acc) -> - {Dupl,_}= lists:mapfoldl(fun(El,El)->{{dup,El},El};(El,_Prev)-> {El,El} end,notag,lists:sort(Acc)), - Dupl2 = [Dup|| {dup,Dup} <- Dupl], - if - length(Dupl2) > 0 -> - throw({error,{asn1,{duplicates_of_the_tags,Dupl2}}}); - true -> - true - end. - -check_unique(L,Pos) -> - Slist = lists:keysort(Pos,L), - check_unique2(Slist,Pos,[]). - -check_unique2([A,B|T],Pos,Acc) when element(Pos,A) == element(Pos,B) -> - check_unique2([B|T],Pos,[element(Pos,B)|Acc]); -check_unique2([_|T],Pos,Acc) -> - check_unique2(T,Pos,Acc); -check_unique2([],_,Acc) -> - lists:reverse(Acc). - -check_each_component(S,Type,{Rlist,ExtList}) -> - {check_each_component(S,Type,Rlist), - check_each_component(S,Type,ExtList)}; -check_each_component(S,Type,Components) -> - check_each_component(S,Type,Components,[],[],noext). - -check_each_component(S = #state{abscomppath=Path,recordtopname=TopName},Type, - [C|Ct],Acc,Extacc,Ext) when record(C,'ComponentType') -> - #'ComponentType'{name=Cname,typespec=Ts,prop=Prop} = C, - NewAbsCPath = - case Ts#type.def of - #'Externaltypereference'{} -> []; - _ -> [Cname|Path] - end, - CheckedTs = check_type(S#state{abscomppath=NewAbsCPath, - recordtopname=[Cname|TopName]},Type,Ts), - NewTags = get_taglist(S,CheckedTs), - - NewProp = -% case lists:member(der,S#state.options) of -% true -> -% True -> - case normalize_value(S,CheckedTs,Prop,[Cname|TopName]) of - mandatory -> mandatory; - 'OPTIONAL' -> 'OPTIONAL'; - DefaultValue -> {'DEFAULT',DefaultValue} - end, -% _ -> -% Prop -% end, - NewC = C#'ComponentType'{typespec=CheckedTs,prop=NewProp,tags=NewTags}, - case Ext of - noext -> - check_each_component(S,Type,Ct,[NewC|Acc],Extacc,Ext); - ext -> - check_each_component(S,Type,Ct,Acc,[NewC|Extacc],Ext) - end; -check_each_component(S,Type,[_|Ct],Acc,Extacc,noext) -> % skip 'EXTENSIONMARK' - check_each_component(S,Type,Ct,Acc,Extacc,ext); -check_each_component(_S,_,[_C|_Ct],_,_,ext) -> % skip 'EXTENSIONMARK' - throw({error,{asn1,{too_many_extension_marks}}}); -check_each_component(_S,_,[],Acc,Extacc,ext) -> - {lists:reverse(Acc),lists:reverse(Extacc)}; -check_each_component(_S,_,[],Acc,_,noext) -> - lists:reverse(Acc). - -check_each_alternative(S,Type,{Rlist,ExtList}) -> - {check_each_alternative(S,Type,Rlist), - check_each_alternative(S,Type,ExtList)}; -check_each_alternative(S,Type,[C|Ct]) -> - check_each_alternative(S,Type,[C|Ct],[],[],noext). - -check_each_alternative(S=#state{abscomppath=Path,recordtopname=TopName},Type,[C|Ct], - Acc,Extacc,Ext) when record(C,'ComponentType') -> - #'ComponentType'{name=Cname,typespec=Ts,prop=_Prop} = C, - NewAbsCPath = - case Ts#type.def of - #'Externaltypereference'{} -> []; - _ -> [Cname|Path] - end, - NewState = - S#state{abscomppath=NewAbsCPath,recordtopname=[Cname|TopName]}, - CheckedTs = check_type(NewState,Type,Ts), - NewTags = get_taglist(S,CheckedTs), - NewC = C#'ComponentType'{typespec=CheckedTs,tags=NewTags}, - case Ext of - noext -> - check_each_alternative(S,Type,Ct,[NewC|Acc],Extacc,Ext); - ext -> - check_each_alternative(S,Type,Ct,Acc,[NewC|Extacc],Ext) - end; - -check_each_alternative(S,Type,[_|Ct],Acc,Extacc,noext) -> % skip 'EXTENSIONMARK' - check_each_alternative(S,Type,Ct,Acc,Extacc,ext); -check_each_alternative(_S,_,[_C|_Ct],_,_,ext) -> % skip 'EXTENSIONMARK' - throw({error,{asn1,{too_many_extension_marks}}}); -check_each_alternative(_S,_,[],Acc,Extacc,ext) -> - {lists:reverse(Acc),lists:reverse(Extacc)}; -check_each_alternative(_S,_,[],Acc,_,noext) -> - lists:reverse(Acc). - -%% componentrelation_leadingattr/2 searches the structure for table -%% constraints, if any is found componentrelation_leadingattr/5 is -%% called. -componentrelation_leadingattr(S,CompList) -> -% {Cs1,Cs2} = - Cs = - case CompList of - {Components,EComponents} when list(Components) -> -% {Components,Components}; - Components ++ EComponents; - CompList when list(CompList) -> -% {CompList,CompList} - CompList - end, -% case any_simple_table(S,Cs1,[]) of - - %% get_simple_table_if_used/2 should find out whether there are any - %% component relation constraints in the entire tree of Cs1 that - %% relates to this level. It returns information about the simple - %% table constraint necessary for the the call to - %% componentrelation_leadingattr/6. The step when the leading - %% attribute and the syntax tree is modified to support the code - %% generating. - case get_simple_table_if_used(S,Cs) of - [] -> {false,CompList}; - STList -> -% componentrelation_leadingattr(S,Cs1,Cs2,STList,[],[]) - componentrelation_leadingattr(S,Cs,Cs,STList,[],[]) - end. - -%% componentrelation_leadingattr/6 when all components are searched -%% the new modified components are returned together with the "leading -%% attribute" information, which later is stored in the tablecinf -%% field in the SEQUENCE/SET record. The "leading attribute" -%% information is used to generate the lookup in the object set -%% table. The other information gathered in the #type.tablecinf field -%% is used in code generating phase too, to recognice the proper -%% components for "open type" encoding and to propagate the result of -%% the object set lookup when needed. -componentrelation_leadingattr(_,[],_CompList,_,[],NewCompList) -> - {false,lists:reverse(NewCompList)}; -componentrelation_leadingattr(_,[],_CompList,_,LeadingAttr,NewCompList) -> - {lists:last(LeadingAttr),lists:reverse(NewCompList)}; %send all info in Ts later -componentrelation_leadingattr(S,[C|Cs],CompList,STList,Acc,CompAcc) -> - {LAAcc,NewC} = - case catch componentrelation1(S,C#'ComponentType'.typespec, - [C#'ComponentType'.name]) of - {'EXIT',_} -> - {[],C}; - {CRI=[{_A1,_B1,_C1,_D1}|_Rest],NewTSpec} -> - %% {ObjectSet,AtPath,ClassDef,Path} - %% _A1 is a reference to the object set of the - %% component relation constraint. - %% _B1 is the path of names in the at-list of the - %% component relation constraint. - %% _C1 is the class definition of the - %% ObjectClassFieldType. - %% _D1 is the path of components that was traversed to - %% find this constraint. - case leading_attr_index(S,CompList,CRI, - lists:reverse(S#state.abscomppath),[]) of - [] -> - {[],C}; - [{ObjSet,Attr,N,ClassDef,_Path,ValueIndex}|_NewRest] -> - OS = object_set_mod_name(S,ObjSet), - UniqueFieldName = - case (catch get_unique_fieldname(#classdef{typespec=ClassDef})) of - {error,'__undefined_'} -> - no_unique; - {asn1,Msg,_} -> - error({type,Msg,S}); - Other -> Other - end, -% UsedFieldName = get_used_fieldname(S,Attr,STList), - %% Res should be done differently: even though - %% a unique field name exists it is not - %% certain that the ObjectClassFieldType of - %% the simple table constraint picks that - %% class field. - Res = #simpletableattributes{objectsetname=OS, -%% c_name=asn1ct_gen:un_hyphen_var(Attr), - c_name=Attr, - c_index=N, - usedclassfield=UniqueFieldName, - uniqueclassfield=UniqueFieldName, - valueindex=ValueIndex}, - {[Res],C#'ComponentType'{typespec=NewTSpec}} - end; - _ -> - %% no constraint was found - {[],C} - end, - componentrelation_leadingattr(S,Cs,CompList,STList,LAAcc++Acc, - [NewC|CompAcc]). - -object_set_mod_name(_S,ObjSet) when atom(ObjSet) -> - ObjSet; -object_set_mod_name(#state{mname=M}, - #'Externaltypereference'{module=M,type=T}) -> - T; -object_set_mod_name(S,#'Externaltypereference'{module=M,type=T}) -> - case lists:member(M,S#state.inputmodules) of - true -> - T; - false -> - {M,T} - end. - -%% get_used_fieldname gets the used field of the class referenced by -%% the ObjectClassFieldType construct in the simple table constraint -%% corresponding to the component relation constraint that depends on -%% it. -% get_used_fieldname(_S,CName,[{[CName|_Rest],_,ClFieldName}|_RestSimpleT]) -> -% ClFieldName; -% get_used_fieldname(S,CName,[_SimpleTC|Rest]) -> -% get_used_fieldname(S,CName,Rest); -% get_used_fieldname(S,_,[]) -> -% error({type,"Error in Simple table constraint",S}). - -%% any_simple_table/3 checks if any of the components on this level is -%% constrained by a simple table constraint. It returns a list of -%% tuples with three elements. It is a name path to the place in the -%% type structure where the constraint is, and the name of the object -%% set and the referenced field in the class. -% any_simple_table(S = #state{mname=M,abscomppath=Path}, -% [#'ComponentType'{name=Name,typespec=Type}|Cs],Acc) -> -% Constraint = Type#type.constraint, -% case lists:keysearch(simpletable,1,Constraint) of -% {value,{_,#type{def=Ref}}} -> -% %% This ObjectClassFieldType, which has a simple table -% %% constraint, must pick a fixed type value, mustn't it ? -% {ClassDef,[{_,ClassFieldName}]} = Type#type.def, -% ST = -% case Ref of -% #'Externaltypereference'{module=M,type=ObjSetName} -> -% {[Name|Path],ObjSetName,ClassFieldName}; -% _ -> -% {[Name|Path],Ref,ClassFieldName} -% end, -% any_simple_table(S,Cs,[ST|Acc]); -% false -> -% any_simple_table(S,Cs,Acc) -% end; -% any_simple_table(_,[],Acc) -> -% lists:reverse(Acc); -% any_simple_table(S,[_|Cs],Acc) -> -% any_simple_table(S,Cs,Acc). - -%% get_simple_table_if_used/2 searches the structure of Cs for any -%% component relation constraints due to the present level of the -%% structure. If there are any, the necessary information for code -%% generation of the look up functionality in the object set table are -%% returned. -get_simple_table_if_used(S,Cs) -> - CNames = lists:map(fun(#'ComponentType'{name=Name}) -> Name; - (_) -> [] %% in case of extension marks - end, - Cs), - RefedSimpleTable=any_component_relation(S,Cs,CNames,[],[]), - get_simple_table_info(S,Cs,remove_doubles(RefedSimpleTable)). - -remove_doubles(L) -> - remove_doubles(L,[]). -remove_doubles([H|T],Acc) -> - NewT = remove_doubles1(H,T), - remove_doubles(NewT,[H|Acc]); -remove_doubles([],Acc) -> - Acc. - -remove_doubles1(El,L) -> - case lists:delete(El,L) of - L -> L; - NewL -> remove_doubles1(El,NewL) - end. - -%% get_simple_table_info searches the commponents Cs by the path from -%% an at-list (third argument), and follows into a component of it if -%% necessary, to get information needed for code generating. -%% -%% Returns a list of tuples with three elements. It holds a list of -%% atoms that is the path, the name of the field of the class that are -%% referred to in the ObjectClassFieldType, and the name of the unique -%% field of the class of the ObjectClassFieldType. -%% -% %% The level information outermost/innermost must be kept. There are -% %% at least two possibilities to cover here for an outermost case: 1) -% %% Both the simple table and the component relation have a common path -% %% at least one step below the outermost level, i.e. the leading -% %% information shall be on a sub level. 2) They don't have any common -% %% path. -get_simple_table_info(S,Cs,[AtList|Rest]) -> -%% [get_simple_table_info1(S,Cs,AtList,S#state.abscomppath)|get_simple_table_info(S,Cs,Rest)]; - [get_simple_table_info1(S,Cs,AtList,[])|get_simple_table_info(S,Cs,Rest)]; -get_simple_table_info(_,_,[]) -> - []. -get_simple_table_info1(S,Cs,[Cname|Cnames],Path) when list(Cs) -> - case lists:keysearch(Cname,#'ComponentType'.name,Cs) of - {value,C} -> - get_simple_table_info1(S,C,Cnames,[Cname|Path]); - _ -> - error({type,"Missing expected simple table constraint",S}) - end; -get_simple_table_info1(S,#'ComponentType'{typespec=TS},[],Path) -> - %% In this component there must be a simple table constraint - %% o.w. the asn1 code is wrong. - #type{def=OCFT,constraint=Cnstr} = TS, - case Cnstr of - [{simpletable,_OSRef}]�-> - #'ObjectClassFieldType'{classname=ClRef, - class=ObjectClass, - fieldname=FieldName} = OCFT, -% #'ObjectClassFieldType'{ObjectClass,FieldType} = ObjectClassFieldType, - ObjectClassFieldName = - case FieldName of - {LastFieldName,[]} -> LastFieldName; - {_FirstFieldName,FieldNames} -> - lists:last(FieldNames) - end, - %%ObjectClassFieldName is the last element in the dotted - %%list of the ObjectClassFieldType. The last element may - %%be of another class, that is referenced from the class - %%of the ObjectClassFieldType - ClassDef = - case ObjectClass of - [] -> - {_,CDef}=get_referenced_type(S,ClRef), - CDef; - _ -> #classdef{typespec=ObjectClass} - end, - UniqueName = - case (catch get_unique_fieldname(ClassDef)) of - {error,'__undefined_'} -> no_unique; - {asn1,Msg,_} -> - error({type,Msg,S}); - Other -> Other - end, - {lists:reverse(Path),ObjectClassFieldName,UniqueName}; - _ -> - error({type,{asn1,"missing expected simple table constraint", - Cnstr},S}) - end; -get_simple_table_info1(S,#'ComponentType'{typespec=TS},Cnames,Path) -> - Components = get_atlist_components(TS#type.def), - get_simple_table_info1(S,Components,Cnames,Path). - -%% any_component_relation searches for all component relation -%% constraints that refers to the actual level and returns a list of -%% the "name path" in the at-list to the component relation constraint -%% that must refer to a simple table constraint. The list is empty if -%% no component relation constraints were found. -%% -%% NamePath has the names of all components that are followed from the -%% beginning of the search. CNames holds the names of all components -%% of the start level, this info is used if an outermost at-notation -%% is found to check the validity of the at-list. -any_component_relation(S,[C|Cs],CNames,NamePath,Acc) -> - CName = C#'ComponentType'.name, - Type = C#'ComponentType'.typespec, - CRelPath = - case Type#type.constraint of - [{componentrelation,_,AtNotation}] -> - %% Found component relation constraint, now check - %% whether this constraint is relevant for the level - %% where the search started - AtNot = extract_at_notation(AtNotation), - %% evaluate_atpath returns the relative path to the - %% simple table constraint from where the component - %% relation is found. - evaluate_atpath(S#state.abscomppath,NamePath,CNames,AtNot); - _ -> - [] - end, - InnerAcc = - case {Type#type.inlined, - asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of - {no,{constructed,bif}} -> - InnerCs = - case get_components(Type#type.def) of - {IC1,_IC2} -> IC1 ++ IC1; - IC -> IC - end, - %% here we are interested in components of an - %% SEQUENCE/SET OF as well as SEQUENCE, SET and CHOICE - any_component_relation(S,InnerCs,CNames,[CName|NamePath],[]); - _ -> - [] - end, - any_component_relation(S,Cs,CNames,NamePath,InnerAcc++CRelPath++Acc); -any_component_relation(_,[],_,_,Acc) -> - Acc. - -%% evaluate_atpath/4 finds out whether the at notation refers to the -%% search level. The list of referenced names in the AtNot list shall -%% begin with a name that exists on the level it refers to. If the -%% found AtPath is refering to the same sub-branch as the simple table -%% has, then there shall not be any leading attribute info on this -%% level. -evaluate_atpath(_,[],Cnames,{innermost,AtPath=[Ref|_Refs]}) -> - %% any innermost constraint found deeper in the structure is - %% ignored. - case lists:member(Ref,Cnames) of - true -> [AtPath]; - false -> [] - end; -%% In this case must check that the AtPath doesn't step any step of -%% the NamePath, in that case the constraint will be handled in an -%% inner level. -evaluate_atpath(TopPath,NamePath,Cnames,{outermost,AtPath=[_Ref|_Refs]}) -> - AtPathBelowTop = - case TopPath of - [] -> AtPath; - _ -> - case lists:prefix(TopPath,AtPath) of - true -> - lists:subtract(AtPath,TopPath); - _ -> [] - end - end, - case {NamePath,AtPathBelowTop} of - {[H|_T1],[H|_T2]} -> []; % this must be handled in lower level - {_,[]} -> [];% this must be handled in an above level - {_,[H|_T]} -> - case lists:member(H,Cnames) of - true -> [AtPathBelowTop]; - _ -> error({type,{asn1,"failed to analyze at-path",AtPath}}) - end - end; -evaluate_atpath(_,_,_,_) -> - []. - -%% Type may be any of SEQUENCE, SET, CHOICE, SEQUENCE OF, SET OF but -%% only the three first have valid components. -get_atlist_components(Def) -> - get_components(atlist,Def). - -get_components(Def) -> - get_components(any,Def). - -get_components(_,#'SEQUENCE'{components=Cs}) -> - Cs; -get_components(_,#'SET'{components=Cs}) -> - Cs; -get_components(_,{'CHOICE',Cs}) -> - Cs; -get_components(any,{'SEQUENCE OF',#type{def=Def}}) -> - get_components(any,Def); -get_components(any,{'SET OF',#type{def=Def}}) -> - get_components(any,Def); -get_components(_,_) -> - []. - - -extract_at_notation([{Level,[#'Externalvaluereference'{value=Name}|Rest]}]) -> - {Level,[Name|extract_at_notation1(Rest)]}; -extract_at_notation(At) -> - exit({error,{asn1,{at_notation,At}}}). -extract_at_notation1([#'Externalvaluereference'{value=Name}|Rest]) -> - [Name|extract_at_notation1(Rest)]; -extract_at_notation1([]) -> - []. - -%% componentrelation1/1 identifies all componentrelation constraints -%% that exist in C or in the substructure of C. Info about the found -%% constraints are returned in a list. It is ObjectSet, the reference -%% to the object set, AttrPath, the name atoms extracted from the -%% at-list in the component relation constraint, ClassDef, the -%% objectclass record of the class of the ObjectClassFieldType, Path, -%% that is the component name "path" from the searched level to this -%% constraint. -%% -%% The function is called with one component of the type in turn and -%% with the component name in Path at the first call. When called from -%% within, the name of the inner component is added to Path. -componentrelation1(S,C = #type{def=Def,constraint=Constraint,tablecinf=TCI}, - Path) -> - Ret = - case Constraint of - [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] -> - [{_,AL=[#'Externalvaluereference'{}|_R1]}|_R2] = AtList, - %% Note: if Path is longer than one,i.e. it is within - %% an inner type of the actual level, then the only - %% relevant at-list is of "outermost" type. -%% #'ObjectClassFieldType'{class=ClassDef} = Def, - ClassDef = get_ObjectClassFieldType_classdef(S,Def), - AtPath = - lists:map(fun(#'Externalvaluereference'{value=V})->V end, - AL), - {[{ObjectSet,AtPath,ClassDef,Path}],Def}; - _Other -> - %% check the inner type of component - innertype_comprel(S,Def,Path) - end, - case Ret of - nofunobj -> - nofunobj; %% ignored by caller - {CRelI=[{ObjSet,_,_,_}],NewDef} -> %% - TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]), - {CRelI,C#type{tablecinf=[{objfun,ObjSet}|TCItmp],def=NewDef}}; - {CompRelInf,NewDef} -> %% more than one tuple in CompRelInf - TCItmp = lists:subtract(TCI,[{objfun,anyset}]), - {CompRelInf,C#type{tablecinf=[{objfun,anyset}|TCItmp],def=NewDef}} - end. - -innertype_comprel(S,{'SEQUENCE OF',Type},Path) -> - case innertype_comprel1(S,Type,Path) of - nofunobj -> - nofunobj; - {CompRelInf,NewType} -> - {CompRelInf,{'SEQUENCE OF',NewType}} - end; -innertype_comprel(S,{'SET OF',Type},Path) -> - case innertype_comprel1(S,Type,Path) of - nofunobj -> - nofunobj; - {CompRelInf,NewType} -> - {CompRelInf,{'SET OF',NewType}} - end; -innertype_comprel(S,{'CHOICE',CTypeList},Path) -> - case componentlist_comprel(S,CTypeList,[],Path,[]) of - nofunobj -> - nofunobj; - {CompRelInf,NewCs} -> - {CompRelInf,{'CHOICE',NewCs}} - end; -innertype_comprel(S,Seq = #'SEQUENCE'{components=Cs},Path) -> - case componentlist_comprel(S,Cs,[],Path,[]) of - nofunobj -> - nofunobj; - {CompRelInf,NewCs} -> - {CompRelInf,Seq#'SEQUENCE'{components=NewCs}} - end; -innertype_comprel(S,Set = #'SET'{components=Cs},Path) -> - case componentlist_comprel(S,Cs,[],Path,[]) of - nofunobj -> - nofunobj; - {CompRelInf,NewCs} -> - {CompRelInf,Set#'SET'{components=NewCs}} - end; -innertype_comprel(_,_,_) -> - nofunobj. - -componentlist_comprel(S,[C = #'ComponentType'{name=Name,typespec=Type}|Cs], - Acc,Path,NewCL) -> - case catch componentrelation1(S,Type,Path++[Name]) of - {'EXIT',_} -> - componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]); - nofunobj -> - componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]); - {CRelInf,NewType} -> - componentlist_comprel(S,Cs,CRelInf++Acc,Path, - [C#'ComponentType'{typespec=NewType}|NewCL]) - end; -componentlist_comprel(_,[],Acc,_,NewCL) -> - case Acc of - [] -> - nofunobj; - _ -> - {Acc,lists:reverse(NewCL)} - end. - -innertype_comprel1(S,T = #type{def=Def,constraint=Cons,tablecinf=TCI},Path) -> - Ret = - case Cons of - [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] -> - %% This AtList must have an "outermost" at sign to be - %% relevent here. - [{_,AL=[#'Externalvaluereference'{value=_Attr}|_R1]}|_R2] - = AtList, -%% #'ObjectClassFieldType'{class=ClassDef} = Def, - ClassDef = get_ObjectClassFieldType_classdef(S,Def), - AtPath = - lists:map(fun(#'Externalvaluereference'{value=V})->V end, - AL), - [{ObjectSet,AtPath,ClassDef,Path}]; - _ -> - innertype_comprel(S,Def,Path) - end, - case Ret of - nofunobj -> nofunobj; - L = [{ObjSet,_,_,_}] -> - TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]), - {L,T#type{tablecinf=[{objfun,ObjSet}|TCItmp]}}; - {CRelInf,NewDef} -> - TCItmp = lists:subtract(TCI,[{objfun,anyset}]), - {CRelInf,T#type{def=NewDef,tablecinf=[{objfun,anyset}|TCItmp]}} - end. - - -%% leading_attr_index counts the index and picks the name of the -%% component that is at the actual level in the at-list of the -%% component relation constraint (AttrP). AbsP is the path of -%% component names from the top type level to the actual level. AttrP -%% is a list with the atoms from the at-list. -leading_attr_index(S,Cs,[H={_,AttrP,_,_}|T],AbsP,Acc) -> - AttrInfo = - case lists:prefix(AbsP,AttrP) of - %% why this ?? It is necessary when in same situation as - %% TConstrChoice, there is an inner structure with an - %% outermost at-list and the "leading attribute" code gen - %% may be at a level some steps below the outermost level. - true -> - RelativAttrP = lists:subtract(AttrP,AbsP), - %% The header is used to calculate the index of the - %% component and to give the fun, received from the - %% object set look up, an unique name. The tail is - %% used to match the proper value input to the fun. - {hd(RelativAttrP),tl(RelativAttrP)}; - false -> - {hd(AttrP),tl(AttrP)} - end, - case leading_attr_index1(S,Cs,H,AttrInfo,1) of - 0 -> - leading_attr_index(S,Cs,T,AbsP,Acc); - Res -> - leading_attr_index(S,Cs,T,AbsP,[Res|Acc]) - end; -leading_attr_index(_,_Cs,[],_,Acc) -> - lists:reverse(Acc). - -leading_attr_index1(_,[],_,_,_) -> - 0; -leading_attr_index1(S,[C|Cs],Arg={ObjectSet,_,CDef,P}, - AttrInfo={Attr,SubAttr},N) -> - case C#'ComponentType'.name of - Attr -> - ValueMatch = value_match(S,C,Attr,SubAttr), - {ObjectSet,Attr,N,CDef,P,ValueMatch}; - _ -> - leading_attr_index1(S,Cs,Arg,AttrInfo,N+1) - end. - -%% value_math gathers information for a proper value match in the -%% generated encode function. For a SEQUENCE or a SET the index of the -%% component is counted. For a CHOICE the index is 2. -value_match(S,C,Name,SubAttr) -> - value_match(S,C,Name,SubAttr,[]). % C has name Name -value_match(_S,#'ComponentType'{},_Name,[],Acc) -> - Acc;% do not reverse, indexes in reverse order -value_match(S,#'ComponentType'{typespec=Type},Name,[At|Ats],Acc) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - Components = - case get_atlist_components(Type#type.def) of - [] -> error({type,{asn1,"element in at list must be a " - "SEQUENCE, SET or CHOICE.",Name},S}); - Comps -> Comps - end, - {Index,ValueIndex} = component_value_index(S,InnerType,At,Components), - value_match(S,lists:nth(Index,Components),At,Ats,[ValueIndex|Acc]). - -component_value_index(S,'CHOICE',At,Components) -> - {component_index(S,At,Components),2}; -component_value_index(S,_,At,Components) -> - %% SEQUENCE or SET - Index = component_index(S,At,Components), - {Index,{Index+1,At}}. - -component_index(S,Name,Components) -> - component_index1(S,Name,Components,1). -component_index1(_S,Name,[#'ComponentType'{name=Name}|_Cs],N) -> - N; -component_index1(S,Name,[_C|Cs],N) -> - component_index1(S,Name,Cs,N+1); -component_index1(S,Name,[],_) -> - error({type,{asn1,"component of at-list was not" - " found in substructure",Name},S}). - -get_unique_fieldname(ClassDef) -> -%% {_,Fields,_} = ClassDef#classdef.typespec, - Fields = (ClassDef#classdef.typespec)#objectclass.fields, - get_unique_fieldname(Fields,[]). - -get_unique_fieldname([],[]) -> - throw({error,'__undefined_'}); -get_unique_fieldname([],[Name]) -> - Name; -get_unique_fieldname([],Acc) -> - throw({asn1,'only one UNIQUE field is allowed in CLASS',Acc}); -get_unique_fieldname([{fixedtypevaluefield,Name,_,'UNIQUE',_}|Rest],Acc) -> - get_unique_fieldname(Rest,[Name|Acc]); -get_unique_fieldname([_H|T],Acc) -> - get_unique_fieldname(T,Acc). - -get_tableconstraint_info(S,Type,{CheckedTs,EComps}) -> - {get_tableconstraint_info(S,Type,CheckedTs,[]), - get_tableconstraint_info(S,Type,EComps,[])}; -get_tableconstraint_info(S,Type,CheckedTs) -> - get_tableconstraint_info(S,Type,CheckedTs,[]). - -get_tableconstraint_info(_S,_Type,[],Acc) -> - lists:reverse(Acc); -get_tableconstraint_info(S,Type,[C|Cs],Acc) -> - CheckedTs = C#'ComponentType'.typespec, - AccComp = - case CheckedTs#type.def of - %% ObjectClassFieldType - OCFT=#'ObjectClassFieldType'{class=#objectclass{}, - type=_AType} -> -% AType = get_ObjectClassFieldType(S,Fields,FieldRef), -% RefedFieldName = -% get_referencedclassfield(CheckedTs#type.def),%is probably obsolete - NewOCFT = - OCFT#'ObjectClassFieldType'{class=[]}, - C#'ComponentType'{typespec= - CheckedTs#type{ -% def=AType, - def=NewOCFT - }}; -% constraint=[{tableconstraint_info, -% FieldRef}]}}; - {'SEQUENCE OF',SOType} when record(SOType,type), - (element(1,SOType#type.def)=='CHOICE') -> - CTypeList = element(2,SOType#type.def), - NewInnerCList = - get_tableconstraint_info(S,Type,CTypeList,[]), - C#'ComponentType'{typespec= - CheckedTs#type{ - def={'SEQUENCE OF', - SOType#type{def={'CHOICE', - NewInnerCList}}}}}; - {'SET OF',SOType} when record(SOType,type), - (element(1,SOType#type.def)=='CHOICE') -> - CTypeList = element(2,SOType#type.def), - NewInnerCList = - get_tableconstraint_info(S,Type,CTypeList,[]), - C#'ComponentType'{typespec= - CheckedTs#type{ - def={'SET OF', - SOType#type{def={'CHOICE', - NewInnerCList}}}}}; - _ -> - C - end, - get_tableconstraint_info(S,Type,Cs,[AccComp|Acc]). - -get_referenced_fieldname([{_,FirstFieldname}]) -> - {FirstFieldname,[]}; -get_referenced_fieldname([{_,FirstFieldname}|Rest]) -> - {FirstFieldname,lists:map(fun(X)->element(2,X) end,Rest)}; -get_referenced_fieldname(Def) -> - {no_type,Def}. - -%% get_ObjectClassFieldType extracts the type from the chain of -%% objects that leads to a final type. -get_ObjectClassFieldType(S,ERef,PrimFieldNameList) when - record(ERef,'Externaltypereference') -> - {_,Type} = get_referenced_type(S,ERef), - ClassSpec = check_class(S,Type), - Fields = ClassSpec#objectclass.fields, - get_ObjectClassFieldType(S,Fields,PrimFieldNameList); -get_ObjectClassFieldType(S,Fields,L=[_PrimFieldName1|_Rest]) -> - check_PrimitiveFieldNames(S,Fields,L), - get_OCFType(S,Fields,L). - -check_PrimitiveFieldNames(_S,_Fields,_) -> - ok. - -%% get_ObjectClassFieldType_classdef gets the def of the class of the -%% ObjectClassFieldType, i.e. the objectclass record. If the type has -%% been checked (it may be a field type of an internal SEQUENCE) the -%% class field = [], then the classdef has to be fetched by help of -%% the class reference in the classname field. -get_ObjectClassFieldType_classdef(S,#'ObjectClassFieldType'{classname=Name, - class=[]}) -> - {_,#classdef{typespec=TS}} = get_referenced_type(S,Name), - TS; -get_ObjectClassFieldType_classdef(_,#'ObjectClassFieldType'{class=Cl}) -> - Cl. - -get_OCFType(S,Fields,[{_FieldType,PrimFieldName}|Rest]) -> - case lists:keysearch(PrimFieldName,2,Fields) of - {value,{fixedtypevaluefield,_,Type,_Unique,_OptSpec}} -> - {fixedtypevaluefield,PrimFieldName,Type}; - {value,{objectfield,_,Type,_Unique,_OptSpec}} -> - {_,ClassDef} = get_referenced_type(S,Type#type.def), - CheckedCDef = check_class(S#state{type=ClassDef, - tname=ClassDef#classdef.name}, - ClassDef#classdef.typespec), - get_OCFType(S,CheckedCDef#objectclass.fields,Rest); - {value,{objectsetfield,_,Type,_OptSpec}} -> - {_,ClassDef} = get_referenced_type(S,Type#type.def), - CheckedCDef = check_class(S#state{type=ClassDef, - tname=ClassDef#classdef.name}, - ClassDef#classdef.typespec), - get_OCFType(S,CheckedCDef#objectclass.fields,Rest); - - {value,Other} -> - {element(1,Other),PrimFieldName}; - _ -> - error({type,"undefined FieldName in ObjectClassFieldType",S}) - end. - -get_taglist(#state{erule=per},_) -> - []; -get_taglist(#state{erule=per_bin},_) -> - []; -get_taglist(S,Ext) when record(Ext,'Externaltypereference') -> - {_,T} = get_referenced_type(S,Ext), - get_taglist(S,T#typedef.typespec); -get_taglist(S,Tref) when record(Tref,typereference) -> - {_,T} = get_referenced_type(S,Tref), - get_taglist(S,T#typedef.typespec); -get_taglist(S,Type) when record(Type,type) -> - case Type#type.tag of - [] -> - get_taglist(S,Type#type.def); - [Tag|_] -> -% case lists:member(S#state.erule,[ber,ber_bin]) of -% true -> -% lists:map(fun(Tx) -> asn1ct_gen:def_to_tag(Tx) end,Type#type.tag); -% _ -> - [asn1ct_gen:def_to_tag(Tag)] -% end - end; -get_taglist(S,{'CHOICE',{Rc,Ec}}) -> - get_taglist(S,{'CHOICE',Rc ++ Ec}); -get_taglist(S,{'CHOICE',Components}) -> - get_taglist1(S,Components); -%% ObjectClassFieldType OTP-4390 -get_taglist(_S,#'ObjectClassFieldType'{type={typefield,_}}) -> - []; -get_taglist(S,#'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}}) -> - get_taglist(S,Type); -get_taglist(S,{ERef=#'Externaltypereference'{},FieldNameList}) - when list(FieldNameList) -> - case get_ObjectClassFieldType(S,ERef,FieldNameList) of - Type when record(Type,type) -> - get_taglist(S,Type); - {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); - {TypeFieldName,_} when atom(TypeFieldName) -> []%should check if allowed - end; -get_taglist(S,{ObjCl,FieldNameList}) when record(ObjCl,objectclass), - list(FieldNameList) -> - case get_ObjectClassFieldType(S,ObjCl#objectclass.fields,FieldNameList) of - Type when record(Type,type) -> - get_taglist(S,Type); - {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); - {TypeFieldName,_} when atom(TypeFieldName) -> []%should check if allowed - end; -get_taglist(S,Def) -> - case lists:member(S#state.erule,[ber_bin_v2]) of - false -> - case Def of - 'ASN1_OPEN_TYPE' -> % open_type has no UNIVERSAL tag as such - []; - _ -> - [asn1ct_gen:def_to_tag(Def)] - end; - _ -> - [] - end. - -get_taglist1(S,[#'ComponentType'{name=_Cname,tags=TagL}|Rest]) when list(TagL) -> - %% tag_list has been here , just return TagL and continue with next alternative - TagL ++ get_taglist1(S,Rest); -get_taglist1(S,[#'ComponentType'{typespec=Ts,tags=undefined}|Rest]) -> - get_taglist(S,Ts) ++ get_taglist1(S,Rest); -get_taglist1(S,[_H|Rest]) -> % skip EXTENSIONMARK - get_taglist1(S,Rest); -get_taglist1(_S,[]) -> - []. - -dbget_ex(_S,Module,Key) -> - case asn1_db:dbget(Module,Key) of - undefined -> - - throw({error,{asn1,{undefined,{Module,Key}}}}); % this is catched on toplevel type or value - T -> T - end. - -merge_tags(T1, T2) when list(T2) -> - merge_tags2(T1 ++ T2, []); -merge_tags(T1, T2) -> - merge_tags2(T1 ++ [T2], []). - -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([H|T],Acc) -> - merge_tags2(T, [H|Acc]); -merge_tags2([], Acc) -> - lists:reverse(Acc). - -merge_constraints(C1, []) -> - C1; -merge_constraints([], C2) -> - C2; -merge_constraints(C1, C2) -> - {SList,VList,PAList,Rest} = splitlist(C1++C2,[],[],[],[]), - SizeC = merge_constraints(SList), - ValueC = merge_constraints(VList), - PermAlphaC = merge_constraints(PAList), - case Rest of - [] -> - SizeC ++ ValueC ++ PermAlphaC; - _ -> - throw({error,{asn1,{not_implemented,{merge_constraints,Rest}}}}) - end. - -merge_constraints([]) -> []; -merge_constraints([C1 = {_,{Low1,High1}},{_,{Low2,High2}}|Rest]) when Low1 >= Low2, - High1 =< High2 -> - merge_constraints([C1|Rest]); -merge_constraints([C1={'PermittedAlphabet',_},C2|Rest]) -> - [C1|merge_constraints([C2|Rest])]; -merge_constraints([C1 = {_,{_Low1,_High1}},C2 = {_,{_Low2,_High2}}|_Rest]) -> - throw({error,asn1,{conflicting_constraints,{C1,C2}}}); -merge_constraints([C]) -> - [C]. - -splitlist([C={'SizeConstraint',_}|Rest],Sacc,Vacc,PAacc,Restacc) -> - splitlist(Rest,[C|Sacc],Vacc,PAacc,Restacc); -splitlist([C={'ValueRange',_}|Rest],Sacc,Vacc,PAacc,Restacc) -> - splitlist(Rest,Sacc,[C|Vacc],PAacc,Restacc); -splitlist([C={'PermittedAlphabet',_}|Rest],Sacc,Vacc,PAacc,Restacc) -> - splitlist(Rest,Sacc,Vacc,[C|PAacc],Restacc); -splitlist([C|Rest],Sacc,Vacc,PAacc,Restacc) -> - splitlist(Rest,Sacc,Vacc,PAacc,[C|Restacc]); -splitlist([],Sacc,Vacc,PAacc,Restacc) -> - {lists:reverse(Sacc), - lists:reverse(Vacc), - lists:reverse(PAacc), - lists:reverse(Restacc)}. - - - -storeindb(M) when record(M,module) -> - TVlist = M#module.typeorval, - NewM = M#module{typeorval=findtypes_and_values(TVlist)}, - asn1_db:dbnew(NewM#module.name), - asn1_db:dbput(NewM#module.name,'MODULE', NewM), - Res = storeindb(NewM#module.name,TVlist,[]), - include_default_class(NewM#module.name), - include_default_type(NewM#module.name), - Res. - -storeindb(Module,[H|T],ErrAcc) when record(H,typedef) -> - storeindb(Module,H#typedef.name,H,T,ErrAcc); -storeindb(Module,[H|T],ErrAcc) when record(H,valuedef) -> - storeindb(Module,H#valuedef.name,H,T,ErrAcc); -storeindb(Module,[H|T],ErrAcc) when record(H,ptypedef) -> - storeindb(Module,H#ptypedef.name,H,T,ErrAcc); -storeindb(Module,[H|T],ErrAcc) when record(H,classdef) -> - storeindb(Module,H#classdef.name,H,T,ErrAcc); -storeindb(Module,[H|T],ErrAcc) when record(H,pvaluesetdef) -> - storeindb(Module,H#pvaluesetdef.name,H,T,ErrAcc); -storeindb(Module,[H|T],ErrAcc) when record(H,pobjectdef) -> - storeindb(Module,H#pobjectdef.name,H,T,ErrAcc); -storeindb(Module,[H|T],ErrAcc) when record(H,pvaluedef) -> - storeindb(Module,H#pvaluedef.name,H,T,ErrAcc); -storeindb(_,[],[]) -> ok; -storeindb(_,[],ErrAcc) -> - {error,ErrAcc}. - -storeindb(Module,Name,H,T,ErrAcc) -> - case asn1_db:dbget(Module,Name) of - undefined -> - asn1_db:dbput(Module,Name,H), - storeindb(Module,T,ErrAcc); - _ -> - case H of - _Type when record(H,typedef) -> - error({type,"already defined", - #state{mname=Module,type=H,tname=Name}}); - _Type when record(H,valuedef) -> - error({value,"already defined", - #state{mname=Module,value=H,vname=Name}}); - _Type when record(H,ptypedef) -> - error({ptype,"already defined", - #state{mname=Module,type=H,tname=Name}}); - _Type when record(H,pobjectdef) -> - error({ptype,"already defined", - #state{mname=Module,type=H,tname=Name}}); - _Type when record(H,pvaluesetdef) -> - error({ptype,"already defined", - #state{mname=Module,type=H,tname=Name}}); - _Type when record(H,pvaluedef) -> - error({ptype,"already defined", - #state{mname=Module,type=H,tname=Name}}); - _Type when record(H,classdef) -> - error({class,"already defined", - #state{mname=Module,value=H,vname=Name}}) - end, - storeindb(Module,T,[H|ErrAcc]) - end. - -findtypes_and_values(TVList) -> - findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values, -%% Parameterizedtypes,Classes,Objects and ObjectSets - -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,typedef),record(H#typedef.typespec,'Object') -> - findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#typedef.name|Oacc],OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,typedef),record(H#typedef.typespec,'ObjectSet') -> - findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#typedef.name|OSacc]); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,typedef) -> - findtypes_and_values(T,[H#typedef.name|Tacc],Vacc,Pacc,Cacc,Oacc,OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,valuedef) -> - findtypes_and_values(T,Tacc,[H#valuedef.name|Vacc],Pacc,Cacc,Oacc,OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,ptypedef) -> - findtypes_and_values(T,Tacc,Vacc,[H#ptypedef.name|Pacc],Cacc,Oacc,OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,classdef) -> - findtypes_and_values(T,Tacc,Vacc,Pacc,[H#classdef.name|Cacc],Oacc,OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,pvaluedef) -> - findtypes_and_values(T,Tacc,[H#pvaluedef.name|Vacc],Pacc,Cacc,Oacc,OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,pvaluesetdef) -> - findtypes_and_values(T,Tacc,[H#pvaluesetdef.name|Vacc],Pacc,Cacc,Oacc,OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,pobjectdef) -> - findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#pobjectdef.name|Oacc],OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,pobjectsetdef) -> - findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#pobjectsetdef.name|OSacc]); -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)}. - - - -error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) -> - Pos = Ref#'Externaltypereference'.pos, - io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]), - {error,{export,Pos,Mname,Typename,Msg}}; -error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) - when record(Type,typedef) -> - io:format("asn1error:~p:~p:~p ~p~n", - [Type#typedef.pos,Mname,Typename,Msg]), - {error,{type,Type#typedef.pos,Mname,Typename,Msg}}; -error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) - when record(Type,ptypedef) -> - io:format("asn1error:~p:~p:~p ~p~n", - [Type#ptypedef.pos,Mname,Typename,Msg]), - {error,{type,Type#ptypedef.pos,Mname,Typename,Msg}}; -error({type,Msg,#state{mname=Mname,value=Value,vname=Valuename}}) - when record(Value,valuedef) -> - io:format("asn1error:~p:~p:~p ~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]), - {error,{type,Value#valuedef.pos,Mname,Valuename,Msg}}; -error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) - when record(Type,pobjectdef) -> - io:format("asn1error:~p:~p:~p ~p~n", - [Type#pobjectdef.pos,Mname,Typename,Msg]), - {error,{type,Type#pobjectdef.pos,Mname,Typename,Msg}}; -error({value,Msg,#state{mname=Mname,value=Value,vname=Valuename}}) -> - io:format("asn1error:~p:~p:~p ~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]), - {error,{value,Value#valuedef.pos,Mname,Valuename,Msg}}; -error({Other,Msg,#state{mname=Mname,value=#valuedef{pos=Pos},vname=Valuename}}) -> - io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Valuename,Msg]), - {error,{Other,Pos,Mname,Valuename,Msg}}; -error({Other,Msg,#state{mname=Mname,type=#typedef{pos=Pos},tname=Typename}}) -> - io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]), - {error,{Other,Pos,Mname,Typename,Msg}}; -error({Other,Msg,#state{mname=Mname,type=#classdef{pos=Pos},tname=Typename}}) -> - io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]), - {error,{Other,Pos,Mname,Typename,Msg}}. - -include_default_type(Module) -> - NameAbsList = default_type_list(), - include_default_type1(Module,NameAbsList). - -include_default_type1(_,[]) -> - ok; -include_default_type1(Module,[{Name,TS}|Rest]) -> - case asn1_db:dbget(Module,Name) of - undefined -> - T = #typedef{name=Name, - typespec=TS}, - asn1_db:dbput(Module,Name,T); - _ -> ok - end, - include_default_type1(Module,Rest). - -default_type_list() -> - %% The EXTERNAL type is represented, according to ASN.1 1997, - %% as a SEQUENCE with components: identification, data-value-descriptor - %% and data-value. - Syntax = - #'ComponentType'{name=syntax, - typespec=#type{def='OBJECT IDENTIFIER'}, - prop=mandatory}, - Presentation_Cid = - #'ComponentType'{name='presentation-context-id', - typespec=#type{def='INTEGER'}, - prop=mandatory}, - Transfer_syntax = - #'ComponentType'{name='transfer-syntax', - typespec=#type{def='OBJECT IDENTIFIER'}, - prop=mandatory}, - Negotiation_items = - #type{def= - #'SEQUENCE'{components= - [Presentation_Cid, - Transfer_syntax#'ComponentType'{prop=mandatory}]}}, - Context_negot = - #'ComponentType'{name='context-negotiation', - typespec=Negotiation_items, - prop=mandatory}, - - Data_value_descriptor = - #'ComponentType'{name='data-value-descriptor', - typespec=#type{def='ObjectDescriptor'}, - prop='OPTIONAL'}, - Data_value = - #'ComponentType'{name='data-value', - typespec=#type{def='OCTET STRING'}, - prop=mandatory}, - - %% The EXTERNAL type is represented, according to ASN.1 1990, - %% as a SEQUENCE with components: direct-reference, indirect-reference, - %% data-value-descriptor and encoding. - - Direct_reference = - #'ComponentType'{name='direct-reference', - typespec=#type{def='OBJECT IDENTIFIER'}, - prop='OPTIONAL'}, - - Indirect_reference = - #'ComponentType'{name='indirect-reference', - typespec=#type{def='INTEGER'}, - prop='OPTIONAL'}, - - Single_ASN1_type = - #'ComponentType'{name='single-ASN1-type', - typespec=#type{tag=[{tag,'CONTEXT',0, - 'EXPLICIT',32}], - def='ANY'}, - prop=mandatory}, - - Octet_aligned = - #'ComponentType'{name='octet-aligned', - typespec=#type{tag=[{tag,'CONTEXT',1, - 'IMPLICIT',32}], - def='OCTET STRING'}, - prop=mandatory}, - - Arbitrary = - #'ComponentType'{name=arbitrary, - typespec=#type{tag=[{tag,'CONTEXT',2, - 'IMPLICIT',32}], - def={'BIT STRING',[]}}, - prop=mandatory}, - - Encoding = - #'ComponentType'{name=encoding, - typespec=#type{def={'CHOICE', - [Single_ASN1_type,Octet_aligned, - Arbitrary]}}, - prop=mandatory}, - - EXTERNAL_components1990 = - [Direct_reference,Indirect_reference,Data_value_descriptor,Encoding], - - %% The EMBEDDED PDV type is represented by a SEQUENCE type - %% with components: identification and data-value - Abstract = - #'ComponentType'{name=abstract, - typespec=#type{def='OBJECT IDENTIFIER'}, - prop=mandatory}, - Transfer = - #'ComponentType'{name=transfer, - typespec=#type{def='OBJECT IDENTIFIER'}, - prop=mandatory}, - AbstractTrSeq = - #'SEQUENCE'{components=[Abstract,Transfer]}, - Syntaxes = - #'ComponentType'{name=syntaxes, - typespec=#type{def=AbstractTrSeq}, - prop=mandatory}, - Fixed = #'ComponentType'{name=fixed, - typespec=#type{def='NULL'}, - prop=mandatory}, - Negotiations = - [Syntaxes,Syntax,Presentation_Cid,Context_negot, - Transfer_syntax,Fixed], - Identification2 = - #'ComponentType'{name=identification, - typespec=#type{def={'CHOICE',Negotiations}}, - prop=mandatory}, - EmbeddedPdv_components = - [Identification2,Data_value], - - %% The CHARACTER STRING type is represented by a SEQUENCE type - %% with components: identification and string-value - String_value = - #'ComponentType'{name='string-value', - typespec=#type{def='OCTET STRING'}, - prop=mandatory}, - CharacterString_components = - [Identification2,String_value], - - [{'EXTERNAL', - #type{tag=[#tag{class='UNIVERSAL', - number=8, - type='IMPLICIT', - form=32}], - def=#'SEQUENCE'{components= - EXTERNAL_components1990}}}, - {'EMBEDDED PDV', - #type{tag=[#tag{class='UNIVERSAL', - number=11, - type='IMPLICIT', - form=32}], - def=#'SEQUENCE'{components=EmbeddedPdv_components}}}, - {'CHARACTER STRING', - #type{tag=[#tag{class='UNIVERSAL', - number=29, - type='IMPLICIT', - form=32}], - def=#'SEQUENCE'{components=CharacterString_components}}} - ]. - - -include_default_class(Module) -> - NameAbsList = default_class_list(), - include_default_class1(Module,NameAbsList). - -include_default_class1(_,[]) -> - ok; -include_default_class1(Module,[{Name,TS}|_Rest]) -> - case asn1_db:dbget(Module,Name) of - undefined -> - C = #classdef{checked=true,name=Name, - typespec=TS}, - asn1_db:dbput(Module,Name,C); - _ -> ok - end. - -default_class_list() -> - [{'TYPE-IDENTIFIER', - {objectclass, - [{fixedtypevaluefield, - id, - {type,[],'OBJECT IDENTIFIER',[]}, - 'UNIQUE', - 'MANDATORY'}, - {typefield,'Type','MANDATORY'}], - {'WITH SYNTAX', - [{typefieldreference,'Type'}, - 'IDENTIFIED', - 'BY', - {valuefieldreference,id}]}}}, - {'ABSTRACT-SYNTAX', - {objectclass, - [{fixedtypevaluefield, - id, - {type,[],'OBJECT IDENTIFIER',[]}, - 'UNIQUE', - 'MANDATORY'}, - {typefield,'Type','MANDATORY'}, - {fixedtypevaluefield, - property, - {type, - [], - {'BIT STRING',[]}, - []}, - undefined, - {'DEFAULT', - [0,1,0]}}], - {'WITH SYNTAX', - [{typefieldreference,'Type'}, - 'IDENTIFIED', - 'BY', - {valuefieldreference,id}, - ['HAS', - 'PROPERTY', - {valuefieldreference,property}]]}}}]. - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_constructed_ber.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_constructed_ber.erl deleted file mode 100644 index 8a639de5bb..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_constructed_ber.erl +++ /dev/null @@ -1,1468 +0,0 @@ -%% ``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: asn1ct_constructed_ber.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ -%% --module(asn1ct_constructed_ber). - --export([gen_encode_sequence/3]). --export([gen_decode_sequence/3]). --export([gen_encode_set/3]). --export([gen_decode_set/3]). --export([gen_encode_sof/4]). --export([gen_decode_sof/4]). --export([gen_encode_choice/3]). --export([gen_decode_choice/3]). - -%%%% Application internal exports --export([match_tag/2]). - --include("asn1_records.hrl"). - --import(asn1ct_gen, [emit/1,demit/1]). - -% the encoding of class of tag bits 8 and 7 --define(UNIVERSAL, 0). --define(APPLICATION, 16#40). --define(CONTEXT, 16#80). --define(PRIVATE, 16#C0). - -% primitive or constructed encoding % bit 6 --define(PRIMITIVE, 0). --define(CONSTRUCTED, 2#00100000). - - - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Encode/decode SEQUENCE -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -gen_encode_sequence(Erules,Typename,D) when record(D,type) -> - asn1ct_name:start(), - asn1ct_name:new(term), - asn1ct_name:new(bytes), - - %% if EXTERNAL type the input value must be transformed to - %% ASN1 1990 format - case Typename of - ['EXTERNAL'] -> - emit([" NewVal = asn1rt_check:transform_to_EXTERNAL1990(Val),", - nl]); - _ -> - ok - end, - - {SeqOrSet,TableConsInfo,CompList} = - case D#type.def of - #'SEQUENCE'{tablecinf=TCI,components=CL} -> - {'SEQUENCE',TCI,CL}; - #'SET'{tablecinf=TCI,components=CL} -> - {'SET',TCI,CL} - end, - Ext = extensible(CompList), - CompList1 = case CompList of - {Rl,El} -> Rl ++ El; - _ -> CompList - end, - EncObj = - case TableConsInfo of - #simpletableattributes{usedclassfield=Used, - uniqueclassfield=Unique} when Used /= Unique -> - false; - %% ObjectSet, name of the object set in constraints - %% - %%{ObjectSet,AttrN,N,UniqueFieldName} - #simpletableattributes{objectsetname=ObjectSet, - c_name=AttrN, - c_index=N, - usedclassfield=UniqueFieldName, - uniqueclassfield=UniqueFieldName, - valueindex=ValueIndex - } -> - OSDef = - case ObjectSet of - {Module,OSName} -> - asn1_db:dbget(Module,OSName); - OSName -> - asn1_db:dbget(get(currmod),OSName) - end, -% io:format("currmod: ~p~nOSName: ~p~nAttrN: ~p~nN: ~p~nUniqueFieldName: ~p~n", -% [get(currmod),OSName,AttrN,N,UniqueFieldName]), - case (OSDef#typedef.typespec)#'ObjectSet'.gen of - true -> -% Val = lists:concat(["?RT_BER:cindex(", -% N+1,",Val,"]), - ObjectEncode = - asn1ct_gen:un_hyphen_var(lists:concat(['Obj', - AttrN])), - emit({ObjectEncode," = ",nl}), - emit({" 'getenc_",ObjectSet,"'(",{asis,UniqueFieldName}, - ", ",nl}), -% emit({indent(35),"?RT_BER:cindex(",N+1,", Val,", -% {asis,AttrN},")),",nl}), - emit([indent(10+length(atom_to_list(ObjectSet))), - "value_match(",{asis,ValueIndex},",", - "?RT_BER:cindex(",N+1,",Val,", - {asis,AttrN},"))),",nl]), - notice_value_match(), - {AttrN,ObjectEncode}; - _ -> - false - end; - _ -> - case D#type.tablecinf of - [{objfun,_}|_] -> - %% when the simpletableattributes was at an - %% outer level and the objfun has been passed - %% through the function call - {"got objfun through args","ObjFun"}; - _ -> - false - end - end, - - gen_enc_sequence_call(Erules,Typename,CompList1,1,Ext,EncObj), - - MyTag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- D#type.tag] - ++ - [#tag{class = asn1ct_gen_ber:decode_class('UNIVERSAL'), - number = asn1ct_gen_ber:decode_type(SeqOrSet), - form = ?CONSTRUCTED, - type = 'IMPLICIT'}], - emit([nl," BytesSoFar = "]), - case SeqOrSet of - 'SET' when (D#type.def)#'SET'.sorted == dynamic -> - emit("?RT_BER:dynamicsort_SET_components(["), - mkvlist(asn1ct_name:all(encBytes)), - emit(["]),",nl]); - _ -> - emit("["), - mkvlist(asn1ct_name:all(encBytes)), - emit(["],",nl]) - end, - emit(" LenSoFar = "), - case asn1ct_name:all(encLen) of - [] -> emit("0"); - AllLengths -> - mkvplus(AllLengths) - end, - emit([",",nl]), -% emit(["{TagBytes,Len} = ?RT_BER:encode_tags(TagIn ++ ", - emit([" ?RT_BER:encode_tags(TagIn ++ ", - {asis,MyTag},", BytesSoFar, LenSoFar).",nl]). - - -gen_decode_sequence(Erules,Typename,D) when record(D,type) -> - asn1ct_name:start(), -% asn1ct_name:new(term), - asn1ct_name:new(tag), - #'SEQUENCE'{tablecinf=TableConsInfo,components=CList} = D#type.def, - Ext = extensible(CList), - CompList = case CList of - {Rl,El} -> Rl ++ El; - _ -> CList - end, - - emit({" %%-------------------------------------------------",nl}), - emit({" %% decode tag and length ",nl}), - emit({" %%-------------------------------------------------",nl}), - - asn1ct_name:new(rb), - MyTag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- D#type.tag] - ++ - [#tag{class = asn1ct_gen_ber:decode_class('UNIVERSAL'), - number = asn1ct_gen_ber:decode_type('SEQUENCE'), - form = ?CONSTRUCTED, - type = 'IMPLICIT'}], - emit([" {{_,",asn1ct_gen_ber:unused_var("Len",D#type.def),"},",{next,bytes},",",{curr,rb}, - "} = ?RT_BER:check_tags(TagIn ++ ",{asis,MyTag},", ", - {curr,bytes},", OptOrMand), ",nl]), - asn1ct_name:new(bytes), - asn1ct_name:new(len), - - case CompList of - [] -> true; - _ -> - emit({"{",{next,bytes}, - ",RemBytes} = ?RT_BER:split_list(", - {curr,bytes}, - ",", {prev,len},"),",nl}), - asn1ct_name:new(bytes) - end, - - {DecObjInf,UniqueFName,ValueIndex} = - case TableConsInfo of - #simpletableattributes{objectsetname=ObjectSet, - c_name=AttrN, - usedclassfield=UniqueFieldName, - uniqueclassfield=UniqueFieldName, - valueindex=ValIndex - } -> - F = fun(#'ComponentType'{typespec=CT})-> - case {CT#type.constraint,CT#type.tablecinf} of - {[],[{objfun,_}|_R]} -> true; - _ -> false - end - end, - case lists:any(F,CompList) of - %%AttributeName = asn1ct_gen:un_hyphen_var(AttrN), - true -> % when component relation constraint establish - %% relation from a component to another components - %% subtype component - {{AttrN,{deep,ObjectSet,UniqueFieldName, - ValIndex}}, - UniqueFieldName,ValIndex}; - false -> - {{AttrN,ObjectSet},UniqueFieldName,ValIndex} - end; - _ -> - {false,false,false} - end, - case gen_dec_sequence_call(Erules,Typename,CompList,Ext,DecObjInf) of - no_terms -> % an empty sequence - emit([nl,nl]), - demit({"Result = "}), %dbg - %% return value as record - asn1ct_name:new(rb), - emit([" {{'",asn1ct_gen:list2rname(Typename),"'}, ",{curr,bytes},",",nl," "]), - asn1ct_gen_ber:add_removed_bytes(), - emit(["}.",nl]); - {LeadingAttrTerm,PostponedDecArgs} -> - emit([com,nl,nl]), - case {LeadingAttrTerm,PostponedDecArgs} of - {[],[]} -> - ok; - {_,[]} -> - ok; - {[{ObjSet,LeadingAttr,Term}],PostponedDecArgs} -> - DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])), - ValueMatch = value_match(ValueIndex,Term), - emit([DecObj," =",nl," 'getdec_",ObjSet,"'(", -% {asis,UniqueFName},", ",Term,"),",nl}), - {asis,UniqueFName},", ",ValueMatch,"),",nl]), - gen_dec_postponed_decs(DecObj,PostponedDecArgs) - end, - demit({"Result = "}), %dbg - %% return value as record - asn1ct_name:new(rb), - asn1ct_name:new(bytes), - ExtStatus = case Ext of - {ext,_,_} -> ext; - noext -> noext - end, - emit([" {",{next,bytes},",",{curr,rb},"} = ?RT_BER:restbytes2(RemBytes, ", - {curr,bytes},",",ExtStatus,"),",nl]), - asn1ct_name:new(rb), - case Typename of - ['EXTERNAL'] -> - emit([" OldFormat={'",asn1ct_gen:list2rname(Typename), - "', "]), - mkvlist(asn1ct_name:all(term)), - emit(["},",nl]), - emit([" ASN11994Format =",nl, - " asn1rt_check:transform_to_EXTERNAL1994", - "(OldFormat),",nl]), - emit([" {ASN11994Format,",{next,bytes},", "]); - _ -> - emit([" {{'",asn1ct_gen:list2rname(Typename),"', "]), - mkvlist(asn1ct_name:all(term)), - emit(["}, ",{next,bytes},", "]) - end, - asn1ct_gen_ber:add_removed_bytes(), - emit(["}.",nl]) - end. - -gen_dec_postponed_decs(_,[]) -> - emit(nl); -gen_dec_postponed_decs(DecObj,[{_Cname,{FirstPFN,PFNList},Term,TmpTerm,_Tag,OptOrMand}|Rest]) -> -% asn1ct_name:new(term), - asn1ct_name:new(tmpterm), - asn1ct_name:new(reason), - - emit({"{",Term,", _, _} = ",nl}), - N = case OptOrMand of - mandatory -> 0; - 'OPTIONAL' -> - emit_opt_or_mand_check(asn1_NOVALUE,TmpTerm), - 6; - {'DEFAULT',Val} -> - emit_opt_or_mand_check(Val,TmpTerm), - 6 - end, - emit({indent(N+3),"case (catch ",DecObj,"(",{asis,FirstPFN}, -% ", ",TmpTerm,", ", {asis,Tag},", ",{asis,PFNList},")) of",nl}), - ", ",TmpTerm,", [], ",{asis,PFNList},")) of",nl}), - emit({indent(N+6),"{'EXIT', ",{curr,reason},"} ->",nl}), - emit({indent(N+9),"exit({'Type not compatible with table constraint',", - {curr,reason},"});",nl}), - emit({indent(N+6),{curr,tmpterm}," ->",nl}), - emit({indent(N+9),{curr,tmpterm},nl}), - - case OptOrMand of - mandatory -> emit([indent(N+3),"end,",nl]); - _ -> - emit([indent(N+3),"end",nl, - indent(3),"end,",nl]) - end, -% emit({indent(3),"end,",nl}), - gen_dec_postponed_decs(DecObj,Rest). - - -emit_opt_or_mand_check(Value,TmpTerm) -> - emit([indent(3),"case ",TmpTerm," of",nl, - indent(6),{asis,Value}," -> {",{asis,Value},",[],[]};",nl, - indent(6),"_ ->",nl]). - -%%============================================================================ -%% Encode/decode SET -%% -%%============================================================================ - -gen_encode_set(Erules,Typename,D) when record(D,type) -> - gen_encode_sequence(Erules,Typename,D). - -gen_decode_set(Erules,Typename,D) when record(D,type) -> - asn1ct_name:start(), - asn1ct_name:new(term), - asn1ct_name:new(tag), - #'SET'{components=TCompList} = D#type.def, - Ext = extensible(TCompList), - CompList = case TCompList of - {Rl,El} -> Rl ++ El; - _ -> TCompList - end, - - emit([" %%-------------------------------------------------",nl]), - emit([" %% decode tag and length ",nl]), - emit([" %%-------------------------------------------------",nl]), - - asn1ct_name:new(rb), - MyTag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- D#type.tag] - ++ - [#tag{class = asn1ct_gen_ber:decode_class('UNIVERSAL'), - number = asn1ct_gen_ber:decode_type('SET'), - form = ?CONSTRUCTED, - type = 'IMPLICIT'}], - emit([" {{_,Len},",{next,bytes},",",{curr,rb}, - "} = ?RT_BER:check_tags(TagIn ++ ",{asis,MyTag},", ", - {curr,bytes},", OptOrMand), ",nl]), - asn1ct_name:new(bytes), - asn1ct_name:new(len), - asn1ct_name:new(rb), - - emit([" {SetTerm, SetBytes, ",{curr,rb},"} = ?RT_BER:decode_set(0, Len, ", - {curr,bytes},", OptOrMand, ", - "fun 'dec_",asn1ct_gen:list2name(Typename),"_fun'/2, []),",nl]), - - asn1ct_name:new(rb), - emit([" 'dec_",asn1ct_gen:list2name(Typename),"_result'(lists:sort(SetTerm), SetBytes, "]), - asn1ct_gen_ber:add_removed_bytes(), - emit([").",nl,nl,nl]), - - emit({"%%-------------------------------------------------",nl}), - emit({"%% Set loop fun for ",asn1ct_gen:list2name(Typename),nl}), - emit({"%%-------------------------------------------------",nl}), - - asn1ct_name:clear(), - asn1ct_name:new(term), - emit(["'dec_",asn1ct_gen:list2name(Typename),"_fun'(",{curr,bytes}, - ", OptOrMand) ->",nl]), - - asn1ct_name:new(bytes), - gen_dec_set(Erules,Typename,CompList,1,Ext), - - emit([" %% tag not found, if extensionmark we should skip bytes here",nl]), - emit([indent(6),"_ -> {[], Bytes,0}",nl]), - emit([indent(3),"end.",nl,nl,nl]), - - - emit({"%%-------------------------------------------------",nl}), - emit({"%% Result ",asn1ct_gen:list2name(Typename),nl}), - emit({"%%-------------------------------------------------",nl}), - - asn1ct_name:clear(), - emit({"'dec_",asn1ct_gen:list2name(Typename),"_result'(", - asn1ct_gen_ber:unused_var("TermList",D#type.def),", Bytes, Rb) ->",nl}), - - case gen_dec_set_result(Erules,Typename,CompList) of - no_terms -> - %% return value as record - asn1ct_name:new(rb), - emit({" {{'",asn1ct_gen:list2rname(Typename),"'}, Bytes, Rb}.",nl}); - _ -> - emit({nl," case ",{curr,termList}," of",nl}), - emit({" [] -> {{'",asn1ct_gen:list2rname(Typename),"', "}), - mkvlist(asn1ct_name:all(term)), - emit({"}, Bytes, Rb};",nl}), - emit({" ExtraAtt -> exit({error,{asn1,{too_many_attributes, ExtraAtt}}})",nl}), - emit({" end.",nl}), - emit({nl,nl,nl}) - end. - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Encode/decode SEQUENCE OF and SET OF -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -gen_encode_sof(Erules,Typename,_InnerTypename,D) when record(D,type) -> - asn1ct_name:start(), - {SeqOrSetOf, Cont} = D#type.def, - - Objfun = case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - "" - end, - - emit({" {EncBytes,EncLen} = 'enc_",asn1ct_gen:list2name(Typename), - "_components'(Val",Objfun,",[],0),",nl}), - - MyTag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- D#type.tag] - ++ - [#tag{class = asn1ct_gen_ber:decode_class('UNIVERSAL'), - number = asn1ct_gen_ber:decode_type(SeqOrSetOf), - form = ?CONSTRUCTED, - type = 'IMPLICIT'}], -% gen_encode_tags(Erules,MyTag,"EncLen","EncBytes"), - emit([" ?RT_BER:encode_tags(TagIn ++ ", - {asis,MyTag},", EncBytes, EncLen).",nl,nl]), - - gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont). -% gen_enc_line(Erules,Typename,TypeNameSuffix,Cont,"H",0, -% mandatory,"{EncBytes,EncLen} = "), - - -gen_decode_sof(Erules,Typename,_InnerTypename,D) when record(D,type) -> - asn1ct_name:start(), - {SeqOrSetOf, TypeTag, Cont} = - case D#type.def of - {'SET OF',_Cont} -> {'SET OF','SET',_Cont}; - {'SEQUENCE OF',_Cont} -> {'SEQUENCE OF','SEQUENCE',_Cont} - end, - TypeNameSuffix = asn1ct_gen:constructed_suffix(SeqOrSetOf,Cont#type.def), - - emit({" %%-------------------------------------------------",nl}), - emit({" %% decode tag and length ",nl}), - emit({" %%-------------------------------------------------",nl}), - - asn1ct_name:new(rb), - MyTag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- D#type.tag] - ++ - [#tag{class = asn1ct_gen_ber:decode_class('UNIVERSAL'), - number = asn1ct_gen_ber:decode_type(TypeTag), - form = ?CONSTRUCTED, - type = 'IMPLICIT'}], - emit([" {{_,Len},",{next,bytes},",",{curr,rb}, - "} = ?RT_BER:check_tags(TagIn ++ ",{asis,MyTag},", ", - {curr,bytes},", OptOrMand), ",nl]), - - emit([" ?RT_BER:decode_components(",{curr,rb}]), - InnerType = asn1ct_gen:get_inner(Cont#type.def), - ContName = case asn1ct_gen:type(InnerType) of - Atom when atom(Atom) -> Atom; - _ -> TypeNameSuffix - end, - emit([", Len, ",{next,bytes},", "]), -% NewCont = -% case Cont#type.def of -% {'ENUMERATED',_,Components}-> -% Cont#type{def={'ENUMERATED',Components}}; -% _ -> Cont -% end, - ObjFun = - case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - [] - end, - gen_dec_line_sof(Erules,Typename,ContName,Cont,ObjFun), - emit([", []).",nl,nl,nl]). - - -gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont) - when record(Cont,type)-> - - {Objfun,ObjFun_novar,EncObj} = - case Cont#type.tablecinf of - [{objfun,_}|_R] -> - {", ObjFun",", _",{no_attr,"ObjFun"}}; - _ -> - {"","",false} - end, - emit(["'enc_",asn1ct_gen:list2name(Typename), - "_components'([]",ObjFun_novar,", AccBytes, AccLen) -> ",nl]), - - case catch lists:member(der,get(encoding_options)) of - true -> - emit([indent(3), - "{?RT_BER:dynamicsort_SETOF(AccBytes),AccLen};",nl,nl]); - _ -> - emit([indent(3),"{lists:reverse(AccBytes),AccLen};",nl,nl]) - end, - emit(["'enc_",asn1ct_gen:list2name(Typename), - "_components'([H|T]",Objfun,",AccBytes, AccLen) ->",nl]), - TypeNameSuffix = asn1ct_gen:constructed_suffix(SeqOrSetOf,Cont#type.def), - gen_enc_line(Erules,Typename,TypeNameSuffix,Cont,"H",3, - mandatory,"{EncBytes,EncLen} = ",EncObj), - emit([",",nl]), - emit([indent(3),"'enc_",asn1ct_gen:list2name(Typename), - "_components'(T",Objfun,","]), - emit(["[EncBytes|AccBytes], AccLen + EncLen).",nl,nl]). - -%%============================================================================ -%% Encode/decode CHOICE -%% -%%============================================================================ - -gen_encode_choice(Erules,Typename,D) when record(D,type) -> - ChoiceTag = D#type.tag, - {'CHOICE',CompList} = D#type.def, - Ext = extensible(CompList), - CompList1 = case CompList of - {Rl,El} -> Rl ++ El; - _ -> CompList - end, - gen_enc_choice(Erules,Typename,ChoiceTag,CompList1,Ext), - emit({nl,nl}). - -gen_decode_choice(Erules,Typename,D) when record(D,type) -> - asn1ct_name:start(), - asn1ct_name:new(bytes), - ChoiceTag = D#type.tag, - {'CHOICE',CompList} = D#type.def, - Ext = extensible(CompList), - CompList1 = case CompList of - {Rl,El} -> Rl ++ El; - _ -> CompList - end, - gen_dec_choice(Erules,Typename,ChoiceTag,CompList1,Ext), - emit({".",nl}). - - -%%============================================================================ -%% Encode SEQUENCE -%% -%%============================================================================ - -gen_enc_sequence_call(Erules,TopType,[#'ComponentType'{name=Cname,typespec=Type,prop=Prop}|Rest],Pos,Ext,EncObj) -> - asn1ct_name:new(encBytes), - asn1ct_name:new(encLen), - Element = - case TopType of - ['EXTERNAL'] -> - io_lib:format("?RT_BER:cindex(~w,NewVal,~w)",[Pos+1,Cname]); - _ -> - io_lib:format("?RT_BER:cindex(~w,Val,~w)",[Pos+1,Cname]) - end, - InnerType = asn1ct_gen:get_inner(Type#type.def), - print_attribute_comment(InnerType,Pos,Prop), - gen_enc_line(Erules,TopType,Cname,Type,Element,3,Prop,EncObj), - case Rest of - [] -> - emit({com,nl}); - _ -> - emit({com,nl}), - gen_enc_sequence_call(Erules,TopType,Rest,Pos+1,Ext,EncObj) - end; - -gen_enc_sequence_call(_Erules,_TopType,[],_Num,_,_) -> - true. - -%%============================================================================ -%% Decode SEQUENCE -%% -%%============================================================================ - -gen_dec_sequence_call(Erules,TopType,CompList,Ext,DecObjInf) -> - gen_dec_sequence_call1(Erules,TopType, CompList, 1, Ext,DecObjInf,[],[]). - - -gen_dec_sequence_call1(Erules,TopType,[#'ComponentType'{name=Cname,typespec=Type,prop=Prop,tags=Tags}|Rest],Num,Ext,DecObjInf,LeadingAttrAcc,ArgsAcc) -> - {LA,PostponedDec} = - gen_dec_component(Erules,TopType,Cname,Tags,Type,Num,Prop, - Ext,DecObjInf), - case Rest of - [] -> - {LA ++ LeadingAttrAcc,PostponedDec ++ ArgsAcc}; - _ -> - emit({com,nl}), -% asn1ct_name:new(term), - asn1ct_name:new(bytes), - gen_dec_sequence_call1(Erules,TopType,Rest,Num+1,Ext,DecObjInf, - LA++LeadingAttrAcc,PostponedDec++ArgsAcc) - end; - -gen_dec_sequence_call1(_Erules,_TopType,[],1,_,_,_,_) -> - no_terms. -%%gen_dec_sequence_call1(Erules,_TopType,[],Num,_) -> -%% true. - - - -%%---------------------------- -%%SEQUENCE mandatory -%%---------------------------- - -gen_dec_component(Erules,TopType,Cname,CTags,Type,Pos,Prop,Ext,DecObjInf) -> - InnerType = - case Type#type.def of - #'ObjectClassFieldType'{type=OCFTType} -> OCFTType; - _ -> asn1ct_gen:get_inner(Type#type.def) - end, -% case asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info) of -% no -> -% asn1ct_gen:get_inner(Type#type.def); -% _ -> -% Type#type.def -% end, - Prop1 = case {Prop,Ext} of - {mandatory,{ext,Epos,_}} when Pos >= Epos -> - 'OPTIONAL'; - _ -> - Prop - end, - print_attribute_comment(InnerType,Pos,Prop1), - emit(" "), - - case {InnerType,DecObjInf} of - {{typefield,_},NotFalse} when NotFalse /= false -> - asn1ct_name:new(term), - asn1ct_name:new(tmpterm), - emit({"{",{curr,tmpterm},", ",{next,bytes},",",{next,rb},"} = "}); - {{objectfield,_,_},_} -> - asn1ct_name:new(term), - asn1ct_name:new(tmpterm), - emit({"{",{curr,tmpterm},", ",{next,bytes},",",{next,rb},"} = "}); - _ -> - asn1ct_name:new(term), - emit({"{",{curr,term},",",{next,bytes},",",{next,rb},"} = "}) - end, - asn1ct_name:new(rb), - PostponedDec = - gen_dec_line(Erules,TopType,Cname,CTags,Type,Prop1,DecObjInf), - asn1ct_name:new(form), - PostponedDec. - - -%%------------------------------------- -%% Decode SET -%%------------------------------------- - -gen_dec_set(Erules,TopType,CompList,Pos,_Ext) -> - TagList = get_all_choice_tags(CompList), - emit({indent(3), - {curr,tagList}," = ",{asis,TagList},",",nl}), - emit({indent(3), - "case ?RT_BER:check_if_valid_tag(Bytes, ", - {curr,tagList},", OptOrMand) of",nl}), - asn1ct_name:new(tagList), - asn1ct_name:new(rbCho), - asn1ct_name:new(choTags), - gen_dec_set_cases(Erules,TopType,CompList,TagList,Pos), - asn1ct_name:new(tag), - asn1ct_name:new(bytes). - - - -gen_dec_set_cases(_,_,[],_,_) -> - ok; -gen_dec_set_cases(Erules,TopType,[H|T],List,Pos) -> - case H of - {'EXTENSIONMARK', _, _} -> - gen_dec_set_cases(Erules,TopType,T,List,Pos); - _ -> - Name = H#'ComponentType'.name, - Type = H#'ComponentType'.typespec, - - emit({indent(6),"'",Name,"' ->",nl}), - case Type#type.def of - {'CHOICE',_NewCompList} -> - gen_dec_set_cases_choice(Erules,TopType,H,Pos); - _ -> - gen_dec_set_cases_type(Erules,TopType,H,Pos) - end, - gen_dec_set_cases(Erules,TopType,T,List,Pos+1) - end. - - - - -gen_dec_set_cases_choice(_Erules,TopType,H,Pos) -> - Cname = H#'ComponentType'.name, - Tag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)} - || X <- (H#'ComponentType'.typespec)#type.tag], - asn1ct_name:new(rbCho), - emit({indent(9),"{Dec, Rest, ",{curr,rbCho},"} = "}), - emit({"'dec_",asn1ct_gen:list2name([Cname|TopType]), - "'(Bytes,OptOrMand,",{asis,Tag},"),",nl}), - emit([" {{",Pos,",Dec}, Rest, ",{curr,rbCho},"}"]), - emit([";",nl,nl]). - - -gen_dec_set_cases_type(Erules,TopType,H,Pos) -> - Cname = H#'ComponentType'.name, - Type = H#'ComponentType'.typespec, - %% always use Prop = mandatory here Prop = H#'ComponentType'.prop, - - asn1ct_name:new(rbCho), - emit({indent(9),"{Dec, Rest, ",{curr,rbCho},"} = "}), - asn1ct_name:delete(bytes), - %% we have already seen the tag so now we must find the value - %% that why we always use 'mandatory' here - gen_dec_line(Erules,TopType,Cname,[],Type,mandatory,decObjInf), - asn1ct_name:new(bytes), - - emit([",",nl]), - emit(["{{",Pos,",Dec}, Rest, ",{curr,rbCho},"}"]), - emit([";",nl,nl]). - - -%%--------------------------------- -%% Decode SET result -%%--------------------------------- - -gen_dec_set_result(Erules,TopType,{CompList,_ExtList}) -> - gen_dec_set_result1(Erules,TopType, CompList, 1); -gen_dec_set_result(Erules,TopType,CompList) -> - gen_dec_set_result1(Erules,TopType, CompList, 1). - -gen_dec_set_result1(Erules,TopType, - [#'ComponentType'{name=Cname, - typespec=Type, - prop=Prop}|Rest],Num) -> - gen_dec_set_component(Erules,TopType,Cname,Type,Num,Prop), - case Rest of - [] -> - true; - _ -> - gen_dec_set_result1(Erules,TopType,Rest,Num+1) - end; - -gen_dec_set_result1(_Erules,_TopType,[],1) -> - no_terms; -gen_dec_set_result1(_Erules,_TopType,[],_Num) -> - true. - - -gen_dec_set_component(_Erules,_TopType,_Cname,Type,Pos,Prop) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - print_attribute_comment(InnerType,Pos,Prop), - emit({" {",{next,term},com,{next,termList},"} =",nl}), - emit({" case ",{curr,termList}," of",nl}), - emit({" [{",Pos,com,{curr,termTmp},"}|", - {curr,rest},"] -> "}), - emit({"{",{curr,termTmp},com, - {curr,rest},"};",nl}), - case Prop of - 'OPTIONAL' -> - emit([indent(10),"_ -> {asn1_NOVALUE, ",{curr,termList},"}",nl]); - {'DEFAULT', DefVal} -> - emit([indent(10), - "_ -> {",{asis,DefVal},", ",{curr,termList},"}",nl]); - mandatory -> - emit([indent(10), - "_ -> exit({error,{asn1,{mandatory_attribute_no, ", - Pos,", missing}}})",nl]) - end, - emit([indent(6),"end,",nl]), - asn1ct_name:new(rest), - asn1ct_name:new(term), - asn1ct_name:new(termList), - asn1ct_name:new(termTmp). - - -%%--------------------------------------------- -%% Encode CHOICE -%%--------------------------------------------- -%% for BER we currently do care (a little) if the choice has an EXTENSIONMARKER - - -gen_enc_choice(Erules,TopType,Tag,CompList,_Ext) -> - gen_enc_choice1(Erules,TopType,Tag,CompList,_Ext). - -gen_enc_choice1(Erules,TopType,Tag,CompList,_Ext) -> - asn1ct_name:clear(), - emit({" {EncBytes,EncLen} = case element(1,Val) of",nl}), - gen_enc_choice2(Erules,TopType,CompList), - emit([nl," end,",nl,nl]), - NewTag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- Tag], -% gen_encode_tags(Erules,NewTag,"EncLen","EncBytes"). - emit(["?RT_BER:encode_tags(TagIn ++",{asis,NewTag},", EncBytes, EncLen).",nl]). - - - -gen_enc_choice2(Erules,TopType,[H1|T]) when record(H1,'ComponentType') -> - Cname = H1#'ComponentType'.name, - Type = H1#'ComponentType'.typespec, - emit({" ",{asis,Cname}," ->",nl}), - {Encobj,Assign} = -% case asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info) of - case {Type#type.def,asn1ct_gen:get_constraint(Type#type.constraint, - componentrelation)} of - {#'ObjectClassFieldType'{},{componentrelation,_,_}} -> - asn1ct_name:new(tmpBytes), - asn1ct_name:new(encBytes), - asn1ct_name:new(encLen), - Emit = ["{",{curr,tmpBytes},", _} = "], - {{no_attr,"ObjFun"},Emit}; - _ -> - {false,[]} - end, - gen_enc_line(Erules,TopType,Cname,Type,"element(2,Val)",9, - mandatory,Assign,Encobj), - case Encobj of - false -> ok; - _ -> - emit({",",nl,indent(9),"{",{curr,encBytes},", ", - {curr,encLen},"}"}) - end, - emit({";",nl}), - case T of - [] -> - emit([indent(6), "Else -> ",nl, - indent(9),"exit({error,{asn1,{invalid_choice_type,Else}}})"]); - _ -> - true - end, - gen_enc_choice2(Erules,TopType,T); - -gen_enc_choice2(_,_,[]) -> - true. - - - - -%%-------------------------------------------- -%% Decode CHOICE -%%-------------------------------------------- - -gen_dec_choice(Erules,TopType, ChTag, CompList, Ext) -> - asn1ct_name:delete(bytes), - Tags = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)}|| X <- ChTag], - - emit([" {{_,Len},",{next,bytes}, - ", RbExp} = ?RT_BER:check_tags(TagIn++", - {asis,Tags},", ", - {curr,bytes},", OptOrMand),",nl]), - asn1ct_name:new(bytes), - asn1ct_name:new(len), - gen_dec_choice_indef_funs(Erules), - case Erules of - ber_bin -> - emit([indent(3),"case ",{curr,bytes}," of",nl]); - ber -> - emit([indent(3), - "case (catch ?RT_BER:peek_tag(",{curr,bytes},")) of",nl]) - end, - asn1ct_name:new(tagList), - asn1ct_name:new(choTags), - gen_dec_choice_cases(Erules,TopType,CompList), - case Ext of - noext -> - emit([indent(6), {curr,else}," -> ",nl]), - emit([indent(9),"case OptOrMand of",nl, - indent(12),"mandatory ->","exit({error,{asn1,", - "{invalid_choice_tag,",{curr,else},"}}});",nl, - indent(12),"_ ->","exit({error,{asn1,{no_optional_tag,", - {curr,else},"}}})",nl, - indent(9),"end",nl]); - _ -> - emit([indent(6),"_ -> ",nl]), - emit([indent(9),"{{asn1_ExtAlt,",{curr,bytes},"},", - empty_lb(Erules),", RbExp}",nl]) - end, - emit([indent(3),"end"]), - asn1ct_name:new(tag), - asn1ct_name:new(else). - -gen_dec_choice_indef_funs(Erules) -> - emit({indent(3),"IndefEndBytes = fun(indefinite,",indefend_match(Erules,used_var), - ")-> R; (_,B)-> B end,",nl}), - emit({indent(3),"IndefEndRb = fun(indefinite,",indefend_match(Erules,unused_var), - ")-> 2; (_,_)-> 0 end,",nl}). - - -gen_dec_choice_cases(_,_, []) -> - ok; -gen_dec_choice_cases(Erules,TopType, [H|T]) -> - asn1ct_name:push(rbCho), - Name = H#'ComponentType'.name, - emit([nl,"%% '",Name,"'",nl]), - Fcases = fun([T1,T2|Tail],Fun) -> - emit([indent(6),match_tag(Erules,T1)," ->",nl]), - gen_dec_choice_cases_type(Erules,TopType, H), - Fun([T2|Tail],Fun); - ([T1],_) -> - emit([indent(6),match_tag(Erules,T1)," ->",nl]), - gen_dec_choice_cases_type(Erules,TopType, H) - end, - Fcases(H#'ComponentType'.tags,Fcases), - asn1ct_name:pop(rbCho), - gen_dec_choice_cases(Erules,TopType, T). - - - -gen_dec_choice_cases_type(Erules,TopType,H) -> - Cname = H#'ComponentType'.name, - Type = H#'ComponentType'.typespec, - Prop = H#'ComponentType'.prop, - emit({indent(9),"{Dec, Rest, ",{curr,rbCho},"} = "}), - gen_dec_line(Erules,TopType,Cname,[],Type,Prop,false), - emit([",",nl,indent(9),"{{",{asis,Cname}, - ", Dec}, IndefEndBytes(Len,Rest), RbExp + ", - {curr,rbCho}," + IndefEndRb(Len,Rest)};",nl,nl]). - -encode_tag_val(Erules,{Class,TagNo}) when integer(TagNo) -> - Rtmod = rtmod(Erules), - Rtmod:encode_tag_val({asn1ct_gen_ber:decode_class(Class), - 0,TagNo}); -encode_tag_val(Erules,{Class,TypeName}) -> - Rtmod = rtmod(Erules), - Rtmod:encode_tag_val({asn1ct_gen_ber:decode_class(Class), - 0,asn1ct_gen_ber:decode_type(TypeName)}). - - -match_tag(ber_bin,Arg) -> - match_tag_with_bitsyntax(Arg); -match_tag(Erules,Arg) -> - io_lib:format("~p",[encode_tag_val(Erules,Arg)]). - -match_tag_with_bitsyntax({Class,TagNo}) when integer(TagNo) -> - match_tag_with_bitsyntax1({asn1ct_gen_ber:decode_class(Class), - 0,TagNo}); -match_tag_with_bitsyntax({Class,TypeName}) -> - match_tag_with_bitsyntax1({asn1ct_gen_ber:decode_class(Class), - 0,asn1ct_gen_ber:decode_type(TypeName)}). - -match_tag_with_bitsyntax1({Class, _Form, TagNo}) when (TagNo =< 30) -> - io_lib:format("<<~p:2,_:1,~p:5,_/binary>>",[Class bsr 6,TagNo]); - -match_tag_with_bitsyntax1({Class, _Form, TagNo}) -> - {Octets,Len} = mk_object_val(TagNo), - OctForm = case Len of - 1 -> "~p"; - 2 -> "~p,~p"; - 3 -> "~p,~p,~p"; - 4 -> "~p,~p,~p,~p" - end, - io_lib:format("<<~p:2,_:1,31:5," ++ OctForm ++ ",_/binary>>", - [Class bsr 6] ++ Octets). - -%%%%%%%%%%% -%% mk_object_val(Value) -> {OctetList, Len} -%% returns a Val as a list of octets, the 8 bit is allways set to one except -%% for the last octet, where its 0 -%% - - -mk_object_val(Val) when Val =< 127 -> - {[255 band Val], 1}; -mk_object_val(Val) -> - mk_object_val(Val bsr 7, [Val band 127], 1). -mk_object_val(0, Ack, Len) -> - {Ack, Len}; -mk_object_val(Val, Ack, Len) -> - mk_object_val(Val bsr 7, [((Val band 127) bor 128) | Ack], Len + 1). - - -get_all_choice_tags(ComponentTypeList) -> - get_all_choice_tags(ComponentTypeList,[]). - -get_all_choice_tags([],TagList) -> - TagList; -get_all_choice_tags([H|T],TagList) -> - Tags = H#'ComponentType'.tags, - get_all_choice_tags(T, TagList ++ [{H#'ComponentType'.name, Tags}]). - - - -%%--------------------------------------- -%% Generate the encode/decode code -%%--------------------------------------- - -gen_enc_line(Erules,TopType,Cname, - Type=#type{constraint=[{componentrelation,_,_}], - def=#'ObjectClassFieldType'{type={typefield,_}}}, - Element,Indent,OptOrMand=mandatory,EncObj) - when list(Element) -> - asn1ct_name:new(tmpBytes), - gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand, - ["{",{curr,tmpBytes},",_} = "],EncObj); -gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,EncObj) - when list(Element) -> - gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand, - ["{",{curr,encBytes},",",{curr,encLen},"} = "],EncObj). - -gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj) - when list(Element) -> - IndDeep = indent(Indent), - - Tag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)} - || X <- Type#type.tag], - InnerType = asn1ct_gen:get_inner(Type#type.def), - WhatKind = asn1ct_gen:type(InnerType), - emit(IndDeep), - emit(Assign), - gen_optormand_case(OptOrMand,Erules,TopType,Cname,Type,InnerType,WhatKind, - Element), - case {Type,asn1ct_gen:get_constraint(Type#type.constraint, - componentrelation)} of -% #type{constraint=[{tableconstraint_info,RefedFieldName}], -% def={typefield,_}} -> - {#type{def=#'ObjectClassFieldType'{type={typefield,_}, - fieldname=RefedFieldName}}, - {componentrelation,_,_}} -> - {_LeadingAttrName,Fun} = EncObj, - case RefedFieldName of - {notype,T} -> - throw({error,{notype,type_from_object,T}}); - {Name,RestFieldNames} when atom(Name) -> - case OptOrMand of - mandatory -> ok; - _ -> -% emit(["{",{curr,tmpBytes},",",{curr,tmpLen}, - emit(["{",{curr,tmpBytes},", _} = "]) -%% asn1ct_name:new(tmpBytes), -%% asn1ct_name:new(tmpLen) - end, - emit({Fun,"(",{asis,Name},", ",Element,", [], ", - {asis,RestFieldNames},"),",nl}), - emit(IndDeep), - case OptOrMand of - mandatory -> - emit({"{",{curr,encBytes},", ",{curr,encLen},"} = "}), - emit({"?RT_BER:encode_open_type(",{curr,tmpBytes}, - ",",{asis,Tag},")"}); - _ -> -% emit({"{",{next,tmpBytes},", _} = "}), - emit({"{",{next,tmpBytes},", ",{curr,tmpLen}, - "} = "}), - emit({"?RT_BER:encode_open_type(",{curr,tmpBytes}, - ",",{asis,Tag},"),",nl}), - emit(IndDeep), - emit({"{",{next,tmpBytes},", ",{curr,tmpLen},"}"}) - end; - _ -> - throw({asn1,{'internal error'}}) - end; -% #type{constraint=[{tableconstraint_info,_}], -% def={objectfield,PrimFieldName1,PFNList}} -> - {{#'ObjectClassFieldType'{type={objectfield,PrimFieldName1, - PFNList}},_}, - {componentrelation,_,_}} -> - %% this is when the dotted list in the FieldName has more - %% than one element - {_LeadingAttrName,Fun} = EncObj, - emit({"?RT_BER:encode_open_type(",Fun,"(",{asis,PrimFieldName1}, - ", ",Element,", ",{asis,PFNList},"),",{asis,Tag},")"}); - _ -> - case WhatKind of - {primitive,bif} -> - EncType = - case Type#type.def of - #'ObjectClassFieldType'{ - type={fixedtypevaluefield, - _,Btype}} -> - Btype; - _ -> - Type - end, - asn1ct_gen_ber:gen_encode_prim(ber,EncType,{asis,Tag}, - Element); - {notype,_} -> - emit({"'enc_",InnerType,"'(",Element,", ",{asis,Tag},")"}); - 'ASN1_OPEN_TYPE' -> - asn1ct_gen_ber:gen_encode_prim(ber,Type#type{def='ASN1_OPEN_TYPE'},{asis,Tag},Element); - _ -> - {EncFunName, _, _} = - mkfuncname(TopType,Cname,WhatKind,enc), - case {WhatKind,Type#type.tablecinf,EncObj} of - {{constructed,bif},[{objfun,_}|_R],{_,Fun}} -> - emit([EncFunName,"(",Element,", ",{asis,Tag}, - ", ",Fun,")"]); - _ -> - emit([EncFunName,"(",Element,", ",{asis,Tag},")"]) - end - end - end, - case OptOrMand of - mandatory -> true; - _ -> - emit({nl,indent(7),"end"}) - end. - - - -gen_optormand_case(mandatory,_,_,_,_,_,_, _) -> - ok; -gen_optormand_case('OPTIONAL',Erules,_,_,_,_,_,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) -> - 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}); - _ -> - emit({" case ",Element," of",nl}), - emit({indent(9),"asn1_DEFAULT -> {", - empty_lb(Erules), - ",0};",nl}), - case DefaultValue of - #'Externalvaluereference'{module=CurrMod, - value=V} -> - emit({indent(9),"?",{asis,V}," -> {", - empty_lb(Erules),",0};",nl}); - _ -> - emit({indent(9),{asis, - DefaultValue}," -> {", - empty_lb(Erules),",0};",nl}) - end - end, - emit({indent(9),"_ ->",nl,indent(12)}). - - - - -gen_dec_line_sof(_Erules,TopType,Cname,Type,ObjFun) -> - - Tag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)} - || X <- Type#type.tag], - InnerType = asn1ct_gen:get_inner(Type#type.def), - WhatKind = asn1ct_gen:type(InnerType), - case WhatKind of - {primitive,bif} -> - asn1ct_name:delete(len), - - asn1ct_name:new(len), - emit(["fun(FBytes,_,_)->",nl]), - EncType = case Type#type.def of - #'ObjectClassFieldType'{ - type={fixedtypevaluefield, - _,Btype}} -> - Btype; - _ -> - Type - end, - asn1ct_gen_ber:gen_dec_prim(ber,EncType,"FBytes",Tag, - [],no_length,?PRIMITIVE, - mandatory), - emit([nl,"end, []"]); - _ -> - case ObjFun of - [] -> - {DecFunName, _, _} = - mkfunname(TopType,Cname,WhatKind,dec,3), - emit([DecFunName,", ",{asis,Tag}]); - _ -> - {DecFunName, _, _} = - mkfunname(TopType,Cname,WhatKind,dec,4), - emit([DecFunName,", ",{asis,Tag},", ObjFun"]) - end - end. - - -gen_dec_line(Erules,TopType,Cname,CTags,Type,OptOrMand,DecObjInf) -> - BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), - Tag = [X#tag{class=asn1ct_gen_ber:decode_class(X#tag.class)} - || X <- Type#type.tag], - InnerType = - case Type#type.def of - #'ObjectClassFieldType'{type=OCFTType} -> - OCFTType; - _ -> - asn1ct_gen:get_inner(Type#type.def) - end, - PostpDec = - case OptOrMand of - mandatory -> - gen_dec_call(InnerType,Erules,TopType,Cname,Type, - BytesVar,Tag,mandatory,", mandatory, ", - DecObjInf,OptOrMand); - _ -> %optional or default - case {CTags,Erules} of - {[CTag],ber_bin} -> - emit(["case ",{curr,bytes}," of",nl]), - emit([match_tag(Erules,CTag)," ->",nl]), - PostponedDec = - gen_dec_call(InnerType,Erules,TopType,Cname,Type, - BytesVar,Tag,mandatory, - ", opt_or_default, ",DecObjInf, - OptOrMand), - emit([";",nl]), - emit(["_ ->",nl]), - case OptOrMand of - {'DEFAULT', Def} -> - emit(["{",{asis,Def},",", - BytesVar,", 0 }",nl]); - 'OPTIONAL' -> - emit(["{ asn1_NOVALUE, ", - BytesVar,", 0 }",nl]) - end, - emit("end"), - PostponedDec; - _ -> - emit("case (catch "), - PostponedDec = - gen_dec_call(InnerType,Erules,TopType,Cname,Type, - BytesVar,Tag,OptOrMand, - ", opt_or_default, ",DecObjInf, - OptOrMand), - emit([") of",nl]), - case OptOrMand of - {'DEFAULT', Def} -> - emit(["{'EXIT',{error,{asn1,{no_optional_tag,_}}}}", - " -> {",{asis,Def},",", - BytesVar,", 0 };",nl]); - 'OPTIONAL' -> - emit(["{'EXIT',{error,{asn1,{no_optional_tag,_}}}}", - " -> { asn1_NOVALUE, ", - BytesVar,", 0 };",nl]) - end, - asn1ct_name:new(casetmp), - emit([{curr,casetmp},"-> ",{curr,casetmp},nl,"end"]), - PostponedDec - end - end, - case DecObjInf of - {Cname,ObjSet} -> % this must be the component were an object is - %% choosen from the object set according to the table - %% constraint. - {[{ObjSet,Cname,asn1ct_gen:mk_var(asn1ct_name:curr(term))}], - PostpDec}; - _ -> {[],PostpDec} - end. - - -gen_dec_call({typefield,_},Erules,_,_,Type,_,Tag,_,_,false,_) -> - %% this in case of a choice with typefield components - asn1ct_name:new(reason), - {FirstPFName,RestPFName} = -% asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info), - (Type#type.def)#'ObjectClassFieldType'.fieldname, - emit([nl,indent(6),"begin",nl]), - emit([indent(9),"{OpenDec,TmpRest,TmpRbCho} =",nl,indent(12), - "?RT_BER:decode_open_type(",Erules,",",{curr,bytes},",", - {asis,Tag},"),",nl]), - emit([indent(9),"case (catch ObjFun(",{asis,FirstPFName}, - ", OpenDec, [], ",{asis,RestPFName}, - ")) of", nl]),%% ??? What about Tag - emit([indent(12),"{'EXIT',",{curr,reason},"} ->",nl]), -%% emit({indent(15),"throw({runtime_error,{'Type not ", -%% "compatible with tableconstraint', OpenDec}});",nl}), - emit([indent(15),"exit({'Type not ", - "compatible with table constraint', ",{curr,reason},"});",nl]), - emit([indent(12),"{TmpDec,_ ,_} ->",nl]), - emit([indent(15),"{TmpDec, TmpRest, TmpRbCho}",nl]), - emit([indent(9),"end",nl,indent(6),"end",nl]), - []; -gen_dec_call({typefield,_},_Erules,_,Cname,Type,_BytesVar,Tag,_,_, - _DecObjInf,OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",{curr,bytes},",",{asis,Tag},")"]), - RefedFieldName = - (Type#type.def)#'ObjectClassFieldType'.fieldname, -% asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info), - [{Cname,RefedFieldName, - asn1ct_gen:mk_var(asn1ct_name:curr(term)), -% asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),[],OptOrMandComp}]; - asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; -gen_dec_call({objectfield,PrimFieldName,PFNList},_Erules,_,Cname,_,_,Tag,_,_,_, - OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",{curr,bytes},",",{asis,Tag},")"]), - [{Cname,{PrimFieldName,PFNList}, - asn1ct_gen:mk_var(asn1ct_name:curr(term)), -% asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),[],OptOrMandComp}]; - asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; -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), - case DecObjInf of - {Cname,{_,OSet,UniqueFName,ValIndex}} -> - Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), - ValueMatch = value_match(ValIndex,Term), - emit({",",nl,"ObjFun = 'getdec_",OSet,"'(", -% {asis,UniqueFName},", ",{curr,term},")"}); - {asis,UniqueFName},", ",ValueMatch,")"}); - _ -> - ok - end, - []. -gen_dec_call1({primitive,bif},InnerType,Erules,_,_,Type,BytesVar, - Tag,OptOrMand,_) -> - case InnerType of - {fixedtypevaluefield,_,Btype} -> - asn1ct_gen_ber:gen_dec_prim(Erules,Btype,BytesVar,Tag,[],no_length, - ?PRIMITIVE,OptOrMand); - _ -> - asn1ct_gen_ber:gen_dec_prim(Erules,Type,BytesVar,Tag,[],no_length, - ?PRIMITIVE,OptOrMand) - end; -gen_dec_call1('ASN1_OPEN_TYPE',_InnerType,Erules,_,_,Type,BytesVar, - Tag,OptOrMand,_) -> - asn1ct_gen_ber:gen_dec_prim(Erules,Type#type{def='ASN1_OPEN_TYPE'}, - BytesVar,Tag,[],no_length, - ?PRIMITIVE,OptOrMand); -gen_dec_call1(WhatKind,_,_Erules,TopType,Cname,Type,_,Tag,_,OptOrMand) -> - {DecFunName,_,_} = - mkfuncname(TopType,Cname,WhatKind,dec), - case {WhatKind,Type#type.tablecinf} of - {{constructed,bif},[{objfun,_}|_R]} -> - emit({DecFunName,"(",{curr,bytes},OptOrMand,{asis,Tag},", ObjFun)"}); - _ -> - emit({DecFunName,"(",{curr,bytes},OptOrMand,{asis,Tag},")"}) - end. - - -%%------------------------------------------------------ -%% General and special help functions (not exported) -%%------------------------------------------------------ - - -indent(N) -> - lists:duplicate(N,32). % 32 = space - - -mkvlist([H,T1|T], Sep) -> % Sep is a string e.g ", " or "+ " - emit([{var,H},Sep]), - mkvlist([T1|T], Sep); -mkvlist([H|T], Sep) -> - emit([{var,H}]), - mkvlist(T, Sep); -mkvlist([], _) -> - true. - -mkvlist(L) -> - mkvlist(L,", "). - -mkvplus(L) -> - mkvlist(L," + "). - -extensible(CompList) when list(CompList) -> - noext; -extensible({RootList,ExtList}) -> - {ext,length(RootList)+1,length(ExtList)}. - - -print_attribute_comment(InnerType,Pos,Prop) -> - CommentLine = "%%-------------------------------------------------", - emit([nl,CommentLine]), - case InnerType of - {typereference,_,Name} -> - emit([nl,"%% attribute number ",Pos," with type ",Name]); - {'Externaltypereference',_,XModule,Name} -> - emit([nl,"%% attribute number ",Pos," External ",XModule,":",Name]); - _ -> - emit([nl,"%% attribute number ",Pos," with type ",InnerType]) - end, - case Prop of - mandatory -> - continue; - {'DEFAULT', Def} -> - emit([" DEFAULT = ",{asis,Def}]); - 'OPTIONAL' -> - emit([" OPTIONAL"]) - end, - emit([nl,CommentLine,nl]). - - -mkfuncname(TopType,Cname,WhatKind,DecOrEnc) -> - CurrMod = get(currmod), - case WhatKind of - #'Externaltypereference'{module=CurrMod,type=EType} -> - F = lists:concat(["'",DecOrEnc,"_",EType,"'"]), - {F, "?MODULE", F}; - #'Externaltypereference'{module=Mod,type=EType} -> - {lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"]),Mod, - lists:concat(["'",DecOrEnc,"_",EType,"'"])}; - {constructed,bif} -> - F = lists:concat(["'",DecOrEnc,"_",asn1ct_gen:list2name([Cname|TopType]),"'"]), - {F, "?MODULE", F} - end. - -mkfunname(TopType,Cname,WhatKind,DecOrEnc,Arity) -> - CurrMod = get(currmod), - case WhatKind of - #'Externaltypereference'{module=CurrMod,type=EType} -> - F = lists:concat(["fun '",DecOrEnc,"_",EType,"'/",Arity]), - {F, "?MODULE", F}; - #'Externaltypereference'{module=Mod,type=EType} -> - {lists:concat(["{'",Mod,"','",DecOrEnc,"_",EType,"'}"]),Mod, - lists:concat(["'",DecOrEnc,"_",EType,"'"])}; - {constructed,bif} -> - F = - lists:concat(["fun '",DecOrEnc,"_", - asn1ct_gen:list2name([Cname|TopType]),"'/", - Arity]), - {F, "?MODULE", F} - end. - -empty_lb(ber) -> - "[]"; -empty_lb(ber_bin) -> - "<<>>". - -rtmod(ber) -> - list_to_atom(?RT_BER); -rtmod(ber_bin) -> - list_to_atom(?RT_BER_BIN). - -indefend_match(ber,used_var) -> - "[0,0|R]"; -indefend_match(ber,unused_var) -> - "[0,0|_R]"; -indefend_match(ber_bin,used_var) -> - "<<0,0,R/binary>>"; -indefend_match(ber_bin,unused_var) -> - "<<0,0,_R/binary>>". - -notice_value_match() -> - Module = get(currmod), - put(value_match,{true,Module}). - -value_match(Index,Value) when atom(Value) -> - value_match(Index,atom_to_list(Value)); -value_match([],Value) -> - Value; -value_match([{VI,_Cname}|VIs],Value) -> - value_match1(Value,VIs,lists:concat(["element(",VI,","]),1). -value_match1(Value,[],Acc,Depth) -> - Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")")); -value_match1(Value,[{VI,_Cname}|VIs],Acc,Depth) -> - value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1). diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_constructed_ber_bin_v2.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_constructed_ber_bin_v2.erl deleted file mode 100644 index 0684ffa084..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_constructed_ber_bin_v2.erl +++ /dev/null @@ -1,1357 +0,0 @@ -%% ``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: asn1ct_constructed_ber_bin_v2.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ -%% --module(asn1ct_constructed_ber_bin_v2). - --export([gen_encode_sequence/3]). --export([gen_decode_sequence/3]). --export([gen_encode_set/3]). --export([gen_decode_set/3]). --export([gen_encode_sof/4]). --export([gen_decode_sof/4]). --export([gen_encode_choice/3]). --export([gen_decode_choice/3]). - - --include("asn1_records.hrl"). - --import(asn1ct_gen, [emit/1,demit/1]). --import(asn1ct_constructed_ber,[match_tag/2]). - --define(ASN1CT_GEN_BER,asn1ct_gen_ber_bin_v2). - -% the encoding of class of tag bits 8 and 7 --define(UNIVERSAL, 0). --define(APPLICATION, 16#40). --define(CONTEXT, 16#80). --define(PRIVATE, 16#C0). - -% primitive or constructed encoding % bit 6 --define(PRIMITIVE, 0). --define(CONSTRUCTED, 2#00100000). - - - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Encode/decode SEQUENCE (and SET) -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -gen_encode_sequence(Erules,Typename,D) when record(D,type) -> - asn1ct_name:start(), - asn1ct_name:new(term), - asn1ct_name:new(bytes), - - %% if EXTERNAL type the input value must be transformed to - %% ASN1 1990 format - ValName = - case Typename of - ['EXTERNAL'] -> - emit([indent(4), - "NewVal = asn1rt_check:transform_to_EXTERNAL1990(Val),", - nl]), - "NewVal"; - _ -> - "Val" - end, - - {SeqOrSet,TableConsInfo,CompList} = - case D#type.def of - #'SEQUENCE'{tablecinf=TCI,components=CL} -> - {'SEQUENCE',TCI,CL}; - #'SET'{tablecinf=TCI,components=CL} -> - {'SET',TCI,CL} - end, - Ext = extensible(CompList), - CompList1 = case CompList of - {Rl,El} -> Rl ++ El; - _ -> CompList - end, - -%% don't match recordname for now, because of compatibility reasons -%% emit(["{'",asn1ct_gen:list2rname(Typename),"'"]), - emit(["{_"]), - case length(CompList1) of - 0 -> - true; - CompListLen -> - emit([","]), - mkcindexlist([Tc || Tc <- lists:seq(1,CompListLen)]) - end, - emit(["} = ",ValName,",",nl]), - EncObj = - case TableConsInfo of - #simpletableattributes{usedclassfield=Used, - uniqueclassfield=Unique} when Used /= Unique -> - false; - %% ObjectSet, name of the object set in constraints - %% - #simpletableattributes{objectsetname=ObjectSet, - c_name=AttrN, - c_index=N, - usedclassfield=UniqueFieldName, - uniqueclassfield=UniqueFieldName, - valueindex=ValueIndex} -> %% N is index of attribute that determines constraint - OSDef = - case ObjectSet of - {Module,OSName} -> - asn1_db:dbget(Module,OSName); - OSName -> - asn1_db:dbget(get(currmod),OSName) - end, -% io:format("currmod: ~p~nOSName: ~p~nAttrN: ~p~nN: ~p~nUniqueFieldName: ~p~n", -% [get(currmod),OSName,AttrN,N,UniqueFieldName]), - case (OSDef#typedef.typespec)#'ObjectSet'.gen of - true -> - ObjectEncode = - asn1ct_gen:un_hyphen_var(lists:concat(['Obj', - AttrN])), - emit([ObjectEncode," = ",nl]), - emit([" 'getenc_",ObjectSet,"'(",{asis,UniqueFieldName}, - ", ",nl]), - ValueMatch = value_match(ValueIndex, - lists:concat(["Cindex",N])), - emit([indent(35),ValueMatch,"),",nl]), - {AttrN,ObjectEncode}; - _ -> - false - end; - _ -> - case D#type.tablecinf of - [{objfun,_}|_] -> - %% when the simpletableattributes was at an outer - %% level and the objfun has been passed through the - %% function call - {"got objfun through args","ObjFun"}; - _ -> - false - end - end, - - gen_enc_sequence_call(Erules,Typename,CompList1,1,Ext,EncObj), - - emit([nl," BytesSoFar = "]), - case SeqOrSet of - 'SET' when (D#type.def)#'SET'.sorted == dynamic -> - emit("?RT_BER:dynamicsort_SET_components(["), - mkvlist(asn1ct_name:all(encBytes)), - emit(["]),",nl]); - _ -> - emit("["), - mkvlist(asn1ct_name:all(encBytes)), - emit(["],",nl]) - end, - emit("LenSoFar = "), - case asn1ct_name:all(encLen) of - [] -> emit("0"); - AllLengths -> - mkvplus(AllLengths) - end, - emit([",",nl]), - emit(["?RT_BER:encode_tags(TagIn, BytesSoFar, LenSoFar)." - ,nl]). - -gen_decode_sequence(Erules,Typename,D) when record(D,type) -> - asn1ct_name:start(), - asn1ct_name:new(tag), - #'SEQUENCE'{tablecinf=TableConsInfo,components=CList} = D#type.def, - Ext = extensible(CList), - CompList = case CList of - {Rl,El} -> Rl ++ El; - _ -> CList - end, - - emit([" %%-------------------------------------------------",nl]), - emit([" %% decode tag and length ",nl]), - emit([" %%-------------------------------------------------",nl]), - - asn1ct_name:new(tlv), - case CompList of - EmptyCL when EmptyCL == [];EmptyCL == {[],[]}-> % empty sequence - true; - _ -> - emit([{curr,tlv}," = "]) - end, - emit(["?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), - asn1ct_name:new(tlv), - asn1ct_name:new(v), - - {DecObjInf,UniqueFName,ValueIndex} = - case TableConsInfo of - #simpletableattributes{objectsetname=ObjectSet, - c_name=AttrN, - usedclassfield=UniqueFieldName, - uniqueclassfield=UniqueFieldName, - valueindex=ValIndex} -> -% {ObjectSet,AttrN,_N,UniqueFieldName} ->%% N is index of attribute that determines constraint - F = fun(#'ComponentType'{typespec=CT})-> - case {CT#type.constraint,CT#type.tablecinf} of - {[],[{objfun,_}|_]} -> true; - _ -> false - end - end, - case lists:any(F,CompList) of - true -> % when component relation constraint establish - %% relation from a component to another components - %% subtype component - {{AttrN,{deep,ObjectSet,UniqueFieldName,ValIndex}}, - UniqueFieldName,ValIndex}; - false -> - {{AttrN,ObjectSet},UniqueFieldName,ValIndex} - end; - _ -> -% case D#type.tablecinf of -% [{objfun,_}|_] -> -% {{"got objfun through args","ObjFun"},false,false}; -% _ -> - {false,false,false} -% end - end, - case gen_dec_sequence_call(Erules,Typename,CompList,Ext,DecObjInf) of - no_terms -> % an empty sequence - emit([nl,nl]), - demit(["Result = "]), %dbg - %% return value as record - asn1ct_name:new(rb), - emit([" {'",asn1ct_gen:list2rname(Typename),"'}.",nl,nl]); - {LeadingAttrTerm,PostponedDecArgs} -> - emit([com,nl,nl]), - case {LeadingAttrTerm,PostponedDecArgs} of - {[],[]} -> - ok; - {_,[]} -> - ok; - {[{ObjSet,LeadingAttr,Term}],PostponedDecArgs} -> - DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])), - ValueMatch = value_match(ValueIndex,Term), - emit([DecObj," =",nl," 'getdec_",ObjSet,"'(", - {asis,UniqueFName},", ",ValueMatch,"),",nl]), - gen_dec_postponed_decs(DecObj,PostponedDecArgs) - end, - demit(["Result = "]), %dbg - %% return value as record - case Ext of - {ext,_,_} -> - emit(["case ",{prev,tlv}," of [] -> true; _ -> true end, % ... extra fields skipped",nl]); - noext -> - emit(["case ",{prev,tlv}," of",nl, - "[] -> true;", - "_ -> exit({error,{asn1, {unexpected,",{prev,tlv}, - "}}}) % extra fields not allowed",nl, - "end,",nl]) - end, - asn1ct_name:new(rb), - case Typename of - ['EXTERNAL'] -> - emit([" OldFormat={'",asn1ct_gen:list2rname(Typename), - "', "]), - mkvlist(asn1ct_name:all(term)), - emit(["},",nl]), - emit([" asn1rt_check:transform_to_EXTERNAL1994", - "(OldFormat).",nl]); - _ -> - emit([" {'",asn1ct_gen:list2rname(Typename),"', "]), - mkvlist(asn1ct_name:all(term)), - emit(["}.",nl,nl]) - end - end. - -gen_dec_postponed_decs(_,[]) -> - emit(nl); -gen_dec_postponed_decs(DecObj,[{_Cname,{FirstPFN,PFNList},Term, - TmpTerm,_Tag,OptOrMand}|Rest]) -> - - asn1ct_name:new(tmpterm), - asn1ct_name:new(reason), - asn1ct_name:new(tmptlv), - - emit([Term," = ",nl]), - N = case OptOrMand of - mandatory -> 0; - 'OPTIONAL' -> - emit_opt_or_mand_check(asn1_NOVALUE,TmpTerm), - 6; - {'DEFAULT',Val} -> - emit_opt_or_mand_check(Val,TmpTerm), - 6 - end, - emit([indent(N+3),"case (catch ",DecObj,"(",{asis,FirstPFN}, - ", ",TmpTerm,", ",{asis,PFNList},")) of",nl]), - emit([indent(N+6),"{'EXIT', ",{curr,reason},"} ->",nl]), - emit([indent(N+9),"exit({'Type not compatible with table constraint',", - {curr,reason},"});",nl]), - emit([indent(N+6),{curr,tmpterm}," ->",nl]), - emit([indent(N+9),{curr,tmpterm},nl]), - - case OptOrMand of - mandatory -> emit([indent(N+3),"end,",nl]); - _ -> - emit([indent(N+3),"end",nl, - indent(3),"end,",nl]) - end, - gen_dec_postponed_decs(DecObj,Rest). - -emit_opt_or_mand_check(Value,TmpTerm) -> - emit([indent(3),"case ",TmpTerm," of",nl, - indent(6),{asis,Value}," ->",{asis,Value},";",nl, - indent(6),"_ ->",nl]). - -%%============================================================================ -%% Encode/decode SET -%% -%%============================================================================ - -gen_encode_set(Erules,Typename,D) when record(D,type) -> - gen_encode_sequence(Erules,Typename,D). - -gen_decode_set(Erules,Typename,D) when record(D,type) -> - asn1ct_name:start(), - asn1ct_name:new(term), - asn1ct_name:new(tag), - #'SET'{tablecinf=TableConsInfo,components=TCompList} = D#type.def, - Ext = extensible(TCompList), - CompList = case TCompList of - {Rl,El} -> Rl ++ El; - _ -> TCompList - end, - - asn1ct_name:clear(), - asn1ct_name:new(tlv), - case CompList of - EmptyCL when EmptyCL == [];EmptyCL == {[],[]}-> % empty sequence - true; - _ -> - emit([{curr,tlv}," = "]) - end, - emit(["?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), - asn1ct_name:new(v), - - - {DecObjInf,UniqueFName} = - case TableConsInfo of - {ObjectSet,AttrN,_N,UniqueFieldName} ->%% N is index of attribute that determines constraint - F = fun(#'ComponentType'{typespec=CT})-> - case {CT#type.constraint,CT#type.tablecinf} of - {[],[{objfun,_}|_]} -> true; - _ -> false - end - end, - case lists:any(F,CompList) of - true -> % when component relation constraint establish - %% relation from a component to another components - %% subtype component - {{AttrN,{deep,ObjectSet,UniqueFieldName}}, - UniqueFieldName}; - false -> - {{AttrN,ObjectSet},UniqueFieldName} - end; - _ -> - {false,false} - end, - - case CompList of - [] -> % empty set - true; - _ -> - emit(["SetFun = fun(FunTlv) ->", nl]), - emit(["case FunTlv of ",nl]), - NextNum = gen_dec_set_cases(Erules,Typename,CompList,1), - emit([indent(6), {curr,else}," -> ",nl, - indent(9),"{",NextNum,", ",{curr,else},"}",nl]), - emit([indent(3),"end",nl]), - emit([indent(3),"end,",nl]), - - emit(["PositionList = [SetFun(TempTlv)|| TempTlv <- ",{curr,tlv},"],",nl]), - asn1ct_name:new(tlv), - emit([{curr,tlv}," = [Stlv || {_,Stlv} <- lists:sort(PositionList)],",nl]), - asn1ct_name:new(tlv) - - end, - case gen_dec_sequence_call(Erules,Typename,CompList,Ext,DecObjInf) of - no_terms -> % an empty sequence - emit([nl,nl]), - demit(["Result = "]), %dbg - %% return value as record - emit([" {'",asn1ct_gen:list2rname(Typename),"'}.",nl]); - {LeadingAttrTerm,PostponedDecArgs} -> - emit([com,nl,nl]), - case {LeadingAttrTerm,PostponedDecArgs} of - {[],[]} -> - ok; - {_,[]} -> - ok; - {[{ObjSet,LeadingAttr,Term}],PostponedDecArgs} -> - DecObj = lists:concat(['DecObj',LeadingAttr,Term]), - emit([DecObj," =",nl," 'getdec_",ObjSet,"'(", - {asis,UniqueFName},", ",Term,"),",nl]), - gen_dec_postponed_decs(DecObj,PostponedDecArgs) - end, - demit(["Result = "]), %dbg - %% return value as record - case Ext of - {ext,_,_} -> - emit(["case ",{prev,tlv}," of [] -> true; _ -> true end, % ... extra fields skipped",nl]); - noext -> - emit(["case ",{prev,tlv}," of",nl, - "[] -> true;", - "_ -> exit({error,{asn1, {unexpected,",{prev,tlv}, - "}}}) % extra fields not allowed",nl, - "end,",nl]) - end, - emit([" {'",asn1ct_gen:list2rname(Typename),"', "]), - mkvlist(asn1ct_name:all(term)), - emit(["}.",nl]) - end. - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Encode/decode SEQUENCE OF and SET OF -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -gen_encode_sof(Erules,Typename,_InnerTypename,D) when record(D,type) -> - asn1ct_name:start(), - {SeqOrSetOf, Cont} = D#type.def, - - Objfun = case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - "" - end, - - emit([" {EncBytes,EncLen} = 'enc_",asn1ct_gen:list2name(Typename), - "_components'(Val",Objfun,",[],0),",nl]), - - emit([" ?RT_BER:encode_tags(TagIn, EncBytes, EncLen).",nl,nl]), - - gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont). - - -gen_decode_sof(Erules,TypeName,_InnerTypeName,D) when record(D,type) -> - asn1ct_name:start(), - {SeqOrSetOf, _TypeTag, Cont} = - case D#type.def of - {'SET OF',_Cont} -> {'SET OF','SET',_Cont}; - {'SEQUENCE OF',_Cont} -> {'SEQUENCE OF','SEQUENCE',_Cont} - end, - TypeNameSuffix = asn1ct_gen:constructed_suffix(SeqOrSetOf,Cont#type.def), - - emit([" %%-------------------------------------------------",nl]), - emit([" %% decode tag and length ",nl]), - emit([" %%-------------------------------------------------",nl]), - - asn1ct_name:new(tlv), - emit([{curr,tlv}, - " = ?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), - asn1ct_name:new(v), - - emit(["["]), - - InnerType = asn1ct_gen:get_inner(Cont#type.def), - ContName = case asn1ct_gen:type(InnerType) of - Atom when atom(Atom) -> Atom; - _ -> TypeNameSuffix - end, -%% fix me - ObjFun = - case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - [] - end, - gen_dec_line(Erules,TypeName,ContName,[],Cont,mandatory,ObjFun), - %% gen_dec_line_sof(Erules,Typename,ContName,Cont,ObjFun), - emit([" || ",{curr,v}," <- ",{curr,tlv},"].",nl,nl,nl]). - - -gen_encode_sof_components(Erules,Typename,SeqOrSetOf,Cont) - when record(Cont,type)-> - - {Objfun,Objfun_novar,EncObj} = - case Cont#type.tablecinf of - [{objfun,_}|_R] -> - {", ObjFun",", _",{no_attr,"ObjFun"}}; - _ -> - {"","",false} - end, - emit(["'enc_",asn1ct_gen:list2name(Typename), - "_components'([]",Objfun_novar,", AccBytes, AccLen) -> ",nl]), - - case catch lists:member(der,get(encoding_options)) of - true -> - emit([indent(3), - "{?RT_BER:dynamicsort_SETOF(AccBytes),AccLen};",nl,nl]); - _ -> - emit([indent(3),"{lists:reverse(AccBytes),AccLen};",nl,nl]) - end, - emit(["'enc_",asn1ct_gen:list2name(Typename), - "_components'([H|T]",Objfun,",AccBytes, AccLen) ->",nl]), - TypeNameSuffix = asn1ct_gen:constructed_suffix(SeqOrSetOf,Cont#type.def), - gen_enc_line(Erules,Typename,TypeNameSuffix,Cont,"H",3, - mandatory,"{EncBytes,EncLen} = ",EncObj), - emit([",",nl]), - emit([indent(3),"'enc_",asn1ct_gen:list2name(Typename), - "_components'(T",Objfun,","]), - emit(["[EncBytes|AccBytes], AccLen + EncLen).",nl,nl]). - -%%============================================================================ -%% Encode/decode CHOICE -%% -%%============================================================================ - -gen_encode_choice(Erules,Typename,D) when record(D,type) -> - ChoiceTag = D#type.tag, - {'CHOICE',CompList} = D#type.def, - Ext = extensible(CompList), - CompList1 = case CompList of - {Rl,El} -> Rl ++ El; - _ -> CompList - end, - gen_enc_choice(Erules,Typename,ChoiceTag,CompList1,Ext), - emit([nl,nl]). - -gen_decode_choice(Erules,Typename,D) when record(D,type) -> - asn1ct_name:start(), - asn1ct_name:new(bytes), - ChoiceTag = D#type.tag, - {'CHOICE',CompList} = D#type.def, - Ext = extensible(CompList), - CompList1 = case CompList of - {Rl,El} -> Rl ++ El; - _ -> CompList - end, - gen_dec_choice(Erules,Typename,ChoiceTag,CompList1,Ext), - emit([".",nl]). - - -%%============================================================================ -%% Encode SEQUENCE -%% -%%============================================================================ - -gen_enc_sequence_call(Erules,TopType,[#'ComponentType'{name=Cname,typespec=Type,prop=Prop}|Rest],Pos,Ext,EncObj) -> - asn1ct_name:new(encBytes), - asn1ct_name:new(encLen), - Element = - case TopType of - ['EXTERNAL'] -> - io_lib:format("Cindex~w",[Pos]); - _ -> - io_lib:format("Cindex~w",[Pos]) - end, - InnerType = asn1ct_gen:get_inner(Type#type.def), - print_attribute_comment(InnerType,Pos,Cname,Prop), - gen_enc_line(Erules,TopType,Cname,Type,Element,3,Prop,EncObj), - emit([com,nl]), - gen_enc_sequence_call(Erules,TopType,Rest,Pos+1,Ext,EncObj); - -gen_enc_sequence_call(_Erules,_TopType,[],_Num,_,_) -> - true. - -%%============================================================================ -%% Decode SEQUENCE -%% -%%============================================================================ - -gen_dec_sequence_call(Erules,TopType,CompList,Ext,DecObjInf) -> - gen_dec_sequence_call1(Erules,TopType, CompList, 1, Ext,DecObjInf,[],[]). - - -gen_dec_sequence_call1(Erules,TopType,[#'ComponentType'{name=Cname,typespec=Type,prop=Prop,tags=Tags}|Rest],Num,Ext,DecObjInf,LeadingAttrAcc,ArgsAcc) -> - {LA,PostponedDec} = - gen_dec_component(Erules,TopType,Cname,Tags,Type,Num,Prop, - Ext,DecObjInf), - case Rest of - [] -> - {LA ++ LeadingAttrAcc,PostponedDec ++ ArgsAcc}; - _ -> - emit([com,nl]), - asn1ct_name:new(bytes), - gen_dec_sequence_call1(Erules,TopType,Rest,Num+1,Ext,DecObjInf, - LA++LeadingAttrAcc,PostponedDec++ArgsAcc) - end; - -gen_dec_sequence_call1(_Erules,_TopType,[],1,_,_,_,_) -> - no_terms. - - -%%---------------------------- -%%SEQUENCE mandatory -%%---------------------------- - -gen_dec_component(Erules,TopType,Cname,CTags,Type,Pos,Prop,Ext,DecObjInf) -> - InnerType = - case Type#type.def of - #'ObjectClassFieldType'{type=OCFTType} -> OCFTType; - _ -> asn1ct_gen:get_inner(Type#type.def) - end, -% case asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info) of -% no -> -% asn1ct_gen:get_inner(Type#type.def); -% _ -> -% Type#type.def -% end, - Prop1 = case {Prop,Ext} of - {mandatory,{ext,Epos,_}} when Pos >= Epos -> - 'OPTIONAL'; - _ -> - Prop - end, - print_attribute_comment(InnerType,Pos,Cname,Prop1), - asn1ct_name:new(term), - emit_term_tlv(Prop1,InnerType,DecObjInf), - asn1ct_name:new(rb), - PostponedDec = - gen_dec_line(Erules,TopType,Cname,CTags,Type,Prop1,DecObjInf), - asn1ct_name:new(v), - asn1ct_name:new(tlv), - asn1ct_name:new(form), - PostponedDec. - - -emit_term_tlv({'DEFAULT',_},InnerType,DecObjInf) -> - emit_term_tlv(opt_or_def,InnerType,DecObjInf); -emit_term_tlv('OPTIONAL',InnerType,DecObjInf) -> - emit_term_tlv(opt_or_def,InnerType,DecObjInf); -emit_term_tlv(Prop,{typefield,_},DecObjInf) -> - emit_term_tlv(Prop,type_or_object_field,DecObjInf); -emit_term_tlv(Prop,{objectfield,_,_},DecObjInf) -> - emit_term_tlv(Prop,type_or_object_field,DecObjInf); -emit_term_tlv(opt_or_def,type_or_object_field,_) -> - asn1ct_name:new(tmpterm), - emit(["{",{curr,tmpterm},",",{curr,tlv},"} = "]); -emit_term_tlv(opt_or_def,_,_) -> - emit(["{",{curr,term},",",{curr,tlv},"} = "]); -emit_term_tlv(_,type_or_object_field,false) -> - emit(["[",{curr,v},"|",{curr,tlv},"] = ",{prev,tlv},", ",nl, - {curr,term}," = "]); -emit_term_tlv(_,type_or_object_field,_) -> - asn1ct_name:new(tmpterm), - emit(["[",{curr,v},"|",{curr,tlv},"] = ",{prev,tlv},", ",nl]), - emit([nl," ",{curr,tmpterm}," = "]); -emit_term_tlv(mandatory,_,_) -> - emit(["[",{curr,v},"|",{curr,tlv},"] = ",{prev,tlv},", ",nl, - {curr,term}," = "]). - - -gen_dec_set_cases(_Erules,_TopType,[],Pos) -> - Pos; -gen_dec_set_cases(Erules,TopType,[Comp|RestComps],Pos) -> - Name = Comp#'ComponentType'.name, - Type = Comp#'ComponentType'.typespec, - CTags = Comp#'ComponentType'.tags, - - emit([indent(6),"%",Name,nl]), - Tags = case Type#type.tag of - [] -> % this is a choice without explicit tag - [(?ASN1CT_GEN_BER:decode_class(T1class) bsl 10) + T1number|| - {T1class,T1number} <- CTags]; - [FirstTag|_] -> - [(?ASN1CT_GEN_BER:decode_class(FirstTag#tag.class) bsl 10) + FirstTag#tag.number] - end, -% emit([indent(6),"%Tags: ",Tags,nl]), -% emit([indent(6),"%Type#type.tag: ",Type#type.tag,nl]), - CaseFun = fun(TagList=[H|T],Fun,N) -> - Semicolon = case TagList of - [_Tag1,_|_] -> [";",nl]; - _ -> "" - end, - emit(["TTlv = {",H,",_} ->",nl]), - emit([indent(4),"{",Pos,", TTlv}",Semicolon]), - Fun(T,Fun,N+1); - ([],_,0) -> - true; - ([],_,_) -> - emit([";",nl]) - end, - CaseFun(Tags,CaseFun,0), -%% emit([";",nl]), - gen_dec_set_cases(Erules,TopType,RestComps,Pos+1). - - - -%%--------------------------------------------- -%% Encode CHOICE -%%--------------------------------------------- -%% for BER we currently do care (a little) if the choice has an EXTENSIONMARKER - - -gen_enc_choice(Erules,TopType,Tag,CompList,_Ext) -> - gen_enc_choice1(Erules,TopType,Tag,CompList,_Ext). - -gen_enc_choice1(Erules,TopType,_Tag,CompList,_Ext) -> - asn1ct_name:clear(), - emit([" {EncBytes,EncLen} = case element(1,Val) of",nl]), - gen_enc_choice2(Erules,TopType,CompList), - emit([nl," end,",nl,nl]), - - emit(["?RT_BER:encode_tags(TagIn, EncBytes, EncLen).",nl]). - - -gen_enc_choice2(Erules,TopType,[H1|T]) when record(H1,'ComponentType') -> - Cname = H1#'ComponentType'.name, - Type = H1#'ComponentType'.typespec, - emit([" ",{asis,Cname}," ->",nl]), - {Encobj,Assign} = - case {Type#type.def,asn1ct_gen:get_constraint(Type#type.constraint, - componentrelation)} of - {#'ObjectClassFieldType'{},{componentrelation,_,_}} -> - asn1ct_name:new(tmpBytes), - asn1ct_name:new(encBytes), - asn1ct_name:new(encLen), - Emit = ["{",{curr,tmpBytes},", _} = "], - {{no_attr,"ObjFun"},Emit}; - _ -> - {false,[]} - end, -% case asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info) of -% no -> -% {false,[]}; -% _ -> -% asn1ct_name:new(tmpBytes), -% asn1ct_name:new(encBytes), -% asn1ct_name:new(encLen), -% Emit = ["{",{curr,tmpBytes},", _} = "], -% {{no_attr,"ObjFun"},Emit} -% end, - gen_enc_line(Erules,TopType,Cname,Type,"element(2,Val)",9, - mandatory,Assign,Encobj), - case Encobj of - false -> ok; - _ -> - emit([",",nl,indent(9),"{",{curr,encBytes},", ", - {curr,encLen},"}"]) - end, - emit([";",nl]), - case T of - [] -> - emit([indent(6), "Else -> ",nl, - indent(9),"exit({error,{asn1,{invalid_choice_type,Else}}})"]); - _ -> - true - end, - gen_enc_choice2(Erules,TopType,T); - -gen_enc_choice2(_Erules,_TopType,[]) -> - true. - - - - -%%-------------------------------------------- -%% Decode CHOICE -%%-------------------------------------------- - -gen_dec_choice(Erules,TopType, _ChTag, CompList, Ext) -> - asn1ct_name:clear(), - asn1ct_name:new(tlv), - emit([{curr,tlv}, - " = ?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), - asn1ct_name:new(tlv), - asn1ct_name:new(v), - emit(["case (case ",{prev,tlv}, - " of [Ctemp",{prev,tlv},"] -> Ctemp",{prev,tlv}, - "; _ -> ",{prev,tlv}," end)"," of",nl]), - asn1ct_name:new(tagList), - asn1ct_name:new(choTags), - asn1ct_name:new(res), - gen_dec_choice_cases(Erules,TopType,CompList), - emit([indent(6), {curr,else}," -> ",nl]), - case Ext of - noext -> - emit([indent(9),"exit({error,{asn1,{invalid_choice_tag,", - {curr,else},"}}})",nl]); - _ -> - emit([indent(9),"{asn1_ExtAlt, ?RT_BER:encode(",{curr,else},")}",nl]) - end, - emit([indent(3),"end",nl]), - asn1ct_name:new(tag), - asn1ct_name:new(else). - - -gen_dec_choice_cases(_Erules,_TopType, []) -> - ok; -gen_dec_choice_cases(Erules,TopType, [H|T]) -> - Cname = H#'ComponentType'.name, - Type = H#'ComponentType'.typespec, - Prop = H#'ComponentType'.prop, - Tags = Type#type.tag, - Fcases = fun([{T1class,T1number}|Tail],Fun) -> - emit([indent(4),{curr,v}," = {", - (?ASN1CT_GEN_BER:decode_class(T1class) bsl 10) + - T1number,",_} -> ",nl]), - emit([indent(8),"{",{asis,Cname},", "]), - gen_dec_line(Erules,TopType,Cname,[],Type,Prop,false), - emit(["};",nl,nl]), - Fun(Tail,Fun); - ([],_) -> - ok - end, - emit([nl,"%% '",Cname,"'",nl]), - case {Tags,asn1ct:get_gen_state_field(namelist)} of - {[],_} -> % choice without explicit tags - Fcases(H#'ComponentType'.tags,Fcases); - {[FirstT|_RestT],[{Cname,undecoded}|Names]} -> - DecTag=(?ASN1CT_GEN_BER:decode_class(FirstT#tag.class) bsl 10) + - FirstT#tag.number, - asn1ct:add_generated_refed_func({[Cname|TopType],undecoded, - [DecTag],Type}), - asn1ct:update_gen_state(namelist,Names), - emit([indent(4),{curr,res}," = ", - match_tag(ber_bin,{FirstT#tag.class,FirstT#tag.number}), - " -> ",nl]), - emit([indent(8),"{",{asis,Cname},", {'", - asn1ct_gen:list2name([Cname|TopType]),"',", - {curr,res},"}};",nl,nl]); - {[FirstT|RestT],_} -> - emit([indent(4),"{", - (?ASN1CT_GEN_BER:decode_class(FirstT#tag.class) bsl 10) + - FirstT#tag.number,", ",{curr,v},"} -> ",nl]), - emit([indent(8),"{",{asis,Cname},", "]), - gen_dec_line(Erules,TopType,Cname,[],Type#type{tag=RestT},Prop,false), - emit(["};",nl,nl]) - end, - gen_dec_choice_cases(Erules,TopType, T). - - - -%%--------------------------------------- -%% Generate the encode/decode code -%%--------------------------------------- - -gen_enc_line(Erules,TopType,Cname, - Type=#type{constraint=[{componentrelation,_,_}], - def=#'ObjectClassFieldType'{type={typefield,_}}}, - Element,Indent,OptOrMand=mandatory,EncObj) - when list(Element) -> - asn1ct_name:new(tmpBytes), - gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand, - ["{",{curr,tmpBytes},",_} = "],EncObj); -gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,EncObj) - when list(Element) -> - gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand, - ["{",{curr,encBytes},",",{curr,encLen},"} = "],EncObj). - -gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj) - when list(Element) -> - IndDeep = indent(Indent), - Tag = lists:reverse([?ASN1CT_GEN_BER:encode_tag_val( - ?ASN1CT_GEN_BER:decode_class(X#tag.class), - X#tag.form, - X#tag.number) - || X <- Type#type.tag]), - InnerType = asn1ct_gen:get_inner(Type#type.def), - WhatKind = asn1ct_gen:type(InnerType), - emit(IndDeep), - emit(Assign), - gen_optormand_case(OptOrMand,Erules,TopType,Cname,Type,InnerType,WhatKind, - Element), - case {Type,asn1ct_gen:get_constraint(Type#type.constraint, - componentrelation)} of -% #type{constraint=[{tableconstraint_info,RefedFieldName}], -% def={typefield,_}} -> - {#type{def=#'ObjectClassFieldType'{type={typefield,_}, - fieldname=RefedFieldName}}, - {componentrelation,_,_}} -> - {_LeadingAttrName,Fun} = EncObj, - case RefedFieldName of - {notype,T} -> - throw({error,{notype,type_from_object,T}}); - {Name,RestFieldNames} when atom(Name) -> - case OptOrMand of - mandatory -> ok; - _ -> -% emit(["{",{curr,tmpBytes},",",{curr,tmpLen}, - emit(["{",{curr,tmpBytes},",_ } = "]) -% "} = "]) - end, - emit([Fun,"(",{asis,Name},", ",Element,", ", - {asis,RestFieldNames},"),",nl]), - emit(IndDeep), - case OptOrMand of - mandatory -> - emit(["{",{curr,encBytes},",",{curr,encLen}, - "} = "]), - emit(["?RT_BER:encode_open_type(",{curr,tmpBytes}, - ",",{asis,Tag},")"]); - _ -> -% emit(["{",{next,tmpBytes},", _} = "]), - emit(["{",{next,tmpBytes},",",{curr,tmpLen}, - "} = "]), - emit(["?RT_BER:encode_open_type(",{curr,tmpBytes}, - ",",{asis,Tag},"),",nl]), - emit(IndDeep), - emit(["{",{next,tmpBytes},", ",{curr,tmpLen},"}"]) - end; - _ -> - throw({asn1,{'internal error'}}) - end; - {{#'ObjectClassFieldType'{type={objectfield,PrimFieldName1, - PFNList}},_}, - {componentrelation,_,_}} -> - %% this is when the dotted list in the FieldName has more - %% than one element - {_LeadingAttrName,Fun} = EncObj, - emit(["?RT_BER:encode_open_type(",Fun,"(",{asis,PrimFieldName1}, - ", ",Element,", ",{asis,PFNList},"))"]); - _ -> - case WhatKind of - {primitive,bif} -> - EncType = - case Type#type.def of - #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Btype}} -> - Btype; - _ -> - Type - end, - ?ASN1CT_GEN_BER:gen_encode_prim(ber,EncType,{asis,Tag}, - Element); - {notype,_} -> - emit(["'enc_",InnerType,"'(",Element,", ",{asis,Tag},")"]); - 'ASN1_OPEN_TYPE' -> - case Type#type.def of - #'ObjectClassFieldType'{} -> %Open Type - ?ASN1CT_GEN_BER:gen_encode_prim(ber,#type{def='ASN1_OPEN_TYPE'},{asis,Tag},Element); - _ -> - ?ASN1CT_GEN_BER:gen_encode_prim(ber,Type, - {asis,Tag}, - Element) - end; - _ -> - {EncFunName, _EncMod, _EncFun} = - mkfuncname(TopType,Cname,WhatKind,"enc_"), - case {WhatKind,Type#type.tablecinf,EncObj} of - {{constructed,bif},[{objfun,_}|_R],{_,Fun}} -> - emit([EncFunName,"(",Element,", ",{asis,Tag}, - ", ",Fun,")"]); - _ -> - emit([EncFunName,"(",Element,", ",{asis,Tag},")"]) - end - end - end, - case OptOrMand of - mandatory -> true; - _ -> - emit([nl,indent(7),"end"]) - end. - -gen_optormand_case(mandatory,_Erules,_TopType,_Cname,_Type,_InnerType,_WhatKind, - _Element) -> - ok; -gen_optormand_case('OPTIONAL',Erules,_TopType,_Cname,_Type,_InnerType,_WhatKind, - 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) -> - 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]); - _ -> - emit([" case ",Element," of",nl]), - emit([indent(9),"asn1_DEFAULT -> {", - empty_lb(Erules), - ",0};",nl]), - case DefaultValue of - #'Externalvaluereference'{module=CurrMod, - value=V} -> - emit([indent(9),"?",{asis,V}," -> {", - empty_lb(Erules),",0};",nl]); - _ -> - emit([indent(9),{asis, - DefaultValue}," -> {", - empty_lb(Erules),",0};",nl]) - end - end, - emit([indent(9),"_ ->",nl,indent(12)]). - - - -gen_dec_line(Erules,TopType,Cname,CTags,Type,OptOrMand,DecObjInf) -> - BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(v)), - Tag = - [(?ASN1CT_GEN_BER:decode_class(X#tag.class) bsl 10) + X#tag.number || - X <- Type#type.tag], - ChoiceTags = - [(?ASN1CT_GEN_BER:decode_class(Class) bsl 10) + Number|| - {Class,Number} <- CTags], - InnerType = - case Type#type.def of - #'ObjectClassFieldType'{type=OCFTType} -> - OCFTType; - _ -> - asn1ct_gen:get_inner(Type#type.def) - end, - PostpDec = - case OptOrMand of - mandatory -> - gen_dec_call(InnerType,Erules,TopType,Cname,Type, - BytesVar,Tag, - mandatory,", mandatory, ",DecObjInf,OptOrMand); - _ -> %optional or default or a mandatory component after an extensionmark - {FirstTag,RestTag} = - case Tag of - [] -> - {ChoiceTags,[]}; - [Ft|Rt] -> - {Ft,Rt} - end, - emit(["case ",{prev,tlv}," of",nl]), - PostponedDec = - case Tag of - [] when length(ChoiceTags) > 0 -> % a choice without explicit tag - Fcases = - fun(FirstTag1) -> - emit(["[",{curr,v}," = {",{asis,FirstTag1}, - ",_}|Temp", - {curr,tlv}, - "] ->",nl]), - emit([indent(4),"{"]), - Pdec= - gen_dec_call(InnerType,Erules, - TopType,Cname,Type, - BytesVar,RestTag, - mandatory, - ", mandatory, ", - DecObjInf,OptOrMand), - - emit([", Temp",{curr,tlv},"}"]), - emit([";",nl]), - Pdec - end, - hd([Fcases(TmpTag)|| TmpTag <- FirstTag]); - - [] -> % an open type without explicit tag - emit(["[",{curr,v},"|Temp",{curr,tlv},"] ->",nl]), - emit([indent(4),"{"]), - Pdec= - gen_dec_call(InnerType,Erules,TopType,Cname, - Type,BytesVar,RestTag,mandatory, - ", mandatory, ",DecObjInf, - OptOrMand), - - emit([", Temp",{curr,tlv},"}"]), - emit([";",nl]), - Pdec; - - _ -> - emit(["[{",{asis,FirstTag}, - ",",{curr,v},"}|Temp", - {curr,tlv}, - "] ->",nl]), - emit([indent(4),"{"]), - Pdec= - gen_dec_call(InnerType,Erules,TopType,Cname, - Type,BytesVar,RestTag,mandatory, - ", mandatory, ",DecObjInf, - OptOrMand), - - emit([", Temp",{curr,tlv},"}"]), - emit([";",nl]), - Pdec - end, - - emit([indent(4),"_ ->",nl]), - case OptOrMand of - {'DEFAULT', Def} -> - emit([indent(8),"{",{asis,Def},",",{prev,tlv},"}",nl]); - 'OPTIONAL' -> - emit([indent(8),"{ asn1_NOVALUE, ",{prev,tlv},"}",nl]) - end, - emit(["end"]), - PostponedDec - end, - case DecObjInf of - {Cname,ObjSet} -> % this must be the component were an object is - %% choosen from the object set according to the table - %% constraint. - {[{ObjSet,Cname,asn1ct_gen:mk_var(asn1ct_name:curr(term))}], - PostpDec}; - _ -> {[],PostpDec} - end. - -gen_dec_call({typefield,_},_,_,_Cname,Type,BytesVar,Tag,_,_,false,_) -> - %% this in case of a choice with typefield components - asn1ct_name:new(reason), - asn1ct_name:new(opendec), - asn1ct_name:new(tmpterm), - asn1ct_name:new(tmptlv), - - {FirstPFName,RestPFName} = -% asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info), - (Type#type.def)#'ObjectClassFieldType'.fieldname, - emit([nl,indent(6),"begin",nl]), -% emit([indent(9),{curr,opendec}," = ?RT_BER:decode_open_type(", - emit([indent(9),{curr,tmptlv}," = ?RT_BER:decode_open_type(", - BytesVar,",",{asis,Tag},"),",nl]), -% emit([indent(9),"{",{curr,tmptlv},",_} = ?RT_BER:decode(", -% {curr,opendec},"),",nl]), - - emit([indent(9),"case (catch ObjFun(",{asis,FirstPFName}, - ", ",{curr,tmptlv},", ",{asis,RestPFName}, - ")) of", nl]),%% ??? What about Tag - emit([indent(12),"{'EXIT',",{curr,reason},"} ->",nl]), - emit([indent(15),"exit({'Type not ", - "compatible with table constraint', ",{curr,reason},"});",nl]), - emit([indent(12),{curr,tmpterm}," ->",nl]), - emit([indent(15),{curr,tmpterm},nl]), - emit([indent(9),"end",nl,indent(6),"end",nl]), - []; -gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag},")"]), - RefedFieldName = -% asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info), - (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({objectfield,PrimFieldName,PFNList},_,_,Cname,_,BytesVar,Tag,_,_,_,OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag},")"]), - [{Cname,{PrimFieldName,PFNList},asn1ct_gen:mk_var(asn1ct_name:curr(term)), - asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; -gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand, - OptOrMand,DecObjInf,_) -> - WhatKind = asn1ct_gen:type(InnerType), - gen_dec_call1(WhatKind,InnerType,Erules,TopType,Cname,Type,BytesVar,Tag, - PrimOptOrMand,OptOrMand), - case DecObjInf of - {Cname,{_,OSet,UniqueFName,ValIndex}} -> - Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), - ValueMatch = value_match(ValIndex,Term), - emit([",",nl,"ObjFun = 'getdec_",OSet,"'(", -% {asis,UniqueFName},", ",{curr,term},")"]); - {asis,UniqueFName},", ",ValueMatch,")"]); - _ -> - ok - end, - []. -gen_dec_call1({primitive,bif},InnerType,Erules,TopType,Cname,Type,BytesVar, - Tag,OptOrMand,_) -> - case {asn1ct:get_gen_state_field(namelist),InnerType} of - {[{Cname,undecoded}|Rest],_} -> - asn1ct:add_generated_refed_func({[Cname|TopType],undecoded, - Tag,Type}), - asn1ct:update_gen_state(namelist,Rest), -% emit(["?RT_BER:match_tags(",BytesVar,",",{asis,Tag},")"]); - emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',", - BytesVar,"}"]); - {_,{fixedtypevaluefield,_,Btype}} -> - ?ASN1CT_GEN_BER:gen_dec_prim(Erules,Btype,BytesVar,Tag,[], - ?PRIMITIVE,OptOrMand); - _ -> - ?ASN1CT_GEN_BER:gen_dec_prim(Erules,Type,BytesVar,Tag,[], - ?PRIMITIVE,OptOrMand) - end; -gen_dec_call1('ASN1_OPEN_TYPE',_InnerType,Erules,TopType,Cname,Type,BytesVar, - Tag,OptOrMand,_) -> - case {asn1ct:get_gen_state_field(namelist),Type#type.def} of - {[{Cname,undecoded}|Rest],_} -> - asn1ct:add_generated_refed_func({[Cname|TopType],undecoded, - Tag,Type}), - asn1ct:update_gen_state(namelist,Rest), - emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',", - BytesVar,"}"]); -% emit(["?RT_BER:match_tags(",BytesVar,",",{asis,Tag},")"]); - {_,#'ObjectClassFieldType'{type=OpenType}} -> - ?ASN1CT_GEN_BER:gen_dec_prim(Erules,#type{def=OpenType}, - BytesVar,Tag,[], - ?PRIMITIVE,OptOrMand); - _ -> - ?ASN1CT_GEN_BER:gen_dec_prim(Erules,Type,BytesVar,Tag,[], - ?PRIMITIVE,OptOrMand) - end; -gen_dec_call1(WhatKind,_,_Erules,TopType,Cname,Type,BytesVar, - Tag,_,_OptOrMand) -> - case asn1ct:get_gen_state_field(namelist) of - [{Cname,undecoded}|Rest] -> - asn1ct:add_generated_refed_func({[Cname|TopType],undecoded, - Tag,Type}), - asn1ct:update_gen_state(namelist,Rest), - emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',", - BytesVar,"}"]); - _ -> -% {DecFunName, _DecMod, _DecFun} = -% case {asn1ct:get_gen_state_field(namelist),WhatKind} of - EmitDecFunCall = - fun(FuncName) -> - case {WhatKind,Type#type.tablecinf} of - {{constructed,bif},[{objfun,_}|_Rest]} -> - emit([FuncName,"(",BytesVar,", ",{asis,Tag}, - ", ObjFun)"]); - _ -> - emit([FuncName,"(",BytesVar,", ",{asis,Tag},")"]) - end - end, - case asn1ct:get_gen_state_field(namelist) of - [{Cname,List}|Rest] when list(List) -> - case WhatKind of - #'Externaltypereference'{} -> - %%io:format("gen_dec_call1 1:~n~p~n~n",[WhatKind]), - asn1ct:add_tobe_refed_func({WhatKind,List}); - _ -> - %%io:format("gen_dec_call1 2:~n~p~n~n",[[Cname|TopType]]), - asn1ct:add_tobe_refed_func({[Cname|TopType], - List}) - end, - asn1ct:update_gen_state(namelist,Rest), - Prefix=asn1ct:get_gen_state_field(prefix), - {DecFunName,_,_}= - mkfuncname(TopType,Cname,WhatKind,Prefix), - EmitDecFunCall(DecFunName); - [{Cname,parts}|Rest] -> - asn1ct:update_gen_state(namelist,Rest), - asn1ct:get_gen_state_field(prefix), - %% This is to prepare SEQUENCE OF value in - %% partial incomplete decode for a later - %% part-decode, i.e. skip %% the tag. - asn1ct:add_generated_refed_func({[Cname|TopType], - parts, - [],Type}), - emit(["{'",asn1ct_gen:list2name([Cname|TopType]),"',"]), - EmitDecFunCall("?RT_BER:match_tags"), - emit("}"); - _ -> - {DecFunName,_,_}= - mkfuncname(TopType,Cname,WhatKind,"dec_"), - EmitDecFunCall(DecFunName) - end -% case {WhatKind,Type#type.tablecinf} of -% {{constructed,bif},[{objfun,_}|_Rest]} -> -% emit([DecFunName,"(",BytesVar,", ",{asis,Tag}, -% ", ObjFun)"]); -% _ -> -% emit([DecFunName,"(",BytesVar,", ",{asis,Tag},")"]) -% end - end. - - -%%------------------------------------------------------ -%% General and special help functions (not exported) -%%------------------------------------------------------ - - -indent(N) -> - lists:duplicate(N,32). % 32 = space - -mkcindexlist([H,T1|T], Sep) -> % Sep is a string e.g ", " or "+ " - emit(["Cindex",H,Sep]), - mkcindexlist([T1|T], Sep); -mkcindexlist([H|T], Sep) -> - emit(["Cindex",H]), - mkcindexlist(T, Sep); -mkcindexlist([], _) -> - true. - -mkcindexlist(L) -> - mkcindexlist(L,", "). - - -mkvlist([H,T1|T], Sep) -> % Sep is a string e.g ", " or "+ " - emit([{var,H},Sep]), - mkvlist([T1|T], Sep); -mkvlist([H|T], Sep) -> - emit([{var,H}]), - mkvlist(T, Sep); -mkvlist([], _) -> - true. - -mkvlist(L) -> - mkvlist(L,", "). - -mkvplus(L) -> - mkvlist(L," + "). - -extensible(CompList) when list(CompList) -> - noext; -extensible({RootList,ExtList}) -> - {ext,length(RootList)+1,length(ExtList)}. - - -print_attribute_comment(InnerType,Pos,Cname,Prop) -> - CommentLine = "%%-------------------------------------------------", - emit([nl,CommentLine]), - case InnerType of - {typereference,_,Name} -> - emit([nl,"%% attribute ",Cname,"(",Pos,") with type ",Name]); - {'Externaltypereference',_,XModule,Name} -> - emit([nl,"%% attribute ",Cname,"(",Pos,") External ",XModule,":",Name]); - _ -> - emit([nl,"%% attribute ",Cname,"(",Pos,") with type ",InnerType]) - end, - case Prop of - mandatory -> - continue; - {'DEFAULT', Def} -> - emit([" DEFAULT = ",{asis,Def}]); - 'OPTIONAL' -> - emit([" OPTIONAL"]) - end, - emit([nl,CommentLine,nl]). - - - -mkfuncname(TopType,Cname,WhatKind,Prefix) -> - CurrMod = get(currmod), - case WhatKind of - #'Externaltypereference'{module=CurrMod,type=EType} -> - F = lists:concat(["'",Prefix,EType,"'"]), - {F, "?MODULE", F}; - #'Externaltypereference'{module=Mod,type=EType} -> - {lists:concat(["'",Mod,"':'",Prefix,EType,"'"]),Mod, - lists:concat(["'",Prefix,EType,"'"])}; - {constructed,bif} -> - F = lists:concat(["'",Prefix,asn1ct_gen:list2name([Cname|TopType]),"'"]), - {F, "?MODULE", F} - end. - -empty_lb(ber) -> - "[]"; -empty_lb(ber_bin) -> - "<<>>"; -empty_lb(ber_bin_v2) -> - "<<>>". - -value_match(Index,Value) when atom(Value) -> - value_match(Index,atom_to_list(Value)); -value_match([],Value) -> - Value; -value_match([{VI,_}|VIs],Value) -> - value_match1(Value,VIs,lists:concat(["element(",VI,","]),1). -value_match1(Value,[],Acc,Depth) -> - Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")")); -value_match1(Value,[{VI,_}|VIs],Acc,Depth) -> - value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1). diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_constructed_per.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_constructed_per.erl deleted file mode 100644 index 9b4e0063bb..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_constructed_per.erl +++ /dev/null @@ -1,1235 +0,0 @@ -% ``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: asn1ct_constructed_per.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ -%% --module(asn1ct_constructed_per). - --export([gen_encode_sequence/3]). --export([gen_decode_sequence/3]). --export([gen_encode_set/3]). --export([gen_decode_set/3]). --export([gen_encode_sof/4]). --export([gen_decode_sof/4]). --export([gen_encode_choice/3]). --export([gen_decode_choice/3]). - --include("asn1_records.hrl"). -%-compile(export_all). - --import(asn1ct_gen, [emit/1,demit/1]). - - -%% ENCODE GENERATOR FOR SEQUENCE TYPE ** ********** - - -gen_encode_set(Erules,TypeName,D) -> - gen_encode_constructed(Erules,TypeName,D). - -gen_encode_sequence(Erules,TypeName,D) -> - gen_encode_constructed(Erules,TypeName,D). - -gen_encode_constructed(Erules,Typename,D) when record(D,type) -> - asn1ct_name:start(), - asn1ct_name:new(term), - asn1ct_name:new(bytes), - {CompList,TableConsInfo} = - case D#type.def of - #'SEQUENCE'{tablecinf=TCI,components=CL} -> - {CL,TCI}; - #'SET'{tablecinf=TCI,components=CL} -> - {CL,TCI} - end, - case Typename of - ['EXTERNAL'] -> - emit({{var,asn1ct_name:next(val)}, - " = asn1rt_check:transform_to_EXTERNAL1990(", - {var,asn1ct_name:curr(val)},"),",nl}), - asn1ct_name:new(val); - _ -> - ok - end, - case {Optionals = optionals(CompList),CompList} of - {[],EmptyCL} when EmptyCL == {[],[]};EmptyCL == [] -> - emit(["%%Variable setting just to eliminate ", - "compiler warning for unused vars!",nl, - "_Val = ",{var,asn1ct_name:curr(val)},",",nl]); - {[],_} -> - emit([{var,asn1ct_name:next(val)}," = ?RT_PER:list_to_record("]), - emit(["'",asn1ct_gen:list2rname(Typename),"'"]), - emit([", ",{var,asn1ct_name:curr(val)},"),",nl]); - _ -> - Fixoptcall = - case Erules of - per -> ",Opt} = ?RT_PER:fixoptionals2("; - _ -> ",Opt} = ?RT_PER:fixoptionals(" - end, - emit({"{",{var,asn1ct_name:next(val)},Fixoptcall, - {asis,Optionals},",",length(Optionals), - ",",{var,asn1ct_name:curr(val)},"),",nl}) - end, - asn1ct_name:new(val), - Ext = extensible(CompList), - case Ext of - {ext,_,NumExt} when NumExt > 0 -> - emit(["Extensions = ?RT_PER:fixextensions(",{asis,Ext}, - ", ",{curr,val},"),",nl]); - _ -> true - end, - EncObj = - case TableConsInfo of - #simpletableattributes{usedclassfield=Used, - uniqueclassfield=Unique} when Used /= Unique -> - false; - %% ObjectSet, name of the object set in constraints - %% - %%{ObjectSet,AttrN,N,UniqueFieldName} -> %% N is index of attribute that determines constraint - #simpletableattributes{objectsetname=ObjectSet, - c_name=AttrN, - c_index=N, - usedclassfield=UniqueFieldName, - uniqueclassfield=UniqueFieldName, - valueindex=ValueIndex - } -> %% N is index of attribute that determines constraint - OSDef = - case ObjectSet of - {Module,OSName} -> - asn1_db:dbget(Module,OSName); - OSName -> - asn1_db:dbget(get(currmod),OSName) - end, - case (OSDef#typedef.typespec)#'ObjectSet'.gen of - true -> - ObjectEncode = - asn1ct_gen:un_hyphen_var(lists:concat(['Obj',AttrN])), - emit([ObjectEncode," = ",nl]), - emit([" 'getenc_",ObjectSet,"'(", - {asis,UniqueFieldName},", ",nl]), - El = make_element(N+1,asn1ct_gen:mk_var(asn1ct_name:curr(val)),AttrN), - Indent = 12 + length(atom_to_list(ObjectSet)), - case ValueIndex of - [] -> - emit([indent(Indent),El,"),",nl]); - _ -> - emit([indent(Indent),"value_match(", - {asis,ValueIndex},",",El,")),",nl]), - notice_value_match() - end, - {AttrN,ObjectEncode}; - _ -> - false - end; - _ -> - case D#type.tablecinf of - [{objfun,_}|_] -> - %% when the simpletableattributes was at an outer - %% level and the objfun has been passed through the - %% function call - {"got objfun through args","ObjFun"}; - _ -> - false - end - end, - emit({"[",nl}), - MaybeComma1 = - case Ext of - {ext,_Pos,NumExt2} when NumExt2 > 0 -> - emit({"?RT_PER:setext(Extensions =/= [])"}), - ", "; - {ext,_Pos,_} -> - emit({"?RT_PER:setext(false)"}), - ", "; - _ -> - "" - end, - MaybeComma2 = - case optionals(CompList) of - [] -> MaybeComma1; - _ -> - emit(MaybeComma1), - emit("Opt"), - {",",nl} - end, - gen_enc_components_call(Typename,CompList,MaybeComma2,EncObj,Ext), - emit({"].",nl}). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% generate decode function for SEQUENCE and SET -%% -gen_decode_set(Erules,Typename,D) -> - gen_decode_constructed(Erules,Typename,D). - -gen_decode_sequence(Erules,Typename,D) -> - gen_decode_constructed(Erules,Typename,D). - -gen_decode_constructed(_Erules,Typename,D) when record(D,type) -> - asn1ct_name:start(), - {CompList,TableConsInfo} = - case D#type.def of - #'SEQUENCE'{tablecinf=TCI,components=CL} -> - {CL,TCI}; - #'SET'{tablecinf=TCI,components=CL} -> - {CL,TCI} - end, - Ext = extensible(CompList), - MaybeComma1 = case Ext of - {ext,_Pos,_NumExt} -> - gen_dec_extension_value("Bytes"), - {",",nl}; - _ -> - "" - end, - Optionals = optionals(CompList), - MaybeComma2 = case Optionals of - [] -> MaybeComma1; - _ -> - Bcurr = asn1ct_name:curr(bytes), - Bnext = asn1ct_name:next(bytes), - emit(MaybeComma1), - GetoptCall = "} = ?RT_PER:getoptionals2(", - emit({"{Opt,",{var,Bnext},GetoptCall, - {var,Bcurr},",",{asis,length(Optionals)},")"}), - asn1ct_name:new(bytes), - ", " - end, - {DecObjInf,UniqueFName,ValueIndex} = - case TableConsInfo of -%% {ObjectSet,AttrN,N,UniqueFieldName} ->%% N is index of attribute that determines constraint - #simpletableattributes{objectsetname=ObjectSet, - c_name=AttrN, - usedclassfield=UniqueFieldName, - uniqueclassfield=UniqueFieldName, - valueindex=ValIndex} -> -%% {AttrN,ObjectSet}; - F = fun(#'ComponentType'{typespec=CT})-> - case {CT#type.constraint,CT#type.tablecinf} of - {[],[{objfun,_}|_R]} -> true; - _ -> false - end - end, - case lists:any(F,CompList) of - true -> % when component relation constraint establish - %% relation from a component to another components - %% subtype component - {{AttrN,{deep,ObjectSet,UniqueFieldName,ValIndex}}, - UniqueFieldName,ValIndex}; - false -> - {{AttrN,ObjectSet},UniqueFieldName,ValIndex} - end; - _ -> - case D#type.tablecinf of - [{objfun,_}|_] -> - {{"got objfun through args","ObjFun"},false,false}; - _ -> - {false,false,false} - end - end, - {AccTerm,AccBytes} = - gen_dec_components_call(Typename,CompList,MaybeComma2,DecObjInf,Ext,length(Optionals)), - case asn1ct_name:all(term) of - [] -> emit(MaybeComma2); % no components at all - _ -> emit({com,nl}) - end, - case {AccTerm,AccBytes} of - {[],[]} -> - ok; - {_,[]} -> - ok; - {[{ObjSet,LeadingAttr,Term}],ListOfOpenTypes} -> - DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])), - ValueMatch = value_match(ValueIndex,Term), - emit({DecObj," =",nl," 'getdec_",ObjSet,"'(", -% {asis,UniqueFName},", ",Term,"),",nl}), - {asis,UniqueFName},", ",ValueMatch,"),",nl}), - gen_dec_listofopentypes(DecObj,ListOfOpenTypes,false) - end, - %% we don't return named lists any more Cnames = mkcnamelist(CompList), - demit({"Result = "}), %dbg - %% return value as record - case Typename of - ['EXTERNAL'] -> - emit({" OldFormat={'",asn1ct_gen:list2rname(Typename), - "'"}), - mkvlist(asn1ct_name:all(term)), - emit({"},",nl}), - emit({" ASN11994Format =",nl, - " asn1rt_check:transform_to_EXTERNAL1994", - "(OldFormat),",nl}), - emit(" {ASN11994Format,"); - _ -> - emit(["{{'",asn1ct_gen:list2rname(Typename),"'"]), - mkvlist(asn1ct_name:all(term)), - emit("},") - end, - emit({{var,asn1ct_name:curr(bytes)},"}"}), - emit({".",nl,nl}). - -gen_dec_listofopentypes(_,[],_) -> - emit(nl); -gen_dec_listofopentypes(DecObj,[{_Cname,{FirstPFN,PFNList},Term,TmpTerm,Prop}|Rest],_Update) -> - -% asn1ct_name:new(term), - asn1ct_name:new(tmpterm), - asn1ct_name:new(reason), - - emit([Term," = ",nl]), - - N = case Prop of - mandatory -> 0; - 'OPTIONAL' -> - emit_opt_or_mand_check(asn1_NOVALUE,TmpTerm), - 6; - {'DEFAULT',Val} -> - emit_opt_or_mand_check(Val,TmpTerm), - 6 - end, - - emit([indent(N+3),"case (catch ",DecObj,"(", - {asis,FirstPFN},", ",TmpTerm,", telltype,",{asis,PFNList},")) of",nl]), - emit([indent(N+6),"{'EXIT', ",{curr,reason},"} ->",nl]), -%% emit({indent(9),"throw({runtime_error,{","'Type not compatible with table constraint'",",",Term,"}});",nl}), - emit([indent(N+9),"exit({'Type not compatible with table constraint',", - {curr,reason},"});",nl]), - emit([indent(N+6),"{",{curr,tmpterm},",_} ->",nl]), - emit([indent(N+9),{curr,tmpterm},nl]), - - case Prop of - mandatory -> - emit([indent(N+3),"end,",nl]); - _ -> - emit([indent(N+3),"end",nl, - indent(3),"end,",nl]) - end, - gen_dec_listofopentypes(DecObj,Rest,true). - - -emit_opt_or_mand_check(Val,Term) -> - emit([indent(3),"case ",Term," of",nl, - indent(6),{asis,Val}," ->",{asis,Val},";",nl, - indent(6),"_ ->",nl]). - -%% ENCODE GENERATOR FOR THE CHOICE TYPE ******* -%% assume Val = {Alternative,AltType} -%% generate -%%[ -%% ?RT_PER:set_choice(element(1,Val),Altnum,Altlist,ext), -%%case element(1,Val) of -%% alt1 -> -%% encode_alt1(element(2,Val)); -%% alt2 -> -%% encode_alt2(element(2,Val)) -%%end -%%]. - -gen_encode_choice(_Erules,Typename,D) when record(D,type) -> - {'CHOICE',CompList} = D#type.def, - emit({"[",nl}), - Ext = extensible(CompList), - gen_enc_choice(Typename,CompList,Ext), - emit({nl,"].",nl}). - -gen_decode_choice(_Erules,Typename,D) when record(D,type) -> - asn1ct_name:start(), - asn1ct_name:new(bytes), - {'CHOICE',CompList} = D#type.def, - Ext = extensible(CompList), - gen_dec_choice(Typename,CompList,Ext), - emit({".",nl}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Encode generator for SEQUENCE OF type - - -gen_encode_sof(_Erules,Typename,SeqOrSetOf,D) when record(D,type) -> - asn1ct_name:start(), -% Val = [Component] -% ?RT_PER:encode_length(length(Val)), -% lists: - {_SeqOrSetOf,ComponentType} = D#type.def, - emit({"[",nl}), - SizeConstraint = - case asn1ct_gen:get_constraint(D#type.constraint, - 'SizeConstraint') of - no -> undefined; - Range -> Range - end, - ObjFun = - case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _-> - "" - end, - emit({nl,indent(3),"?RT_PER:encode_length(", - {asis,SizeConstraint}, - ",length(Val)),",nl}), - emit({indent(3),"'enc_",asn1ct_gen:list2name(Typename), - "_components'(Val",ObjFun,", [])"}), - emit({nl,"].",nl}), - NewComponentType = - case ComponentType#type.def of - {'ENUMERATED',_,Component}-> - ComponentType#type{def={'ENUMERATED',Component}}; - _ -> ComponentType - end, - gen_encode_sof_components(Typename,SeqOrSetOf,NewComponentType). - -gen_decode_sof(_Erules,Typename,SeqOrSetOf,D) when record(D,type) -> - asn1ct_name:start(), -% Val = [Component] -% ?RT_PER:encode_length(length(Val)), -% lists: - {_SeqOrSetOf,ComponentType} = D#type.def, - SizeConstraint = - case asn1ct_gen:get_constraint(D#type.constraint, - 'SizeConstraint') of - no -> undefined; - Range -> Range - end, - ObjFun = - case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - "" - end, - emit({nl,"{Num,Bytes1} = ?RT_PER:decode_length(Bytes,",{asis,SizeConstraint},"),",nl}), - emit({"'dec_",asn1ct_gen:list2name(Typename), - "_components'(Num, Bytes1, telltype",ObjFun,", []).",nl}), - NewComponentType = - case ComponentType#type.def of - {'ENUMERATED',_,Component}-> - ComponentType#type{def={'ENUMERATED',Component}}; - _ -> ComponentType - end, - gen_decode_sof_components(Typename,SeqOrSetOf,NewComponentType). - -gen_encode_sof_components(Typename,SeqOrSetOf,Cont) -> - {ObjFun,ObjFun_Var} = - case Cont#type.tablecinf of - [{objfun,_}|_R] -> - {", ObjFun",", _"}; - _ -> - {"",""} - end, - emit({"'enc_",asn1ct_gen:list2name(Typename),"_components'([]", - ObjFun_Var,", Acc) -> lists:reverse(Acc);",nl,nl}), - emit({"'enc_",asn1ct_gen:list2name(Typename),"_components'([H|T]", - ObjFun,", Acc) ->",nl}), - emit({"'enc_",asn1ct_gen:list2name(Typename),"_components'(T"}), - emit({ObjFun,", ["}), - %% the component encoder - Constructed_Suffix = asn1ct_gen:constructed_suffix(SeqOrSetOf, - Cont#type.def), - - Conttype = asn1ct_gen:get_inner(Cont#type.def), - Currmod = get(currmod), - Ctgenmod = list_to_atom(lists:concat(["asn1ct_gen_",per, - asn1ct_gen:rt2ct_suffix()])), - case asn1ct_gen:type(Conttype) of - {primitive,bif} -> - gen_encode_prim_wrapper(Ctgenmod,per,Cont,false,"H"); -% Ctgenmod:gen_encode_prim(per,Cont,false,"H"); - {constructed,bif} -> - NewTypename = [Constructed_Suffix|Typename], - emit({"'enc_",asn1ct_gen:list2name(NewTypename),"'(H", - ObjFun,")",nl,nl}); - #'Externaltypereference'{module=Currmod,type=Ename} -> - emit({"'enc_",Ename,"'(H)",nl,nl}); - #'Externaltypereference'{module=EMod,type=EType} -> - emit({"'",EMod,"':'enc_",EType,"'(H)",nl,nl}); - _ -> - emit({"'enc_",Conttype,"'(H)",nl,nl}) - end, - emit({" | Acc]).",nl}). - -gen_decode_sof_components(Typename,SeqOrSetOf,Cont) -> - {ObjFun,ObjFun_Var} = - case Cont#type.tablecinf of - [{objfun,_}|_R] -> - {", ObjFun",", _"}; - _ -> - {"",""} - end, - emit({"'dec_",asn1ct_gen:list2name(Typename), - "_components'(0, Bytes, _",ObjFun_Var,", Acc) ->",nl, - indent(3),"{lists:reverse(Acc), Bytes};",nl}), - emit({"'dec_",asn1ct_gen:list2name(Typename), - "_components'(Num, Bytes, _",ObjFun,", Acc) ->",nl}), - emit({indent(3),"{Term,Remain} = "}), - Constructed_Suffix = asn1ct_gen:constructed_suffix(SeqOrSetOf, - Cont#type.def), - Conttype = asn1ct_gen:get_inner(Cont#type.def), - Ctgenmod = list_to_atom(lists:concat(["asn1ct_gen_",per, - asn1ct_gen:rt2ct_suffix()])), - case asn1ct_gen:type(Conttype) of - {primitive,bif} -> - Ctgenmod:gen_dec_prim(per,Cont,"Bytes"), - emit({com,nl}); - {constructed,bif} -> - NewTypename = [Constructed_Suffix|Typename], - emit({"'dec_",asn1ct_gen:list2name(NewTypename), - "'(Bytes, telltype",ObjFun,"),",nl}); - #typereference{val=Dname} -> - emit({"'dec_",Dname,"'(Bytes,telltype),",nl}); - #'Externaltypereference'{module=EMod,type=EType} -> - emit({"'",EMod,"':'dec_",EType,"'(Bytes,telltype),",nl}); - _ -> - emit({"'dec_",Conttype,"'(Bytes,telltype),",nl}) - end, - emit({indent(3),"'dec_",asn1ct_gen:list2name(Typename), - "_components'(Num-1, Remain, telltype",ObjFun,", [Term|Acc]).",nl}). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% General and special help functions (not exported) - -mkvlist([H|T]) -> - emit(","), - mkvlist2([H|T]); -mkvlist([]) -> - true. -mkvlist2([H,T1|T]) -> - emit({{var,H},","}), - mkvlist2([T1|T]); -mkvlist2([H|T]) -> - emit({{var,H}}), - mkvlist2(T); -mkvlist2([]) -> - true. - -extensible(CompList) when list(CompList) -> - noext; -extensible({RootList,ExtList}) -> - {ext,length(RootList)+1,length(ExtList)}. - -gen_dec_extension_value(_) -> - emit({"{Ext,",{next,bytes},"} = ?RT_PER:getext(",{curr,bytes},")"}), - asn1ct_name:new(bytes). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Produce a list with positions (in the Value record) where -%% there are optional components, start with 2 because first element -%% is the record name - -optionals({L,_Ext}) -> optionals(L,[],2); -optionals(L) -> optionals(L,[],2). - -optionals([{'EXTENSIONMARK',_,_}|Rest],Acc,Pos) -> - optionals(Rest,Acc,Pos); % optionals in extension are currently not handled -optionals([#'ComponentType'{prop='OPTIONAL'}|Rest],Acc,Pos) -> - optionals(Rest,[Pos|Acc],Pos+1); -optionals([#'ComponentType'{prop={'DEFAULT',_}}|Rest],Acc,Pos) -> - optionals(Rest,[Pos|Acc],Pos+1); -optionals([#'ComponentType'{}|Rest],Acc,Pos) -> - optionals(Rest,Acc,Pos+1); -optionals([],Acc,_) -> - lists:reverse(Acc). - - -gen_enc_components_call(TopType,{CompList,ExtList},MaybeComma,DynamicEnc,Ext) -> - %% The type has extensionmarker - Rpos = gen_enc_components_call1(TopType,CompList,1,MaybeComma,DynamicEnc,noext), - case Ext of - {ext,_,ExtNum} when ExtNum > 0 -> - emit([nl, - ",Extensions",nl]); - _ -> true - end, - %handle extensions - gen_enc_components_call1(TopType,ExtList,Rpos,MaybeComma,DynamicEnc,Ext); -gen_enc_components_call(TopType, CompList, MaybeComma, DynamicEnc, Ext) -> - %% The type has no extensionmarker - gen_enc_components_call1(TopType,CompList,1,MaybeComma,DynamicEnc,Ext). - -gen_enc_components_call1(TopType, - [C=#'ComponentType'{name=Cname,typespec=Type,prop=Prop}|Rest], - Tpos, - MaybeComma, DynamicEnc, Ext) -> - - put(component_type,{true,C}), - %% information necessary in asn1ct_gen_per_rt2ct:gen_encode_prim - - Pos = case Ext of - noext -> Tpos; - {ext,Epos,_Enum} -> Tpos - Epos + 1 - end, - emit(MaybeComma), - case Prop of - 'OPTIONAL' -> - gen_enc_component_optional(TopType,Cname,Type,Tpos,DynamicEnc,Ext); - {'DEFAULT',_DefVal} -> - gen_enc_component_default(TopType,Cname,Type,Tpos,DynamicEnc,Ext); - _ -> - case Ext of - {ext,ExtPos,_} when Tpos >= ExtPos -> - gen_enc_component_optional(TopType,Cname,Type,Tpos,DynamicEnc,Ext); - _ -> - gen_enc_component_mandatory(TopType,Cname,Type,Tpos,DynamicEnc,Ext) - end - end, - - erase(component_type), - - case Rest of - [] -> - Pos+1; - _ -> - emit({com,nl}), - gen_enc_components_call1(TopType,Rest,Tpos+1,"",DynamicEnc,Ext) - end; -gen_enc_components_call1(_TopType,[],Pos,_,_,_) -> - Pos. - -gen_enc_component_default(TopType,Cname,Type,Pos,DynamicEnc,Ext) -> -% Element = io_lib:format("?RT_PER:cindex(~w,Val1,~w)",[Pos+1,Cname]), - Element = make_element(Pos+1,"Val1",Cname), - emit({"case ",Element," of",nl}), -% case Ext of -% {ext,ExtPos,_} when Pos >= ExtPos -> -% emit({"asn1_NOEXTVALUE -> [];",nl}); -% _ -> - emit({"asn1_DEFAULT -> [];",nl}), -% end, - asn1ct_name:new(tmpval), - emit({{curr,tmpval}," ->",nl}), - InnerType = asn1ct_gen:get_inner(Type#type.def), - emit({nl,"%% attribute number ",Pos," with type ", - InnerType,nl}), - NextElement = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)), - gen_enc_line(TopType,Cname,Type,NextElement, Pos,DynamicEnc,Ext), - emit({nl,"end"}). - -gen_enc_component_optional(TopType,Cname,Type,Pos,DynamicEnc,Ext) -> -% Element = io_lib:format("?RT_PER:cindex(~w,Val1,~w)",[Pos+1,Cname]), - Element = make_element(Pos+1,"Val1",Cname), - emit({"case ",Element," of",nl}), -% case Ext of -% {ext,ExtPos,_} when Pos >= ExtPos -> -% emit({"asn1_NOEXTVALUE -> [];",nl}); -% _ -> - emit({"asn1_NOVALUE -> [];",nl}), -% end, - asn1ct_name:new(tmpval), - emit({{curr,tmpval}," ->",nl}), - InnerType = asn1ct_gen:get_inner(Type#type.def), - emit({nl,"%% attribute number ",Pos," with type ", - InnerType,nl}), - NextElement = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)), - gen_enc_line(TopType,Cname,Type,NextElement, Pos,DynamicEnc,Ext), - emit({nl,"end"}). - -gen_enc_component_mandatory(TopType,Cname,Type,Pos,DynamicEnc,Ext) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - emit({nl,"%% attribute number ",Pos," with type ", - InnerType,nl}), - gen_enc_line(TopType,Cname,Type,[],Pos,DynamicEnc,Ext). - -gen_enc_line(TopType, Cname, Type, [], Pos,DynamicEnc,Ext) -> -% Element = io_lib:format("?RT_PER:cindex(~w,~s,~w)",[Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val)),Cname]), - Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val)),Cname), - gen_enc_line(TopType,Cname,Type,Element, Pos,DynamicEnc,Ext); -gen_enc_line(TopType,Cname,Type,Element, Pos,DynamicEnc,Ext) -> - Ctgenmod = list_to_atom(lists:concat(["asn1ct_gen_",per, - asn1ct_gen:rt2ct_suffix()])), - Atype = - case Type of - #type{def=#'ObjectClassFieldType'{type=InnerType}} -> - InnerType; - _ -> - asn1ct_gen:get_inner(Type#type.def) - end, -% case asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info) of -% no -> -% asn1ct_gen:get_inner(Type#type.def); -% _ -> -% Type#type.def -% end, - case Ext of - {ext,Ep1,_} when Pos >= Ep1 -> - emit(["?RT_PER:encode_open_type(dummy,?RT_PER:complete("]); - _ -> true - end, - case Atype of - {typefield,_} -> - case DynamicEnc of - {_LeadingAttrName,Fun} -> -% case asn1ct_gen:get_constraint(Type#type.constraint, -% componentrelation) of - case (Type#type.def)#'ObjectClassFieldType'.fieldname of - {notype,T} -> - throw({error,{notype,type_from_object,T}}); - {Name,RestFieldNames} when atom(Name) -> - emit({"?RT_PER:encode_open_type([],?RT_PER:complete(",nl}), - emit({" ",Fun,"(",{asis,Name},", ", - Element,", ",{asis,RestFieldNames},")))"}); - Other -> - throw({asn1,{'internal error',Other}}) - end - end; - {objectfield,PrimFieldName1,PFNList} -> - case DynamicEnc of - {_LeadingAttrName,Fun} -> - emit({"?RT_PER:encode_open_type([]," - "?RT_PER:complete(",nl}), - emit({" ",Fun,"(",{asis,PrimFieldName1}, - ", ",Element,", ",{asis,PFNList},")))"}) - end; - _ -> - CurrMod = get(currmod), - case asn1ct_gen:type(Atype) of - #'Externaltypereference'{module=Mod,type=EType} when - (CurrMod==Mod) -> - emit({"'enc_",EType,"'(",Element,")"}); - #'Externaltypereference'{module=Mod,type=EType} -> - emit({"'",Mod,"':'enc_", - EType,"'(",Element,")"}); - #typereference{val=Ename} -> - emit({"'enc_",Ename,"'(",Element,")"}); - {notype,_} -> - emit({"'enc_",Atype,"'(",Element,")"}); - {primitive,bif} -> - EncType = - case Atype of - {fixedtypevaluefield,_,Btype} -> - Btype; - _ -> - Type - end, - gen_encode_prim_wrapper(Ctgenmod,per,EncType, - false,Element); -% Ctgenmod:gen_encode_prim(per,EncType, -% false,Element); - 'ASN1_OPEN_TYPE' -> - case Type#type.def of - #'ObjectClassFieldType'{type=OpenType} -> - gen_encode_prim_wrapper(Ctgenmod,per, - #type{def=OpenType}, - false,Element); - _ -> - gen_encode_prim_wrapper(Ctgenmod,per,Type, - false,Element) - end; -% Ctgenmod:gen_encode_prim(per,Type, -% false,Element); - {constructed,bif} -> - NewTypename = [Cname|TopType], - case {Type#type.tablecinf,DynamicEnc} of - {[{objfun,_}|_R],{_,EncFun}} -> -%% emit({"?RT_PER:encode_open_type([],", -%% "?RT_PER:complete(",nl}), - emit({"'enc_", - asn1ct_gen:list2name(NewTypename), - "'(",Element,", ",EncFun,")"}); - _ -> - emit({"'enc_", - asn1ct_gen:list2name(NewTypename), - "'(",Element,")"}) - end - end - end, - case Ext of - {ext,Ep2,_} when Pos >= Ep2 -> - emit(["))"]); - _ -> true - end. - -gen_dec_components_call(TopType,{CompList,ExtList},MaybeComma,DecInfObj,Ext,NumberOfOptionals) -> - %% The type has extensionmarker - {Rpos,AccTerm,AccBytes} = - gen_dec_components_call1(TopType, CompList, 1, 1, MaybeComma,DecInfObj, - noext,[],[],NumberOfOptionals), - emit([",",nl,"{Extensions,",{next,bytes},"} = "]), - emit(["?RT_PER:getextension(Ext,",{curr,bytes},"),",nl]), - asn1ct_name:new(bytes), - {_Epos,AccTermE,AccBytesE} = - gen_dec_components_call1(TopType,ExtList,Rpos, 1, "",DecInfObj,Ext,[],[],NumberOfOptionals), - case ExtList of - [] -> true; - _ -> emit([",",nl]) - end, - emit([{next,bytes},"= ?RT_PER:skipextensions(",{curr,bytes},",", - length(ExtList)+1,",Extensions)",nl]), - asn1ct_name:new(bytes), - {AccTerm++AccTermE,AccBytes++AccBytesE}; - -gen_dec_components_call(TopType,CompList,MaybeComma,DecInfObj,Ext,NumberOfOptionals) -> - %% The type has no extensionmarker - {_,AccTerm,AccBytes} = - gen_dec_components_call1(TopType, CompList, 1, 1,MaybeComma,DecInfObj,Ext,[],[],NumberOfOptionals), - {AccTerm,AccBytes}. - - -gen_dec_components_call1(TopType, - [C=#'ComponentType'{name=Cname,typespec=Type,prop=Prop}|Rest], - Tpos,OptPos,MaybeComma,DecInfObj,Ext,AccTerm,AccBytes,NumberOfOptionals) -> - Pos = case Ext of - noext -> Tpos; - {ext,Epos,_Enum} -> Tpos - Epos + 1 - end, - emit(MaybeComma), -%% asn1ct_name:new(term), - InnerType = - case Type#type.def of - #'ObjectClassFieldType'{type=InType} -> - InType; - Def -> - asn1ct_gen:get_inner(Def) - end, -% case asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info) of -% no -> -% asn1ct_gen:get_inner(Type#type.def); -% _ -> -% Type#type.def -% end, - case InnerType of - #'Externaltypereference'{type=T} -> - emit({nl,"%% attribute number ",Tpos," with type ", - T,nl}); - IT when tuple(IT) -> - emit({nl,"%% attribute number ",Tpos," with type ", - element(2,IT),nl}); - _ -> - emit({nl,"%% attribute number ",Tpos," with type ", - InnerType,nl}) - end, - - case InnerType of - {typefield,_} -> - asn1ct_name:new(term), - asn1ct_name:new(tmpterm), - emit({"{",{curr,tmpterm},", ",{next,bytes},"} = "}); - {objectfield,_,_} -> - asn1ct_name:new(term), - asn1ct_name:new(tmpterm), - emit({"{",{curr,tmpterm},", ",{next,bytes},"} = "}); - _ -> - asn1ct_name:new(term), - emit({"{",{curr,term},",",{next,bytes},"} = "}) - end, - - NewOptPos = - case {Ext,Prop} of - {noext,mandatory} -> OptPos; % generate nothing - {noext,_} -> - Element = io_lib:format("Opt band (1 bsl ~w)",[NumberOfOptionals - OptPos]), - emit({"case ",Element," of",nl}), - emit({"_Opt",OptPos," when _Opt",OptPos," > 0 ->"}), - OptPos+1; - _ -> - emit(["case Extensions of",nl]), - emit(["_ when size(Extensions) >= ",Pos,",element(",Pos,",Extensions) == 1 ->",nl]) - end, - put(component_type,{true,C}), - {TermVar,BytesVar} = gen_dec_line(TopType,Cname,Type,Tpos,DecInfObj,Ext), - erase(component_type), - case {Ext,Prop} of - {noext,mandatory} -> true; % generate nothing - {noext,_} -> - emit([";",nl,"0 ->"]), - gen_dec_component_no_val(TopType,Cname,Type,Prop,Tpos,Ext); - _ -> - emit([";",nl,"_ ->",nl]), - gen_dec_component_no_val(TopType,Cname,Type,Prop,Tpos,Ext) - end, - case {Ext,Prop} of - {noext,mandatory} -> true; % generate nothing - {noext,_} -> - emit([nl,"end"]); - _ -> - emit([nl,"end"]) - - end, - asn1ct_name:new(bytes), - case Rest of - [] -> - {Pos+1,AccTerm++TermVar,AccBytes++BytesVar}; - _ -> - emit({com,nl}), - gen_dec_components_call1(TopType,Rest,Tpos+1,NewOptPos,"",DecInfObj,Ext, - AccTerm++TermVar,AccBytes++BytesVar,NumberOfOptionals) - end; - -gen_dec_components_call1(_TopType,[],Pos,_OptPos,_,_,_,AccTerm,AccBytes,_NumberOfOptionals) -> - {Pos,AccTerm,AccBytes}. - - -%%gen_dec_component_no_val(TopType,Cname,Type,_,Pos,{ext,Ep,Enum}) when Pos >= Ep -> -%% emit({"{asn1_NOEXTVALUE,",{curr,bytes},"}",nl}); -gen_dec_component_no_val(_,_,_,{'DEFAULT',DefVal},_,_) -> - emit(["{",{asis,DefVal},",",{curr,bytes},"}",nl]); -gen_dec_component_no_val(_,_,_,'OPTIONAL',_,_) -> - emit({"{asn1_NOVALUE,",{curr,bytes},"}",nl}); -gen_dec_component_no_val(_,_,_,mandatory,_,{ext,_,_}) -> - emit({"{asn1_NOVALUE,",{curr,bytes},"}",nl}). - - -gen_dec_line(TopType,Cname,Type,Pos,DecInfObj,Ext) -> - Ctgenmod = list_to_atom(lists:concat(["asn1ct_gen_",per, - asn1ct_gen:rt2ct_suffix()])), - Atype = - case Type of - #type{def=#'ObjectClassFieldType'{type=InnerType}} -> - InnerType; - _ -> - asn1ct_gen:get_inner(Type#type.def) - end, -% case asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info) of -% no -> -% asn1ct_gen:get_inner(Type#type.def); -% _ -> -% Type#type.def -% end, - BytesVar0 = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), - BytesVar = case Ext of - {ext,Ep,_} when Pos >= Ep -> - emit(["begin",nl,"{TmpVal",Pos,",Trem",Pos, - "}=?RT_PER:decode_open_type(", - {curr,bytes},",[]),",nl, - "{TmpValx",Pos,",_}="]), - io_lib:format("TmpVal~p",[Pos]); - _ -> BytesVar0 - end, - SaveBytes = - case Atype of - {typefield,_} -> - case DecInfObj of - false -> % This is in a choice with typefield components - {Name,RestFieldNames} = - (Type#type.def)#'ObjectClassFieldType'.fieldname, -% asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info), - asn1ct_name:new(tmpterm), - asn1ct_name:new(reason), - emit([indent(2),"{",{curr,tmpterm},", ",{next,bytes}, - "} = ?RT_PER:decode_open_type(",{curr,bytes}, - ", []),",nl]), - emit([indent(2),"case (catch ObjFun(", - {asis,Name}, - ",",{curr,tmpterm},",telltype,", - {asis,RestFieldNames},")) of", nl]), - emit([indent(4),"{'EXIT',",{curr,reason},"} ->",nl]), - emit([indent(6),"exit({'Type not ", - "compatible with table constraint', ", - {curr,reason},"});",nl]), - asn1ct_name:new(tmpterm), - emit([indent(4),"{",{curr,tmpterm},", _} ->",nl]), - emit([indent(6),"{",Cname,", {",{curr,tmpterm},", ", - {next,bytes},"}}",nl]), - emit([indent(2),"end"]), - []; - {"got objfun through args","ObjFun"} -> - %% this is when the generated code gots the - %% objfun though arguments on function - %% invocation. - {Name,RestFieldNames} = - (Type#type.def)#'ObjectClassFieldType'.fieldname, - emit(["?RT_PER:decode_open_type(",{curr,bytes}, - ", []),",nl]), - emit([{curr,term}," =",nl, - " case (catch ObjFun(",{asis,Name},",", - {curr,tmpterm},",telltype,", - {asis,RestFieldNames},")) of", nl]), - emit([" {'EXIT',",{curr,reason},"} ->",nl]), - emit([indent(6),"exit({'Type not ", - "compatible with table constraint', ", - {curr,reason},"});",nl]), - asn1ct_name:new(tmpterm), - emit([indent(4),"{",{curr,tmpterm},", _} ->",nl]), - emit([indent(6),{curr,tmpterm},nl]), - emit([indent(2),"end"]), - []; - _ -> - emit({"?RT_PER:decode_open_type(",{curr,bytes}, - ", [])"}), - RefedFieldName = - (Type#type.def)#'ObjectClassFieldType'.fieldname, -% asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info), - [{Cname,RefedFieldName, - asn1ct_gen:mk_var(asn1ct_name:curr(term)), - asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)), - get_components_prop()}] - end; - {objectfield,PrimFieldName1,PFNList} -> - emit({"?RT_PER:decode_open_type(",{curr,bytes},", [])"}), - [{Cname,{PrimFieldName1,PFNList}, - asn1ct_gen:mk_var(asn1ct_name:curr(term)), - asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)), - get_components_prop()}]; - _ -> - CurrMod = get(currmod), - case asn1ct_gen:type(Atype) of - #'Externaltypereference'{module=CurrMod,type=EType} -> - emit({"'dec_",EType,"'(",BytesVar,",telltype)"}); - #'Externaltypereference'{module=Mod,type=EType} -> - emit({"'",Mod,"':'dec_",EType,"'(",BytesVar, - ",telltype)"}); - {primitive,bif} -> - case Atype of - {fixedtypevaluefield,_,Btype} -> - Ctgenmod:gen_dec_prim(per,Btype, - BytesVar); - _ -> - Ctgenmod:gen_dec_prim(per,Type, - BytesVar) - end; - 'ASN1_OPEN_TYPE' -> - case Type#type.def of - #'ObjectClassFieldType'{type=OpenType} -> - Ctgenmod:gen_dec_prim(per,#type{def=OpenType}, - BytesVar); - _ -> - Ctgenmod:gen_dec_prim(per,Type, - BytesVar) - end; - #typereference{val=Dname} -> - emit({"'dec_",Dname,"'(",BytesVar,",telltype)"}); - {notype,_} -> - emit({"'dec_",Atype,"'(",BytesVar,",telltype)"}); - {constructed,bif} -> - NewTypename = [Cname|TopType], - case Type#type.tablecinf of - [{objfun,_}|_R] -> - emit({"'dec_",asn1ct_gen:list2name(NewTypename), - "'(",BytesVar,", telltype, ObjFun)"}); - _ -> - emit({"'dec_",asn1ct_gen:list2name(NewTypename), - "'(",BytesVar,", telltype)"}) - end - end, - case DecInfObj of - {Cname,{_,OSet,UniqueFName,ValIndex}} -> - Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)), - ValueMatch = value_match(ValIndex,Term), - emit({",",nl,"ObjFun = 'getdec_",OSet,"'(", - {asis,UniqueFName},", ",ValueMatch,")"}); - _ -> - ok - end, - [] - end, - case Ext of - {ext,Ep2,_} when Pos >= Ep2 -> - emit([", {TmpValx",Pos,",Trem",Pos,"}",nl,"end"]); - _ -> true - end, - %% Prepare return value - case DecInfObj of - {Cname,ObjSet} -> - {[{ObjSet,Cname,asn1ct_gen:mk_var(asn1ct_name:curr(term))}], - SaveBytes}; - _ -> - {[],SaveBytes} - end. - -gen_enc_choice(TopType,CompList,Ext) -> - gen_enc_choice_tag(CompList, [], Ext), - emit({com,nl}), - emit({"case element(1,Val) of",nl}), - gen_enc_choice2(TopType, CompList, Ext), - emit({nl,"end"}). - -gen_enc_choice_tag({C1,C2},_,_) -> - N1 = get_name_list(C1), - N2 = get_name_list(C2), - emit(["?RT_PER:set_choice(element(1,Val),", - {asis,{N1,N2}},", ",{asis,{length(N1),length(N2)}},")"]); -gen_enc_choice_tag(C,_,_) -> - N = get_name_list(C), - emit(["?RT_PER:set_choice(element(1,Val),", - {asis,N},", ",{asis,length(N)},")"]). - -get_name_list(L) -> - get_name_list(L,[]). - -get_name_list([#'ComponentType'{name=Name}|T], Acc) -> - get_name_list(T,[Name|Acc]); -get_name_list([], Acc) -> - lists:reverse(Acc). - -%gen_enc_choice_tag([H|T],Acc,Ext) when record(H,'ComponentType') -> -% gen_enc_choice_tag(T,[H#'ComponentType'.name|Acc],Ext); -%gen_enc_choice_tag([H|T],Acc,Ext) -> % skip EXTENSIONMARK -% gen_enc_choice_tag(T,Acc,Ext); -%gen_enc_choice_tag([],Acc,Ext) -> -% Length = length(Acc), -% emit({"?RT_PER:set_choice(element(1,Val),",{asis,Length},",", -% {asis,lists:reverse(Acc)},",",{asis,Ext},")"}), -% Length. - -gen_enc_choice2(TopType, {L1,L2}, Ext) -> - gen_enc_choice2(TopType, L1 ++ L2, 0, Ext); -gen_enc_choice2(TopType, L, Ext) -> - gen_enc_choice2(TopType, L, 0, Ext). - -gen_enc_choice2(TopType,[H1,H2|T], Pos, Ext) -when record(H1,'ComponentType'), record(H2,'ComponentType') -> - Cname = H1#'ComponentType'.name, - Type = H1#'ComponentType'.typespec, - EncObj = -% case asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info) of -% no -> -% false; -% _ -> -% {no_attr,"ObjFun"} -% end, - case asn1ct_gen:get_constraint(Type#type.constraint, - componentrelation) of - no -> false; - _ -> {no_attr,"ObjFun"} - end, - emit({{asis,Cname}," ->",nl}), - gen_enc_line(TopType,Cname,Type,"element(2,Val)", Pos+1,EncObj,Ext), - emit({";",nl}), - gen_enc_choice2(TopType,[H2|T], Pos+1, Ext); -gen_enc_choice2(TopType,[H1|T], Pos, Ext) when record(H1,'ComponentType') -> - Cname = H1#'ComponentType'.name, - Type = H1#'ComponentType'.typespec, - EncObj = -% case asn1ct_gen:get_constraint(Type#type.constraint, -% tableconstraint_info) of -% no -> -% false; -% _ -> -% {no_attr,"ObjFun"} -% end, - case asn1ct_gen:get_constraint(Type#type.constraint, - componentrelation) of - no -> false; - _ -> {no_attr,"ObjFun"} - end, - emit({{asis,H1#'ComponentType'.name}," ->",nl}), - gen_enc_line(TopType,Cname,Type,"element(2,Val)", Pos+1,EncObj,Ext), - gen_enc_choice2(TopType,T, Pos+1, Ext); -gen_enc_choice2(_,[], _, _) -> - true. - -gen_dec_choice(TopType,CompList,{ext,Pos,NumExt}) -> - emit({"{Ext,",{curr,bytes},"} = ?RT_PER:getbit(Bytes),",nl}), - asn1ct_name:new(bytes), - gen_dec_choice1(TopType,CompList,{ext,Pos,NumExt}); -gen_dec_choice(TopType,CompList,noext) -> - gen_dec_choice1(TopType,CompList,noext). - -gen_dec_choice1(TopType,CompList,noext) -> - emit({"{Choice,",{curr,bytes}, - "} = ?RT_PER:getchoice(",{prev,bytes},",", - length(CompList),", 0),",nl}), - emit({"{Cname,{Val,NewBytes}} = case Choice of",nl}), - gen_dec_choice2(TopType,CompList,noext), - emit({nl,"end,",nl}), - emit({nl,"{{Cname,Val},NewBytes}"}); -gen_dec_choice1(TopType,{RootList,ExtList},Ext) -> - NewList = RootList ++ ExtList, - gen_dec_choice1(TopType, NewList, Ext); -gen_dec_choice1(TopType,CompList,{ext,ExtPos,ExtNum}) -> - emit({"{Choice,",{curr,bytes}, - "} = ?RT_PER:getchoice(",{prev,bytes},",", - length(CompList)-ExtNum,",Ext ),",nl}), - emit({"{Cname,{Val,NewBytes}} = case Choice + Ext*",ExtPos-1," of",nl}), - gen_dec_choice2(TopType,CompList,{ext,ExtPos,ExtNum}), - emit([";",nl,"_ -> {asn1_ExtAlt, ?RT_PER:decode_open_type(",{curr,bytes},",[])}"]), - emit({nl,"end,",nl}), - emit({nl,"{{Cname,Val},NewBytes}"}). - - -gen_dec_choice2(TopType,L,Ext) -> - gen_dec_choice2(TopType,L,0,Ext). - -gen_dec_choice2(TopType,[H1,H2|T],Pos,Ext) -when record(H1,'ComponentType'), record(H2,'ComponentType') -> - Cname = H1#'ComponentType'.name, - Type = H1#'ComponentType'.typespec, - case Type#type.def of - #'ObjectClassFieldType'{type={typefield,_}} -> - emit({Pos," -> ",nl}), - wrap_gen_dec_line(H1,TopType,Cname,Type,Pos+1,false,Ext), - emit({";",nl}); - _ -> - emit({Pos," -> {",{asis,Cname},",",nl}), - wrap_gen_dec_line(H1,TopType,Cname,Type,Pos+1,false,Ext), - emit({"};",nl}) - end, - gen_dec_choice2(TopType,[H2|T],Pos+1,Ext); -gen_dec_choice2(TopType,[H1,_H2|T],Pos,Ext) when record(H1,'ComponentType') -> - gen_dec_choice2(TopType,[H1|T],Pos,Ext); % skip extensionmark -gen_dec_choice2(TopType,[H1|T],Pos,Ext) when record(H1,'ComponentType') -> - Cname = H1#'ComponentType'.name, - Type = H1#'ComponentType'.typespec, - case Type#type.def of - #'ObjectClassFieldType'{type={typefield,_}} -> - emit({Pos," -> ",nl}), - wrap_gen_dec_line(H1,TopType,Cname,Type,Pos+1,false,Ext); - _ -> - emit({Pos," -> {",{asis,Cname},",",nl}), - wrap_gen_dec_line(H1,TopType,Cname,Type,Pos+1,false,Ext), - emit("}") - end, - gen_dec_choice2(TopType,[T],Pos+1); -gen_dec_choice2(TopType,[_|T],Pos,Ext) -> - gen_dec_choice2(TopType,T,Pos,Ext);% skip extensionmark -gen_dec_choice2(_,[],Pos,_) -> - Pos. - -indent(N) -> - lists:duplicate(N,32). % 32 = space - -gen_encode_prim_wrapper(CtgenMod,Erule,Cont,DoTag,Value) -> -% put(component_type,true), % add more info in component_type - CtgenMod:gen_encode_prim(Erule,Cont,DoTag,Value). -% erase(component_type). - -make_element(I,Val,Cname) -> - case lists:member(optimize,get(encoding_options)) of - false -> - io_lib:format("?RT_PER:cindex(~w,~s,~w)",[I,Val,Cname]); - _ -> - io_lib:format("element(~w,~s)",[I,Val]) - end. - -wrap_gen_dec_line(C,TopType,Cname,Type,Pos,DIO,Ext) -> - put(component_type,{true,C}), - gen_dec_line(TopType,Cname,Type,Pos,DIO,Ext), - erase(component_type). - -get_components_prop() -> - case get(component_type) of - undefined -> - mandatory; - {true,#'ComponentType'{prop=Prop}} -> Prop - end. - - -value_match(Index,Value) when atom(Value) -> - value_match(Index,atom_to_list(Value)); -value_match([],Value) -> - Value; -value_match([{VI,_}|VIs],Value) -> - value_match1(Value,VIs,lists:concat(["element(",VI,","]),1). -value_match1(Value,[],Acc,Depth) -> - Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")")); -value_match1(Value,[{VI,_}|VIs],Acc,Depth) -> - value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1). - -notice_value_match() -> - Module = get(currmod), - put(value_match,{true,Module}). - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen.erl deleted file mode 100644 index e4a0b1fd9a..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen.erl +++ /dev/null @@ -1,1664 +0,0 @@ -%% ``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: asn1ct_gen.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ -%% --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]). --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(Erules,Module), - 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(Erules,Module) -> - pgen_partial_inc_dec(Erules,Module), - pgen_partial_dec(Erules,Module). - -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-"), - Rtmod:gen_decode(Erules,TypeDef), -%% asn1ct:update_gen_state(namelist,tl(P)), %% - 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},Pattern} -> - TypeDef = asn1_db:dbget(M,Name), - asn1ct:update_gen_state(namelist,Pattern), - Rtmod:gen_inc_decode(Erule,TypeDef), - gen_dec_part_inner_constr(Erule,TypeDef,[Name]), - gen_partial_inc_dec_refed_funcs(Erule); - _ -> - gen_partial_inc_dec_refed_funcs(Erule) - end; -gen_partial_inc_dec_refed_funcs(_) -> - ok. - -pgen_partial_dec(_Erules,_Module) -> - ok. %%%% implement later - -%% generate code for all inner types that are called from the top type -%% of the partial incomplete decode -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,TopTypeName,Pattern}) -> - emit([{asis,FuncName},"(Bytes) ->",nl, - " decode_partial_incomplete(",{asis,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}}}); -gen_part_decode_funcs({constructed,bif},TypeName, - {_Name,undecoded,Tag,_Type}) -> - 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, "); -gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) -> - throw({error,{asn1,{"Not implemented yet",WhatKind," partial incomplete directive:",Directive}}}). - -gen_types(Erules,Tname,{RootList,ExtList}) when list(RootList) -> - gen_types(Erules,Tname,RootList), - gen_types(Erules,Tname,ExtList); -gen_types(Erules,Tname,[{'EXTENSIONMARK',_,_}|Rest]) -> - gen_types(Erules,Tname,Rest); -gen_types(Erules,Tname,[ComponentType|Rest]) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), - asn1ct_name:clear(), - Rtmod:gen_encode(Erules,Tname,ComponentType), - asn1ct_name:clear(), - Rtmod:gen_decode(Erules,Tname,ComponentType), - gen_types(Erules,Tname,Rest); -gen_types(_,_,[]) -> - true; -gen_types(Erules,Tname,Type) when record(Type,type) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), - asn1ct_name:clear(), - Rtmod:gen_encode(Erules,Tname,Type), - asn1ct_name:clear(), - Rtmod:gen_decode(Erules,Tname,Type). - -gen_value_match(Module) -> - case get(value_match) of - {true,Module} -> - emit(["value_match([{Index,Cname}|Rest],Value) ->",nl, - " Value2 =",nl, - " case element(Index,Value) of",nl, - " {Cname,Val2} -> Val2;",nl, - " X -> X",nl, - " end,",nl, - " value_match(Rest,Value2);",nl, - "value_match([],Value) ->",nl, - " Value.",nl]); - _ -> ok - end, - put(value_match,undefined). - -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}) -> - emit({Name,"(V,asn1_DEFAULT) ->",nl," true;",nl}), - emit({Name,"(V,V) ->",nl," true;",nl}), - emit({Name,"(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({Name,"(DefaultValue,Value) ->",nl}), - emit({" ",list2name([T,check]),"(DefaultValue,Value).",nl}); - MaybePrim -> - InnerType = get_inner(MaybePrim), - case type(InnerType) of - {primitive,bif} -> - emit({Name,"(DefaultValue,Value) ->",nl," "}), - gen_prim_check_call(InnerType,"DefaultValue","Value", - FType), - emit({".",nl,nl}); - _ -> - throw({asn1_error,{unknown,type,MaybePrim}}) - end - end. - -gen_check_sof(Name,SOF,Type) -> - NewName = list2name([sorted,Name]), - emit({Name,"(V1,V2) ->",nl}), - emit({" ",NewName,"(lists:sort(V1),lists:sort(V2)).",nl,nl}), - emit({NewName,"([],[]) ->",nl," true;",nl}), - emit({NewName,"([DV|DVs],[V|Vs]) ->",nl," "}), - InnerType = get_inner(Type#type.def), - case type(InnerType) of - {primitive,bif} -> - gen_prim_check_call(InnerType,"DV","V",Type), - emit({",",nl}); - {constructed,bif} -> - emit({list2name([SOF,Name]),"(DV, V),",nl}); - #'Externaltypereference'{type=T} -> - emit({list2name([T,check]),"(DV,V),",nl}) - end, - emit({" ",NewName,"(DVs,Vs).",nl,nl}). - -gen_check_sequence(Name,Components) -> - emit({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 = lists:concat(["lists:nth(",Num,",DefaultValue)"]), - NthDefV = ["element(",Num+1,",DefaultValue)"], -% NthV = lists:concat(["lists:nth(",Num,",Value)"]), - 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_sequence(_,[],_) -> - ok. - -gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) -> - emit({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), -% DefVal = ["element(2,lists:nth(",Num,",DefaultValue))"], - 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(InnerType,DefVal,Val,Type); - #'Externaltypereference'{type=T} -> - emit({" ",list2name([T,check]),"(",DefVal,",",Val,")"}); - _ -> - emit({" ",list2name([N,Name]),"(",DefVal,",",Val,")"}) - end. - - -%% VARIOUS GENERATOR STUFF -%% ************************************************* -%%************************************************** - -mk_var(X) when atom(X) -> - list_to_atom(mk_var(atom_to_list(X))); - -mk_var([H|T]) -> - [H-32|T]. - -%% Since hyphens are allowed in ASN.1 names, it may occur in a -%% variable to. Turn a hyphen into a under-score sign. -un_hyphen_var(X) when atom(X) -> - list_to_atom(un_hyphen_var(atom_to_list(X))); -un_hyphen_var([45|T]) -> - [95|un_hyphen_var(T)]; -un_hyphen_var([H|T]) -> - [H|un_hyphen_var(T)]; -un_hyphen_var([]) -> - []. - -%% Generate value functions *************** -%% **************************************** -%% Generates a function 'V'/0 for each Value V defined in the ASN.1 module -%% the function returns the value in an Erlang representation which can be -%% used as input to the runtime encode functions - -gen_value(Value) when record(Value,valuedef) -> -%% io:format(" ~w ",[Value#valuedef.name]), - emit({"'",Value#valuedef.name,"'() ->",nl}), - V = Value#valuedef.value, - emit([{asis,V},".",nl,nl]). - -gen_encode_constructed(Erules,Typename,InnerType,D) when record(D,type) -> - - Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])), - case InnerType of - 'SET' -> - Rtmod:gen_encode_set(Erules,Typename,D), - #'SET'{components=Components} = D#type.def, - gen_types(Erules,Typename,Components); - 'SEQUENCE' -> - Rtmod:gen_encode_sequence(Erules,Typename,D), - #'SEQUENCE'{components=Components} = D#type.def, - gen_types(Erules,Typename,Components); - 'CHOICE' -> - Rtmod:gen_encode_choice(Erules,Typename,D), - {_,Components} = D#type.def, - gen_types(Erules,Typename,Components); - 'SEQUENCE OF' -> - Rtmod:gen_encode_sof(Erules,Typename,InnerType,D), - {_,Type} = D#type.def, - NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def), - gen_types(Erules,[NameSuffix|Typename],Type); - 'SET OF' -> - Rtmod:gen_encode_sof(Erules,Typename,InnerType,D), - {_,Type} = D#type.def, - NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def), - gen_types(Erules,[NameSuffix|Typename],Type); - _ -> - exit({nyi,InnerType}) - end; -gen_encode_constructed(Erules,Typename,InnerType,D) - when record(D,typedef) -> - gen_encode_constructed(Erules,Typename,InnerType,D#typedef.typespec). - -gen_decode_constructed(Erules,Typename,InnerType,D) when record(D,type) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])), - asn1ct:step_in_constructed(), %% updates namelist for incomplete - %% partial decode - case InnerType of - 'SET' -> - Rtmod:gen_decode_set(Erules,Typename,D); - 'SEQUENCE' -> - Rtmod:gen_decode_sequence(Erules,Typename,D); - 'CHOICE' -> - Rtmod:gen_decode_choice(Erules,Typename,D); - 'SEQUENCE OF' -> - Rtmod:gen_decode_sof(Erules,Typename,InnerType,D); - 'SET OF' -> - Rtmod:gen_decode_sof(Erules,Typename,InnerType,D); - _ -> - exit({nyi,InnerType}) - end; - - -gen_decode_constructed(Erules,Typename,InnerType,D) when record(D,typedef) -> - gen_decode_constructed(Erules,Typename,InnerType,D#typedef.typespec). - - -pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> - emit({"-export([encoding_rule/0]).",nl}), - case Types of - [] -> ok; - _ -> - emit({"-export([",nl}), - case Erules of - ber -> - gen_exports1(Types,"enc_",2); - ber_bin -> - gen_exports1(Types,"enc_",2); - ber_bin_v2 -> - gen_exports1(Types,"enc_",2); - _ -> - gen_exports1(Types,"enc_",1) - end, - emit({"-export([",nl}), - gen_exports1(Types,"dec_",2), - case Erules of - ber -> - emit({"-export([",nl}), - gen_exports1(Types,"dec_",3); - ber_bin -> - emit({"-export([",nl}), - gen_exports1(Types,"dec_",3); - ber_bin_v2 -> - emit({"-export([",nl}), - gen_exports1(Types,"dec_",2); - _ -> ok - end - end, - case Values of - [] -> ok; - _ -> - emit({"-export([",nl}), - gen_exports1(Values,"",0) - end, - case Objects of - [] -> ok; - _ -> - case erule(Erules) of - per -> - emit({"-export([",nl}), - gen_exports1(Objects,"enc_",3), - emit({"-export([",nl}), - gen_exports1(Objects,"dec_",4); - ber_bin_v2 -> - emit({"-export([",nl}), - gen_exports1(Objects,"enc_",3), - emit({"-export([",nl}), - gen_exports1(Objects,"dec_",3); - _ -> - emit({"-export([",nl}), - gen_exports1(Objects,"enc_",4), - emit({"-export([",nl}), - gen_exports1(Objects,"dec_",4) - end - end, - case ObjectSets of - [] -> ok; - _ -> - emit({"-export([",nl}), - gen_exports1(ObjectSets,"getenc_",2), - emit({"-export([",nl}), - gen_exports1(ObjectSets,"getdec_",2) - end, - emit({"-export([info/0]).",nl}), - gen_partial_inc_decode_exports(), - emit({nl,nl}). - -gen_exports1([F1,F2|T],Prefix,Arity) -> - emit({"'",Prefix,F1,"'/",Arity,com,nl}), - gen_exports1([F2|T],Prefix,Arity); -gen_exports1([Flast|_T],Prefix,Arity) -> - emit({"'",Prefix,Flast,"'/",Arity,nl,"]).",nl,nl}). - -gen_partial_inc_decode_exports() -> - case {asn1ct:read_config_data(partial_incomplete_decode), - asn1ct:get_gen_state_field(inc_type_pattern)} of - {undefined,_} -> - ok; - {_,undefined} -> - ok; - {Data,_} -> - gen_partial_inc_decode_exports(Data), - emit("-export([decode_part/2]).") - end. -gen_partial_inc_decode_exports([]) -> - ok; -gen_partial_inc_decode_exports([{Name,_,_}|Rest]) -> - emit(["-export([",Name,"/1"]), - gen_partial_inc_decode_exports1(Rest); -gen_partial_inc_decode_exports([_|Rest]) -> - gen_partial_inc_decode_exports(Rest). - -gen_partial_inc_decode_exports1([]) -> - emit(["]).",nl]); -gen_partial_inc_decode_exports1([{Name,_,_}|Rest]) -> - emit([", ",Name,"/1"]), - gen_partial_inc_decode_exports1(Rest); -gen_partial_inc_decode_exports1([_|Rest]) -> - gen_partial_inc_decode_exports1(Rest). - -pgen_dispatcher(Erules,_Module,{[],_Values,_,_,_Objects,_ObjectSets}) -> - emit(["encoding_rule() ->",nl]), - emit([{asis,Erules},".",nl,nl]); -pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> - emit(["-export([encode/2,decode/2,encode_disp/2,decode_disp/2]).",nl,nl]), - emit(["encoding_rule() ->",nl]), - emit([" ",{asis,Erules},".",nl,nl]), - Call = case Erules of - per -> "?RT_PER:complete(encode_disp(Type,Data))"; - per_bin -> "?RT_PER:complete(encode_disp(Type,Data))"; - ber -> "encode_disp(Type,Data)"; - ber_bin -> "encode_disp(Type,Data)"; - ber_bin_v2 -> "encode_disp(Type,Data)" - end, - EncWrap = case Erules of - ber -> "wrap_encode(Bytes)"; - _ -> "Bytes" - end, - emit(["encode(Type,Data) ->",nl, - "case catch ",Call," of",nl, - " {'EXIT',{error,Reason}} ->",nl, - " {error,Reason};",nl, - " {'EXIT',Reason} ->",nl, - " {error,{asn1,Reason}};",nl, - " {Bytes,_Len} ->",nl, - " {ok,",EncWrap,"};",nl, - " Bytes ->",nl, - " {ok,",EncWrap,"}",nl, - "end.",nl,nl]), - - case Erules of - ber_bin_v2 -> - emit(["decode(Type,Data0) ->",nl]), - emit(["{Data,_RestBin} = ?RT_BER:decode(Data0",driver_parameter(),"),",nl]); - _ -> - emit(["decode(Type,Data) ->",nl]) - end, - DecWrap = case Erules of - ber -> "wrap_decode(Data)"; - _ -> "Data" - end, - - emit(["case catch decode_disp(Type,",DecWrap,") of",nl, - " {'EXIT',{error,Reason}} ->",nl, - " {error,Reason};",nl, - " {'EXIT',Reason} ->",nl, - " {error,{asn1,Reason}};",nl]), - case Erules of - ber_bin_v2 -> - emit([" Result ->",nl, - " {ok,Result}",nl]); - _ -> - emit([" {X,_Rest} ->",nl, - " {ok,X};",nl, - " {X,_Rest,_Len} ->",nl, - " {ok,X}",nl]) - end, - emit(["end.",nl,nl]), - - gen_decode_partial_incomplete(Erules), - - case Types of - [] -> ok; - _ -> - case Erules of - ber -> - gen_dispatcher(Types,"encode_disp","enc_",",[]"), - gen_dispatcher(Types,"decode_disp","dec_",",mandatory"); - ber_bin -> - gen_dispatcher(Types,"encode_disp","enc_",",[]"), - gen_dispatcher(Types,"decode_disp","dec_",",mandatory"); - ber_bin_v2 -> - gen_dispatcher(Types,"encode_disp","enc_",""), - gen_dispatcher(Types,"decode_disp","dec_",""), - gen_partial_inc_dispatcher(); - _PerOrPer_bin -> - gen_dispatcher(Types,"encode_disp","enc_",""), - gen_dispatcher(Types,"decode_disp","dec_",",mandatory") - end, - emit([nl]) - end, - case Erules of - ber -> - gen_wrapper(); - _ -> ok - end, - emit({nl,nl}). - - -gen_decode_partial_incomplete(Erule) when Erule == ber;Erule==ber_bin; - Erule==ber_bin_v2 -> - case {asn1ct:read_config_data(partial_incomplete_decode), - asn1ct:get_gen_state_field(inc_type_pattern)} of - {undefined,_} -> - ok; - {_,undefined} -> - ok; - _ -> - case Erule of - ber_bin_v2 -> - EmitCaseClauses = - fun() -> - emit([" {'EXIT',{error,Reason}} ->",nl, - " {error,Reason};",nl, - " {'EXIT',Reason} ->",nl, - " {error,{asn1,Reason}};",nl, - " Result ->",nl, - " {ok,Result}",nl, - " end.",nl,nl]) - end, - emit(["decode_partial_incomplete(Type,Data0,", - "Pattern) ->",nl]), - emit([" {Data,_RestBin} =",nl, - " ?RT_BER:decode_primitive_", - "incomplete(Pattern,Data0),",nl, - " case catch decode_partial_inc_disp(Type,", - "Data) of",nl]), - EmitCaseClauses(), - emit(["decode_part(Type,Data0) ->",nl, - " {Data,_RestBin} = ?RT_BER:decode(Data0),",nl, - " case catch decode_inc_disp(Type,Data) of",nl]), - EmitCaseClauses(); - _ -> ok % add later - end - end; -gen_decode_partial_incomplete(_Erule) -> - ok. - -gen_partial_inc_dispatcher() -> - case {asn1ct:read_config_data(partial_incomplete_decode), - asn1ct:get_gen_state_field(inc_type_pattern)} of - {undefined,_} -> - ok; - {_,undefined} -> - ok; - {Data,_} -> - gen_partial_inc_dispatcher(Data) - end. -gen_partial_inc_dispatcher([{_FuncName,TopType,_Pattern}|Rest]) -> - emit(["decode_partial_inc_disp(",{asis,TopType},",Data) ->",nl, - " ",{asis,list_to_atom(lists:concat([dec,"-inc-",TopType]))}, - "(Data);",nl]), - gen_partial_inc_dispatcher(Rest); -gen_partial_inc_dispatcher([]) -> - emit(["decode_partial_inc_disp(Type,_Data) ->",nl, - " exit({error,{asn1,{undefined_type,Type}}}).",nl]). - -driver_parameter() -> - Options = get(encoding_options), - case lists:member(driver,Options) of - true -> - ",driver"; - _ -> "" - end. - -gen_wrapper() -> - emit(["wrap_encode(Bytes) when list(Bytes) ->",nl, - " binary_to_list(list_to_binary(Bytes));",nl, - "wrap_encode(Bytes) when binary(Bytes) ->",nl, - " binary_to_list(Bytes);",nl, - "wrap_encode(Bytes) -> Bytes.",nl,nl]), - emit(["wrap_decode(Bytes) when list(Bytes) ->",nl, - " list_to_binary(Bytes);",nl, - "wrap_decode(Bytes) -> Bytes.",nl]). - -gen_dispatcher([F1,F2|T],FuncName,Prefix,ExtraArg) -> - emit([FuncName,"('",F1,"',Data) -> '",Prefix,F1,"'(Data",ExtraArg,")",";",nl]), - gen_dispatcher([F2|T],FuncName,Prefix,ExtraArg); -gen_dispatcher([Flast|_T],FuncName,Prefix,ExtraArg) -> - emit([FuncName,"('",Flast,"',Data) -> '",Prefix,Flast,"'(Data",ExtraArg,")",";",nl]), - emit([FuncName,"(","Type",",_Data) -> exit({error,{asn1,{undefined_type,Type}}}).",nl,nl,nl]). - -pgen_info(_Erules,Module) -> - Options = get(encoding_options), - emit({"info() ->",nl, - " [{vsn,'",asn1ct:vsn(),"'},", - " {module,'",Module,"'},", - " {options,",io_lib:format("~p",[Options]),"}].",nl}). - -open_hrl(OutFile,Module) -> - File = lists:concat([OutFile,".hrl"]), - Fid = fopen(File,write), - put(gen_file_out,Fid), - gen_hrlhead(Module). - -%% EMIT functions ************************ -%% *************************************** - - % debug generation -demit(Term) -> - case get(asndebug) of - true -> emit(Term); - _ ->true - end. - - % always generation - -emit({external,_M,T}) -> - emit(T); - -emit({prev,Variable}) when atom(Variable) -> - emit({var,asn1ct_name:prev(Variable)}); - -emit({next,Variable}) when atom(Variable) -> - emit({var,asn1ct_name:next(Variable)}); - -emit({curr,Variable}) when atom(Variable) -> - emit({var,asn1ct_name:curr(Variable)}); - -emit({var,Variable}) when atom(Variable) -> - [Head|V] = atom_to_list(Variable), - emit([Head-32|V]); - -emit({var,Variable}) -> - [Head|V] = Variable, - emit([Head-32|V]); - -emit({asis,What}) -> - format(get(gen_file_out),"~w",[What]); - -emit(nl) -> - nl(get(gen_file_out)); - -emit(com) -> - emit(","); - -emit(tab) -> - put_chars(get(gen_file_out)," "); - -emit(What) when integer(What) -> - put_chars(get(gen_file_out),integer_to_list(What)); - -emit(What) when list(What), integer(hd(What)) -> - put_chars(get(gen_file_out),What); - -emit(What) when atom(What) -> - put_chars(get(gen_file_out),atom_to_list(What)); - -emit(What) when tuple(What) -> - emit_parts(tuple_to_list(What)); - -emit(What) when list(What) -> - emit_parts(What); - -emit(X) -> - exit({'cant emit ',X}). - -emit_parts([]) -> true; -emit_parts([H|T]) -> - emit(H), - emit_parts(T). - -format(undefined,X,Y) -> - io:format(X,Y); -format(X,Y,Z) -> - io:format(X,Y,Z). - -nl(undefined) -> io:nl(); -nl(X) -> io:nl(X). - -put_chars(undefined,X) -> - io:put_chars(X); -put_chars(Y,X) -> - io:put_chars(Y,X). - -fopen(F, Mode) -> - case file:open(F, [Mode]) of - {ok, Fd} -> - Fd; - {error, Reason} -> - io:format("** Can't open file ~p ~n", [F]), - exit({error,Reason}) - end. - -pgen_hrl(Erules,Module,TypeOrVal,_Indent) -> - put(currmod,Module), - {Types,Values,Ptypes,_,_,_} = TypeOrVal, - Ret = - case pgen_hrltypes(Erules,Module,Ptypes++Types,0) of - 0 -> - case Values of - [] -> - 0; - _ -> - open_hrl(get(outfile),get(currmod)), - pgen_macros(Erules,Module,Values), - 1 - end; - X -> - pgen_macros(Erules,Module,Values), - X - end, - case Ret of - 0 -> - 0; - Y -> - Fid = get(gen_file_out), - file:close(Fid), - io:format("--~p--~n", - [{generated,lists:concat([get(outfile),".hrl"])}]), - Y - end. - -pgen_macros(_,_,[]) -> - true; -pgen_macros(Erules,Module,[H|T]) -> - Valuedef = asn1_db:dbget(Module,H), - gen_macro(Valuedef), - pgen_macros(Erules,Module,T). - -pgen_hrltypes(_,_,[],NumRecords) -> - NumRecords; -pgen_hrltypes(Erules,Module,[H|T],NumRecords) -> -% io:format("records = ~p~n",NumRecords), - Typedef = asn1_db:dbget(Module,H), - AddNumRecords = gen_record(Typedef,NumRecords), - pgen_hrltypes(Erules,Module,T,NumRecords+AddNumRecords). - - -%% Generates a macro for value Value defined in the ASN.1 module -gen_macro(Value) when record(Value,valuedef) -> - emit({"-define('",Value#valuedef.name,"', ", - {asis,Value#valuedef.value},").",nl}). - -%% Generate record functions ************** -%% Generates an Erlang record for each named and unnamed SEQUENCE and SET in the ASN.1 -%% module. If no SEQUENCE or SET is found there is no .hrl file generated - - -gen_record(Tdef,NumRecords) when record(Tdef,typedef) -> - Name = [Tdef#typedef.name], - Type = Tdef#typedef.typespec, - gen_record(type,Name,Type,NumRecords); - -gen_record(Tdef,NumRecords) when record(Tdef,ptypedef) -> - Name = [Tdef#ptypedef.name], - Type = Tdef#ptypedef.typespec, - gen_record(ptype,Name,Type,NumRecords). - -gen_record(TorPtype,Name,[#'ComponentType'{name=Cname,typespec=Type}|T],Num) -> - Num2 = gen_record(TorPtype,[Cname|Name],Type,Num), - gen_record(TorPtype,Name,T,Num2); -gen_record(TorPtype,Name,{Clist1,Clist2},Num) when list(Clist1), list(Clist2) -> - gen_record(TorPtype,Name,Clist1++Clist2,Num); -gen_record(TorPtype,Name,[_|T],Num) -> % skip EXTENSIONMARK - gen_record(TorPtype,Name,T,Num); -gen_record(_TorPtype,_Name,[],Num) -> - Num; - -gen_record(TorPtype,Name,Type,Num) when record(Type,type) -> - Def = Type#type.def, - Rec = case Def of - Seq when record(Seq,'SEQUENCE') -> - case Seq#'SEQUENCE'.pname of - false -> - {record,Seq#'SEQUENCE'.components}; - _Pname when TorPtype == type -> - false; - _ -> - {record,Seq#'SEQUENCE'.components} - end; - Set when record(Set,'SET') -> - case Set#'SET'.pname of - false -> - {record,Set#'SET'.components}; - _Pname when TorPtype == type -> - false; - _ -> - {record,Set#'SET'.components} - end; -% {'SET',{_,_CompList}} -> -% {record,_CompList}; - {'CHOICE',_CompList} -> {inner,Def}; - {'SEQUENCE OF',_CompList} -> {['SEQOF'|Name],Def}; - {'SET OF',_CompList} -> {['SETOF'|Name],Def}; - _ -> false - end, - case Rec of - false -> Num; - {record,CompList} -> - case Num of - 0 -> open_hrl(get(outfile),get(currmod)); - _ -> true - end, - emit({"-record('",list2name(Name),"',{",nl}), - RootList = case CompList of - _ when list(CompList) -> - CompList; - {_Rl,_} -> _Rl - end, - gen_record2(Name,'SEQUENCE',RootList), - NewCompList = - case CompList of - {CompList1,[]} -> - emit({"}). % with extension mark",nl,nl}), - CompList1; - {Tr,ExtensionList2} -> - case Tr of - [] -> true; - _ -> emit({",",nl}) - end, - emit({"%% with extensions",nl}), - gen_record2(Name, 'SEQUENCE', ExtensionList2, - "", ext), - emit({"}).",nl,nl}), - Tr ++ ExtensionList2; - _ -> - emit({"}).",nl,nl}), - CompList - end, - gen_record(TorPtype,Name,NewCompList,Num+1); - {inner,{'CHOICE', CompList}} -> - gen_record(TorPtype,Name,CompList,Num); - {NewName,{_, CompList}} -> - gen_record(TorPtype,NewName,CompList,Num) - end; -gen_record(_,_,_,NumRecords) -> % skip CLASS etc for now. - NumRecords. - -gen_head(Erules,Mod,Hrl) -> - {Rtmac,Rtmod} = case Erules of - per -> - emit({"%% Generated by the Erlang ASN.1 PER-" - "compiler version:",asn1ct:vsn(),nl}), - {"RT_PER",?RT_PER}; - ber -> - emit({"%% Generated by the Erlang ASN.1 BER-" - "compiler version:",asn1ct:vsn(),nl}), - {"RT_BER",?RT_BER_BIN}; - per_bin -> - emit({"%% Generated by the Erlang ASN.1 BER-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl}), - %% temporary code to enable rt2ct optimization - Options = get(encoding_options), - case lists:member(optimize,Options) of - true -> {"RT_PER","asn1rt_per_bin_rt2ct"}; - _ -> - {"RT_PER",?RT_PER_BIN} - end; - ber_bin -> - emit({"%% Generated by the Erlang ASN.1 BER-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl}), - {"RT_BER",?RT_BER_BIN}; - ber_bin_v2 -> - emit({"%% Generated by the Erlang ASN.1 BER_V2-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl}), - {"RT_BER","asn1rt_ber_bin_v2"} - end, - emit({"%% Purpose: encoder and decoder to the types in mod ",Mod,nl,nl}), - emit({"-module('",Mod,"').",nl}), - put(currmod,Mod), - %emit({"-compile(export_all).",nl}), - case Hrl of - 0 -> true; - _ -> - emit({"-include(\"",Mod,".hrl\").",nl}) - end, - emit(["-define('",Rtmac,"',",Rtmod,").",nl]). - - -gen_hrlhead(Mod) -> - emit({"%% Generated by the Erlang ASN.1 compiler version:",asn1ct:vsn(),nl}), - emit({"%% Purpose: Erlang record definitions for each named and unnamed",nl}), - emit({"%% SEQUENCE and SET, and macro definitions for each value",nl}), - emit({"%% definition,in module ",Mod,nl,nl}), - emit({nl,nl}). - -gen_record2(Name,SeqOrSet,Comps) -> - gen_record2(Name,SeqOrSet,Comps,"",noext). - -gen_record2(_Name,_SeqOrSet,[],_Com,_Extension) -> - true; -gen_record2(Name,SeqOrSet,[{'EXTENSIONMARK',_,_}|T],Com,Extension) -> - gen_record2(Name,SeqOrSet,T,Com,Extension); -gen_record2(_Name,_SeqOrSet,[H],Com,Extension) -> - #'ComponentType'{name=Cname} = H, - emit(Com), - emit({asis,Cname}), - gen_record_default(H, Extension); -gen_record2(Name,SeqOrSet,[H|T],Com, Extension) -> - #'ComponentType'{name=Cname} = H, - emit(Com), - emit({asis,Cname}), - gen_record_default(H, Extension), -% emit(", "), - gen_record2(Name,SeqOrSet,T,", ", Extension). - -%gen_record_default(C, ext) -> -% emit(" = asn1_NOEXTVALUE"); -gen_record_default(#'ComponentType'{prop='OPTIONAL'}, _)-> - emit(" = asn1_NOVALUE"); -gen_record_default(#'ComponentType'{prop={'DEFAULT',_}}, _)-> - emit(" = asn1_DEFAULT"); -gen_record_default(_, _) -> - true. - -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); -% case asn1ct_gen:type(InType) of -% {constructed,bif} -> -% lookahead_innertype([T],InType,RefType); -% #'Externaltypereference'{type=TNew} -> -% lookahead_innertype([TNew],InType,RefType); -% _ -> -% ok -% end; - _ -> - ok - end; - {constructed,bif} -> - NameList = [Cname|TopType], - Name = list2name(NameList ++ [check]), - emit({"'",Name,"'(",DefaultValue,", ",Element,")"}), - ets: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) - end. - -gen_prim_check_call(PrimType,DefaultValue,Element,Type) -> - case unify_if_string(PrimType) of - 'BOOLEAN' -> - emit({"asn1rt_check:check_bool(",DefaultValue,", ", - Element,")"}); - 'INTEGER' -> - NNL = - case Type#type.def of - {_,NamedNumberList} -> NamedNumberList; - _ -> [] - end, - emit({"asn1rt_check:check_int(",DefaultValue,", ", - Element,", ",{asis,NNL},")"}); - 'BIT STRING' -> - {_,NBL} = Type#type.def, - emit({"asn1rt_check:check_bitstring(",DefaultValue,", ", - Element,", ",{asis,NBL},")"}); - 'OCTET STRING' -> - emit({"asn1rt_check:check_octetstring(",DefaultValue,", ", - Element,")"}); - 'NULL' -> - emit({"asn1rt_check:check_null(",DefaultValue,", ", - Element,")"}); - 'OBJECT IDENTIFIER' -> - emit({"asn1rt_check:check_objectidentifier(",DefaultValue, - ", ",Element,")"}); - 'ObjectDescriptor' -> - emit({"asn1rt_check:check_objectdescriptor(",DefaultValue, - ", ",Element,")"}); - 'REAL' -> - emit({"asn1rt_check:check_real(",DefaultValue, - ", ",Element,")"}); - 'ENUMERATED' -> - {_,Enumerations} = Type#type.def, - emit({"asn1rt_check:check_enum(",DefaultValue, - ", ",Element,", ",{asis,Enumerations},")"}); - restrictedstring -> - emit({"asn1rt_check:check_restrictedstring(",DefaultValue, - ", ",Element,")"}) - end. - -%% 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, - InType = asn1ct_gen:get_inner(RefType#type.def), - case type(InType) of - {constructed,bif} -> - NewName = list2name([T,check]), - case insert_once(check_functions,{NewName,RefType}) of - true -> - lookahead_innertype([T],InType,RefType); - _ -> - ok - end; - #'Externaltypereference'{} -> - NewName = list2name([T,check]), - case insert_once(check_functions,{NewName,RefType}) of - true -> - lookahead_innertype([T],InType,RefType); - _ -> - ok - end; - _ -> - ok - end; -% case insert_once(check_functions,{list2name(Name++[check]),Type}) of -% true -> -% InnerType = asn1ct_gen:get_inner(Type#type.def), -% case asn1ct_gen:type(InnerType) of -% {constructed,bif} -> -% lookahead_innertype([T],InnerType,Type); -% #'Externaltypereference'{type=TNew} -> -% lookahead_innertype([TNew],InnerType,Type); -% _ -> -% ok -% end; -% _ -> -% 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); - #'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; - _ -> - ok - end. - - -insert_once(Table,Object) -> - case ets:lookup(Table,element(1,Object)) of - [] -> - ets:insert(Table,Object); %returns true - _ -> false - end. - -unify_if_string(PrimType) -> - case PrimType of - 'NumericString' -> - restrictedstring; - 'PrintableString' -> - restrictedstring; - 'TeletexString' -> - restrictedstring; - 'VideotexString' -> - restrictedstring; - 'IA5String' -> - restrictedstring; - 'UTCTime' -> - restrictedstring; - 'GeneralizedTime' -> - restrictedstring; - 'GraphicString' -> - restrictedstring; - 'VisibleString' -> - restrictedstring; - 'GeneralString' -> - restrictedstring; - 'UniversalString' -> - restrictedstring; - 'BMPString' -> - restrictedstring; - Other -> Other - end. - - - - - -get_inner(A) when atom(A) -> A; -get_inner(Ext) when record(Ext,'Externaltypereference') -> Ext; -get_inner(Tref) when record(Tref,typereference) -> Tref; -get_inner({fixedtypevaluefield,_,Type}) -> - if - record(Type,type) -> - get_inner(Type#type.def); - true -> - get_inner(Type) - end; -get_inner({typefield,TypeName}) -> - TypeName; -get_inner(#'ObjectClassFieldType'{type=Type}) -> -% get_inner(Type); - Type; -get_inner(T) when tuple(T) -> - case element(1,T) of - Tuple when tuple(Tuple),element(1,Tuple) == objectclass -> - case catch(lists:last(element(2,T))) of - {valuefieldreference,FieldName} -> - get_fieldtype(element(2,Tuple),FieldName); - {typefieldreference,FieldName} -> - get_fieldtype(element(2,Tuple),FieldName); - {'EXIT',Reason} -> - throw({asn1,{'internal error in get_inner/1',Reason}}) - end; - _ -> element(1,T) - end. - - - - - -type(X) when record(X,'Externaltypereference') -> - X; -type(X) when record(X,typereference) -> - X; -type('ASN1_OPEN_TYPE') -> - 'ASN1_OPEN_TYPE'; -type({fixedtypevaluefield,_Name,Type}) when record(Type,type) -> - type(get_inner(Type#type.def)); -type({typefield,_}) -> - 'ASN1_OPEN_TYPE'; -type(X) -> - %% io:format("asn1_types:type(~p)~n",[X]), - case catch type2(X) of - {'EXIT',_} -> - {notype,X}; - Normal -> - Normal - end. - -type2(X) -> - case prim_bif(X) of - true -> - {primitive,bif}; - false -> - case construct_bif(X) of - true -> - {constructed,bif}; - false -> - {undefined,user} - end - end. - -prim_bif(X) -> - lists:member(X,['INTEGER' , - 'ENUMERATED', - 'OBJECT IDENTIFIER', - 'ANY', - 'NULL', - 'BIT STRING' , - 'OCTET STRING' , - 'ObjectDescriptor', - 'NumericString', - 'TeletexString', - 'VideotexString', - 'UTCTime', - 'GeneralizedTime', - 'GraphicString', - 'VisibleString', - 'GeneralString', - 'PrintableString', - 'IA5String', - 'UniversalString', - 'BMPString', - 'ENUMERATED', - 'BOOLEAN']). - -construct_bif(T) -> - lists:member(T,['SEQUENCE' , - 'SEQUENCE OF' , - 'CHOICE' , - 'SET' , - 'SET OF']). - -def_to_tag(#tag{class=Class,number=Number}) -> - {Class,Number}; -def_to_tag(#'ObjectClassFieldType'{type=Type}) -> - case Type of - T when tuple(T),element(1,T)==fixedtypevaluefield -> - {'UNIVERSAL',get_inner(Type)}; - _ -> - [] - end; -def_to_tag(Def) -> - {'UNIVERSAL',get_inner(Def)}. - - -%% Information Object Class - -type_from_object(X) -> - case (catch lists:last(element(2,X))) of - {'EXIT',_} -> - {notype,X}; - Normal -> - Normal - end. - - -get_fieldtype([],_FieldName)-> - {no_type,no_name}; -get_fieldtype([Field|Rest],FieldName) -> - case element(2,Field) of - FieldName -> - case element(1,Field) of - fixedtypevaluefield -> - {element(1,Field),FieldName,element(3,Field)}; - _ -> - {element(1,Field),FieldName} - end; - _ -> - get_fieldtype(Rest,FieldName) - end. - -get_fieldcategory([],_FieldName) -> - no_cat; -get_fieldcategory([Field|Rest],FieldName) -> - case element(2,Field) of - FieldName -> - element(1,Field); - _ -> - get_fieldcategory(Rest,FieldName) - end. - -get_typefromobject(Type) when record(Type,type) -> - case Type#type.def of - {{objectclass,_,_},TypeFrObj} when list(TypeFrObj) -> - {_,FieldName} = lists:last(TypeFrObj), - FieldName; - _ -> - {no_field} - end. - -get_classfieldcategory(Type,FieldName) -> - case (catch Type#type.def) of - {{obejctclass,Fields,_},_} -> - get_fieldcategory(Fields,FieldName); - {'EXIT',_} -> - no_cat; - _ -> - no_cat - end. -%% Information Object Class - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Convert a list of name parts to something that can be output by emit -%% -%% used to output function names in generated code. - -list2name(L) -> - NewL = list2name1(L), - lists:concat(lists:reverse(NewL)). - -list2name1([{ptype,H1},H2|T]) -> - [H1,"_",list2name([H2|T])]; -list2name1([H1,H2|T]) -> - [H1,"_",list2name([H2|T])]; -list2name1([{ptype,H}|_T]) -> - [H]; -list2name1([H|_T]) -> - [H]; -list2name1([]) -> - []. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Convert a list of name parts to something that can be output by emit -%% stops at {ptype,Pname} i.e Pname whill be the first part of the name -%% used to output record names in generated code. - -list2rname(L) -> - NewL = list2rname1(L), - lists:concat(lists:reverse(NewL)). - -list2rname1([{ptype,H1},_H2|_T]) -> - [H1]; -list2rname1([H1,H2|T]) -> - [H1,"_",list2name([H2|T])]; -list2rname1([{ptype,H}|_T]) -> - [H]; -list2rname1([H|_T]) -> - [H]; -list2rname1([]) -> - []. - - - -constructed_suffix(_,#'SEQUENCE'{pname=Ptypename}) when Ptypename =/= false -> - {ptype, Ptypename}; -constructed_suffix(_,#'SET'{pname=Ptypename}) when Ptypename =/= false -> - {ptype,Ptypename}; -constructed_suffix('SEQUENCE OF',_) -> - 'SEQOF'; -constructed_suffix('SET OF',_) -> - 'SETOF'. - -erule(ber) -> - ber; -erule(ber_bin) -> - ber; -erule(ber_bin_v2) -> - ber_bin_v2; -erule(per) -> - per; -erule(per_bin) -> - per. - -wrap_ber(ber) -> - ber_bin; -wrap_ber(Erule) -> - Erule. - -rt2ct_suffix() -> - Options = get(encoding_options), - case {lists:member(optimize,Options),lists:member(per_bin,Options)} of - {true,true} -> "_rt2ct"; - _ -> "" - end. -rt2ct_suffix(per_bin) -> - Options = get(encoding_options), - case lists:member(optimize,Options) of - true -> "_rt2ct"; - _ -> "" - end; -rt2ct_suffix(_) -> "". - -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V; - {value,Cnstr} -> - Cnstr - end. diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_ber.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_ber.erl deleted file mode 100644 index f063dff765..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_ber.erl +++ /dev/null @@ -1,1525 +0,0 @@ -%% ``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: asn1ct_gen_ber.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ -%% --module(asn1ct_gen_ber). - -%% Generate erlang module which handles (PER) encode and decode for -%% all types in an ASN.1 module - --include("asn1_records.hrl"). - --export([pgen/4]). --export([decode_class/1, decode_type/1]). --export([add_removed_bytes/0]). --export([gen_encode/2,gen_encode/3,gen_decode/2,gen_decode/3]). --export([gen_encode_prim/4]). --export([gen_dec_prim/8]). --export([gen_objectset_code/2, gen_obj_code/3]). --export([re_wrap_erule/1]). --export([unused_var/2]). - --import(asn1ct_gen, [emit/1,demit/1]). - - % the encoding of class of tag bits 8 and 7 --define(UNIVERSAL, 0). --define(APPLICATION, 16#40). --define(CONTEXT, 16#80). --define(PRIVATE, 16#C0). - - % primitive or constructed encoding % bit 6 --define(PRIMITIVE, 0). --define(CONSTRUCTED, 2#00100000). - - --define(T_ObjectDescriptor, ?UNIVERSAL bor ?PRIMITIVE bor 7). - % restricted character string types --define(T_NumericString, ?UNIVERSAL bor ?PRIMITIVE bor 18). %can be constructed --define(T_PrintableString, ?UNIVERSAL bor ?PRIMITIVE bor 19). %can be constructed --define(T_TeletexString, ?UNIVERSAL bor ?PRIMITIVE bor 20). %can be constructed --define(T_VideotexString, ?UNIVERSAL bor ?PRIMITIVE bor 21). %can be constructed --define(T_IA5String, ?UNIVERSAL bor ?PRIMITIVE bor 22). %can be constructed --define(T_GraphicString, ?UNIVERSAL bor ?PRIMITIVE bor 25). %can be constructed --define(T_VisibleString, ?UNIVERSAL bor ?PRIMITIVE bor 26). %can be constructed --define(T_GeneralString, ?UNIVERSAL bor ?PRIMITIVE bor 27). %can be constructed - -%% 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 -%% Module = atom() -%% TypeOrVal = {TypeList,ValueList,PTypeList} -%% TypeList = ValueList = [atom()] - -pgen(OutFile,Erules,Module,TypeOrVal) -> - asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,true). - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Generate ENCODING -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% encode #{typedef, {pos, name, typespec}} -%%=============================================================================== - -gen_encode(Erules,Type) when record(Type,typedef) -> - gen_encode_user(Erules,Type). - -%%=============================================================================== -%% encode #{type, {tag, def, constraint}} -%%=============================================================================== - -gen_encode(Erules,Typename,Type) when record(Type,type) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - ObjFun = - case lists:keysearch(objfun,1,Type#type.tablecinf) of - {value,{_,_Name}} -> - ", ObjFun"; - false -> - "" - end, - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - emit([nl,nl,nl,"%%================================"]), - emit([nl,"%% ",asn1ct_gen:list2name(Typename)]), - emit([nl,"%%================================",nl]), - case lists:member(InnerType,['SET','SEQUENCE']) of - true -> - case get(asn_keyed_list) of - true -> - CompList = - case Type#type.def of - #'SEQUENCE'{components=Cl} -> Cl; - #'SET'{components=Cl} -> Cl - end, - emit([nl,"'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn",ObjFun, - ") when list(Val) ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(?RT_BER:fixoptionals(", - {asis,optionals(CompList)}, - ",Val), TagIn",ObjFun,");",nl,nl]); - _ -> true - end; - _ -> - emit([nl,"'enc_",asn1ct_gen:list2name(Typename), - "'({'",asn1ct_gen:list2name(Typename), - "',Val}, TagIn",ObjFun,") ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn",ObjFun,");",nl,nl]) - end, - emit(["'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn",ObjFun,") ->",nl," "]), - asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); - _ -> - true - end; - -%%=============================================================================== -%% encode ComponentType -%%=============================================================================== - -gen_encode(Erules,Tname,{'ComponentType',_Pos,Cname,Type,_,_}) -> - NewTname = [Cname|Tname], - %% The tag is set to [] to avoid that it is - %% taken into account twice, both as a component/alternative (passed as - %% argument to the encode decode function and within the encode decode - %% function it self. - NewType = Type#type{tag=[]}, - gen_encode(Erules,NewTname,NewType). - -gen_encode_user(Erules,D) when record(D,typedef) -> - Typename = [D#typedef.name], - Type = D#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Type#type.def), - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - emit([nl,nl,"%%================================"]), - emit([nl,"%% ",Typename]), - emit([nl,"%%================================",nl]), - case lists:member(InnerType,['SET','SEQUENCE']) of - true -> - case get(asn_keyed_list) of - true -> - CompList = - case Type#type.def of - #'SEQUENCE'{components=Cl} -> Cl; - #'SET'{components=Cl} -> Cl - end, - - emit([nl,"'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn) when list(Val) ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(?RT_BER:fixoptionals(", - {asis,optionals(CompList)}, - ",Val), TagIn);",nl,nl]); - _ -> true - end; - _ -> - emit({nl,"'enc_",asn1ct_gen:list2name(Typename), - "'({'",asn1ct_gen:list2name(Typename),"',Val}, TagIn) ->",nl}), - emit({" 'enc_",asn1ct_gen:list2name(Typename),"'(Val, TagIn);",nl,nl}) - end, - emit({"'enc_",asn1ct_gen:list2name(Typename),"'(", - unused_var("Val",Type#type.def),", TagIn) ->",nl}), - CurrentMod = get(currmod), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D); - {primitive,bif} -> - asn1ct_gen_ber:gen_encode_prim(ber,Type,["TagIn ++ ", - {asis,Tag}],"Val"), - emit([".",nl]); - #typereference{val=Ename} -> - emit([" 'enc_",Ename,"'(Val, TagIn ++ ",{asis,Tag},").",nl]); - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'enc_",Etype,"'(Val, TagIn ++ ", - {asis,Tag},").",nl]); - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'enc_",Etype,"'(Val, TagIn ++ ", - {asis,Tag},").",nl]); - 'ASN1_OPEN_TYPE' -> - emit(["%% OPEN TYPE",nl]), - asn1ct_gen_ber:gen_encode_prim(ber, - Type#type{def='ASN1_OPEN_TYPE'}, - ["TagIn ++ ", - {asis,Tag}],"Val"), - emit([".",nl]) - end. - -unused_var(Var,#'SEQUENCE'{components=Cl}) -> - unused_var1(Var,Cl); -unused_var(Var,#'SET'{components=Cl}) -> - unused_var1(Var,Cl); -unused_var(Var,_) -> - Var. -unused_var1(Var,Cs) when Cs == []; Cs == {[],[]} -> - lists:concat(["_",Var]); -unused_var1(Var,_) -> - Var. - -unused_optormand_var(Var,Def) -> - case asn1ct_gen:type(asn1ct_gen:get_inner(Def)) of - 'ASN1_OPEN_TYPE' -> - lists:concat(["_",Var]); - _ -> - Var - end. - - -gen_encode_prim(_Erules,D,DoTag,Value) when record(D,type) -> - -%%% Currently not used for BER (except for BitString) and therefore replaced -%%% with [] as a placeholder - BitStringConstraint = D#type.constraint, - Constraint = [], - asn1ct_name:new(enumval), - case D#type.def of - 'BOOLEAN' -> - emit_encode_func('boolean',Value,DoTag); - 'INTEGER' -> - emit_encode_func('integer',Constraint,Value,DoTag); - {'INTEGER',NamedNumberList} -> - emit_encode_func('integer',Constraint,Value, - NamedNumberList,DoTag); - {'ENUMERATED',NamedNumberList={_,_}} -> - - emit(["case (case ",Value," of {asn1_enum,_}->",Value,";{_,_}->element(2,",Value,");_->", - Value," end) of",nl]), - emit_enc_enumerated_cases(NamedNumberList,DoTag); - {'ENUMERATED',NamedNumberList} -> - - emit(["case (case ",Value," of {_,_}->element(2,",Value,");_->", - Value," end) of",nl]), - emit_enc_enumerated_cases(NamedNumberList,DoTag); - - {'BIT STRING',NamedNumberList} -> - emit_encode_func('bit_string',BitStringConstraint,Value, - NamedNumberList,DoTag); - 'ANY' -> - emit_encode_func('open_type', Value,DoTag); - 'NULL' -> - emit_encode_func('null',Value,DoTag); - 'OBJECT IDENTIFIER' -> - emit_encode_func("object_identifier",Value,DoTag); - 'ObjectDescriptor' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_ObjectDescriptor,DoTag); - 'OCTET STRING' -> - emit_encode_func('octet_string',Constraint,Value,DoTag); - 'NumericString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_NumericString,DoTag); - 'TeletexString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_TeletexString,DoTag); - 'VideotexString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_VideotexString,DoTag); - 'GraphicString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_GraphicString,DoTag); - 'VisibleString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_VisibleString,DoTag); - 'GeneralString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_GeneralString,DoTag); - 'PrintableString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_PrintableString,DoTag); - 'IA5String' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_IA5String,DoTag); - 'UniversalString' -> - emit_encode_func('universal_string',Constraint,Value,DoTag); - 'BMPString' -> - emit_encode_func('BMP_string',Constraint,Value,DoTag); - 'UTCTime' -> - emit_encode_func('utc_time',Constraint,Value,DoTag); - 'GeneralizedTime' -> - emit_encode_func('generalized_time',Constraint,Value,DoTag); - 'ASN1_OPEN_TYPE' -> - emit_encode_func('open_type', Value,DoTag); - XX -> - exit({'can not encode' ,XX}) - end. - - -emit_encode_func(Name,Value,Tags) when atom(Name) -> - emit_encode_func(atom_to_list(Name),Value,Tags); -emit_encode_func(Name,Value,Tags) -> - Fname = "?RT_BER:encode_" ++ Name, - emit([Fname,"(",Value,", ",Tags,")"]). - -emit_encode_func(Name,Constraint,Value,Tags) when atom(Name) -> - emit_encode_func(atom_to_list(Name),Constraint,Value,Tags); -emit_encode_func(Name,Constraint,Value,Tags) -> - Fname = "?RT_BER:encode_" ++ Name, - emit([Fname,"(",{asis,Constraint},", ",Value,", ",Tags,")"]). - -emit_encode_func(Name,Constraint,Value,Asis,Tags) when atom(Name) -> - emit_encode_func(atom_to_list(Name),Constraint,Value,Asis,Tags); -emit_encode_func(Name,Constraint,Value,Asis,Tags) -> - Fname = "?RT_BER:encode_" ++ Name, - emit([Fname,"(",{asis,Constraint},", ",Value, - ", ",{asis,Asis}, - ", ",Tags,")"]). - -emit_enc_enumerated_cases({L1,L2}, Tags) -> - emit_enc_enumerated_cases(L1++L2, Tags, ext); -emit_enc_enumerated_cases(L, Tags) -> - emit_enc_enumerated_cases(L, Tags, noext). - -emit_enc_enumerated_cases([{EnumName,EnumVal},H2|T], Tags, Ext) -> - emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), -%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), - emit_enc_enumerated_cases([H2|T], Tags, Ext); -emit_enc_enumerated_cases([{EnumName,EnumVal}], Tags, Ext) -> - emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), -%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), - case Ext of - noext -> emit([";",nl]); - ext -> - emit([";",nl,"{asn1_enum,",{curr,enumval},"} -> ", - "?RT_BER:encode_enumerated(",{curr,enumval},",",Tags,");",nl]), - asn1ct_name:new(enumval) - end, - emit([{curr,enumval}," -> exit({error,{asn1, {enumerated_not_in_range,",{curr, enumval},"}}})"]), - emit([nl,"end"]). - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Generate DECODING -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% decode #{typedef, {pos, name, typespec}} -%%=============================================================================== - -gen_decode(Erules,Type) when record(Type,typedef) -> - D = Type, - emit({nl,nl}), - emit({"'dec_",Type#typedef.name,"'(Bytes, OptOrMand) ->",nl}), - emit({" 'dec_",Type#typedef.name,"'(Bytes, OptOrMand, []).",nl,nl}), - emit({"'dec_",Type#typedef.name,"'(Bytes, ", - unused_optormand_var("OptOrMand",(Type#typedef.typespec)#type.def),", TagIn) ->",nl}), - dbdec(Type#typedef.name), - gen_decode_user(Erules,D). - - -%%=============================================================================== -%% decode #{type, {tag, def, constraint}} -%%=============================================================================== - -gen_decode(Erules,Tname,Type) when record(Type,type) -> - Typename = Tname, - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - ObjFun = - case Type#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - "" - end, - emit({"'dec_",asn1ct_gen:list2name(Typename),"'(Bytes, OptOrMand, TagIn",ObjFun,") ->",nl}), - dbdec(Typename), - asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type); - _ -> - true - end; - - -%%=============================================================================== -%% decode ComponentType -%%=============================================================================== - -gen_decode(Erules,Tname,{'ComponentType',_Pos,Cname,Type,_,_}) -> - NewTname = [Cname|Tname], - %% The tag is set to [] to avoid that it is - %% taken into account twice, both as a component/alternative (passed as - %% argument to the encode decode function and within the encode decode - %% function it self. - NewType = Type#type{tag=[]}, - gen_decode(Erules,NewTname,NewType). - - -gen_decode_user(Erules,D) when record(D,typedef) -> - Typename = [D#typedef.name], - Def = D#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Def#type.def), - InnerTag = Def#type.tag , - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- InnerTag], - case asn1ct_gen:type(InnerType) of - 'ASN1_OPEN_TYPE' -> - BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), - asn1ct_name:new(len), - gen_dec_prim(Erules, Def#type{def='ASN1_OPEN_TYPE'}, - BytesVar, Tag, "TagIn",no_length, - ?PRIMITIVE,"OptOrMand"), - emit({".",nl,nl}); - {primitive,bif} -> - BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), - asn1ct_name:new(len), - gen_dec_prim(Erules, Def, BytesVar, Tag, "TagIn",no_length, - ?PRIMITIVE,"OptOrMand"), - emit({".",nl,nl}); - {constructed,bif} -> - asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D); - TheType -> - DecFunName = mkfuncname(TheType,dec), - emit({DecFunName,"(",{curr,bytes}, - ", OptOrMand, TagIn++",{asis,Tag},")"}), - emit({".",nl,nl}) - end. - - -gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Length,_Form,OptOrMand) -> - Typename = Att#type.def, -%% Currently not used for BER replaced with [] as place holder -%% Constraint = Att#type.constraint, -%% Constraint = [], - Constraint = - case get_constraint(Att#type.constraint,'SizeConstraint') of - no -> []; - Tc -> Tc - end, - ValueRange = - case get_constraint(Att#type.constraint,'ValueRange') of - no -> []; - Tv -> Tv - end, - SingleValue = - case get_constraint(Att#type.constraint,'SingleValue') of - no -> []; - Sv -> Sv - end, - AsBin = case get(binary_strings) of - true -> "_as_bin"; - _ -> "" - end, - NewTypeName = case Typename of - 'ANY' -> 'ASN1_OPEN_TYPE'; - _ -> Typename - end, - DoLength = - case NewTypeName of - 'BOOLEAN'-> - emit({"?RT_BER:decode_boolean(",BytesVar,","}), - false; - 'INTEGER' -> - emit({"?RT_BER:decode_integer(",BytesVar,",", - {asis,int_constr(SingleValue,ValueRange)},","}), - false; - {'INTEGER',NamedNumberList} -> - emit({"?RT_BER:decode_integer(",BytesVar,",", - {asis,int_constr(SingleValue,ValueRange)},",", - {asis,NamedNumberList},","}), - false; - {'ENUMERATED',NamedNumberList} -> - emit({"?RT_BER:decode_enumerated(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},","}), - false; - {'BIT STRING',NamedNumberList} -> - case get(compact_bit_string) of - true -> - emit({"?RT_BER:decode_compact_bit_string(", - BytesVar,",",{asis,Constraint},",", - {asis,NamedNumberList},","}); - _ -> - emit({"?RT_BER:decode_bit_string(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},","}) - end, - true; - 'NULL' -> - emit({"?RT_BER:decode_null(",BytesVar,","}), - false; - 'OBJECT IDENTIFIER' -> - emit({"?RT_BER:decode_object_identifier(",BytesVar,","}), - false; - 'ObjectDescriptor' -> - emit({"?RT_BER:decode_restricted_string(", - BytesVar,",",{asis,Constraint},",",{asis,?T_ObjectDescriptor},","}), - true; - 'OCTET STRING' -> - emit({"?RT_BER:decode_octet_string",AsBin,"(",BytesVar,",",{asis,Constraint},","}), - true; - 'NumericString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_NumericString},","}),true; - 'TeletexString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_TeletexString},","}), - true; - 'VideotexString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_VideotexString},","}), - true; - 'GraphicString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_GraphicString},","}) - ,true; - 'VisibleString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_VisibleString},","}), - true; - 'GeneralString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_GeneralString},","}), - true; - 'PrintableString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_PrintableString},","}), - true; - 'IA5String' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_IA5String},","}), - true; - 'UniversalString' -> - emit({"?RT_BER:decode_universal_string",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - true; - 'BMPString' -> - emit({"?RT_BER:decode_BMP_string",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - true; - 'UTCTime' -> - emit({"?RT_BER:decode_utc_time",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - true; - 'GeneralizedTime' -> - emit({"?RT_BER:decode_generalized_time",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - true; - 'ASN1_OPEN_TYPE' -> - emit(["?RT_BER:decode_open_type(",re_wrap_erule(Erules),",", - BytesVar,","]), - false; - Other -> - exit({'can not decode' ,Other}) - end, - - NewLength = case DoLength of - true -> [", ", Length]; - false -> "" - end, - NewOptOrMand = case OptOrMand of - _ when list(OptOrMand) -> OptOrMand; - mandatory -> {asis,mandatory}; - _ -> {asis,opt_or_default} - end, - case {TagIn,NewTypeName} of - {[],'ASN1_OPEN_TYPE'} -> - emit([{asis,DoTag},")"]); - {_,'ASN1_OPEN_TYPE'} -> - emit([TagIn,"++",{asis,DoTag},")"]); - {[],_} -> - emit([{asis,DoTag},NewLength,", ",NewOptOrMand,")"]); - _ when list(TagIn) -> - emit([TagIn,"++",{asis,DoTag},NewLength,", ",NewOptOrMand,")"]) - end. - - -int_constr([],[]) -> - []; -int_constr([],ValueRange) -> - ValueRange; -int_constr(SingleValue,[]) -> - SingleValue; -int_constr(SV,VR) -> - [SV,VR]. - -%% Object code generating for encoding and decoding -%% ------------------------------------------------ - -gen_obj_code(Erules,_Module,Obj) when record(Obj,typedef) -> - ObjName = Obj#typedef.name, - Def = Obj#typedef.typespec, - #'Externaltypereference'{module=M,type=ClName} = Def#'Object'.classname, - Class = asn1_db:dbget(M,ClName), - - {object,_,Fields} = Def#'Object'.def, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjName}), - emit({nl,"%%================================",nl}), - EncConstructed = - gen_encode_objectfields(ClName,get_class_fields(Class), - ObjName,Fields,[]), - emit(nl), - gen_encode_constr_type(Erules,EncConstructed), - emit(nl), - DecConstructed = - gen_decode_objectfields(ClName,get_class_fields(Class), - ObjName,Fields,[]), - emit(nl), - gen_decode_constr_type(Erules,DecConstructed); -gen_obj_code(_Erules,_Module,Obj) when record(Obj,pobjectdef) -> - ok. - - -gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Args) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ", ",Args,", _RestPrimFieldName) ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val, TagIn, _RestPrimFieldName) ->",nl]), - MaybeConstr= - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_, _"), - emit([" {[],0}"]), - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Val, TagIn"), - gen_encode_default_call(ClassName,Name,DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Val, TagIn"), - gen_encode_field_call(ObjName,Name,TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields, - MaybeConstr++ConstrAcc); -gen_encode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Args) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ", ",Args,") ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val, TagIn, [H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_,_"), - emit([" exit({error,{'use of missing field in object', ",Name, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,TypeSpec},_} -> - EmitFuncClause(" Val, TagIn, [H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'enc_",TypeName, - "'(H, Val, TagIn, T)"}); - TypeName -> - emit({indent(3),"'enc_",TypeName,"'(H, Val, TagIn, T)"}) - end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); -gen_encode_objectfields(ClassName,[_|Cs],O,OF,Acc) -> - gen_encode_objectfields(ClassName,Cs,O,OF,Acc); -gen_encode_objectfields(_,[],_,_,Acc) -> - Acc. - - -% gen_encode_objectfields(Class,ObjName,[{FieldName,Type}|Rest],ConstrAcc) -> -% Fields = Class#objectclass.fields, -% MaybeConstr= -% case is_typefield(Fields,FieldName) of -% true -> -% Def = Type#typedef.typespec, -% OTag = Def#type.tag, -% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], -% emit({"'enc_",ObjName,"'(",{asis,FieldName}, -% ", Val, TagIn, RestPrimFieldName) ->",nl}), -% CAcc= -% case Type#typedef.name of -% {primitive,bif} -> -% gen_encode_prim(ber,Def,["TagIn ++ ",{asis,Tag}], -% "Val"), -% []; -% {constructed,bif} -> -% %%InnerType = asn1ct_gen:get_inner(Def#type.def), -% %%asn1ct_gen:gen_encode_constructed(ber,[ObjName], -% %% InnerType,Def); -% emit({" 'enc_",ObjName,'_',FieldName, -% "'(Val, TagIn ++ ",{asis,Tag},")"}), -% [{['enc_',ObjName,'_',FieldName],Def}]; -% {ExtMod,TypeName} -> -% emit({" '",ExtMod,"':'enc_",TypeName, -% "'(Val, TagIn ++ ",{asis,Tag},")"}), -% []; -% TypeName -> -% emit({" 'enc_",TypeName,"'(Val, TagIn ++ ", -% {asis,Tag},")"}), -% [] -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% CAcc; -% {false,objectfield} -> -% emit({"'enc_",ObjName,"'(",{asis,FieldName}, -% ", Val, TagIn, [H|T]) ->",nl}), -% case Type#typedef.name of -% {ExtMod,TypeName} -> -% emit({indent(3),"'",ExtMod,"':'enc_",TypeName, -% "'(H, Val, TagIn, T)"}); -% TypeName -> -% emit({indent(3),"'enc_",TypeName,"'(H, Val, TagIn, T)"}) -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% []; -% {false,_} -> [] -% end, -% gen_encode_objectfields(Class,ObjName,Rest,MaybeConstr ++ ConstrAcc); -% gen_encode_objectfields(C,O,[H|T],Acc) -> -% gen_encode_objectfields(C,O,T,Acc); -% gen_encode_objectfields(_,_,[],Acc) -> -% Acc. - -% gen_encode_constr_type([{Name,Def}|Rest]) -> -% emit({Name,"(Val,TagIn) ->",nl}), -% InnerType = asn1ct_gen:get_inner(Def#type.def), -% asn1ct_gen:gen_encode_constructed(ber,Name,InnerType,Def), -% gen_encode_constr_type(Rest); -gen_encode_constr_type(Erules,[TypeDef|Rest]) when record(TypeDef,typedef) -> - case is_already_generated(enc,TypeDef#typedef.name) of - true -> ok; - _ -> gen_encode_user(Erules,TypeDef) - end, - gen_encode_constr_type(Erules,Rest); -gen_encode_constr_type(_,[]) -> - ok. - -gen_encode_field_call(ObjName,FieldName,Type) -> - Def = Type#typedef.typespec, - OTag = Def#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case Type#typedef.name of - {primitive,bif} -> %%tag should be the primitive tag - gen_encode_prim(ber,Def,["TagIn ++ ",{asis,Tag}], - "Val"), - []; - {constructed,bif} -> - emit({" 'enc_",ObjName,'_',FieldName, - "'(Val, TagIn ++",{asis,Tag},")"}), - [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'enc_",TypeName, - "'(Val, TagIn ++ ",{asis,Tag},")"}), - []; - TypeName -> - emit({" 'enc_",TypeName,"'(Val, TagIn ++ ",{asis,Tag},")"}), - [] - end. - -gen_encode_default_call(ClassName,FieldName,Type) -> - CurrentMod = get(currmod), - InnerType = asn1ct_gen:get_inner(Type#type.def), - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> -%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); - emit([" 'enc_",ClassName,'_',FieldName,"'(Bytes, TagIn ++ ", - {asis,Tag},")"]), - [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - typespec=Type}]; - {primitive,bif} -> - gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val"), - []; - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'enc_",Etype,"'(Val, TagIn ++ ",{asis,Tag},")",nl]), - []; - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'enc_",Etype,"'(Val, TagIn ++ ",{asis,Tag},")",nl]), - [] - end. - - - -gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Args) -> - emit(["'dec_",ObjName,"'(",{asis,Name}, - ", ",Args,"_) ->",nl]) - end, -% emit(["'dec_",ObjName,"'(",{asis,Name}, -% ", Bytes, TagIn, RestPrimFieldName) ->",nl]), - MaybeConstr= - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_, _,"), - emit([" asn1_NOVALUE"]), - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Bytes, TagIn,"), - gen_decode_default_call(ClassName,Name,"Bytes",DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Bytes, TagIn,"), - gen_decode_field_call(ObjName,Name,"Bytes",TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc); -gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Args) -> - emit(["'dec_",ObjName,"'(",{asis,Name}, - ", ",Args,") ->",nl]) - end, -% emit(["'dec_",ObjName,"'(",{asis,Name}, -% ", Bytes,TagIn,[H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_,_"), - emit([" exit({error,{'illegal use of missing field in object', ",Name, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,TypeSpec},_} -> - EmitFuncClause("Bytes,TagIn,[H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'dec_",TypeName, - "'(H, Bytes, TagIn, T)"}); - TypeName -> - emit({indent(3),"'dec_",TypeName,"'(H, Bytes, TagIn, T)"}) - end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); -gen_decode_objectfields(CN,[_|Cs],O,OF,CAcc) -> - gen_decode_objectfields(CN,Cs,O,OF,CAcc); -gen_decode_objectfields(_,[],_,_,CAcc) -> - CAcc. - - - -% gen_decode_objectfields(Erules,Class,ObjName,[{FieldName,Type}|Rest],ConstrAcc) -> -% Fields = Class#objectclass.fields, -% MaybeConstr = -% case is_typefield(Fields,FieldName) of -% true -> -% Def = Type#typedef.typespec, -% emit({"'dec_",ObjName,"'(",{asis,FieldName}, -% ", Bytes, TagIn, RestPrimFieldName) ->",nl}), -% OTag = Def#type.tag, -% Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], -% Prop = -% case get_optionalityspec(Fields,FieldName) of -% 'OPTIONAL' -> opt_or_default; -% {'DEFAULT',_} -> opt_or_default; -% _ -> mandatory -% end, -% CAcc = -% case Type#typedef.name of -% {primitive,bif} -> -% gen_dec_prim(Erules,Def,"Bytes",Tag,"TagIn",no_length, -% ?PRIMITIVE,Prop), -% []; -% {constructed,bif} -> -% emit({" 'dec_",ObjName,'_',FieldName,"'(Bytes,", -% {asis,Prop},", TagIn ++ ",{asis,Tag},")"}), -% [{['dec_',ObjName,'_',FieldName],Def}]; -% {ExtMod,TypeName} -> -% emit({" '",ExtMod,"':'dec_",TypeName,"'(Bytes, ", -% {asis,Prop},", TagIn ++ ",{asis,Tag},")"}), -% []; -% TypeName -> -% emit({" 'dec_",TypeName,"'(Bytes, ",{asis,Prop}, -% ", TagIn ++ ",{asis,Tag},")"}), -% [] -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% CAcc; -% {false,objectfield} -> -% emit({"'dec_",ObjName,"'(",{asis,FieldName}, -% ", Bytes, TagIn, [H|T]) ->",nl}), -% case Type#typedef.name of -% {ExtMod,TypeName} -> -% emit({indent(3),"'",ExtMod,"':'dec_",TypeName, -% "'(H, Bytes, TagIn, T)"}); -% TypeName -> -% emit({indent(3),"'dec_",TypeName, -% "'(H, Bytes, TagIn, T)"}) -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% []; -% {false,_} -> -% [] -% end, -% gen_decode_objectfields(Erules,Class,ObjName,Rest,MaybeConstr ++ ConstrAcc); -% gen_decode_objectfields(Erules,C,O,[H|T],CAcc) -> -% gen_decode_objectfields(Erules,C,O,T,CAcc); -% gen_decode_objectfields(_,_,_,[],CAcc) -> -% CAcc. - -gen_decode_constr_type(Erules,[{Name,Def}|Rest]) -> -%% emit({Name,"(Bytes, OptOrMand) ->",nl}), -%% emit({" ",Name,"(Bytes, OptOrMand, []).",nl,nl}), - emit({Name,"(Bytes, OptOrMand, TagIn) ->",nl}), - InnerType = asn1ct_gen:get_inner(Def#type.def), - asn1ct_gen:gen_decode_constructed(ber,Name,InnerType,Def), - gen_decode_constr_type(Erules,Rest); -gen_decode_constr_type(Erules,[TypeDef|Rest]) when record(TypeDef,typedef) -> - case is_already_generated(dec,TypeDef#typedef.name) of - true -> ok; - _ -> - gen_decode(Erules,TypeDef) - end, - gen_decode_constr_type(Erules,Rest); -gen_decode_constr_type(_,[]) -> - ok. - -gen_decode_field_call(ObjName,FieldName,Bytes,Type) -> - Def = Type#typedef.typespec, - OTag = Def#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case Type#typedef.name of - {primitive,bif} -> %%tag should be the primitive tag - gen_dec_prim(ber,Def,Bytes,Tag,"TagIn",no_length, - ?PRIMITIVE,opt_or_default), - []; - {constructed,bif} -> - emit({" 'dec_",ObjName,'_',FieldName, - "'(",Bytes,",opt_or_default, TagIn ++ ",{asis,Tag},")"}), - [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'dec_",TypeName, - "'(",Bytes,", opt_or_default,TagIn ++ ",{asis,Tag},")"}), - []; - TypeName -> - emit({" 'dec_",TypeName,"'(",Bytes, - ", opt_or_default,TagIn ++ ",{asis,Tag},")"}), - [] - end. - -gen_decode_default_call(ClassName,FieldName,Bytes,Type) -> - CurrentMod = get(currmod), - InnerType = asn1ct_gen:get_inner(Type#type.def), - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes, - ",opt_or_default, TagIn ++ ",{asis,Tag},")"]), - [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - typespec=Type}]; - {primitive,bif} -> - gen_dec_prim(ber,Type,Bytes,Tag,"TagIn",no_length, - ?PRIMITIVE,opt_or_default), - []; - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'dec_",Etype,"'(",Bytes, - " ,opt_or_default, TagIn ++ ",{asis,Tag},")",nl]), - []; - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'dec_",Etype,"'(",Bytes, - ", opt_or_defualt, TagIn ++ ",{asis,Tag},")",nl]), - [] - end. - - -more_genfields([]) -> - false; -more_genfields([Field|Fields]) -> - case element(1,Field) of - typefield -> - true; - objectfield -> - true; - _ -> - more_genfields(Fields) - end. - - - -%% Object Set code generating for encoding and decoding -%% ---------------------------------------------------- -gen_objectset_code(Erules,ObjSet) -> - ObjSetName = ObjSet#typedef.name, - Def = ObjSet#typedef.typespec, -% {ClassName,ClassDef} = Def#'ObjectSet'.class, - #'Externaltypereference'{module=ClassModule, - type=ClassName} = Def#'ObjectSet'.class, - ClassDef = asn1_db:dbget(ClassModule,ClassName), - UniqueFName = Def#'ObjectSet'.uniquefname, - Set = Def#'ObjectSet'.set, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjSetName}), - emit({nl,"%%================================",nl}), - case ClassName of - {_Module,ExtClassName} -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set, - ExtClassName,ClassDef); - _ -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set, - ClassName,ClassDef) - end, - emit(nl). - -gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)-> - ClassFields = (ClassDef#classdef.typespec)#objectclass.fields, - InternalFuncs=gen_objset_enc(ObjSetName,UniqueFName,Set,ClassName,ClassFields,1,[]), - gen_objset_dec(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassFields,1), - gen_internal_funcs(Erules,InternalFuncs). - -%% gen_objset_enc iterates over the objects of the object set -gen_objset_enc(_,{unique,undefined},_,_,_,_,_) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - []; -gen_objset_enc(ObjSName,UniqueName, - [{ObjName,Val,Fields},T|Rest],ClName,ClFields,NthObj,Acc)-> - emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}), - {InternalFunc,NewNthObj}= - case ObjName of - no_name -> - gen_inlined_enc_funs(Fields,ClFields,ObjSName,NthObj); - _Other -> - emit({" fun 'enc_",ObjName,"'/4"}), - {[],NthObj} - end, - emit({";",nl}), - gen_objset_enc(ObjSName,UniqueName,[T|Rest],ClName,ClFields, - NewNthObj,InternalFunc ++ Acc); -gen_objset_enc(ObjSetName,UniqueName, - [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) -> - emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}), - {InternalFunc,_}= - case ObjName of - no_name -> - gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj); - _Other -> - emit({" fun 'enc_",ObjName,"'/4"}), - {[],NthObj} - end, - emit({".",nl,nl}), - InternalFunc ++ Acc; -%% See X.681 Annex E for the following case -gen_objset_enc(ObjSetName,_UniqueName,['EXTENSIONMARK'], - _ClName,_ClFields,_NthObj,Acc) -> - emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(_Attr, Val, _TagIn, _RestPrimFieldName) ->",nl}), - emit({indent(6),"Len = case Val of",nl,indent(9), - "Bin when binary(Bin) -> size(Bin);",nl,indent(9), - "_ -> length(Val)",nl,indent(6),"end,"}), - emit({indent(6),"{Val,Len}",nl}), - emit({indent(3),"end.",nl,nl}), - Acc; -gen_objset_enc(_,_,[],_,_,_,Acc) -> - Acc. - -%% gen_inlined_enc_funs for each object iterates over all fields of a -%% class, and for each typefield it checks if the object has that -%% field and emits the proper code. -gen_inlined_enc_funs(Fields,[{typefield,Name,_}|Rest],ObjSetName, - NthObj) -> - InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({indent(3),"fun(Type, Val, TagIn, _RestPrimFieldName) ->",nl, - indent(6),"case Type of",nl}), - {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName), - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret); - {value,{_,Type}} when record(Type,typedef) -> - emit({indent(3),"fun(Type, Val, TagIn, _RestPrimFieldName) ->",nl, - indent(6),"case Type of",nl}), - emit({indent(9),{asis,Name}," ->",nl}), - {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName), - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret); - false -> - gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj) - end; -gen_inlined_enc_funs(Fields,[_H|Rest],ObjSetName,NthObj) -> - gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj); -gen_inlined_enc_funs(_,[],_,NthObj) -> - {[],NthObj}. - -gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName, - NthObj,Acc) -> - InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), - {Acc2,NAdd}= - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({";",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - {Ret++Acc,N}; - {value,{_,Type}} when record(Type,typedef) -> - emit({";",nl,indent(9),{asis,Name}," ->",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - {Ret++Acc,N}; - false -> - {Acc,0} - end, - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+NAdd,Acc2); -gen_inlined_enc_funs1(Fields,[_H|Rest],ObjSetName,NthObj,Acc)-> - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,Acc); -gen_inlined_enc_funs1(_,[],_,NthObj,Acc) -> - emit({nl,indent(6),"end",nl}), - emit({indent(3),"end"}), - {Acc,NthObj}. - - -emit_inner_of_fun(TDef = #typedef{name={ExtMod,Name},typespec=Type}, - InternalDefFunName) -> - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case {ExtMod,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val"), - {[],0}; - {constructed,bif} -> - emit([indent(12),"'enc_", - InternalDefFunName,"'(Val,TagIn ++ ", - {asis,Tag},")"]), - {[TDef#typedef{name=InternalDefFunName}],1}; - _ -> - emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val, TagIn ++ ", - {asis,Tag},")"}), - {[],0} - end; -emit_inner_of_fun(#typedef{name=Name,typespec=Type},_) -> - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - emit({indent(12),"'enc_",Name,"'(Val, TagIn ++ ",{asis,Tag},")"}), - {[],0}; -emit_inner_of_fun(Type,_) when record(Type,type) -> - CurrMod = get(currmod), - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case Type#type.def of - Def when atom(Def) -> - emit({indent(9),Def," ->",nl,indent(12)}), - gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val"); - TRef when record(TRef,typereference) -> - T = TRef#typereference.val, - emit({indent(9),T," ->",nl,indent(12),"'enc_",T, - "'(Val, TagIn ++ ",{asis,Tag},")"}); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),"'enc_",T, - "'(Val, TagIn ++ ",{asis,Tag},")"}); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),ExtMod,":'enc_", - T,"'(Val, TagIn ++ ",{asis,Tag},")"}) - end, - {[],0}. - -indent(N) -> - lists:duplicate(N,32). % 32 = space - - -gen_objset_dec(_,_,{unique,undefined},_,_,_,_) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - ok; -gen_objset_dec(Erules,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest], - ClName,ClFields,NthObj)-> - emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val}, - ") ->",nl}), - NewNthObj= - case ObjName of - no_name -> - gen_inlined_dec_funs(Erules,Fields,ClFields,ObjSName, - NthObj); - _Other -> - emit({" fun 'dec_",ObjName,"'/4"}), - NthObj - end, - emit({";",nl}), - gen_objset_dec(Erules,ObjSName,UniqueName,[T|Rest],ClName,ClFields, - NewNthObj); -gen_objset_dec(Erules,ObjSetName,UniqueName,[{ObjName,Val,Fields}],_ClName, - ClFields,NthObj) -> - emit({"'getdec_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}), - case ObjName of - no_name -> - gen_inlined_dec_funs(Erules,Fields,ClFields,ObjSetName, - NthObj); - _Other -> - emit({" fun 'dec_",ObjName,"'/4"}) - end, - emit({".",nl,nl}); -gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,_ClFields, - _NthObj) -> - emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(_, Bytes, _, _) ->",nl}), - emit({indent(6),"Len = case Bytes of",nl,indent(9), - "Bin when binary(Bin) -> size(Bin);",nl,indent(9), - "_ -> length(Bytes)",nl,indent(6),"end,"}), - emit({indent(6),"{Bytes,[],Len}",nl}), - emit({indent(3),"end.",nl,nl}), - ok; -gen_objset_dec(_,_,_,[],_,_,_) -> - ok. - -gen_inlined_dec_funs(Erules,Fields,[{typefield,Name,Prop}|Rest], - ObjSetName,NthObj) -> - DecProp = case Prop of - 'OPTIONAL' -> opt_or_default; - {'DEFAULT',_} -> opt_or_default; - _ -> mandatory - end, - InternalDefFunName = [NthObj,Name,ObjSetName], - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({indent(3),"fun(Type, Bytes, TagIn, _RestPrimFieldName) ->", - nl,indent(6),"case Type of",nl}), - N=emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName), - gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj+N); - {value,{_,Type}} when record(Type,typedef) -> - emit({indent(3),"fun(Type, Bytes, TagIn, _RestPrimFieldName) ->", - nl,indent(6),"case Type of",nl}), - emit({indent(9),{asis,Name}," ->",nl}), - N=emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName), - gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj+N); - false -> - gen_inlined_dec_funs(Erules,Fields,Rest,ObjSetName,NthObj) - end; -gen_inlined_dec_funs(Erules,Fields,[_H|Rest],ObjSetName,NthObj) -> - gen_inlined_dec_funs(Erules,Fields,Rest,ObjSetName,NthObj); -gen_inlined_dec_funs(_,_,[],_,NthObj) -> - NthObj. - -gen_inlined_dec_funs1(Erules,Fields,[{typefield,Name,Prop}|Rest], - ObjSetName,NthObj) -> - DecProp = case Prop of - 'OPTIONAL' -> opt_or_default; - {'DEFAULT',_} -> opt_or_default; - _ -> mandatory - end, - InternalDefFunName = [NthObj,Name,ObjSetName], - N= - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({";",nl}), - emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName); - {value,{_,Type}} when record(Type,typedef) -> - emit({";",nl,indent(9),{asis,Name}," ->",nl}), - emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName); - false -> - 0 - end, - gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj+N); -gen_inlined_dec_funs1(Erules,Fields,[_H|Rest],ObjSetName,NthObj)-> - gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj); -gen_inlined_dec_funs1(_,_,[],_,NthObj) -> - emit({nl,indent(6),"end",nl}), - emit({indent(3),"end"}), - NthObj. - -emit_inner_of_decfun(Erules,#typedef{name={ExtName,Name},typespec=Type}, - Prop,InternalDefFunName) -> - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case {ExtName,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_dec_prim(Erules,Type,"Bytes",Tag,"TagIn",no_length, - ?PRIMITIVE,Prop), - 0; - {constructed,bif} -> - emit({indent(12),"'dec_", - asn1ct_gen:list2name(InternalDefFunName),"'(Bytes, ",Prop, - ", TagIn ++ ",{asis,Tag},")"}), - 1; - _ -> - emit({indent(12),"'",ExtName,"':'dec_",Name,"'(Bytes, ",Prop, - ", TagIn ++ ",{asis,Tag},")"}), - 0 - end; -emit_inner_of_decfun(_,#typedef{name=Name,typespec=Type},Prop,_) -> - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - emit({indent(12),"'dec_",Name,"'(Bytes, ",Prop,", TagIn ++ ", - {asis,Tag},")"}), - 0; -emit_inner_of_decfun(Erules,Type,Prop,_) when record(Type,type) -> - OTag = Type#type.tag, - Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - CurrMod = get(currmod), - Def = Type#type.def, - InnerType = asn1ct_gen:get_inner(Def), - WhatKind = asn1ct_gen:type(InnerType), - case WhatKind of - {primitive,bif} -> - emit({indent(9),Def," ->",nl,indent(12)}), - gen_dec_prim(Erules,Type,"Bytes",Tag,"TagIn",no_length, - ?PRIMITIVE,Prop); -% TRef when record(TRef,typereference) -> -% T = TRef#typereference.val, -% emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),"'dec_",T, - "'(Bytes, ",Prop,", TagIn ++ ",{asis,Tag},")"}); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),ExtMod,":'dec_", - T,"'(Bytes, ",Prop,", TagIn ++ ",{asis,Tag},")"}) - end, - 0. - - -gen_internal_funcs(_,[]) -> - ok; -gen_internal_funcs(Erules,[TypeDef|Rest]) -> - gen_encode_user(Erules,TypeDef), - emit({"'dec_",TypeDef#typedef.name,"'(Bytes, ", - unused_optormand_var("OptOrMand",(TypeDef#typedef.typespec)#type.def),", TagIn) ->",nl}), - gen_decode_user(Erules,TypeDef), - gen_internal_funcs(Erules,Rest). - - -dbdec(Type) -> - demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[Bytes]),",nl}). - - -decode_class('UNIVERSAL') -> - ?UNIVERSAL; -decode_class('APPLICATION') -> - ?APPLICATION; -decode_class('CONTEXT') -> - ?CONTEXT; -decode_class('PRIVATE') -> - ?PRIVATE. - -decode_type('BOOLEAN') -> 1; -decode_type('INTEGER') -> 2; -decode_type('BIT STRING') -> 3; -decode_type('OCTET STRING') -> 4; -decode_type('NULL') -> 5; -decode_type('OBJECT IDENTIFIER') -> 6; -decode_type('OBJECT DESCRIPTOR') -> 7; -decode_type('EXTERNAL') -> 8; -decode_type('REAL') -> 9; -decode_type('ENUMERATED') -> 10; -decode_type('EMBEDDED_PDV') -> 11; -decode_type('SEQUENCE') -> 16; -decode_type('SEQUENCE OF') -> 16; -decode_type('SET') -> 17; -decode_type('SET OF') -> 17; -decode_type('NumericString') -> 18; -decode_type('PrintableString') -> 19; -decode_type('TeletexString') -> 20; -decode_type('VideotexString') -> 21; -decode_type('IA5String') -> 22; -decode_type('UTCTime') -> 23; -decode_type('GeneralizedTime') -> 24; -decode_type('GraphicString') -> 25; -decode_type('VisibleString') -> 26; -decode_type('GeneralString') -> 27; -decode_type('UniversalString') -> 28; -decode_type('BMPString') -> 30; -decode_type('CHOICE') -> 'CHOICE'; % choice gets the tag from the actual alternative -decode_type(Else) -> exit({error,{asn1,{unrecognized_type,Else}}}). - -add_removed_bytes() -> - asn1ct_name:delete(rb), - add_removed_bytes(asn1ct_name:all(rb)). - -add_removed_bytes([H,T1|T]) -> - emit({{var,H},"+"}), - add_removed_bytes([T1|T]); -add_removed_bytes([H|T]) -> - emit({{var,H}}), - add_removed_bytes(T); -add_removed_bytes([]) -> - true. - -mkfuncname(WhatKind,DecOrEnc) -> - case WhatKind of - #'Externaltypereference'{module=Mod,type=EType} -> - CurrMod = get(currmod), - case CurrMod of - Mod -> - lists:concat(["'",DecOrEnc,"_",EType,"'"]); - _ -> -% io:format("CurrMod: ~p, Mod: ~p~n",[CurrMod,Mod]), - lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"]) - end; - #'typereference'{val=EType} -> - lists:concat(["'",DecOrEnc,"_",EType,"'"]); - 'ASN1_OPEN_TYPE' -> - lists:concat(["'",DecOrEnc,"_",WhatKind,"'"]) - - end. - -optionals(L) -> optionals(L,[],1). - -optionals([{'EXTENSIONMARK',_,_}|Rest],Acc,Pos) -> - optionals(Rest,Acc,Pos); % optionals in extension are currently not handled -optionals([#'ComponentType'{name=Name,prop='OPTIONAL'}|Rest],Acc,Pos) -> - optionals(Rest,[{Name,Pos}|Acc],Pos+1); -optionals([#'ComponentType'{name=Name,prop={'DEFAULT',_}}|Rest],Acc,Pos) -> - optionals(Rest,[{Name,Pos}|Acc],Pos+1); -optionals([#'ComponentType'{}|Rest],Acc,Pos) -> - optionals(Rest,Acc,Pos+1); -optionals([],Acc,_) -> - lists:reverse(Acc). - -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - -%% if the original option was ber and it has been wrapped to ber_bin -%% turn it back to ber -re_wrap_erule(ber_bin) -> - case get(encoding_options) of - Options when list(Options) -> - case lists:member(ber,Options) of - true -> ber; - _ -> ber_bin - end; - _ -> ber_bin - end; -re_wrap_erule(Erule) -> - Erule. - -is_already_generated(Operation,Name) -> - case get(class_default_type) of - undefined -> - put(class_default_type,[{Operation,Name}]), - false; - GeneratedList -> - case lists:member({Operation,Name},GeneratedList) of - true -> - true; - false -> - put(class_default_type,[{Operation,Name}|GeneratedList]), - false - end - end. - -get_class_fields(#classdef{typespec=ObjClass}) -> - ObjClass#objectclass.fields; -get_class_fields(#objectclass{fields=Fields}) -> - Fields; -get_class_fields(_) -> - []. - -get_object_field(Name,ObjectFields) -> - case lists:keysearch(Name,1,ObjectFields) of - {value,Field} -> Field; - false -> false - end. diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_ber_bin_v2.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_ber_bin_v2.erl deleted file mode 100644 index be8ae6f8a5..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_ber_bin_v2.erl +++ /dev/null @@ -1,1568 +0,0 @@ -%% ``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: asn1ct_gen_ber_bin_v2.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ -%% --module(asn1ct_gen_ber_bin_v2). - -%% Generate erlang module which handles (PER) encode and decode for -%% all types in an ASN.1 module - --include("asn1_records.hrl"). - --export([pgen/4]). --export([decode_class/1, decode_type/1]). --export([add_removed_bytes/0]). --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_objectset_code/2, gen_obj_code/3]). --export([encode_tag_val/3]). --export([gen_inc_decode/2]). - --import(asn1ct_gen, [emit/1,demit/1]). - - % the encoding of class of tag bits 8 and 7 --define(UNIVERSAL, 0). --define(APPLICATION, 16#40). --define(CONTEXT, 16#80). --define(PRIVATE, 16#C0). - - % primitive or constructed encoding % bit 6 --define(PRIMITIVE, 0). --define(CONSTRUCTED, 2#00100000). - - --define(T_ObjectDescriptor, ?UNIVERSAL bor ?PRIMITIVE bor 7). - % restricted character string types --define(T_NumericString, ?UNIVERSAL bor ?PRIMITIVE bor 18). %can be constructed --define(T_PrintableString, ?UNIVERSAL bor ?PRIMITIVE bor 19). %can be constructed --define(T_TeletexString, ?UNIVERSAL bor ?PRIMITIVE bor 20). %can be constructed --define(T_VideotexString, ?UNIVERSAL bor ?PRIMITIVE bor 21). %can be constructed --define(T_IA5String, ?UNIVERSAL bor ?PRIMITIVE bor 22). %can be constructed --define(T_GraphicString, ?UNIVERSAL bor ?PRIMITIVE bor 25). %can be constructed --define(T_VisibleString, ?UNIVERSAL bor ?PRIMITIVE bor 26). %can be constructed --define(T_GeneralString, ?UNIVERSAL bor ?PRIMITIVE bor 27). %can be constructed - -%% 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 -%% Module = atom() -%% TypeOrVal = {TypeList,ValueList,PTypeList} -%% TypeList = ValueList = [atom()] - -pgen(OutFile,Erules,Module,TypeOrVal) -> - asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,true). - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Generate ENCODING -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% encode #{typedef, {pos, name, typespec}} -%%=============================================================================== - -gen_encode(Erules,Type) when record(Type,typedef) -> - gen_encode_user(Erules,Type). - -%%=============================================================================== -%% encode #{type, {tag, def, constraint}} -%%=============================================================================== - -gen_encode(Erules,Typename,Type) when record(Type,type) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - ObjFun = - case lists:keysearch(objfun,1,Type#type.tablecinf) of - {value,{_,_Name}} -> - ", ObjFun"; - false -> - "" - end, - - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - emit([nl,nl,nl,"%%================================"]), - emit([nl,"%% ",asn1ct_gen:list2name(Typename)]), - emit([nl,"%%================================",nl]), - case length(Typename) of - 1 -> % top level type - emit(["'enc_",asn1ct_gen:list2name(Typename), - "'(Val",ObjFun,") ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(Val, ", {asis,lists:reverse(Type#type.tag)},ObjFun,").",nl,nl]); - _ -> % embedded type with constructed name - true - end, - case lists:member(InnerType,['SET','SEQUENCE']) of - true -> - case get(asn_keyed_list) of - true -> - CompList = - case Type#type.def of - #'SEQUENCE'{components=Cl} -> Cl; - #'SET'{components=Cl} -> Cl - end, - emit([nl,"'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn",ObjFun, - ") when list(Val) ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(?RT_BER:fixoptionals(", - {asis,optionals(CompList)}, - ",Val), TagIn",ObjFun,");",nl,nl]); - _ -> true - end; - _ -> - emit([nl,"'enc_",asn1ct_gen:list2name(Typename), - "'({'",asn1ct_gen:list2name(Typename), - "',Val}, TagIn",ObjFun,") ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn",ObjFun,");",nl,nl]) - end, - emit(["'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn",ObjFun,") ->",nl," "]), - asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); - _ -> - true - end; - -%%=============================================================================== -%% encode ComponentType -%%=============================================================================== - -gen_encode(Erules,Tname,{'ComponentType',_Pos,Cname,Type,_Prop,_Tags}) -> - NewTname = [Cname|Tname], - %% The tag is set to [] to avoid that it is - %% taken into account twice, both as a component/alternative (passed as - %% argument to the encode decode function and within the encode decode - %% function it self. - NewType = Type#type{tag=[]}, - gen_encode(Erules,NewTname,NewType). - -gen_encode_user(Erules,D) when record(D,typedef) -> - Typename = [D#typedef.name], - Type = D#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Type#type.def), - OTag = Type#type.tag, - Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag], - emit([nl,nl,"%%================================"]), - emit([nl,"%% ",Typename]), - emit([nl,"%%================================",nl]), - emit(["'enc_",asn1ct_gen:list2name(Typename), - "'(Val",") ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(Val, ", {asis,lists:reverse(Tag)},").",nl,nl]), - - case lists:member(InnerType,['SET','SEQUENCE']) of - true -> - case get(asn_keyed_list) of - true -> - CompList = - case Type#type.def of - #'SEQUENCE'{components=Cl} -> Cl; - #'SET'{components=Cl} -> Cl - end, - - emit([nl,"'enc_",asn1ct_gen:list2name(Typename), - "'(Val, TagIn) when list(Val) ->",nl]), - emit([" 'enc_",asn1ct_gen:list2name(Typename), - "'(?RT_BER:fixoptionals(", - {asis,optionals(CompList)}, - ",Val), TagIn);",nl,nl]); - _ -> true - end; - _ -> - emit({nl,"'enc_",asn1ct_gen:list2name(Typename), - "'({'",asn1ct_gen:list2name(Typename),"',Val}, TagIn) ->",nl}), - emit({" 'enc_",asn1ct_gen:list2name(Typename),"'(Val, TagIn);",nl,nl}) - end, - emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val, TagIn) ->",nl}), - CurrentMod = get(currmod), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D); - {primitive,bif} -> - gen_encode_prim(ber,Type,"TagIn","Val"), - emit([".",nl]); - #typereference{val=Ename} -> - emit([" 'enc_",Ename,"'(Val, TagIn).",nl]); - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'enc_",Etype,"'(Val, TagIn).",nl]); - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'enc_",Etype,"'(Val, TagIn).",nl]); - 'ASN1_OPEN_TYPE' -> - emit(["%% OPEN TYPE",nl]), - gen_encode_prim(ber, - Type#type{def='ASN1_OPEN_TYPE'}, - "TagIn","Val"), - emit([".",nl]) - end. - -gen_encode_prim(_Erules,D,DoTag,Value) when record(D,type) -> - -%%% Constraint is currently not used for BER (except for BitString) and therefore replaced -%%% with [] as a placeholder - BitStringConstraint = D#type.constraint, - Constraint = [], - asn1ct_name:new(enumval), - case D#type.def of - 'BOOLEAN' -> - emit_encode_func('boolean',Value,DoTag); - 'INTEGER' -> - emit_encode_func('integer',Constraint,Value,DoTag); - {'INTEGER',NamedNumberList} -> - emit_encode_func('integer',Constraint,Value, - NamedNumberList,DoTag); - {'ENUMERATED',NamedNumberList={_,_}} -> - - emit(["case (case ",Value," of {asn1_enum,_}->",Value,";{_,_}->element(2,",Value,");_->", - Value," end) of",nl]), - emit_enc_enumerated_cases(NamedNumberList,DoTag); - {'ENUMERATED',NamedNumberList} -> - - emit(["case (case ",Value," of {_,_}->element(2,",Value,");_->", - Value," end) of",nl]), - emit_enc_enumerated_cases(NamedNumberList,DoTag); - - {'BIT STRING',NamedNumberList} -> - emit_encode_func('bit_string',BitStringConstraint,Value, - NamedNumberList,DoTag); - 'ANY' -> - emit_encode_func('open_type', Value,DoTag); - 'NULL' -> - emit_encode_func('null',Value,DoTag); - 'OBJECT IDENTIFIER' -> - emit_encode_func("object_identifier",Value,DoTag); - 'ObjectDescriptor' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_ObjectDescriptor,DoTag); - 'OCTET STRING' -> - emit_encode_func('octet_string',Constraint,Value,DoTag); - 'NumericString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_NumericString,DoTag); - 'TeletexString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_TeletexString,DoTag); - 'VideotexString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_VideotexString,DoTag); - 'GraphicString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_GraphicString,DoTag); - 'VisibleString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_VisibleString,DoTag); - 'GeneralString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_GeneralString,DoTag); - 'PrintableString' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_PrintableString,DoTag); - 'IA5String' -> - emit_encode_func('restricted_string',Constraint,Value, - ?T_IA5String,DoTag); - 'UniversalString' -> - emit_encode_func('universal_string',Constraint,Value,DoTag); - 'BMPString' -> - emit_encode_func('BMP_string',Constraint,Value,DoTag); - 'UTCTime' -> - emit_encode_func('utc_time',Constraint,Value,DoTag); - 'GeneralizedTime' -> - emit_encode_func('generalized_time',Constraint,Value,DoTag); - 'ASN1_OPEN_TYPE' -> - emit_encode_func('open_type', Value,DoTag); - XX -> - exit({'can not encode' ,XX}) - end. - - -emit_encode_func(Name,Value,Tags) when atom(Name) -> - emit_encode_func(atom_to_list(Name),Value,Tags); -emit_encode_func(Name,Value,Tags) -> - Fname = "?RT_BER:encode_" ++ Name, - emit([Fname,"(",Value,", ",Tags,")"]). - -emit_encode_func(Name,Constraint,Value,Tags) when atom(Name) -> - emit_encode_func(atom_to_list(Name),Constraint,Value,Tags); -emit_encode_func(Name,Constraint,Value,Tags) -> - Fname = "?RT_BER:encode_" ++ Name, - emit([Fname,"(",{asis,Constraint},", ",Value,", ",Tags,")"]). - -emit_encode_func(Name,Constraint,Value,Asis,Tags) when atom(Name) -> - emit_encode_func(atom_to_list(Name),Constraint,Value,Asis,Tags); -emit_encode_func(Name,Constraint,Value,Asis,Tags) -> - Fname = "?RT_BER:encode_" ++ Name, - emit([Fname,"(",{asis,Constraint},", ",Value, - ", ",{asis,Asis}, - ", ",Tags,")"]). - -emit_enc_enumerated_cases({L1,L2}, Tags) -> - emit_enc_enumerated_cases(L1++L2, Tags, ext); -emit_enc_enumerated_cases(L, Tags) -> - emit_enc_enumerated_cases(L, Tags, noext). - -emit_enc_enumerated_cases([{EnumName,EnumVal},H2|T], Tags, Ext) -> - emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), -%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), - emit_enc_enumerated_cases([H2|T], Tags, Ext); -emit_enc_enumerated_cases([{EnumName,EnumVal}], Tags, Ext) -> - emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), -%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), - case Ext of - noext -> emit([";",nl]); - ext -> - emit([";",nl,"{asn1_enum,",{curr,enumval},"} -> ", - "?RT_BER:encode_enumerated(",{curr,enumval},",",Tags,");",nl]), - asn1ct_name:new(enumval) - end, - emit([{curr,enumval}," -> exit({error,{asn1, {enumerated_not_in_range,",{curr, enumval},"}}})"]), - emit([nl,"end"]). - - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Generate DECODING -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% decode #{typedef, {pos, name, typespec}} -%%=============================================================================== - -gen_decode(Erules,Type) when record(Type,typedef) -> - Def = Type#typedef.typespec, - InnerTag = Def#type.tag , - - Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- InnerTag], - - Prefix = - case {asn1ct:get_gen_state_field(active), - asn1ct:get_gen_state_field(prefix)} of - {true,Pref} -> Pref; - _ -> "dec_" - end, - emit({nl,nl}), - emit(["'",Prefix,Type#typedef.name,"'(Tlv) ->",nl]), - emit([" '",Prefix,Type#typedef.name,"'(Tlv, ",{asis,Tag},").",nl,nl]), - emit(["'",Prefix,Type#typedef.name,"'(Tlv, TagIn) ->",nl]), - dbdec(Type#typedef.name), - gen_decode_user(Erules,Type). - -gen_inc_decode(Erules,Type) when record(Type,typedef) -> - Prefix = asn1ct:get_gen_state_field(prefix), - emit({nl,nl}), - emit(["'",Prefix,Type#typedef.name,"'(Tlv, TagIn) ->",nl]), - gen_decode_user(Erules,Type). - -%%=============================================================================== -%% decode #{type, {tag, def, constraint}} -%%=============================================================================== - -%% This gen_decode is called by the gen_decode/3 that decodes -%% ComponentType and the type of a SEQUENCE OF/SET OF. -gen_decode(Erules,Tname,Type) when record(Type,type) -> - Typename = Tname, - InnerType = asn1ct_gen:get_inner(Type#type.def), - Prefix = - case asn1ct:get_gen_state_field(active) of - true -> "'dec-inc-"; - _ -> "'dec_" - end, - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - ObjFun = - case Type#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - "" - end, - emit([Prefix,asn1ct_gen:list2name(Typename),"'(Tlv, TagIn",ObjFun,") ->",nl]), - dbdec(Typename), - asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type); - Rec when record(Rec,'Externaltypereference') -> - case {Typename,asn1ct:get_gen_state_field(namelist)} of - {[Cname|_],[{Cname,_}|_]} -> %% - %% This referenced type must only be generated - %% once as incomplete partial decode. Therefore we - %% have to check whether this function already is - %% generated. - case asn1ct:is_function_generated(Typename) of - true -> - ok; - _ -> - asn1ct:generated_refed_func(Typename), - #'Externaltypereference'{module=M,type=Name}=Rec, - TypeDef = asn1_db:dbget(M,Name), - gen_decode(Erules,TypeDef) - end; - _ -> - true - end; - _ -> - true - end; - - -%%=============================================================================== -%% decode ComponentType -%%=============================================================================== - -gen_decode(Erules,Tname,{'ComponentType',_Pos,Cname,Type,_Prop,_Tags}) -> - NewTname = [Cname|Tname], - %% The tag is set to [] to avoid that it is - %% taken into account twice, both as a component/alternative (passed as - %% argument to the encode decode function and within the encode decode - %% function it self. - NewType = Type#type{tag=[]}, - case {asn1ct:get_gen_state_field(active), - asn1ct:get_tobe_refed_func(NewTname)} of - {true,{_,NameList}} -> - asn1ct:update_gen_state(namelist,NameList), - %% remove to gen_refed_funcs list from tobe_refed_funcs later - gen_decode(Erules,NewTname,NewType); - {No,_} when No == false; No == undefined -> - gen_decode(Erules,NewTname,NewType); - _ -> - ok - end. - - -gen_decode_user(Erules,D) when record(D,typedef) -> - Typename = [D#typedef.name], - Def = D#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Def#type.def), - BytesVar = "Tlv", - 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"), - emit({".",nl,nl}); - {primitive,bif} -> - asn1ct_name:new(len), - gen_dec_prim(ber, Def, BytesVar,{string,"TagIn"},[] , - ?PRIMITIVE,"OptOrMand"), - emit([".",nl,nl]); - {constructed,bif} -> - asn1ct:update_namelist(D#typedef.name), - asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D); - TheType -> - DecFunName = mkfuncname(TheType,dec), - emit([DecFunName,"(",BytesVar, - ", TagIn)"]), - emit([".",nl,nl]) - end. - - -gen_dec_prim(_Erules,Att,BytesVar,DoTag,_TagIn,_Form,_OptOrMand) -> - Typename = Att#type.def, -%% Currently not used for BER replaced with [] as place holder -%% Constraint = Att#type.constraint, -%% Constraint = [], - Constraint = - case get_constraint(Att#type.constraint,'SizeConstraint') of - no -> []; - Tc -> Tc - end, - ValueRange = - case get_constraint(Att#type.constraint,'ValueRange') of - no -> []; - Tv -> Tv - end, - SingleValue = - case get_constraint(Att#type.constraint,'SingleValue') of - no -> []; - Sv -> Sv - end, - AsBin = case get(binary_strings) of - true -> "_as_bin"; - _ -> "" - end, - NewTypeName = case Typename of - 'ANY' -> 'ASN1_OPEN_TYPE'; - _ -> Typename - end, -% DoLength = - case NewTypeName of - 'BOOLEAN'-> - emit({"?RT_BER:decode_boolean(",BytesVar,","}), - add_func({decode_boolean,2}); - 'INTEGER' -> - emit({"?RT_BER:decode_integer(",BytesVar,",", - {asis,int_constr(SingleValue,ValueRange)},","}), - add_func({decode_integer,3}); - {'INTEGER',NamedNumberList} -> - emit({"?RT_BER:decode_integer(",BytesVar,",", - {asis,int_constr(SingleValue,ValueRange)},",", - {asis,NamedNumberList},","}), - add_func({decode_integer,4}); - {'ENUMERATED',NamedNumberList} -> - emit({"?RT_BER:decode_enumerated(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},","}), - add_func({decode_enumerated,4}); - {'BIT STRING',NamedNumberList} -> - case get(compact_bit_string) of - true -> - emit({"?RT_BER:decode_compact_bit_string(", - BytesVar,",",{asis,Constraint},",", - {asis,NamedNumberList},","}), - add_func({decode_compact_bit_string,4}); - _ -> - emit({"?RT_BER:decode_bit_string(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},","}), - add_func({decode_bit_string,4}) - end; - 'NULL' -> - emit({"?RT_BER:decode_null(",BytesVar,","}), - add_func({decode_null,2}); - 'OBJECT IDENTIFIER' -> - emit({"?RT_BER:decode_object_identifier(",BytesVar,","}), - add_func({decode_object_identifier,2}); - 'ObjectDescriptor' -> - emit({"?RT_BER:decode_restricted_string(", - BytesVar,",",{asis,Constraint},",",{asis,?T_ObjectDescriptor},","}), - add_func({decode_restricted_string,4}); - 'OCTET STRING' -> - emit({"?RT_BER:decode_octet_string",AsBin,"(",BytesVar,",",{asis,Constraint},","}), - add_func({decode_octet_string,3}); - 'NumericString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_NumericString},","}), - add_func({decode_restricted_string,4}); - 'TeletexString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_TeletexString},","}), - add_func({decode_restricted_string,4}); - 'VideotexString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_VideotexString},","}), - add_func({decode_restricted_string,4}); - 'GraphicString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_GraphicString},","}), - add_func({decode_restricted_string,4}); - 'VisibleString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_VisibleString},","}), - add_func({decode_restricted_string,4}); - 'GeneralString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_GeneralString},","}), - add_func({decode_restricted_string,4}); - 'PrintableString' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_PrintableString},","}), - add_func({decode_restricted_string,4}); - 'IA5String' -> - emit({"?RT_BER:decode_restricted_string",AsBin,"(", - BytesVar,",",{asis,Constraint},",",{asis,?T_IA5String},","}), - add_func({decode_restricted_string,4}) ; - 'UniversalString' -> - emit({"?RT_BER:decode_universal_string",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - add_func({decode_universal_string,3}); - 'BMPString' -> - emit({"?RT_BER:decode_BMP_string",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - add_func({decode_BMP_string,3}); - 'UTCTime' -> - emit({"?RT_BER:decode_utc_time",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - add_func({decode_utc_time,3}); - 'GeneralizedTime' -> - emit({"?RT_BER:decode_generalized_time",AsBin,"(", - BytesVar,",",{asis,Constraint},","}), - add_func({decode_generalized_time,3}); - 'ASN1_OPEN_TYPE' -> - emit(["?RT_BER:decode_open_type_as_binary(", - BytesVar,","]), - add_func({decode_open_type_as_binary,2}); - Other -> - exit({'can not decode' ,Other}) - end, - - case {DoTag,NewTypeName} of - {{string,TagStr},'ASN1_OPEN_TYPE'} -> - emit([TagStr,")"]); - {_,'ASN1_OPEN_TYPE'} -> - emit([{asis,DoTag},")"]); - {{string,TagStr},_} -> - emit([TagStr,")"]); - _ when list(DoTag) -> - emit([{asis,DoTag},")"]) - end. - - -int_constr([],[]) -> - []; -int_constr([],ValueRange) -> - ValueRange; -int_constr(SingleValue,[]) -> - SingleValue; -int_constr(SV,VR) -> - [SV,VR]. - -%% Object code generating for encoding and decoding -%% ------------------------------------------------ - -gen_obj_code(Erules,_Module,Obj) when record(Obj,typedef) -> - ObjName = Obj#typedef.name, - Def = Obj#typedef.typespec, - #'Externaltypereference'{module=M,type=ClName} = Def#'Object'.classname, - Class = asn1_db:dbget(M,ClName), - {object,_,Fields} = Def#'Object'.def, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjName}), - emit({nl,"%%================================",nl}), - EncConstructed = - gen_encode_objectfields(ClName,get_class_fields(Class), - ObjName,Fields,[]), - emit(nl), - gen_encode_constr_type(Erules,EncConstructed), - emit(nl), - DecConstructed = - gen_decode_objectfields(ClName,get_class_fields(Class), - ObjName,Fields,[]), - emit(nl), - gen_decode_constr_type(Erules,DecConstructed), - emit_tlv_format_function(); -gen_obj_code(_Erules,_Module,Obj) when record(Obj,pobjectdef) -> - ok. - -gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Arg) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ", ",Arg,", _RestPrimFieldName) ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val, RestPrimFieldName) ->",nl]), - MaybeConstr= - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_"), - emit([" {<<>>,0}"]), - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Val"), - gen_encode_default_call(ClassName,Name,DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Val"), - gen_encode_field_call(ObjName,Name,TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields, - MaybeConstr++ConstrAcc); -gen_encode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Args) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ", ",Args,") ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val,[H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_"), - emit([" exit({error,{'use of missing field in object', ",Name, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,TypeSpec},_} -> - EmitFuncClause(" Val, [H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'enc_",TypeName, - "'(H, Val, T)"}); - TypeName -> - emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}) - end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); - -% gen_encode_objectfields(Class,ObjName,[{FieldName,Type}|Rest],ConstrAcc) -> -% Fields = Class#objectclass.fields, -% MaybeConstr= -% case is_typefield(Fields,FieldName) of -% true -> -% Def = Type#typedef.typespec, -% emit({"'enc_",ObjName,"'(",{asis,FieldName}, -% ", Val, RestPrimFieldName) ->",nl}), -% CAcc= -% case Type#typedef.name of -% {primitive,bif} -> %%tag should be the primitive tag -% OTag = Def#type.tag, -% Tag = [encode_tag_val(decode_class(X#tag.class), -% X#tag.form,X#tag.number)|| -% X <- OTag], -% gen_encode_prim(ber,Def,{asis,lists:reverse(Tag)}, -% "Val"), -% []; -% {constructed,bif} -> -% emit({" 'enc_",ObjName,'_',FieldName, -% "'(Val)"}), -% [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; -% {ExtMod,TypeName} -> -% emit({" '",ExtMod,"':'enc_",TypeName, -% "'(Val)"}), -% []; -% TypeName -> -% emit({" 'enc_",TypeName,"'(Val)"}), -% [] -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% CAcc; -% {false,objectfield} -> -% emit({"'enc_",ObjName,"'(",{asis,FieldName}, -% ", Val,[H|T]) ->",nl}), -% case Type#typedef.name of -% {ExtMod,TypeName} -> -% emit({indent(3),"'",ExtMod,"':'enc_",TypeName, -% "'(H, Val, T)"}); -% TypeName -> -% emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}) -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% []; -% {false,_} -> [] -% end, -% gen_encode_objectfields(Class,ObjName,Rest,MaybeConstr ++ ConstrAcc); -gen_encode_objectfields(ClassName,[_C|Cs],O,OF,Acc) -> - gen_encode_objectfields(ClassName,Cs,O,OF,Acc); -gen_encode_objectfields(_,[],_,_,Acc) -> - Acc. - -% gen_encode_constr_type(Erules,[{Name,Def}|Rest]) -> -% emit({Name,"(Val,TagIn) ->",nl}), -% InnerType = asn1ct_gen:get_inner(Def#type.def), -% asn1ct_gen:gen_encode_constructed(Erules,Name,InnerType,Def), -% gen_encode_constr_type(Erules,Rest); -gen_encode_constr_type(Erules,[TypeDef|Rest]) when record(TypeDef,typedef) -> - case is_already_generated(enc,TypeDef#typedef.name) of - true -> ok; - _ -> gen_encode_user(Erules,TypeDef) - end, - gen_encode_constr_type(Erules,Rest); -gen_encode_constr_type(_,[]) -> - ok. - -gen_encode_field_call(ObjName,FieldName,Type) -> - Def = Type#typedef.typespec, - OTag = Def#type.tag, - Tag = [encode_tag_val(decode_class(X#tag.class), - X#tag.form,X#tag.number)|| - X <- OTag], - case Type#typedef.name of - {primitive,bif} -> %%tag should be the primitive tag -% OTag = Def#type.tag, -% Tag = [encode_tag_val(decode_class(X#tag.class), -% X#tag.form,X#tag.number)|| -% X <- OTag], - gen_encode_prim(ber,Def,{asis,lists:reverse(Tag)}, - "Val"), - []; - {constructed,bif} -> - emit({" 'enc_",ObjName,'_',FieldName, - "'(Val,",{asis,Tag},")"}), - [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'enc_",TypeName, - "'(Val,",{asis,Tag},")"}), - []; - TypeName -> - emit({" 'enc_",TypeName,"'(Val,",{asis,Tag},")"}), - [] - end. - -gen_encode_default_call(ClassName,FieldName,Type) -> - CurrentMod = get(currmod), - InnerType = asn1ct_gen:get_inner(Type#type.def), - OTag = Type#type.tag, - Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag], - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> -%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); - emit([" 'enc_",ClassName,'_',FieldName,"'(Bytes)"]), - [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - typespec=Type}]; - {primitive,bif} -> - gen_encode_prim(ber,Type,{asis,lists:reverse(Tag)},"Val"), - []; - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'enc_",Etype,"'(Val, ",{asis,Tag},")",nl]), - []; - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'enc_",Etype,"'(Val, ",{asis,Tag},")",nl]), - [] -% 'ASN1_OPEN_TYPE' -> -% emit(["%% OPEN TYPE",nl]), -% gen_encode_prim(ber, -% Type#type{def='ASN1_OPEN_TYPE'}, -% "TagIn","Val"), -% emit([".",nl]) - end. - -%%%%%%%%%%%%%%%% - -gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Arg) -> - emit(["'dec_",ObjName,"'(",{asis,Name}, - ", ",Arg,",_) ->",nl]) - end, -% emit(["'dec_",ObjName,"'(",{asis,Name}, -% ", Bytes, RestPrimFieldName) ->",nl]), - MaybeConstr= - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause(" _"), - emit([" asn1_NOVALUE"]), - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Bytes"), - emit_tlv_format("Bytes"), - gen_decode_default_call(ClassName,Name,"Tlv",DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Bytes"), - emit_tlv_format("Bytes"), - gen_decode_field_call(ObjName,Name,"Tlv",TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc); -gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Args) -> - emit(["'dec_",ObjName,"'(",{asis,Name}, - ", ",Args,") ->",nl]) - end, -% emit(["'dec_",ObjName,"'(",{asis,Name}, -% ", Bytes,[H|T]) ->",nl]), -% emit_tlv_format("Bytes"), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_"), - emit([" exit({error,{'illegal use of missing field in object', ",Name, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,TypeSpec},_} -> - EmitFuncClause("Bytes,[H|T]"), -% emit_tlv_format("Bytes"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'dec_",TypeName, - "'(H, Bytes, T)"}); - TypeName -> - emit({indent(3),"'dec_",TypeName,"'(H, Bytes, T)"}) - end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); -gen_decode_objectfields(CN,[_C|Cs],O,OF,CAcc) -> - gen_decode_objectfields(CN,Cs,O,OF,CAcc); -gen_decode_objectfields(_,[],_,_,CAcc) -> - CAcc. - -emit_tlv_format(Bytes) -> - notice_tlv_format_gen(), % notice for generating of tlv_format/1 - emit([" Tlv = tlv_format(",Bytes,"),",nl]). - -notice_tlv_format_gen() -> - Module = get(currmod), -% io:format("Noticed: ~p~n",[Module]), - case get(tlv_format) of - {done,Module} -> - ok; - _ -> % true or undefined - put(tlv_format,true) - end. - -emit_tlv_format_function() -> - Module = get(currmod), -% io:format("Tlv formated: ~p",[Module]), - case get(tlv_format) of - true -> -% io:format(" YES!~n"), - emit_tlv_format_function1(), - put(tlv_format,{done,Module}); - _ -> -% io:format(" NO!~n"), - ok - end. -emit_tlv_format_function1() -> - emit(["tlv_format(Bytes) when binary(Bytes) ->",nl, - " {Tlv,_}=?RT_BER:decode(Bytes),",nl, - " Tlv;",nl, - "tlv_format(Bytes) ->",nl, - " Bytes.",nl]). - - -gen_decode_constr_type(Erules,[{Name,Def}|Rest]) -> - emit([Name,"(Tlv, TagIn) ->",nl]), - InnerType = asn1ct_gen:get_inner(Def#type.def), - asn1ct_gen:gen_decode_constructed(Erules,Name,InnerType,Def), - gen_decode_constr_type(Erules,Rest); -gen_decode_constr_type(Erules,[TypeDef|Rest]) when record(TypeDef,typedef) -> - case is_already_generated(dec,TypeDef#typedef.name) of - true -> ok; - _ -> - gen_decode(Erules,TypeDef) - end, - gen_decode_constr_type(Erules,Rest); -gen_decode_constr_type(_,[]) -> - ok. - -%%%%%%%%%%% -gen_decode_field_call(ObjName,FieldName,Bytes,Type) -> - Def = Type#typedef.typespec, - OTag = Def#type.tag, - 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), - []; - {constructed,bif} -> - emit({" 'dec_",ObjName,'_',FieldName, - "'(",Bytes,",",{asis,Tag},")"}), - [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'dec_",TypeName, - "'(",Bytes,",",{asis,Tag},")"}), - []; - TypeName -> - emit({" 'dec_",TypeName,"'(",Bytes,",",{asis,Tag},")"}), - [] - end. - -gen_decode_default_call(ClassName,FieldName,Bytes,Type) -> - CurrentMod = get(currmod), - InnerType = asn1ct_gen:get_inner(Type#type.def), - OTag = Type#type.tag, - Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- OTag], - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes,",", - {asis,Tag},")"]), - [#typedef{name=list_to_atom(lists:concat([ClassName,'_', - FieldName])), - typespec=Type}]; - {primitive,bif} -> - gen_dec_prim(ber,Type,Bytes,Tag,"TagIn", - ?PRIMITIVE,opt_or_default), - []; - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'dec_",Etype,"'(",Bytes, " ,",{asis,Tag},")",nl]), - []; - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'dec_",Etype,"'(",Bytes,", ", - {asis,Tag},")",nl]), - [] -% 'ASN1_OPEN_TYPE' -> -% emit(["%% OPEN TYPE",nl]), -% gen_encode_prim(ber, -% Type#type{def='ASN1_OPEN_TYPE'}, -% "TagIn","Val"), -% emit([".",nl]) - end. -%%%%%%%%%%% - -is_already_generated(Operation,Name) -> - case get(class_default_type) of - undefined -> - put(class_default_type,[{Operation,Name}]), - false; - GeneratedList -> - case lists:member({Operation,Name},GeneratedList) of - true -> - true; - false -> - put(class_default_type,[{Operation,Name}|GeneratedList]), - false - end - end. - -more_genfields([]) -> - false; -more_genfields([Field|Fields]) -> - case element(1,Field) of - typefield -> - true; - objectfield -> - true; - _ -> - more_genfields(Fields) - end. - - - - -%% Object Set code generating for encoding and decoding -%% ---------------------------------------------------- -gen_objectset_code(Erules,ObjSet) -> - ObjSetName = ObjSet#typedef.name, - Def = ObjSet#typedef.typespec, -% {ClassName,ClassDef} = Def#'ObjectSet'.class, - #'Externaltypereference'{module=ClassModule, - type=ClassName} = Def#'ObjectSet'.class, - ClassDef = asn1_db:dbget(ClassModule,ClassName), - UniqueFName = Def#'ObjectSet'.uniquefname, - Set = Def#'ObjectSet'.set, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjSetName}), - emit({nl,"%%================================",nl}), - case ClassName of - {_Module,ExtClassName} -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ExtClassName,ClassDef); - _ -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef) - end, - emit(nl). - -gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)-> - ClassFields = get_class_fields(ClassDef), - InternalFuncs=gen_objset_enc(Erules,ObjSetName,UniqueFName,Set, - ClassName,ClassFields,1,[]), - gen_objset_dec(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassFields,1), - gen_internal_funcs(Erules,InternalFuncs). - -%% gen_objset_enc iterates over the objects of the object set -gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - []; -gen_objset_enc(Erules,ObjSName,UniqueName, - [{ObjName,Val,Fields},T|Rest],ClName,ClFields, - NthObj,Acc)-> - emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val}, - ") ->",nl}), - {InternalFunc,NewNthObj}= - case ObjName of - no_name -> - gen_inlined_enc_funs(Fields,ClFields,ObjSName,NthObj); - _ -> - emit({" fun 'enc_",ObjName,"'/3"}), - {[],NthObj} - end, - emit({";",nl}), - gen_objset_enc(Erules,ObjSName,UniqueName,[T|Rest],ClName,ClFields, - NewNthObj,InternalFunc ++ Acc); -gen_objset_enc(_,ObjSetName,UniqueName, - [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) -> - emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",", - {asis,Val},") ->",nl}), - {InternalFunc,_} = - case ObjName of - no_name -> - gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj); - _ -> - emit({" fun 'enc_",ObjName,"'/3"}), - {[],NthObj} - end, - emit({".",nl,nl}), - InternalFunc ++ Acc; -%% See X.681 Annex E for the following case -gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, - _ClFields,_NthObj,Acc) -> - emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(_, Val, _RestPrimFieldName) ->",nl}), - emit({indent(6),"Len = case Val of",nl,indent(9), - "Bin when binary(Bin) -> size(Bin);",nl,indent(9), - "_ -> length(Val)",nl,indent(6),"end,"}), - emit({indent(6),"{Val,Len}",nl}), - emit({indent(3),"end.",nl,nl}), - Acc; -gen_objset_enc(_,_,_,[],_,_,_,Acc) -> - Acc. - -%% gen_inlined_enc_funs for each object iterates over all fields of a -%% class, and for each typefield it checks if the object has that -%% field and emits the proper code. -gen_inlined_enc_funs(Fields,[{typefield,Name,_}|Rest], - ObjSetName,NthObj) -> - InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl, - indent(6),"case Type of",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret); - {value,{_,Type}} when record(Type,typedef) -> - emit({indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl, - indent(6),"case Type of",nl}), - emit({indent(9),{asis,Name}," ->",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret); - false -> - gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj) - end; -gen_inlined_enc_funs(Fields,[_|Rest],ObjSetName,NthObj) -> - gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj); -gen_inlined_enc_funs(_,[],_,NthObj) -> - {[],NthObj}. - -gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName, - NthObj,Acc) -> - InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), - {Acc2,NAdd}= - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({";",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - {Ret++Acc,N}; - {value,{_,Type}} when record(Type,typedef) -> - emit({";",nl,indent(9),{asis,Name}," ->",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - {Ret++Acc,N}; - false -> - {Acc,0} - end, - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+NAdd,Acc2); -gen_inlined_enc_funs1(Fields,[_|Rest],ObjSetName,NthObj,Acc)-> - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,Acc); -gen_inlined_enc_funs1(_,[],_,NthObj,Acc) -> - emit({nl,indent(6),"end",nl}), - emit({indent(3),"end"}), - {Acc,NthObj}. - -emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type}, - InternalDefFunName) -> - OTag = Type#type.tag, - Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag], -% remove Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], - case {ExtMod,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_encode_prim(ber,Type,[{asis,lists:reverse(Tag)}],"Val"), - {[],0}; - {constructed,bif} -> - emit([indent(12),"'enc_", - InternalDefFunName,"'(Val)"]), - {[TDef#typedef{name=InternalDefFunName}],1}; - _ -> - emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val)"}), - {[],0} - end; -emit_inner_of_fun(#typedef{name=Name},_) -> -% OTag = Type#type.tag, -% remove Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], -% Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag], - emit({indent(12),"'enc_",Name,"'(Val)"}), - {[],0}; -emit_inner_of_fun(Type,_) when record(Type,type) -> - CurrMod = get(currmod), -% OTag = Type#type.tag, -% remove Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], -% Tag = [encode_tag_val(decode_class(X#tag.class),X#tag.form,X#tag.number)|| X <- OTag], - case Type#type.def of - Def when atom(Def) -> - OTag = Type#type.tag, - Tag = [encode_tag_val(decode_class(X#tag.class), - X#tag.form,X#tag.number)||X <- OTag], - emit([indent(9),Def," ->",nl,indent(12)]), - gen_encode_prim(ber,Type,{asis,lists:reverse(Tag)},"Val"); - TRef when record(TRef,typereference) -> - T = TRef#typereference.val, - emit([indent(9),T," ->",nl,indent(12),"'enc_",T, - "'(Val)"]); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit([indent(9),T," ->",nl,indent(12),"'enc_",T, - "'(Val)"]); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit([indent(9),T," ->",nl,indent(12),ExtMod,":'enc_", - T,"'(Val)"]) - end, - {[],0}. - -indent(N) -> - lists:duplicate(N,32). % 32 = space - - -gen_objset_dec(_,_,{unique,undefined},_,_,_,_) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - ok; -gen_objset_dec(Erules,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest], - ClName,ClFields,NthObj)-> - emit(["'getdec_",ObjSName,"'(",{asis,UniqueName},",", - {asis,Val},") ->",nl]), - NewNthObj= - case ObjName of - no_name -> - gen_inlined_dec_funs(Fields,ClFields,ObjSName,NthObj); - _ -> - emit([" fun 'dec_",ObjName,"'/3"]), - NthObj - end, - emit([";",nl]), - gen_objset_dec(Erules,ObjSName,UniqueName,[T|Rest],ClName, - ClFields,NewNthObj); -gen_objset_dec(_,ObjSetName,UniqueName,[{ObjName,Val,Fields}], - _ClName,ClFields,NthObj) -> - emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},",", - {asis,Val},") ->",nl]), - case ObjName of - no_name -> - gen_inlined_dec_funs(Fields,ClFields,ObjSetName,NthObj); - _ -> - emit([" fun 'dec_",ObjName,"'/3"]) - end, - emit([".",nl,nl]), - ok; -gen_objset_dec(Erules,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, - _ClFields,_NthObj) -> - emit(["'getdec_",ObjSetName,"'(_, _) ->",nl]), - emit([indent(2),"fun(_,Bytes, _RestPrimFieldName) ->",nl]), - case Erules of - ber_bin_v2 -> - emit([indent(4),"case Bytes of",nl, - indent(6),"Bin when binary(Bin) -> ",nl, - indent(8),"Bin;",nl, - indent(6),"_ ->",nl, - indent(8),"?RT_BER:encode(Bytes)",nl, - indent(4),"end",nl]); - _ -> - emit([indent(6),"Len = case Bytes of",nl,indent(9), - "Bin when binary(Bin) -> size(Bin);",nl,indent(9), - "_ -> length(Bytes)",nl,indent(6),"end,"]), - emit([indent(4),"{Bytes,[],Len}",nl]) - end, - emit([indent(2),"end.",nl,nl]), - ok; -gen_objset_dec(_,_,_,[],_,_,_) -> - ok. - -gen_inlined_dec_funs(Fields,[{typefield,Name,Prop}|Rest], - ObjSetName,NthObj) -> - DecProp = case Prop of - 'OPTIONAL' -> opt_or_default; - {'DEFAULT',_} -> opt_or_default; - _ -> mandatory - end, - InternalDefFunName = [NthObj,Name,ObjSetName], - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->", - nl,indent(6),"case Type of",nl]), - N=emit_inner_of_decfun(Type,DecProp,InternalDefFunName), - gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N); - {value,{_,Type}} when record(Type,typedef) -> - emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->", - nl,indent(6),"case Type of",nl]), - emit([indent(9),{asis,Name}," ->",nl]), - N=emit_inner_of_decfun(Type,DecProp,InternalDefFunName), - gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N); - false -> - gen_inlined_dec_funs(Fields,Rest,ObjSetName,NthObj) - end; -gen_inlined_dec_funs(Fields,[_H|Rest],ObjSetName,NthObj) -> - gen_inlined_dec_funs(Fields,Rest,ObjSetName,NthObj); -gen_inlined_dec_funs(_,[],_,NthObj) -> - NthObj. - -gen_inlined_dec_funs1(Fields,[{typefield,Name,Prop}|Rest], - ObjSetName,NthObj) -> - DecProp = case Prop of - 'OPTIONAL' -> opt_or_default; - {'DEFAULT',_} -> opt_or_default; - _ -> mandatory - end, - InternalDefFunName = [NthObj,Name,ObjSetName], - N= - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit([";",nl]), - emit_inner_of_decfun(Type,DecProp,InternalDefFunName); - {value,{_,Type}} when record(Type,typedef) -> - emit([";",nl,indent(9),{asis,Name}," ->",nl]), - emit_inner_of_decfun(Type,DecProp,InternalDefFunName); - false -> - 0 - end, - gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N); -gen_inlined_dec_funs1(Fields,[_|Rest],ObjSetName,NthObj)-> - gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj); -gen_inlined_dec_funs1(_,[],_,NthObj) -> - emit([nl,indent(6),"end",nl]), - emit([indent(3),"end"]), - NthObj. - -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], - Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- OTag], - case {ExtName,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_dec_prim(ber,Type,"Bytes",Tag,"TagIn", - ?PRIMITIVE,Prop), - 0; - {constructed,bif} -> - emit([indent(12),"'dec_", -% asn1ct_gen:list2name(InternalDefFunName),"'(Bytes, ",Prop, -% ", ",{asis,Tag},")"]), - asn1ct_gen:list2name(InternalDefFunName),"'(Bytes, ", - {asis,Tag},")"]), - 1; - _ -> - emit([indent(12),"'",ExtName,"':'dec_",Name,"'(Bytes)"]), - 0 - end; -emit_inner_of_decfun(#typedef{name=Name},_Prop,_) -> - emit([indent(12),"'dec_",Name,"'(Bytes)"]), - 0; -emit_inner_of_decfun(Type,Prop,_) when record(Type,type) -> - 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], - CurrMod = get(currmod), - Def = Type#type.def, - InnerType = asn1ct_gen:get_inner(Def), - WhatKind = asn1ct_gen:type(InnerType), - case WhatKind of - {primitive,bif} -> - emit([indent(9),Def," ->",nl,indent(12)]), - gen_dec_prim(ber,Type,"Bytes",Tag,"TagIn", - ?PRIMITIVE,Prop); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit([indent(9),T," ->",nl,indent(12),"'dec_",T, -% "'(Bytes, ",Prop,")"]); - "'(Bytes)"]); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit([indent(9),T," ->",nl,indent(12),ExtMod,":'dec_", -% T,"'(Bytes, ",Prop,")"]) - T,"'(Bytes)"]) - end, - 0. - -gen_internal_funcs(_,[]) -> - ok; -gen_internal_funcs(Erules,[TypeDef|Rest]) -> - gen_encode_user(Erules,TypeDef), - emit([nl,nl,"'dec_",TypeDef#typedef.name, -% "'(Tlv, OptOrMand, TagIn) ->",nl]), - "'(Tlv, TagIn) ->",nl]), - gen_decode_user(Erules,TypeDef), - gen_internal_funcs(Erules,Rest). - - -dbdec(Type) -> - demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[Bytes]),",nl}). - - -decode_class('UNIVERSAL') -> - ?UNIVERSAL; -decode_class('APPLICATION') -> - ?APPLICATION; -decode_class('CONTEXT') -> - ?CONTEXT; -decode_class('PRIVATE') -> - ?PRIVATE. - -decode_type('BOOLEAN') -> 1; -decode_type('INTEGER') -> 2; -decode_type('BIT STRING') -> 3; -decode_type('OCTET STRING') -> 4; -decode_type('NULL') -> 5; -decode_type('OBJECT IDENTIFIER') -> 6; -decode_type('OBJECT DESCRIPTOR') -> 7; -decode_type('EXTERNAL') -> 8; -decode_type('REAL') -> 9; -decode_type('ENUMERATED') -> 10; -decode_type('EMBEDDED_PDV') -> 11; -decode_type('SEQUENCE') -> 16; -decode_type('SEQUENCE OF') -> 16; -decode_type('SET') -> 17; -decode_type('SET OF') -> 17; -decode_type('NumericString') -> 18; -decode_type('PrintableString') -> 19; -decode_type('TeletexString') -> 20; -decode_type('VideotexString') -> 21; -decode_type('IA5String') -> 22; -decode_type('UTCTime') -> 23; -decode_type('GeneralizedTime') -> 24; -decode_type('GraphicString') -> 25; -decode_type('VisibleString') -> 26; -decode_type('GeneralString') -> 27; -decode_type('UniversalString') -> 28; -decode_type('BMPString') -> 30; -decode_type('CHOICE') -> 'CHOICE'; % choice gets the tag from the actual alternative -decode_type(Else) -> exit({error,{asn1,{unrecognized_type,Else}}}). - -add_removed_bytes() -> - asn1ct_name:delete(rb), - add_removed_bytes(asn1ct_name:all(rb)). - -add_removed_bytes([H,T1|T]) -> - emit({{var,H},"+"}), - add_removed_bytes([T1|T]); -add_removed_bytes([H|T]) -> - emit({{var,H}}), - add_removed_bytes(T); -add_removed_bytes([]) -> - true. - -mkfuncname(WhatKind,DecOrEnc) -> - case WhatKind of - #'Externaltypereference'{module=Mod,type=EType} -> - CurrMod = get(currmod), - case CurrMod of - Mod -> - lists:concat(["'",DecOrEnc,"_",EType,"'"]); - _ -> -% io:format("CurrMod: ~p, Mod: ~p~n",[CurrMod,Mod]), - lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"]) - end; - #'typereference'{val=EType} -> - lists:concat(["'",DecOrEnc,"_",EType,"'"]); - 'ASN1_OPEN_TYPE' -> - lists:concat(["'",DecOrEnc,"_",WhatKind,"'"]) - - end. - -optionals(L) -> optionals(L,[],1). - -optionals([{'EXTENSIONMARK',_,_}|Rest],Acc,Pos) -> - optionals(Rest,Acc,Pos); % optionals in extension are currently not handled -optionals([#'ComponentType'{name=Name,prop='OPTIONAL'}|Rest],Acc,Pos) -> - optionals(Rest,[{Name,Pos}|Acc],Pos+1); -optionals([#'ComponentType'{name=Name,prop={'DEFAULT',_}}|Rest],Acc,Pos) -> - optionals(Rest,[{Name,Pos}|Acc],Pos+1); -optionals([#'ComponentType'{}|Rest],Acc,Pos) -> - optionals(Rest,Acc,Pos+1); -optionals([],Acc,_) -> - lists:reverse(Acc). - -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - - -get_class_fields(#classdef{typespec=ObjClass}) -> - ObjClass#objectclass.fields; -get_class_fields(#objectclass{fields=Fields}) -> - Fields; -get_class_fields(_) -> - []. - -get_object_field(Name,ObjectFields) -> - case lists:keysearch(Name,1,ObjectFields) of - {value,Field} -> Field; - false -> false - end. - -%%encode_tag(TagClass(?UNI, APP etc), Form (?PRIM etx), TagInteger) -> -%% 8bit Int | binary -encode_tag_val(Class, Form, TagNo) when (TagNo =< 30) -> - <<(Class bsr 6):2,(Form bsr 5):1,TagNo:5>>; - -encode_tag_val(Class, Form, TagNo) -> - {Octets,_Len} = mk_object_val(TagNo), - BinOct = list_to_binary(Octets), - <<(Class bsr 6):2, (Form bsr 5):1, 31:5,BinOct/binary>>. - -%%%%%%%%%%% -%% mk_object_val(Value) -> {OctetList, Len} -%% returns a Val as a list of octets, the 8 bit is allways set to one except -%% for the last octet, where its 0 -%% - - -mk_object_val(Val) when Val =< 127 -> - {[255 band Val], 1}; -mk_object_val(Val) -> - mk_object_val(Val bsr 7, [Val band 127], 1). -mk_object_val(0, Ack, Len) -> - {Ack, Len}; -mk_object_val(Val, Ack, Len) -> - mk_object_val(Val bsr 7, [((Val band 127) bor 128) | Ack], Len + 1). - -add_func(F={_Func,_Arity}) -> - ets:insert(asn1_functab,{F}). - - - - - - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_per.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_per.erl deleted file mode 100644 index 8cd8d34918..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_per.erl +++ /dev/null @@ -1,1190 +0,0 @@ -%% ``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: asn1ct_gen_per.erl,v 1.1 2008/12/17 09:53:30 mikpe Exp $ -%% --module(asn1ct_gen_per). - -%% Generate erlang module which handles (PER) encode and decode for -%% all types in an ASN.1 module - --include("asn1_records.hrl"). -%-compile(export_all). - --export([pgen/4,gen_dec_prim/3,gen_encode_prim/4]). --export([gen_obj_code/3,gen_objectset_code/2]). --export([gen_decode/2, gen_decode/3]). --export([gen_encode/2, gen_encode/3]). --export([is_already_generated/2,more_genfields/1,get_class_fields/1, - get_object_field/2]). - --import(asn1ct_gen, [emit/1,demit/1]). - -%% 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 -%% Module = atom() -%% TypeOrVal = {TypeList,ValueList} -%% TypeList = ValueList = [atom()] - -pgen(OutFile,Erules,Module,TypeOrVal) -> - asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,true). - - -%% Generate ENCODING ****************************** -%%****************************************x - - -gen_encode(Erules,Type) when record(Type,typedef) -> - gen_encode_user(Erules,Type). -%% case Type#typedef.typespec of -%% Def when record(Def,type) -> -%% gen_encode_user(Erules,Type); -%% Def when tuple(Def),(element(1,Def) == 'Object') -> -%% gen_encode_object(Erules,Type); -%% Other -> -%% exit({error,{asn1,{unknown,Other}}}) -%% end. - -gen_encode(Erules,Typename,#'ComponentType'{name=Cname,typespec=Type}) -> - NewTypename = [Cname|Typename], - gen_encode(Erules,NewTypename,Type); - -gen_encode(Erules,Typename,Type) when record(Type,type) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - ObjFun = - case lists:keysearch(objfun,1,Type#type.tablecinf) of - {value,{_,_Name}} -> -%% lists:concat([", ObjFun",Name]); - ", ObjFun"; - false -> - "" - end, - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - case InnerType of - 'SET' -> - true; - 'SEQUENCE' -> - true; - _ -> - emit({nl,"'enc_",asn1ct_gen:list2name(Typename), - "'({'",asn1ct_gen:list2name(Typename), - "',Val}",ObjFun,") ->",nl}), - emit({"'enc_",asn1ct_gen:list2name(Typename), - "'(Val",ObjFun,");",nl,nl}) - end, - emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val",ObjFun, - ") ->",nl}), - asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); - _ -> - true - end. - - -gen_encode_user(Erules,D) when record(D,typedef) -> - CurrMod = get(currmod), - Typename = [D#typedef.name], - Def = D#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Def#type.def), - case InnerType of - 'SET' -> true; - 'SEQUENCE' -> true; - _ -> - emit({nl,"'enc_",asn1ct_gen:list2name(Typename),"'({'",asn1ct_gen:list2name(Typename),"',Val}) ->",nl}), - emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val);",nl,nl}) - end, - emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val) ->",nl}), - case asn1ct_gen:type(InnerType) of - {primitive,bif} -> - gen_encode_prim(Erules,Def,"false"), - emit({".",nl}); - 'ASN1_OPEN_TYPE' -> - gen_encode_prim(Erules,Def#type{def='ASN1_OPEN_TYPE'},"false"), - emit({".",nl}); - {constructed,bif} -> - asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D); - #'Externaltypereference'{module=CurrMod,type=Etype} -> - emit({"'enc_",Etype,"'(Val).",nl,nl}); - #'Externaltypereference'{module=Emod,type=Etype} -> - emit({"'",Emod,"':'enc_",Etype,"'(Val).",nl,nl}); - #typereference{val=Ename} -> - emit({"'enc_",Ename,"'(Val).",nl,nl}); - {notype,_} -> - emit({"'enc_",InnerType,"'(Val).",nl,nl}) - end. - - -gen_encode_prim(Erules,D,DoTag) -> - Value = case asn1ct_name:active(val) of - true -> - asn1ct_gen:mk_var(asn1ct_name:curr(val)); - false -> - "Val" - end, - gen_encode_prim(Erules,D,DoTag,Value). - -gen_encode_prim(_Erules,D,_DoTag,Value) when record(D,type) -> - Constraint = D#type.constraint, - case D#type.def of - 'INTEGER' -> - emit({"?RT_PER:encode_integer(", %fel - {asis,Constraint},",",Value,")"}); - {'INTEGER',NamedNumberList} -> - emit({"?RT_PER:encode_integer(", - {asis,Constraint},",",Value,",", - {asis,NamedNumberList},")"}); - {'ENUMERATED',{Nlist1,Nlist2}} -> - NewList = lists:concat([[{0,X}||{X,_} <- Nlist1],['EXT_MARK'],[{1,X}||{X,_} <- Nlist2]]), - NewC = [{'ValueRange',{0,length(Nlist1)-1}}], - emit(["case (case ",Value," of {_,_}->element(2,",Value,");_->", - Value," end) of",nl]), - emit_enc_enumerated_cases(NewC, NewList++[{asn1_enum,length(Nlist1)-1}], 0); - {'ENUMERATED',NamedNumberList} -> - NewList = [X||{X,_} <- NamedNumberList], - NewC = [{'ValueRange',{0,length(NewList)-1}}], - emit(["case (case ",Value," of {_,_}->element(2,",Value,");_->", - Value," end) of",nl]), - emit_enc_enumerated_cases(NewC, NewList, 0); - {'BIT STRING',NamedNumberList} -> - emit({"?RT_PER:encode_bit_string(", - {asis,Constraint},",",Value,",", - {asis,NamedNumberList},")"}); - 'NULL' -> - emit({"?RT_PER:encode_null(",Value,")"}); - 'OBJECT IDENTIFIER' -> - emit({"?RT_PER:encode_object_identifier(",Value,")"}); - 'ObjectDescriptor' -> - emit({"?RT_PER:encode_ObjectDescriptor(",{asis,Constraint}, - ",",Value,")"}); - 'BOOLEAN' -> - emit({"?RT_PER:encode_boolean(",Value,")"}); - 'OCTET STRING' -> - emit({"?RT_PER:encode_octet_string(",{asis,Constraint},",",Value,")"}); - 'NumericString' -> - emit({"?RT_PER:encode_NumericString(",{asis,Constraint},",",Value,")"}); - 'TeletexString' -> - emit({"?RT_PER:encode_TeletexString(",{asis,Constraint},",",Value,")"}); - 'VideotexString' -> - emit({"?RT_PER:encode_VideotexString(",{asis,Constraint},",",Value,")"}); - 'UTCTime' -> - emit({"?RT_PER:encode_VisibleString(",{asis,Constraint},",",Value,")"}); - 'GeneralizedTime' -> - emit({"?RT_PER:encode_VisibleString(",{asis,Constraint},",",Value,")"}); - 'GraphicString' -> - emit({"?RT_PER:encode_GraphicString(",{asis,Constraint},",",Value,")"}); - 'VisibleString' -> - emit({"?RT_PER:encode_VisibleString(",{asis,Constraint},",",Value,")"}); - 'GeneralString' -> - emit({"?RT_PER:encode_GeneralString(",{asis,Constraint},",",Value,")"}); - 'PrintableString' -> - emit({"?RT_PER:encode_PrintableString(",{asis,Constraint},",",Value,")"}); - 'IA5String' -> - emit({"?RT_PER:encode_IA5String(",{asis,Constraint},",",Value,")"}); - 'BMPString' -> - emit({"?RT_PER:encode_BMPString(",{asis,Constraint},",",Value,")"}); - 'UniversalString' -> - emit({"?RT_PER:encode_UniversalString(",{asis,Constraint},",",Value,")"}); - 'ANY' -> - emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", - Value, ")"]); - 'ASN1_OPEN_TYPE' -> - NewValue = case Constraint of - [#'Externaltypereference'{type=Tname}] -> - io_lib:format( - "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); - [#type{def=#'Externaltypereference'{type=Tname}}] -> - io_lib:format( - "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); - _ -> Value - end, - emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", - NewValue, ")"]); - XX -> - exit({asn1_error,nyi,XX}) - end. - -emit_enc_enumerated_cases(C, [H], Count) -> - emit_enc_enumerated_case(C, H, Count), - emit([";",nl,"EnumVal -> exit({error,{asn1, {enumerated_not_in_range, EnumVal}}})"]), - emit([nl,"end"]); -emit_enc_enumerated_cases(C, ['EXT_MARK'|T], _Count) -> - emit_enc_enumerated_cases(C, T, 0); -emit_enc_enumerated_cases(C, [H1,H2|T], Count) -> - emit_enc_enumerated_case(C, H1, Count), - emit([";",nl]), - emit_enc_enumerated_cases(C, [H2|T], Count+1). - - - -emit_enc_enumerated_case(_C, {asn1_enum,High}, _) -> - emit([ - "{asn1_enum,EnumV} when integer(EnumV), EnumV > ",High," -> ", - "[{bit,1},?RT_PER:encode_small_number(EnumV)]"]); -emit_enc_enumerated_case(_C, 'EXT_MARK', _Count) -> - true; -emit_enc_enumerated_case(_C, {1,EnumName}, Count) -> - emit(["'",EnumName,"' -> [{bit,1},?RT_PER:encode_small_number(",Count,")]"]); -emit_enc_enumerated_case(C, {0,EnumName}, Count) -> - emit(["'",EnumName,"' -> [{bit,0},?RT_PER:encode_integer(",{asis,C},", ",Count,")]"]); -emit_enc_enumerated_case(C, EnumName, Count) -> - emit(["'",EnumName,"' -> ?RT_PER:encode_integer(",{asis,C},", ",Count,")"]). - - -%% Object code generating for encoding and decoding -%% ------------------------------------------------ - -gen_obj_code(Erules,_Module,Obj) when record(Obj,typedef) -> - ObjName = Obj#typedef.name, - Def = Obj#typedef.typespec, - #'Externaltypereference'{module=Mod,type=ClassName} = - Def#'Object'.classname, - Class = asn1_db:dbget(Mod,ClassName), - {object,_,Fields} = Def#'Object'.def, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjName}), - emit({nl,"%%================================",nl}), - EncConstructed = - gen_encode_objectfields(ClassName,get_class_fields(Class), - ObjName,Fields,[]), - emit(nl), - gen_encode_constr_type(Erules,EncConstructed), - emit(nl), - DecConstructed = - gen_decode_objectfields(ClassName,get_class_fields(Class), - ObjName,Fields,[]), - emit(nl), - gen_decode_constr_type(Erules,DecConstructed), - emit(nl); -gen_obj_code(_,_,Obj) when record(Obj,pobjectdef) -> - ok. - - -gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(V) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ",",V,",_RestPrimFieldName) ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val, _RestPrimFieldName) ->",nl]), - MaybeConstr = - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_"), - emit(" []"), - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Val"), - gen_encode_default_call(ClassName,Name,DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Val"), - gen_encode_field_call(ObjName,Name,TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields, - MaybeConstr++ConstrAcc); -gen_encode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Attrs) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ",",Attrs,") ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val,[H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_"), - emit([" exit({error,{'use of missing field in object', ",Name, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,TypeSpec},_} -> - EmitFuncClause("Val,[H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'enc_",TypeName, - "'(H, Val, T)"}); - TypeName -> - emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}) - end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); -gen_encode_objectfields(ClassName,[_C|Cs],O,OF,Acc) -> - gen_encode_objectfields(ClassName,Cs,O,OF,Acc); -gen_encode_objectfields(_,[],_,_,Acc) -> - Acc. - - -% gen_encode_objectfields(Class,ObjName,[{FieldName,Type}|Rest],ConstrAcc) -> -% Fields = Class#objectclass.fields, - -% MaybeConstr = -% case is_typefield(Fields,FieldName) of -% true -> -% Def = Type#typedef.typespec, -% emit({"'enc_",ObjName,"'(",{asis,FieldName}, -% ", Val, Dummy) ->",nl}), - -% CAcc = -% case Type#typedef.name of -% {primitive,bif} -> -% gen_encode_prim(per,Def,"false","Val"), -% []; -% {constructed,bif} -> -% emit({" 'enc_",ObjName,'_',FieldName, -% "'(Val)"}), -% [{['enc_',ObjName,'_',FieldName],Def}]; -% {ExtMod,TypeName} -> -% emit({" '",ExtMod,"':'enc_",TypeName,"'(Val)"}), -% []; -% TypeName -> -% emit({" 'enc_",TypeName,"'(Val)"}), -% [] -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% CAcc; -% {false,objectfield} -> -% emit({"'enc_",ObjName,"'(",{asis,FieldName}, -% ", Val, [H|T]) ->",nl}), -% case Type#typedef.name of -% {ExtMod,TypeName} -> -% emit({indent(3),"'",ExtMod,"':'enc_",TypeName, -% "'(H, Val, T)"}); -% TypeName -> -% emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}) -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% []; -% {false,_} -> [] -% end, -% gen_encode_objectfields(Class,ObjName,Rest,MaybeConstr ++ ConstrAcc); -% gen_encode_objectfields(C,O,[H|T],Acc) -> -% gen_encode_objectfields(C,O,T,Acc); -% gen_encode_objectfields(_,_,[],Acc) -> -% Acc. - -% gen_encode_constr_type(Erules,[{Name,Def}|Rest]) -> -% emit({Name,"(Val) ->",nl}), -% InnerType = asn1ct_gen:get_inner(Def#type.def), -% asn1ct_gen:gen_encode_constructed(Erules,Name,InnerType,Def), -% gen_encode_constr_type(Erules,Rest); -gen_encode_constr_type(Erules,[TypeDef|Rest]) when record(TypeDef,typedef) -> - case is_already_generated(enc,TypeDef#typedef.name) of - true -> ok; - _ -> - Name = lists:concat(["enc_",TypeDef#typedef.name]), - emit({Name,"(Val) ->",nl}), - Def = TypeDef#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Def#type.def), - asn1ct_gen:gen_encode_constructed(Erules,Name,InnerType,Def), - gen_encode_constr_type(Erules,Rest) - end; -gen_encode_constr_type(_,[]) -> - ok. - -gen_encode_field_call(ObjName,FieldName,Type) -> - Def = Type#typedef.typespec, - case Type#typedef.name of - {primitive,bif} -> - gen_encode_prim(per,Def,"false", - "Val"), - []; - {constructed,bif} -> - emit({" 'enc_",ObjName,'_',FieldName, - "'(Val)"}), - [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'enc_",TypeName, - "'(Val)"}), - []; - TypeName -> - emit({" 'enc_",TypeName,"'(Val)"}), - [] - end. - -gen_encode_default_call(ClassName,FieldName,Type) -> - CurrentMod = get(currmod), - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> -%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); - emit([" 'enc_",ClassName,'_',FieldName,"'(Val)"]), - [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - typespec=Type}]; - {primitive,bif} -> - gen_encode_prim(per,Type,"false","Val"), - []; - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'enc_",Etype,"'(Val)",nl]), - []; - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'enc_",Etype,"'(Val)",nl]), - [] - end. - - -gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Bytes) -> - emit(["'dec_",ObjName,"'(",{asis,Name},",",Bytes, - ",_,_RestPrimFieldName) ->",nl]) - end, - MaybeConstr= - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_"), - emit([" asn1_NOVALUE"]), - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Bytes"), - gen_decode_default_call(ClassName,Name,"Bytes",DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Bytes"), - gen_decode_field_call(ObjName,Name,"Bytes",TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc); -gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Attrs) -> - emit(["'dec_",ObjName,"'(",{asis,Name}, - ",",Attrs,") ->",nl]) - end, -% emit(["'dec_",ObjName,"'(",{asis,Name}, -% ", Bytes,_,[H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_,_"), - emit([" exit({error,{'illegal use of missing field in object', ",Name, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,TypeSpec},_} -> - EmitFuncClause("Bytes,_,[H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'dec_",TypeName, - "'(H, Bytes, telltype, T)"}); - TypeName -> - emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"}) - end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); -gen_decode_objectfields(CN,[_C|Cs],O,OF,CAcc) -> - gen_decode_objectfields(CN,Cs,O,OF,CAcc); -gen_decode_objectfields(_,[],_,_,CAcc) -> - CAcc. - - -% gen_decode_objectfields(Class,ObjName,[{FieldName,Type}|Rest],ConstrAcc) -> -% Fields = Class#objectclass.fields, - -% MaybeConstr = -% case is_typefield(Fields,FieldName) of -% true -> -% Def = Type#typedef.typespec, -% emit({"'dec_",ObjName,"'(",{asis,FieldName}, -% ", Val, Telltype, RestPrimFieldName) ->",nl}), - -% CAcc = -% case Type#typedef.name of -% {primitive,bif} -> -% gen_dec_prim(per,Def,"Val"), -% []; -% {constructed,bif} -> -% emit({" 'dec_",ObjName,'_',FieldName, -% "'(Val, Telltype)"}), -% [{['dec_',ObjName,'_',FieldName],Def}]; -% {ExtMod,TypeName} -> -% emit({" '",ExtMod,"':'dec_",TypeName, -% "'(Val, Telltype)"}), -% []; -% TypeName -> -% emit({" 'dec_",TypeName,"'(Val, Telltype)"}), -% [] -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% CAcc; -% {false,objectfield} -> -% emit({"'dec_",ObjName,"'(",{asis,FieldName}, -% ", Val, Telltype, [H|T]) ->",nl}), -% case Type#typedef.name of -% {ExtMod,TypeName} -> -% emit({indent(3),"'",ExtMod,"':'dec_",TypeName, -% "'(H, Val, Telltype, T)"}); -% TypeName -> -% emit({indent(3),"'dec_",TypeName, -% "'(H, Val, Telltype, T)"}) -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% []; -% {false,_} -> -% [] -% end, -% gen_decode_objectfields(Class,ObjName,Rest,MaybeConstr ++ ConstrAcc); -% gen_decode_objectfields(C,O,[H|T],CAcc) -> -% gen_decode_objectfields(C,O,T,CAcc); -% gen_decode_objectfields(_,_,[],CAcc) -> -% CAcc. - - -gen_decode_field_call(ObjName,FieldName,Bytes,Type) -> - Def = Type#typedef.typespec, - case Type#typedef.name of - {primitive,bif} -> - gen_dec_prim(per,Def,Bytes), - []; - {constructed,bif} -> - emit({" 'dec_",ObjName,'_',FieldName, - "'(",Bytes,",telltype)"}), - [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'dec_",TypeName, - "'(",Bytes,", telltype)"}), - []; - TypeName -> - emit({" 'dec_",TypeName,"'(",Bytes,", telltype)"}), - [] - end. - -gen_decode_default_call(ClassName,FieldName,Bytes,Type) -> - CurrentMod = get(currmod), - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes,", telltype)"]), - [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - typespec=Type}]; - {primitive,bif} -> - gen_dec_prim(per,Type,Bytes), - []; - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'dec_",Etype,"'(",Bytes,", telltype)",nl]), - []; - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'dec_",Etype,"'(",Bytes,", telltype)",nl]), - [] - end. - - -gen_decode_constr_type(Erules,[{Name,Def}|Rest]) -> - emit({Name,"(Bytes,_) ->",nl}), - InnerType = asn1ct_gen:get_inner(Def#type.def), - asn1ct_gen:gen_decode_constructed(Erules,Name,InnerType,Def), - gen_decode_constr_type(Erules,Rest); -gen_decode_constr_type(Erules,[TypeDef|Rest]) when record(TypeDef,typedef) -> - case is_already_generated(dec,TypeDef#typedef.name) of - true -> ok; - _ -> - gen_decode(Erules,TypeDef) - end, - gen_decode_constr_type(Erules,Rest); -gen_decode_constr_type(_,[]) -> - ok. - -% more_genfields(Fields,[]) -> -% false; -% more_genfields(Fields,[{FieldName,_}|T]) -> -% case is_typefield(Fields,FieldName) of -% true -> true; -% {false,objectfield} -> true; -% {false,_} -> more_genfields(Fields,T) -% end. - -more_genfields([]) -> - false; -more_genfields([Field|Fields]) -> - case element(1,Field) of - typefield -> - true; - objectfield -> - true; - _ -> - more_genfields(Fields) - end. - -% is_typefield(Fields,FieldName) -> -% case lists:keysearch(FieldName,2,Fields) of -% {value,Field} -> -% case element(1,Field) of -% typefield -> -% true; -% Other -> -% {false,Other} -% end; -% _ -> -% false -% end. -%% Object Set code generating for encoding and decoding -%% ---------------------------------------------------- -gen_objectset_code(Erules,ObjSet) -> - ObjSetName = ObjSet#typedef.name, - Def = ObjSet#typedef.typespec, -%% {ClassName,ClassDef} = Def#'ObjectSet'.class, - #'Externaltypereference'{module=ClassModule, - type=ClassName} = Def#'ObjectSet'.class, - ClassDef = asn1_db:dbget(ClassModule,ClassName), - UniqueFName = Def#'ObjectSet'.uniquefname, - Set = Def#'ObjectSet'.set, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjSetName}), - emit({nl,"%%================================",nl}), - case ClassName of - {_Module,ExtClassName} -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set, - ExtClassName,ClassDef); - _ -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set, - ClassName,ClassDef) - end, - emit(nl). - -gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)-> - ClassFields = (ClassDef#classdef.typespec)#objectclass.fields, - InternalFuncs= - gen_objset_enc(ObjSetName,UniqueFName,Set,ClassName,ClassFields,1,[]), - gen_objset_dec(ObjSetName,UniqueFName,Set,ClassName,ClassFields,1), - gen_internal_funcs(Erules,InternalFuncs). - -%% gen_objset_enc iterates over the objects of the object set -gen_objset_enc(_,{unique,undefined},_,_,_,_,_) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - []; -gen_objset_enc(ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest], - ClName,ClFields,NthObj,Acc)-> - emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val}, - ") ->",nl}), - {InternalFunc,NewNthObj}= - case ObjName of - no_name -> - gen_inlined_enc_funs(Fields,ClFields,ObjSName,NthObj); - _Other -> - emit({" fun 'enc_",ObjName,"'/3"}), - {[],0} - end, - emit({";",nl}), - gen_objset_enc(ObjSName,UniqueName,[T|Rest],ClName,ClFields, - NewNthObj,InternalFunc ++ Acc); -gen_objset_enc(ObjSetName,UniqueName, - [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) -> - - emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",", - {asis,Val},") ->",nl}), - {InternalFunc,_}= - case ObjName of - no_name -> - gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj); - _Other -> - emit({" fun 'enc_",ObjName,"'/3"}), - {[],NthObj} - end, - emit({".",nl,nl}), - InternalFunc++Acc; -gen_objset_enc(ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, - _ClFields,_NthObj,Acc) -> - emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(_, Val, _) ->",nl}), - emit({indent(6),"[{octets,Val}]",nl}), - emit({indent(3),"end.",nl,nl}), - Acc; -gen_objset_enc(_,_,[],_,_,_,Acc) -> - Acc. - -%% gen_inlined_enc_funs for each object iterates over all fields of a -%% class, and for each typefield it checks if the object has that -%% field and emits the proper code. -gen_inlined_enc_funs(Fields,[{typefield,Name,_}|Rest],ObjSetName,NthObj) -> - InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({indent(3),"fun(Type, Val, _) ->",nl, - indent(6),"case Type of",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret); - {value,{_,Type}} when record(Type,typedef) -> - emit({indent(3),"fun(Type, Val, _) ->",nl, - indent(6),"case Type of",nl}), - emit({indent(9),{asis,Name}," ->",nl}), - {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName), - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret); - false -> - gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj) - end; -gen_inlined_enc_funs(Fields,[_H|Rest],ObjSetName,NthObj) -> - gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj); -gen_inlined_enc_funs(_,[],_,NthObj) -> - {[],NthObj}. - -gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName, - NthObj,Acc) -> - InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), - {Acc2,NAdd}= - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({";",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - {Ret++Acc,N}; - {value,{_,Type}} when record(Type,typedef) -> - emit({";",nl,indent(9),{asis,Name}," ->",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - {Ret++Acc,N}; - false -> - {Acc,0} - end, - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+NAdd,Acc2); -gen_inlined_enc_funs1(Fields,[_H|Rest],ObjSetName,NthObj,Acc)-> - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,Acc); -gen_inlined_enc_funs1(_,[],_,NthObj,Acc) -> - emit({nl,indent(6),"end",nl}), - emit({indent(3),"end"}), - {Acc,NthObj}. - -emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type}, - InternalDefFunName) -> - case {ExtMod,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_encode_prim(per,Type,dotag,"Val"), - {[],0}; - {constructed,bif} -> - emit([indent(12),"'enc_", - InternalDefFunName,"'(Val)"]), - {[TDef#typedef{name=InternalDefFunName}],1}; - _ -> - emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val)"}), - {[],0} - end; -emit_inner_of_fun(#typedef{name=Name},_) -> - emit({indent(12),"'enc_",Name,"'(Val)"}), - {[],0}; -emit_inner_of_fun(Type,_) when record(Type,type) -> - CurrMod = get(currmod), - case Type#type.def of - Def when atom(Def) -> - emit({indent(9),Def," ->",nl,indent(12)}), - gen_encode_prim(erules,Type,dotag,"Val"); - TRef when record(TRef,typereference) -> - T = TRef#typereference.val, - emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"}); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"}); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),ExtMod,":'enc_", - T,"'(Val)"}) - end, - {[],0}. - -indent(N) -> - lists:duplicate(N,32). % 32 = space - - -gen_objset_dec(_,{unique,undefined},_,_,_,_) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - ok; -gen_objset_dec(ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],ClName, - ClFields,NthObj)-> - - emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val}, - ") ->",nl}), - NewNthObj= - case ObjName of - no_name -> - gen_inlined_dec_funs(Fields,ClFields,ObjSName,NthObj); - _Other -> - emit({" fun 'dec_",ObjName,"'/4"}), - NthObj - end, - emit({";",nl}), - gen_objset_dec(ObjSName,UniqueName,[T|Rest],ClName,ClFields,NewNthObj); -gen_objset_dec(ObjSetName,UniqueName,[{ObjName,Val,Fields}],_ClName, - ClFields,NthObj) -> - - emit({"'getdec_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val}, - ") ->",nl}), - case ObjName of - no_name -> - gen_inlined_dec_funs(Fields,ClFields,ObjSetName,NthObj); - _Other -> - emit({" fun 'dec_",ObjName,"'/4"}) - end, - emit({".",nl,nl}), - ok; -gen_objset_dec(ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,_ClFields, - _NthObj) -> - emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(Attr1, Bytes, _,_) ->",nl}), -%% emit({indent(6),"?RT_PER:decode_open_type(Bytes,[])",nl}), - emit({indent(6),"{Bytes,Attr1}",nl}), - emit({indent(3),"end.",nl,nl}), - ok; -gen_objset_dec(_,_,[],_,_,_) -> - ok. - -gen_inlined_dec_funs(Fields,[{typefield,Name,_}|Rest], - ObjSetName,NthObj) -> - InternalDefFunName = [NthObj,Name,ObjSetName], - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({indent(3),"fun(Type, Val, _, _) ->",nl, - indent(6),"case Type of",nl}), - N=emit_inner_of_decfun(Type,InternalDefFunName), - gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N); - {value,{_,Type}} when record(Type,typedef) -> - emit({indent(3),"fun(Type, Val, _, _) ->",nl, - indent(6),"case Type of",nl}), - emit({indent(9),{asis,Name}," ->",nl}), - N=emit_inner_of_decfun(Type,InternalDefFunName), - gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N); - false -> - gen_inlined_dec_funs(Fields,Rest,ObjSetName,NthObj) - end; -gen_inlined_dec_funs(Fields,[_|Rest],ObjSetName,NthObj) -> - gen_inlined_dec_funs(Fields,Rest,ObjSetName,NthObj); -gen_inlined_dec_funs(_,[],_,NthObj) -> - NthObj. - -gen_inlined_dec_funs1(Fields,[{typefield,Name,_}|Rest], - ObjSetName,NthObj) -> - InternalDefFunName = [NthObj,Name,ObjSetName], - N=case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({";",nl}), - emit_inner_of_decfun(Type,InternalDefFunName); - {value,{_,Type}} when record(Type,typedef) -> - emit({";",nl,indent(9),{asis,Name}," ->",nl}), - emit_inner_of_decfun(Type,InternalDefFunName); - false -> - 0 - end, - gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N); -gen_inlined_dec_funs1(Fields,[_|Rest],ObjSetName,NthObj)-> - gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj); -gen_inlined_dec_funs1(_,[],_,NthObj) -> - emit({nl,indent(6),"end",nl}), - emit({indent(3),"end"}), - NthObj. - -emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type}, - InternalDefFunName) -> - case {ExtName,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_dec_prim(per,Type,"Val"), - 0; - {constructed,bif} -> - emit({indent(12),"'dec_", - asn1ct_gen:list2name(InternalDefFunName),"'(Val)"}), - 1; - _ -> - emit({indent(12),"'",ExtName,"':'dec_",Name,"'(Val, telltype)"}), - 0 - end; -emit_inner_of_decfun(#typedef{name=Name},_) -> - emit({indent(12),"'dec_",Name,"'(Val, telltype)"}), - 0; -emit_inner_of_decfun(Type,_) when record(Type,type) -> - CurrMod = get(currmod), - case Type#type.def of - Def when atom(Def) -> - emit({indent(9),Def," ->",nl,indent(12)}), - gen_dec_prim(erules,Type,"Val"); - TRef when record(TRef,typereference) -> - T = TRef#typereference.val, - emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),ExtMod,":'dec_", - T,"'(Val)"}) - end, - 0. - - -gen_internal_funcs(_,[]) -> - ok; -gen_internal_funcs(Erules,[TypeDef|Rest]) -> - gen_encode_user(Erules,TypeDef), - emit([nl,nl,"'dec_",TypeDef#typedef.name,"'(Bytes) ->",nl]), - gen_decode_user(Erules,TypeDef), - gen_internal_funcs(Erules,Rest). - - - -%% DECODING ***************************** -%%*************************************** - - -gen_decode(Erules,Type) when record(Type,typedef) -> - D = Type, - emit({nl,nl}), - emit({"'dec_",Type#typedef.name,"'(Bytes,_) ->",nl}), - dbdec(Type#typedef.name), - gen_decode_user(Erules,D). - -gen_decode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) -> - NewTname = [Cname|Tname], - gen_decode(Erules,NewTname,Type); - -gen_decode(Erules,Typename,Type) when record(Type,type) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - ObjFun = - case Type#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - "" - end, - emit({nl,"'dec_",asn1ct_gen:list2name(Typename), - "'(Bytes,_",ObjFun,") ->",nl}), - dbdec(Typename), - asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type); - _ -> - true - end. - -dbdec(Type) when list(Type)-> - demit({"io:format(\"decoding: ",asn1ct_gen:list2name(Type),"~w~n\",[Bytes]),",nl}); -dbdec(Type) -> - demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[Bytes]),",nl}). - -gen_decode_user(Erules,D) when record(D,typedef) -> - CurrMod = get(currmod), - Typename = [D#typedef.name], - Def = D#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Def#type.def), - case asn1ct_gen:type(InnerType) of - {primitive,bif} -> - gen_dec_prim(Erules,Def,"Bytes"), - emit({".",nl,nl}); - 'ASN1_OPEN_TYPE' -> - gen_dec_prim(Erules,Def#type{def='ASN1_OPEN_TYPE'},"Bytes"), - emit({".",nl,nl}); - {constructed,bif} -> - asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D); - #typereference{val=Dname} -> - emit({"'dec_",Dname,"'(Bytes,telltype)"}), - emit({".",nl,nl}); - #'Externaltypereference'{module=CurrMod,type=Etype} -> - emit({"'dec_",Etype,"'(Bytes,telltype).",nl,nl}); - #'Externaltypereference'{module=Emod,type=Etype} -> - emit({"'",Emod,"':'dec_",Etype,"'(Bytes,telltype).",nl,nl}); - Other -> - exit({error,{asn1,{unknown,Other}}}) - end. - - -gen_dec_prim(_Erules,Att,BytesVar) -> - Typename = Att#type.def, - Constraint = Att#type.constraint, - case Typename of - 'INTEGER' -> - emit({"?RT_PER:decode_integer(",BytesVar,",", - {asis,Constraint},")"}); - {'INTEGER',NamedNumberList} -> - emit({"?RT_PER:decode_integer(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},")"}); - {'BIT STRING',NamedNumberList} -> - case get(compact_bit_string) of - true -> - emit({"?RT_PER:decode_compact_bit_string(", - BytesVar,",",{asis,Constraint},",", - {asis,NamedNumberList},")"}); - _ -> - emit({"?RT_PER:decode_bit_string(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},")"}) - end; - 'NULL' -> - emit({"?RT_PER:decode_null(", - BytesVar,")"}); - 'OBJECT IDENTIFIER' -> - emit({"?RT_PER:decode_object_identifier(", - BytesVar,")"}); - 'ObjectDescriptor' -> - emit({"?RT_PER:decode_ObjectDescriptor(", - BytesVar,")"}); - {'ENUMERATED',{NamedNumberList1,NamedNumberList2}} -> - NewTup = {list_to_tuple([X||{X,_} <- NamedNumberList1]), - list_to_tuple([X||{X,_} <- NamedNumberList2])}, - NewC = [{'ValueRange',{0,size(element(1,NewTup))-1}}], - emit({"?RT_PER:decode_enumerated(",BytesVar,",", - {asis,NewC},",", - {asis,NewTup},")"}); - {'ENUMERATED',NamedNumberList} -> - NewTup = list_to_tuple([X||{X,_} <- NamedNumberList]), - NewC = [{'ValueRange',{0,size(NewTup)-1}}], - emit({"?RT_PER:decode_enumerated(",BytesVar,",", - {asis,NewC},",", - {asis,NewTup},")"}); - 'BOOLEAN'-> - emit({"?RT_PER:decode_boolean(",BytesVar,")"}); - 'OCTET STRING' -> - emit({"?RT_PER:decode_octet_string(",BytesVar,",", - {asis,Constraint},")"}); - 'NumericString' -> - emit({"?RT_PER:decode_NumericString(",BytesVar,",", - {asis,Constraint},")"}); - 'TeletexString' -> - emit({"?RT_PER:decode_TeletexString(",BytesVar,",", - {asis,Constraint},")"}); - 'VideotexString' -> - emit({"?RT_PER:decode_VideotexString(",BytesVar,",", - {asis,Constraint},")"}); - 'UTCTime' -> - emit({"?RT_PER:decode_VisibleString(",BytesVar,",", - {asis,Constraint},")"}); - 'GeneralizedTime' -> - emit({"?RT_PER:decode_VisibleString(",BytesVar,",", - {asis,Constraint},")"}); - 'GraphicString' -> - emit({"?RT_PER:decode_GraphicString(",BytesVar,",", - {asis,Constraint},")"}); - 'VisibleString' -> - emit({"?RT_PER:decode_VisibleString(",BytesVar,",", - {asis,Constraint},")"}); - 'GeneralString' -> - emit({"?RT_PER:decode_GeneralString(",BytesVar,",", - {asis,Constraint},")"}); - 'PrintableString' -> - emit({"?RT_PER:decode_PrintableString(",BytesVar,",",{asis,Constraint},")"}); - 'IA5String' -> - emit({"?RT_PER:decode_IA5String(",BytesVar,",",{asis,Constraint},")"}); - 'BMPString' -> - emit({"?RT_PER:decode_BMPString(",BytesVar,",",{asis,Constraint},")"}); - 'UniversalString' -> - emit({"?RT_PER:decode_UniversalString(",BytesVar,",",{asis,Constraint},")"}); - 'ANY' -> - emit(["?RT_PER:decode_open_type(",BytesVar,",", - {asis,Constraint}, ")"]); - 'ASN1_OPEN_TYPE' -> - case Constraint of - [#'Externaltypereference'{type=Tname}] -> - emit(["fun(FBytes) ->",nl, - " {XTerm,XBytes} = "]), - emit(["?RT_PER:decode_open_type(FBytes,[]),",nl]), - emit([" {YTerm,_} = dec_",Tname,"(XTerm,mandatory),",nl]), - emit([" {YTerm,XBytes} end(",BytesVar,")"]); - [#type{def=#'Externaltypereference'{type=Tname}}] -> - emit(["fun(FBytes) ->",nl, - " {XTerm,XBytes} = "]), - emit(["?RT_PER:decode_open_type(FBytes,[]),",nl]), - emit([" {YTerm,_} = dec_",Tname,"(XTerm,mandatory),",nl]), - emit([" {YTerm,XBytes} end(",BytesVar,")"]); - _ -> - emit(["?RT_PER:decode_open_type(",BytesVar,",[])"]) - end; - Other -> - exit({'cant decode' ,Other}) - end. - - -is_already_generated(Operation,Name) -> - case get(class_default_type) of - undefined -> - put(class_default_type,[{Operation,Name}]), - false; - GeneratedList -> - case lists:member({Operation,Name},GeneratedList) of - true -> - true; - false -> - put(class_default_type,[{Operation,Name}|GeneratedList]), - false - end - end. - -get_class_fields(#classdef{typespec=ObjClass}) -> - ObjClass#objectclass.fields; -get_class_fields(#objectclass{fields=Fields}) -> - Fields; -get_class_fields(_) -> - []. - - -get_object_field(Name,ObjectFields) -> - case lists:keysearch(Name,1,ObjectFields) of - {value,Field} -> Field; - false -> false - end. - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_per_rt2ct.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_per_rt2ct.erl deleted file mode 100644 index 70a017ac6a..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen_per_rt2ct.erl +++ /dev/null @@ -1,1811 +0,0 @@ -%% ``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: asn1ct_gen_per_rt2ct.erl,v 1.1 2008/12/17 09:53:30 mikpe Exp $ -%% --module(asn1ct_gen_per_rt2ct). - -%% Generate erlang module which handles (PER) encode and decode for -%% all types in an ASN.1 module - --include("asn1_records.hrl"). -%-compile(export_all). - --export([pgen/4,gen_dec_prim/3,gen_encode_prim/4]). --export([gen_obj_code/3,gen_objectset_code/2]). --export([gen_decode/2, gen_decode/3]). --export([gen_encode/2, gen_encode/3]). - --import(asn1ct_gen, [emit/1,demit/1]). --import(asn1ct_gen_per, [is_already_generated/2,more_genfields/1, - get_class_fields/1,get_object_field/2]). - -%% 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 -%% Module = atom() -%% TypeOrVal = {TypeList,ValueList} -%% TypeList = ValueList = [atom()] - -pgen(OutFile,Erules,Module,TypeOrVal) -> - asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,true). - - -%% Generate ENCODING ****************************** -%%****************************************x - - -gen_encode(Erules,Type) when record(Type,typedef) -> - gen_encode_user(Erules,Type). - -gen_encode(Erules,Typename,#'ComponentType'{name=Cname,typespec=Type}) -> - NewTypename = [Cname|Typename], - gen_encode(Erules,NewTypename,Type); - -gen_encode(Erules,Typename,Type) when record(Type,type) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - ObjFun = - case lists:keysearch(objfun,1,Type#type.tablecinf) of - {value,{_,_Name}} -> - ", ObjFun"; - false -> - "" - end, - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - case InnerType of - 'SET' -> - true; - 'SEQUENCE' -> - true; - _ -> - emit({nl,"'enc_",asn1ct_gen:list2name(Typename), - "'({'",asn1ct_gen:list2name(Typename), - "',Val}",ObjFun,") ->",nl}), - emit({"'enc_",asn1ct_gen:list2name(Typename), - "'(Val",ObjFun,");",nl,nl}) - end, - emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val",ObjFun, - ") ->",nl}), - asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); - _ -> - true - end. - - -gen_encode_user(Erules,D) when record(D,typedef) -> - CurrMod = get(currmod), - Typename = [D#typedef.name], - Def = D#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Def#type.def), - case InnerType of - 'SET' -> true; - 'SEQUENCE' -> true; - _ -> - emit({nl,"'enc_",asn1ct_gen:list2name(Typename),"'({'",asn1ct_gen:list2name(Typename),"',Val}) ->",nl}), - emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val);",nl,nl}) - end, - emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val) ->",nl}), - case asn1ct_gen:type(InnerType) of - {primitive,bif} -> - gen_encode_prim(Erules,Def,"false"), - emit({".",nl}); - 'ASN1_OPEN_TYPE' -> - gen_encode_prim(Erules,Def#type{def='ASN1_OPEN_TYPE'},"false"), - emit({".",nl}); - {constructed,bif} -> - asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,D); - #'Externaltypereference'{module=CurrMod,type=Etype} -> - emit({"'enc_",Etype,"'(Val).",nl,nl}); - #'Externaltypereference'{module=Emod,type=Etype} -> - emit({"'",Emod,"':'enc_",Etype,"'(Val).",nl,nl}); - #typereference{val=Ename} -> - emit({"'enc_",Ename,"'(Val).",nl,nl}); - {notype,_} -> - emit({"'enc_",InnerType,"'(Val).",nl,nl}) - end. - - -gen_encode_prim(Erules,D,DoTag) -> - Value = case asn1ct_name:active(val) of - true -> - asn1ct_gen:mk_var(asn1ct_name:curr(val)); - false -> - "Val" - end, - gen_encode_prim(Erules,D,DoTag,Value). - - - - - -gen_encode_prim(_Erules,D,_DoTag,Value) when record(D,type) -> - Constraint = D#type.constraint, - case D#type.def of - 'INTEGER' -> - EffectiveConstr = effective_constraint(integer,Constraint), - emit([" %%INTEGER with effective constraint: ", - {asis,EffectiveConstr},nl]), - emit_enc_integer(EffectiveConstr,Value); - {'INTEGER',NamedNumberList} -> - EffectiveConstr = effective_constraint(integer,Constraint), - %% maybe an emit_enc_NNL_integer - emit([" %%INTEGER with effective constraint: ", - {asis,EffectiveConstr},nl]), - emit_enc_integer_NNL(EffectiveConstr,Value,NamedNumberList); - {'ENUMERATED',{Nlist1,Nlist2}} -> - NewList = lists:concat([[{0,X}||{X,_} <- Nlist1],['EXT_MARK'],[{1,X}||{X,_} <- Nlist2]]), - NewC = [{'ValueRange',{0,length(Nlist1)-1}}], - emit(["case (case ",Value," of {_,_}->element(2,",Value,");_->", - Value," end) of",nl]), - emit_enc_enumerated_cases(NewC, NewList++[{asn1_enum,length(Nlist1)-1}], 0); - {'ENUMERATED',NamedNumberList} -> - NewList = [X||{X,_} <- NamedNumberList], - NewC = effective_constraint(integer, - [{'ValueRange', - {0,length(NewList)-1}}]), - NewVal = enc_enum_cases(Value,NewList), - emit_enc_integer(NewC,NewVal); - {'BIT STRING',NamedNumberList} -> - EffectiveC = effective_constraint(bitstring,Constraint), - case EffectiveC of - 0 -> emit({"[]"}); - _ -> - emit({"?RT_PER:encode_bit_string(", - {asis,EffectiveC},",",Value,",", - {asis,NamedNumberList},")"}) - end; - 'NULL' -> - emit({"?RT_PER:encode_null(",Value,")"}); - 'OBJECT IDENTIFIER' -> - emit({"?RT_PER:encode_object_identifier(",Value,")"}); - 'ObjectDescriptor' -> - emit({"?RT_PER:encode_ObjectDescriptor(",{asis,Constraint}, - ",",Value,")"}); - 'BOOLEAN' -> -% emit({"?RT_PER:encode_boolean(",Value,")"}); - emit({"case ",Value," of",nl, -% " true -> {bits,1,1};",nl, - " true -> [1];",nl, -% " false -> {bits,1,0};",nl, - " false -> [0];",nl, - " _ -> exit({error,{asn1,{encode_boolean,",Value,"}}})",nl, - "end"}); - 'OCTET STRING' -> - emit_enc_octet_string(Constraint,Value); - - 'NumericString' -> - emit_enc_known_multiplier_string('NumericString',Constraint,Value); - 'TeletexString' -> - emit({"?RT_PER:encode_TeletexString(",{asis,Constraint},",",Value,")"}); - 'VideotexString' -> - emit({"?RT_PER:encode_VideotexString(",{asis,Constraint},",",Value,")"}); - 'UTCTime' -> - emit_enc_known_multiplier_string('VisibleString',Constraint,Value); - 'GeneralizedTime' -> - emit_enc_known_multiplier_string('VisibleString',Constraint,Value); - 'GraphicString' -> - emit({"?RT_PER:encode_GraphicString(",{asis,Constraint},",",Value,")"}); - 'VisibleString' -> - emit_enc_known_multiplier_string('VisibleString',Constraint,Value); - 'GeneralString' -> - emit({"?RT_PER:encode_GeneralString(",{asis,Constraint},",",Value,")"}); - 'PrintableString' -> - emit_enc_known_multiplier_string('PrintableString',Constraint,Value); - 'IA5String' -> - emit_enc_known_multiplier_string('IA5String',Constraint,Value); - 'BMPString' -> - emit_enc_known_multiplier_string('BMPString',Constraint,Value); - 'UniversalString' -> - emit_enc_known_multiplier_string('UniversalString',Constraint,Value); - 'ANY' -> - emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", - Value, ")"]); - 'ASN1_OPEN_TYPE' -> - NewValue = case Constraint of - [#'Externaltypereference'{type=Tname}] -> - io_lib:format( - "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); - [#type{def=#'Externaltypereference'{type=Tname}}] -> - io_lib:format( - "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); - _ -> Value - end, - emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", - NewValue, ")"]); - XX -> - exit({asn1_error,nyi,XX}) - end. - -emit_enc_known_multiplier_string(StringType,C,Value) -> - SizeC = - case get_constraint(C,'SizeConstraint') of - L when list(L) -> {lists:min(L),lists:max(L)}; - L -> L - end, - PAlphabC = get_constraint(C,'PermittedAlphabet'), - case {StringType,PAlphabC} of - {'UniversalString',{_,_}} -> - exit({error,{asn1,{'not implemented',"UniversalString with " - "PermittedAlphabet constraint"}}}); - {'BMPString',{_,_}} -> - exit({error,{asn1,{'not implemented',"BMPString with " - "PermittedAlphabet constraint"}}}); - _ -> ok - end, - NumBits = get_NumBits(C,StringType), - CharOutTab = get_CharOutTab(C,StringType), - %% NunBits and CharOutTab for chars_encode - emit_enc_k_m_string(StringType,SizeC,NumBits,CharOutTab,Value). - -emit_enc_k_m_string(_StringType,0,_NumBits,_CharOutTab,_Value) -> - emit({"[]"}); -emit_enc_k_m_string(StringType,SizeC,NumBits,CharOutTab,Value) -> - emit({"?RT_PER:encode_known_multiplier_string(",{asis,StringType},",", - {asis,SizeC},",",NumBits,",",{asis,CharOutTab},",",Value,")"}). - -emit_dec_known_multiplier_string(StringType,C,BytesVar) -> - SizeC = get_constraint(C,'SizeConstraint'), - PAlphabC = get_constraint(C,'PermittedAlphabet'), - case {StringType,PAlphabC} of - {'BMPString',{_,_}} -> - exit({error,{asn1, - {'not implemented', - "BMPString with PermittedAlphabet " - "constraint"}}}); - _ -> - ok - end, - NumBits = get_NumBits(C,StringType), - CharInTab = get_CharInTab(C,StringType), - case SizeC of - 0 -> - emit({"{[],",BytesVar,"}"}); - _ -> - emit({"?RT_PER:decode_known_multiplier_string(", - {asis,StringType},",",{asis,SizeC},",",NumBits, - ",",{asis,CharInTab},",",BytesVar,")"}) - end. - - -%% copied from run time module - -get_CharOutTab(C,StringType) -> - get_CharTab(C,StringType,out). - -get_CharInTab(C,StringType) -> - get_CharTab(C,StringType,in). - -get_CharTab(C,StringType,InOut) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} -> - get_CharTab2(C,StringType,hd(Sv),lists:max(Sv),Sv,InOut); - no -> - case StringType of - 'IA5String' -> - {0,16#7F,notab}; - 'VisibleString' -> - get_CharTab2(C,StringType,16#20,16#7F,notab,InOut); - 'PrintableString' -> - Chars = lists:sort( - " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), - get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars,InOut); - 'NumericString' -> - get_CharTab2(C,StringType,16#20,$9," 0123456789",InOut); - 'UniversalString' -> - {0,16#FFFFFFFF,notab}; - 'BMPString' -> - {0,16#FFFF,notab} - end - end. - -get_CharTab2(C,StringType,Min,Max,Chars,InOut) -> - BitValMax = (1 bsl get_NumBits(C,StringType))-1, - if - Max =< BitValMax -> - {0,Max,notab}; - true -> - case InOut of - out -> - {Min,Max,create_char_tab(Min,Chars)}; - in -> - {Min,Max,list_to_tuple(Chars)} - end - end. - -create_char_tab(Min,L) -> - list_to_tuple(create_char_tab(Min,L,0)). -create_char_tab(Min,[Min|T],V) -> - [V|create_char_tab(Min+1,T,V+1)]; -create_char_tab(_Min,[],_V) -> - []; -create_char_tab(Min,L,V) -> - [false|create_char_tab(Min+1,L,V)]. - -get_NumBits(C,StringType) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} -> - charbits(length(Sv),aligned); - no -> - case StringType of - 'IA5String' -> - charbits(128,aligned); % 16#00..16#7F - 'VisibleString' -> - charbits(95,aligned); % 16#20..16#7E - 'PrintableString' -> - charbits(74,aligned); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z - 'NumericString' -> - charbits(11,aligned); % $ ,"0123456789" - 'UniversalString' -> - 32; - 'BMPString' -> - 16 - end - end. - -charbits(NumOfChars,aligned) -> - case charbits(NumOfChars) of - 1 -> 1; - 2 -> 2; - B when B =< 4 -> 4; - B when B =< 8 -> 8; - B when B =< 16 -> 16; - B when B =< 32 -> 32 - end. - -charbits(NumOfChars) when NumOfChars =< 2 -> 1; -charbits(NumOfChars) when NumOfChars =< 4 -> 2; -charbits(NumOfChars) when NumOfChars =< 8 -> 3; -charbits(NumOfChars) when NumOfChars =< 16 -> 4; -charbits(NumOfChars) when NumOfChars =< 32 -> 5; -charbits(NumOfChars) when NumOfChars =< 64 -> 6; -charbits(NumOfChars) when NumOfChars =< 128 -> 7; -charbits(NumOfChars) when NumOfChars =< 256 -> 8; -charbits(NumOfChars) when NumOfChars =< 512 -> 9; -charbits(NumOfChars) when NumOfChars =< 1024 -> 10; -charbits(NumOfChars) when NumOfChars =< 2048 -> 11; -charbits(NumOfChars) when NumOfChars =< 4096 -> 12; -charbits(NumOfChars) when NumOfChars =< 8192 -> 13; -charbits(NumOfChars) when NumOfChars =< 16384 -> 14; -charbits(NumOfChars) when NumOfChars =< 32768 -> 15; -charbits(NumOfChars) when NumOfChars =< 65536 -> 16; -charbits(NumOfChars) when integer(NumOfChars) -> - 16 + charbits1(NumOfChars bsr 16). - -charbits1(0) -> - 0; -charbits1(NumOfChars) -> - 1 + charbits1(NumOfChars bsr 1). - -%% copied from run time module - -emit_enc_octet_string(Constraint,Value) -> - case get_constraint(Constraint,'SizeConstraint') of - 0 -> - emit({" []"}); - 1 -> - asn1ct_name:new(tmpval), - emit({" begin",nl}), - emit({" [",{curr,tmpval},"] = ",Value,",",nl}), -% emit({" {bits,8,",{curr,tmpval},"}",nl}), - emit({" [10,8,",{curr,tmpval},"]",nl}), - emit(" end"); - 2 -> - asn1ct_name:new(tmpval), - emit({" begin",nl}), - emit({" [",{curr,tmpval},",",{next,tmpval},"] = ", - Value,",",nl}), -% emit({" [{bits,8,",{curr,tmpval},"},{bits,8,", -% {next,tmpval},"}]",nl}), - emit({" [[10,8,",{curr,tmpval},"],[10,8,", - {next,tmpval},"]]",nl}), - emit(" end"), - asn1ct_name:new(tmpval); - Sv when integer(Sv),Sv =< 256 -> - asn1ct_name:new(tmpval), - emit({" begin",nl}), -% emit({" case length(",Value,") == ",Sv," of",nl}), - emit({" case length(",Value,") of",nl}), - emit({" ",{curr,tmpval}," when ",{curr,tmpval}," == ",Sv," -> [2,20,",{curr,tmpval},",",Value,"];",nl}), - emit({" _ -> exit({error,{value_out_of_bounds,",Value,"}})", - nl," end",nl}), - emit(" end"); - Sv when integer(Sv),Sv =< 65535 -> - asn1ct_name:new(tmpval), - emit({" begin",nl}), -% emit({" case length(",Value,") == ",Sv," of",nl}), - emit({" case length(",Value,") of",nl}), -% emit({" true -> [align,{octets,",Value,"}];",nl}), - emit({" ",{curr,tmpval}," when ",{curr,tmpval}," == ",Sv," -> [2,21,",{curr,tmpval},",",Value,"];",nl}), - emit({" _ -> exit({error,{value_out_of_bounds,",Value,"}})", - nl," end",nl}), - emit(" end"); - C -> - emit({" ?RT_PER:encode_octet_string(",{asis,C},",false,",Value,")",nl}) - end. - -emit_dec_octet_string(Constraint,BytesVar) -> - case get_constraint(Constraint,'SizeConstraint') of - 0 -> - emit({" {[],",BytesVar,"}",nl}); - {_,0} -> - emit({" {[],",BytesVar,"}",nl}); - C -> - emit({" ?RT_PER:decode_octet_string(",BytesVar,",", - {asis,C},",false)",nl}) - end. - -emit_enc_integer_case(Value) -> - case get(component_type) of - {true,#'ComponentType'{prop=Prop}} -> - emit({" begin",nl}), - case Prop of - Opt when Opt=='OPTIONAL'; - tuple(Opt),element(1,Opt)=='DEFAULT' -> - emit({" case ",Value," of",nl}), - ok; - _ -> - emit({" ",{curr,tmpval},"=",Value,",",nl}), - emit({" case ",{curr,tmpval}," of",nl}), - asn1ct_name:new(tmpval) - end; -% asn1ct_name:new(tmpval); - _ -> - emit({" case ",Value," of ",nl}) - end. -emit_enc_integer_end_case() -> - case get(component_type) of - {true,_} -> - emit({nl," end"}); % end of begin ... end - _ -> ok - end. - - -emit_enc_integer_NNL(C,Value,NNL) -> - EncVal = enc_integer_NNL_cases(Value,NNL), - emit_enc_integer(C,EncVal). - -enc_integer_NNL_cases(Value,NNL) -> - asn1ct_name:new(tmpval), - TmpVal = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)), - Cases=enc_integer_NNL_cases1(NNL), - lists:flatten(io_lib:format("(case ~s of "++Cases++ - "~s when atom(~s)->exit({error,{asn1,{namednumber,~s}}});_->~s end)",[Value,TmpVal,TmpVal,TmpVal,Value])). - -enc_integer_NNL_cases1([{NNo,No}|Rest]) -> - io_lib:format("~w->~w;",[NNo,No])++enc_integer_NNL_cases1(Rest); -enc_integer_NNL_cases1([]) -> - "". - -emit_enc_integer([{'SingleValue',Int}],Value) -> - asn1ct_name:new(tmpval), - emit_enc_integer_case(Value),% emit([" case ",Value," of",nl]), - emit([" ",Int," -> [];",nl]), - emit([" ",{curr,tmpval}," ->",nl]), - emit([" exit({error,{value_out_of_bounds,",{curr,tmpval},"}})", - nl," end",nl]), - emit_enc_integer_end_case(); - -emit_enc_integer([{_,{Lb,Ub},_Range,{bits,NoBs}}],Value) -> % Range =< 255 - asn1ct_name:new(tmpval), - emit_enc_integer_case(Value), - emit([" ",{curr,tmpval}," when ",{curr,tmpval},"=<",Ub,",", - {curr,tmpval},">=",Lb," ->",nl]), - emit([" [10,",NoBs,",",{curr,tmpval},"-",Lb,"];",nl]), - emit([" ",{curr,tmpval}," ->",nl]), - emit([" exit({error,{value_out_of_bounds,",{curr,tmpval},"}})", - nl," end",nl]), - emit_enc_integer_end_case(); - -emit_enc_integer([{_,{Lb,Ub},Range,_}],Value) when Range =< 256 -> - asn1ct_name:new(tmpval), - emit_enc_integer_case(Value), - emit([" ",{curr,tmpval}," when ",{curr,tmpval},"=<",Ub,",", - {curr,tmpval},">=",Lb," ->",nl]), - emit([" [20,1,",{curr,tmpval},"-",Lb,"];",nl]), - emit([" ",{curr,tmpval}," ->",nl]), - emit([" exit({error,{value_out_of_bounds,",{curr,tmpval},"}})", - nl," end",nl]), - emit_enc_integer_end_case(); - -emit_enc_integer([{_,{Lb,Ub},Range,_}],Value) when Range =< 65536 -> - asn1ct_name:new(tmpval), - emit_enc_integer_case(Value), - emit([" ",{curr,tmpval}," when ",{curr,tmpval},"=<",Ub,",", - {curr,tmpval},">=",Lb," ->",nl]), - emit([" [20,2,<<(",{curr,tmpval},"-",Lb,"):16>>];",nl]), - emit([" ",{curr,tmpval}," ->",nl]), - emit([" exit({error,{value_out_of_bounds,",{curr,tmpval},"}})", - nl," end",nl]), - emit_enc_integer_end_case(); - - -emit_enc_integer(C,Value) -> - emit({" ?RT_PER:encode_integer(",{asis,C},",",Value,")"}). - - - - -enc_enum_cases(Value,NewList) -> - asn1ct_name:new(tmpval), - TmpVal = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)), - Cases=enc_enum_cases1(NewList), - lists:flatten(io_lib:format("(case ~s of "++Cases++ - "~s ->exit({error," - "{asn1,{enumerated,~s}}})" - " end)", - [Value,TmpVal,TmpVal])). -enc_enum_cases1(NNL) -> - enc_enum_cases1(NNL,0). -enc_enum_cases1([H|T],Index) -> - io_lib:format("~w->~w;",[H,Index])++enc_enum_cases1(T,Index+1); -enc_enum_cases1([],_) -> - "". - - -emit_enc_enumerated_cases(C, [H], Count) -> - emit_enc_enumerated_case(C, H, Count), - emit([";",nl,"EnumVal -> exit({error,{asn1, {enumerated_not_in_range, EnumVal}}})"]), - emit([nl,"end"]); -emit_enc_enumerated_cases(C, ['EXT_MARK'|T], _Count) -> - emit_enc_enumerated_cases(C, T, 0); -emit_enc_enumerated_cases(C, [H1,H2|T], Count) -> - emit_enc_enumerated_case(C, H1, Count), - emit([";",nl]), - emit_enc_enumerated_cases(C, [H2|T], Count+1). - - -%% The function clauses matching on tuples with first element -%% asn1_enum, 1 or 0 and the atom 'EXT_MARK' are for ENUMERATED -%% with extension mark. -emit_enc_enumerated_case(_C, {asn1_enum,High}, _) -> - %% ENUMERATED with extensionmark - %% value higher than the extension base and not - %% present in the extension range. - emit(["{asn1_enum,EnumV} when integer(EnumV), EnumV > ",High," -> ", - "[1,?RT_PER:encode_small_number(EnumV)]"]); -emit_enc_enumerated_case(_C, 'EXT_MARK', _Count) -> - %% ENUMERATED with extensionmark - true; -emit_enc_enumerated_case(_C, {1,EnumName}, Count) -> - %% ENUMERATED with extensionmark - %% values higher than extension root - emit(["'",EnumName,"' -> [1,?RT_PER:encode_small_number(",Count,")]"]); -emit_enc_enumerated_case(C, {0,EnumName}, Count) -> - %% ENUMERATED with extensionmark - %% values within extension root - emit(["'",EnumName,"' -> [0,?RT_PER:encode_integer(",{asis,C},", ",Count,")]"]); - -%% This clause is invoked in case of an ENUMERATED without extension mark -emit_enc_enumerated_case(_C, EnumName, Count) -> - emit(["'",EnumName,"' -> ",Count]). - - -get_constraint([{Key,V}],Key) -> - V; -get_constraint([],_) -> - no; -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - -get_constraints(L=[{Key,_}],Key) -> - L; -get_constraints([],_) -> - []; -get_constraints(C,Key) -> - {value,L} = keysearch_allwithkey(Key,1,C,[]), - L. - -keysearch_allwithkey(Key,Ix,C,Acc) -> - case lists:keysearch(Key,Ix,C) of - false -> - {value,Acc}; - {value,T} -> - RestC = lists:delete(T,C), - keysearch_allwithkey(Key,Ix,RestC,[T|Acc]) - end. - -%% effective_constraint(Type,C) -%% Type = atom() -%% C = [C1,...] -%% C1 = {'SingleValue',SV} | {'ValueRange',VR} | {atom(),term()} -%% SV = integer() | [integer(),...] -%% VR = {Lb,Ub} -%% Lb = 'MIN' | integer() -%% Ub = 'MAX' | integer() -%% Returns a single value if C only has a single value constraint, and no -%% value range constraints, that constrains to a single value, otherwise -%% returns a value range that has the lower bound set to the lowest value -%% of all single values and lower bound values in C and the upper bound to -%% the greatest value. -effective_constraint(integer,[C={{_,_},_}|_Rest]) -> % extension - [C]; %% [C|effective_constraint(integer,Rest)]; XXX what is possible ??? -effective_constraint(integer,C) -> - SVs = get_constraints(C,'SingleValue'), - SV = effective_constr('SingleValue',SVs), - VRs = get_constraints(C,'ValueRange'), - VR = effective_constr('ValueRange',VRs), - CRange = greatest_common_range(SV,VR), - pre_encode(integer,CRange); -effective_constraint(bitstring,C) -> -% Constr=get_constraints(C,'SizeConstraint'), -% case Constr of -% [] -> no; -% [{'SizeConstraint',Val}] -> Val; -% Other -> Other -% end; - get_constraint(C,'SizeConstraint'); -effective_constraint(Type,C) -> - io:format("Effective constraint for ~p, not implemented yet.~n",[Type]), - C. - -effective_constr(_,[]) -> - []; -effective_constr('SingleValue',List) -> - SVList = lists:flatten(lists:map(fun(X)->element(2,X)end,List)), - case lists:usort(SVList) of - [N] -> - [{'SingleValue',N}]; - L when list(L) -> - [{'ValueRange',{hd(L),lists:last(L)}}] - end; -effective_constr('ValueRange',List) -> - LBs = lists:map(fun({_,{Lb,_}})-> Lb end,List), - UBs = lists:map(fun({_,{_,Ub}})-> Ub end,List), - Lb = least_Lb(LBs), - [{'ValueRange',{Lb,lists:max(UBs)}}]. - -greatest_common_range([],VR) -> - VR; -greatest_common_range(SV,[]) -> - SV; -greatest_common_range([{_,Int}],[{_,{'MIN',Ub}}]) when integer(Int), - Int > Ub -> - [{'ValueRange',{'MIN',Int}}]; -greatest_common_range([{_,Int}],[{_,{Lb,Ub}}]) when integer(Int), - Int < Lb -> - [{'ValueRange',{Int,Ub}}]; -greatest_common_range([{_,Int}],VR=[{_,{_Lb,_Ub}}]) when integer(Int) -> - VR; -greatest_common_range([{_,L}],[{_,{Lb,Ub}}]) when list(L) -> - Min = least_Lb([Lb|L]), - Max = greatest_Ub([Ub|L]), - [{'ValueRange',{Min,Max}}]. - - -least_Lb(L) -> - case lists:member('MIN',L) of - true -> 'MIN'; - _ -> lists:min(L) - end. - -greatest_Ub(L) -> - case lists:member('MAX',L) of - true -> 'MAX'; - _ -> lists:max(L) - end. - -% effective_constraint1('SingleValue',List) -> -% SVList = lists:map(fun(X)->element(2,X)end,List), -% sv_effective_constraint(hd(SVList),tl(SVList)); -% effective_constraint1('ValueRange',List) -> -% VRList = lists:map(fun(X)->element(2,X)end,List), -% vr_effective_constraint(lists:map(fun(X)->element(1,X)end,VRList), -% lists:map(fun(X)->element(2,X)end,VRList)). - -%% vr_effective_constraint/2 -%% Gets all LowerEndPoints and UpperEndPoints as arguments -%% Returns {'ValueRange',{Lb,Ub}} where Lb is the highest value of -%% the LowerEndPoints and Ub is the lowest value of the UpperEndPoints, -%% i.e. the intersection of all value ranges. -% vr_effective_constraint(Mins,Maxs) -> -% Lb=lists:foldl(fun(X,'MIN') when integer(X) -> X; -% (X,'MIN') -> 'MIN'; -% (X,AccIn) when integer(X),X >= AccIn -> X; -% (X,AccIn) -> AccIn -% end,hd(Mins),tl(Mins)), -% Ub = lists:min(Maxs), -% {'ValueRange',{Lb,Ub}}. - - -% sv_effective_constraint(SV,[]) -> -% {'SingleValue',SV}; -% sv_effective_constraint([],_) -> -% exit({error,{asn1,{illegal_single_value_constraint}}}); -% sv_effective_constraint(SV,[SV|Rest]) -> -% sv_effective_constraint(SV,Rest); -% sv_effective_constraint(Int,[SV|Rest]) when integer(Int),list(SV) -> -% case lists:member(Int,SV) of -% true -> -% sv_effective_constraint(Int,Rest); -% _ -> -% exit({error,{asn1,{illegal_single_value_constraint}}}) -% end; -% sv_effective_constraint(SV,[Int|Rest]) when integer(Int),list(SV) -> -% case lists:member(Int,SV) of -% true -> -% sv_effective_constraint(Int,Rest); -% _ -> -% exit({error,{asn1,{illegal_single_value_constraint}}}) -% end; -% sv_effective_constraint(SV1,[SV2|Rest]) when list(SV1),list(SV2) -> -% sv_effective_constraint(common_set(SV1,SV2),Rest); -% sv_effective_constraint(_,_) -> -% exit({error,{asn1,{illegal_single_value_constraint}}}). - -%% common_set/2 -%% Two lists as input -%% Returns the list with all elements that are common for both -%% input lists -% common_set(SV1,SV2) -> -% lists:filter(fun(X)->lists:member(X,SV1) end,SV2). - - - -pre_encode(integer,[]) -> - []; -pre_encode(integer,C=[{'SingleValue',_}]) -> - C; -pre_encode(integer,C=[{'ValueRange',VR={Lb,Ub}}]) when integer(Lb),integer(Ub)-> - Range = Ub-Lb+1, - if - Range =< 255 -> - NoBits = no_bits(Range), - [{'ValueRange',VR,Range,{bits,NoBits}}]; - Range =< 256 -> - [{'ValueRange',VR,Range,{octets,1}}]; - Range =< 65536 -> - [{'ValueRange',VR,Range,{octets,2}}]; - true -> - C - end; -pre_encode(integer,C) -> - C. - -no_bits(2) -> 1; -no_bits(N) when N=<4 -> 2; -no_bits(N) when N=<8 -> 3; -no_bits(N) when N=<16 -> 4; -no_bits(N) when N=<32 -> 5; -no_bits(N) when N=<64 -> 6; -no_bits(N) when N=<128 -> 7; -no_bits(N) when N=<255 -> 8. - -%% Object code generating for encoding and decoding -%% ------------------------------------------------ - -gen_obj_code(Erules,_Module,Obj) when record(Obj,typedef) -> - ObjName = Obj#typedef.name, - Def = Obj#typedef.typespec, - #'Externaltypereference'{module=Mod,type=ClassName} = - Def#'Object'.classname, - Class = asn1_db:dbget(Mod,ClassName), - {object,_,Fields} = Def#'Object'.def, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjName}), - emit({nl,"%%================================",nl}), - EncConstructed = -% gen_encode_objectfields(Class#classdef.typespec,ObjName,Fields,[]), - gen_encode_objectfields(ClassName,get_class_fields(Class), - ObjName,Fields,[]), - emit(nl), - gen_encode_constr_type(Erules,EncConstructed), - emit(nl), - DecConstructed = -% gen_decode_objectfields(Class#classdef.typespec,ObjName,Fields,[]), - gen_decode_objectfields(ClassName,get_class_fields(Class), - ObjName,Fields,[]), - emit(nl), - gen_decode_constr_type(Erules,DecConstructed), - emit(nl); -gen_obj_code(_Erules,_Module,Obj) when record(Obj,pobjectdef) -> - ok. - -gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(V) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ",",V,",_RestPrimFieldName) ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val, RestPrimFieldName) ->",nl]), - MaybeConstr = - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_"), - emit(" <<>>"), - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Val"), - gen_encode_default_call(ClassName,Name,DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Val"), - gen_encode_field_call(ObjName,Name,TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields, - MaybeConstr++ConstrAcc); -gen_encode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Attrs) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ",",Attrs,") ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val,[H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_"), - emit([" exit({error,{'use of missing field in object', ",Name, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,TypeSpec},_} -> - EmitFuncClause("Val,[H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'enc_",TypeName, - "'(H, Val, T)"}); - TypeName -> - emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}) - end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); -gen_encode_objectfields(ClassName,[_C|Cs],O,OF,Acc) -> - gen_encode_objectfields(ClassName,Cs,O,OF,Acc); -gen_encode_objectfields(_,[],_,_,Acc) -> - Acc. - -% gen_encode_objectfields(Class,ObjName,[{FieldName,Type}|Rest],ConstrAcc) -> -% Fields = Class#objectclass.fields, - -% MaybeConstr = -% case is_typefield(Fields,FieldName) of -% true -> -% Def = Type#typedef.typespec, -% emit({"'enc_",ObjName,"'(",{asis,FieldName}, -% ", Val, Dummy) ->",nl}), - -% CAcc = -% case Type#typedef.name of -% {primitive,bif} -> -% gen_encode_prim(per,Def,"false","Val"), -% []; -% {constructed,bif} -> -% emit({" 'enc_",ObjName,'_',FieldName, -% "'(Val)"}), -% [{['enc_',ObjName,'_',FieldName],Def}]; -% {ExtMod,TypeName} -> -% emit({" '",ExtMod,"':'enc_",TypeName,"'(Val)"}), -% []; -% TypeName -> -% emit({" 'enc_",TypeName,"'(Val)"}), -% [] -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% CAcc; -% {false,objectfield} -> -% emit({"'enc_",ObjName,"'(",{asis,FieldName}, -% ", Val, [H|T]) ->",nl}), -% case Type#typedef.name of -% {ExtMod,TypeName} -> -% emit({indent(3),"'",ExtMod,"':'enc_",TypeName, -% "'(H, Val, T)"}); -% TypeName -> -% emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}) -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% []; -% {false,_} -> [] -% end, -% gen_encode_objectfields(Class,ObjName,Rest,MaybeConstr ++ ConstrAcc); -% gen_encode_objectfields(C,O,[_|T],Acc) -> -% gen_encode_objectfields(C,O,T,Acc); -% gen_encode_objectfields(_,_,[],Acc) -> -% Acc. - -gen_encode_constr_type(Erules,[TypeDef|Rest]) when record(TypeDef,typedef) -> - case is_already_generated(enc,TypeDef#typedef.name) of - true -> ok; - _ -> - Name = lists:concat(["enc_",TypeDef#typedef.name]), - emit({Name,"(Val) ->",nl}), - Def = TypeDef#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Def#type.def), - asn1ct_gen:gen_encode_constructed(Erules,Name,InnerType,Def), - gen_encode_constr_type(Erules,Rest) - end; -gen_encode_constr_type(_,[]) -> - ok. - -gen_encode_field_call(ObjName,FieldName,Type) -> - Def = Type#typedef.typespec, - case Type#typedef.name of - {primitive,bif} -> - gen_encode_prim(per,Def,"false", - "Val"), - []; - {constructed,bif} -> - emit({" 'enc_",ObjName,'_',FieldName, - "'(Val)"}), - [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'enc_",TypeName, - "'(Val)"}), - []; - TypeName -> - emit({" 'enc_",TypeName,"'(Val)"}), - [] - end. - -gen_encode_default_call(ClassName,FieldName,Type) -> - CurrentMod = get(currmod), - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> -%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); - emit([" 'enc_",ClassName,'_',FieldName,"'(Val)"]), - [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - typespec=Type}]; - {primitive,bif} -> - gen_encode_prim(per,Type,"false","Val"), - []; - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'enc_",Etype,"'(Val)",nl]), - []; - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'enc_",Etype,"'(Val)",nl]), - [] - end. - - - -gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Bytes) -> - emit(["'dec_",ObjName,"'(",{asis,Name},",",Bytes, - ",_,_RestPrimFieldName) ->",nl]) - end, -% emit(["'dec_",ObjName,"'(",{asis,Name}, -% ", Bytes, _, RestPrimFieldName) ->",nl]), - MaybeConstr= - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_"), - emit([" asn1_NOVALUE"]), - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Bytes"), - gen_decode_default_call(ClassName,Name,"Bytes",DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Bytes"), - gen_decode_field_call(ObjName,Name,"Bytes",TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc); -gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - EmitFuncClause = - fun(Attrs) -> - emit(["'dec_",ObjName,"'(",{asis,Name}, - ",",Attrs,") ->",nl]) - end, -% emit(["'dec_",ObjName,"'(",{asis,Name}, -% ", Bytes,_,[H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_,_"), - emit([" exit({error,{'illegal use of missing field in object', ",Name, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,TypeSpec},_} -> - EmitFuncClause("Bytes,_,[H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'dec_",TypeName, - "'(H, Bytes, telltype, T)"}); - TypeName -> - emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"}) - end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,ConstrAcc); -gen_decode_objectfields(CN,[_C|Cs],O,OF,CAcc) -> - gen_decode_objectfields(CN,Cs,O,OF,CAcc); -gen_decode_objectfields(_,[],_,_,CAcc) -> - CAcc. - - -gen_decode_field_call(ObjName,FieldName,Bytes,Type) -> - Def = Type#typedef.typespec, - case Type#typedef.name of - {primitive,bif} -> - gen_dec_prim(per,Def,Bytes), - []; - {constructed,bif} -> - emit({" 'dec_",ObjName,'_',FieldName, - "'(",Bytes,",telltype)"}), - [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'dec_",TypeName, - "'(",Bytes,", telltype)"}), - []; - TypeName -> - emit({" 'dec_",TypeName,"'(",Bytes,", telltype)"}), - [] - end. - -gen_decode_default_call(ClassName,FieldName,Bytes,Type) -> - CurrentMod = get(currmod), - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes,", telltype)"]), - [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - typespec=Type}]; - {primitive,bif} -> - gen_dec_prim(per,Type,Bytes), - []; - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'dec_",Etype,"'(",Bytes,", telltype)",nl]), - []; - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'dec_",Etype,"'(",Bytes,", telltype)",nl]), - [] - end. - -%%%%%%%%%%%%%%% - -% gen_decode_objectfields(Class,ObjName,[{FieldName,Type}|Rest],ConstrAcc) -> -% Fields = Class#objectclass.fields, - -% MaybeConstr = -% case is_typefield(Fields,FieldName) of -% true -> -% Def = Type#typedef.typespec, -% emit({"'dec_",ObjName,"'(",{asis,FieldName}, -% ", Val, Telltype, RestPrimFieldName) ->",nl}), - -% CAcc = -% case Type#typedef.name of -% {primitive,bif} -> -% gen_dec_prim(per,Def,"Val"), -% []; -% {constructed,bif} -> -% emit({" 'dec_",ObjName,'_',FieldName, -% "'(Val, Telltype)"}), -% [{['dec_',ObjName,'_',FieldName],Def}]; -% {ExtMod,TypeName} -> -% emit({" '",ExtMod,"':'dec_",TypeName, -% "'(Val, Telltype)"}), -% []; -% TypeName -> -% emit({" 'dec_",TypeName,"'(Val, Telltype)"}), -% [] -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% CAcc; -% {false,objectfield} -> -% emit({"'dec_",ObjName,"'(",{asis,FieldName}, -% ", Val, Telltype, [H|T]) ->",nl}), -% case Type#typedef.name of -% {ExtMod,TypeName} -> -% emit({indent(3),"'",ExtMod,"':'dec_",TypeName, -% "'(H, Val, Telltype, T)"}); -% TypeName -> -% emit({indent(3),"'dec_",TypeName, -% "'(H, Val, Telltype, T)"}) -% end, -% case more_genfields(Fields,Rest) of -% true -> -% emit({";",nl}); -% false -> -% emit({".",nl}) -% end, -% []; -% {false,_} -> -% [] -% end, -% gen_decode_objectfields(Class,ObjName,Rest,MaybeConstr ++ ConstrAcc); -% gen_decode_objectfields(C,O,[_|T],CAcc) -> -% gen_decode_objectfields(C,O,T,CAcc); -% gen_decode_objectfields(_,_,[],CAcc) -> -% CAcc. - -gen_decode_constr_type(Erules,[{Name,Def}|Rest]) -> - emit({Name,"(Bytes,_) ->",nl}), - InnerType = asn1ct_gen:get_inner(Def#type.def), - asn1ct_gen:gen_decode_constructed(Erules,Name,InnerType,Def), - gen_decode_constr_type(Erules,Rest); -gen_decode_constr_type(Erules,[TypeDef|Rest]) when record(TypeDef,typedef) -> - case is_already_generated(dec,TypeDef#typedef.name) of - true -> ok; - _ -> - gen_decode(Erules,TypeDef) - end, - gen_decode_constr_type(Erules,Rest); -gen_decode_constr_type(_,[]) -> - ok. - -% is_typefield(Fields,FieldName) -> -% case lists:keysearch(FieldName,2,Fields) of -% {value,Field} -> -% case element(1,Field) of -% typefield -> -% true; -% Other -> -% {false,Other} -% end; -% _ -> -% false -% end. -%% Object Set code generating for encoding and decoding -%% ---------------------------------------------------- -gen_objectset_code(Erules,ObjSet) -> - ObjSetName = ObjSet#typedef.name, - Def = ObjSet#typedef.typespec, -%% {ClassName,ClassDef} = Def#'ObjectSet'.class, - #'Externaltypereference'{module=ClassModule, - type=ClassName} = Def#'ObjectSet'.class, - ClassDef = asn1_db:dbget(ClassModule,ClassName), - UniqueFName = Def#'ObjectSet'.uniquefname, - Set = Def#'ObjectSet'.set, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjSetName}), - emit({nl,"%%================================",nl}), - case ClassName of - {_Module,ExtClassName} -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set, - ExtClassName,ClassDef); - _ -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set, - ClassName,ClassDef) - end, - emit(nl). - -gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)-> - ClassFields = (ClassDef#classdef.typespec)#objectclass.fields, - InternalFuncs= - gen_objset_enc(ObjSetName,UniqueFName,Set,ClassName, - ClassFields,1,[]), - gen_objset_dec(ObjSetName,UniqueFName,Set,ClassName,ClassFields,1), - gen_internal_funcs(Erules,InternalFuncs). - -gen_objset_enc(_,{unique,undefined},_,_,_,_,_) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - []; -gen_objset_enc(ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest], - ClName,ClFields,NthObj,Acc)-> - emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",", - {asis,Val},") ->",nl}), - {InternalFunc,NewNthObj}= - case ObjName of - no_name -> - gen_inlined_enc_funs(Fields,ClFields,ObjSName,NthObj); - _ -> - emit({" fun 'enc_",ObjName,"'/3"}), - {[],NthObj} - end, - emit({";",nl}), - gen_objset_enc(ObjSName,UniqueName,[T|Rest],ClName,ClFields, - NewNthObj,InternalFunc++Acc); -gen_objset_enc(ObjSetName,UniqueName, - [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) -> - - emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",", - {asis,Val},") ->",nl}), - {InternalFunc,_}= - case ObjName of - no_name -> - gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj); - _ -> - emit({" fun 'enc_",ObjName,"'/3"}), - {[],NthObj} - end, - emit({".",nl,nl}), - InternalFunc++Acc; -gen_objset_enc(ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, - _ClFields,_NthObj,Acc) -> - emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(_, Val, _) ->",nl}), - emit({indent(6),"Size = if",nl}), - emit({indent(9),"list(Val) -> length(Val);",nl}), - emit({indent(9),"true -> size(Val)",nl}), - emit({indent(6),"end,",nl}), - emit({indent(6),"if",nl}), - emit({indent(9),"Size < 256 ->",nl}), - emit({indent(12),"[20,Size,Val];",nl}), - emit({indent(9),"true ->",nl}), - emit({indent(12),"[21,<<Size:16>>,Val]",nl}), - emit({indent(6),"end",nl}), - emit({indent(3),"end.",nl,nl}), - Acc; -gen_objset_enc(_,_,[],_,_,_,Acc) -> - Acc. - -%% gen_inlined_enc_funs for each object iterates over all fields of a -%% class, and for each typefield it checks if the object has that -%% field and emits the proper code. -gen_inlined_enc_funs(Fields,[{typefield,Name,_}|Rest],ObjSetName,NthObj) -> - InternalDefFunName=asn1ct_gen:list2name([NthObj,Name,ObjSetName]), - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({indent(3),"fun(Type, Val, _) ->",nl, - indent(6),"case Type of",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret); - {value,{_,Type}} when record(Type,typedef) -> - emit({indent(3),"fun(Type, Val, _) ->",nl, - indent(6),"case Type of",nl}), - emit({indent(9),{asis,Name}," ->",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+N,Ret); - false -> - gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj) - end; -gen_inlined_enc_funs(Fields,[_|Rest],ObjSetName,NthObj) -> - gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj); -gen_inlined_enc_funs(_,[],_,NthObj) -> - {[],NthObj}. - -gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName, - NthObj,Acc) -> - InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), - {Acc2,NAdd}= - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({";",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - {Ret++Acc,N}; - {value,{_,Type}} when record(Type,typedef) -> - emit({";",nl,indent(9),{asis,Name}," ->",nl}), - {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), - {Ret++Acc,N}; - false -> - {Acc,0} - end, - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj+NAdd,Acc2); -gen_inlined_enc_funs1(Fields,[_|Rest],ObjSetName,NthObj,Acc)-> - gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,Acc); -gen_inlined_enc_funs1(_,[],_,NthObj,Acc) -> - emit({nl,indent(6),"end",nl}), - emit({indent(3),"end"}), - {Acc,NthObj}. - -emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type}, - InternalDefFunName) -> - case {ExtMod,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_encode_prim(per,Type,dotag,"Val"), - {[],0}; - {constructed,bif} -> - emit([indent(12),"'enc_", - InternalDefFunName,"'(Val)"]), - {[TDef#typedef{name=InternalDefFunName}],1}; - _ -> - emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val)"}), - {[],0} - end; -emit_inner_of_fun(#typedef{name=Name},_) -> - emit({indent(12),"'enc_",Name,"'(Val)"}), - {[],0}; -emit_inner_of_fun(Type,_) when record(Type,type) -> - CurrMod = get(currmod), - case Type#type.def of - Def when atom(Def) -> - emit({indent(9),Def," ->",nl,indent(12)}), - gen_encode_prim(erules,Type,dotag,"Val"); - TRef when record(TRef,typereference) -> - T = TRef#typereference.val, - emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"}); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"}); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),ExtMod,":'enc_", - T,"'(Val)"}) - end, - {[],0}. - -indent(N) -> - lists:duplicate(N,32). % 32 = space - - -gen_objset_dec(_,{unique,undefined},_,_,_,_) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - ok; -gen_objset_dec(ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest],ClName, - ClFields,NthObj)-> - - emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",", - {asis,Val},") ->",nl}), - NewNthObj= - case ObjName of - no_name -> - gen_inlined_dec_funs(Fields,ClFields,ObjSName,NthObj); - _ -> - emit({" fun 'dec_",ObjName,"'/4"}), - NthObj - end, - emit({";",nl}), - gen_objset_dec(ObjSName,UniqueName,[T|Rest],ClName,ClFields,NewNthObj); -gen_objset_dec(ObjSetName,UniqueName,[{ObjName,Val,Fields}],_ClName, - ClFields,NthObj) -> - - emit({"'getdec_",ObjSetName,"'(",{asis,UniqueName},",", - {asis,Val},") ->",nl}), - case ObjName of - no_name -> - gen_inlined_dec_funs(Fields,ClFields,ObjSetName,NthObj); - _ -> - emit({" fun 'dec_",ObjName,"'/4"}) - end, - emit({".",nl,nl}), - ok; -gen_objset_dec(ObjSetName,_,['EXTENSIONMARK'],_ClName,_ClFields, - _NthObj) -> - emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(Attr1, Bytes, _, _) ->",nl}), - %% emit({indent(6),"?RT_PER:decode_open_type(Bytes,[])",nl}), - emit({indent(6),"{Bytes,Attr1}",nl}), - emit({indent(3),"end.",nl,nl}), - ok; -gen_objset_dec(_,_,[],_,_,_) -> - ok. - -gen_inlined_dec_funs(Fields,[{typefield,Name,_}|Rest], - ObjSetName,NthObj) -> - InternalDefFunName = [NthObj,Name,ObjSetName], - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({indent(3),"fun(Type, Val, _, _) ->",nl, - indent(6),"case Type of",nl}), - N=emit_inner_of_decfun(Type,InternalDefFunName), - gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N); - {value,{_,Type}} when record(Type,typedef) -> - emit({indent(3),"fun(Type, Val, _, _) ->",nl, - indent(6),"case Type of",nl}), - emit({indent(9),{asis,Name}," ->",nl}), - N=emit_inner_of_decfun(Type,InternalDefFunName), - gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N); - false -> - gen_inlined_dec_funs(Fields,Rest,ObjSetName,NthObj) - end; -gen_inlined_dec_funs(Fields,[_|Rest],ObjSetName,NthObj) -> - gen_inlined_dec_funs(Fields,Rest,ObjSetName,NthObj); -gen_inlined_dec_funs(_,[],_,NthObj) -> - NthObj. - -gen_inlined_dec_funs1(Fields,[{typefield,Name,_}|Rest], - ObjSetName,NthObj) -> - InternalDefFunName = [NthObj,Name,ObjSetName], - N= - case lists:keysearch(Name,1,Fields) of - {value,{_,Type}} when record(Type,type) -> - emit({";",nl}), - emit_inner_of_decfun(Type,InternalDefFunName); - {value,{_,Type}} when record(Type,typedef) -> - emit({";",nl,indent(9),{asis,Name}," ->",nl}), - emit_inner_of_decfun(Type,InternalDefFunName); - false -> - 0 - end, - gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj+N); -gen_inlined_dec_funs1(Fields,[_|Rest],ObjSetName,NthObj)-> - gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj); -gen_inlined_dec_funs1(_,[],_,NthObj) -> - emit({nl,indent(6),"end",nl}), - emit({indent(3),"end"}), - NthObj. - -emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type}, - InternalDefFunName) -> - case {ExtName,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_dec_prim(per,Type,"Val"), - 0; - {constructed,bif} -> - emit({indent(12),"'dec_", - asn1ct_gen:list2name(InternalDefFunName),"'(Val)"}), - 1; - _ -> - emit({indent(12),"'",ExtName,"':'dec_",Name, - "'(Val, telltype)"}), - 0 - end; -emit_inner_of_decfun(#typedef{name=Name},_) -> - emit({indent(12),"'dec_",Name,"'(Val, telltype)"}), - 0; -emit_inner_of_decfun(Type,_) when record(Type,type) -> - CurrMod = get(currmod), - case Type#type.def of - Def when atom(Def) -> - emit({indent(9),Def," ->",nl,indent(12)}), - gen_dec_prim(erules,Type,"Val"); - TRef when record(TRef,typereference) -> - T = TRef#typereference.val, - emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),ExtMod,":'dec_", - T,"'(Val)"}) - end, - 0. - - -gen_internal_funcs(_Erules,[]) -> - ok; -gen_internal_funcs(Erules,[TypeDef|Rest]) -> - gen_encode_user(Erules,TypeDef), - emit([nl,nl,"'dec_",TypeDef#typedef.name,"'(Bytes) ->",nl]), - gen_decode_user(Erules,TypeDef), - gen_internal_funcs(Erules,Rest). - - - -%% DECODING ***************************** -%%*************************************** - - -gen_decode(Erules,Type) when record(Type,typedef) -> - D = Type, - emit({nl,nl}), - emit({"'dec_",Type#typedef.name,"'(Bytes,_) ->",nl}), - dbdec(Type#typedef.name), - gen_decode_user(Erules,D). - -gen_decode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) -> - NewTname = [Cname|Tname], - gen_decode(Erules,NewTname,Type); - -gen_decode(Erules,Typename,Type) when record(Type,type) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - ObjFun = - case Type#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - "" - end, - emit({nl,"'dec_",asn1ct_gen:list2name(Typename), - "'(Bytes,_",ObjFun,") ->",nl}), - dbdec(Typename), - asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type); - _ -> - true - end. - -dbdec(Type) when list(Type)-> - demit({"io:format(\"decoding: ",asn1ct_gen:list2name(Type),"~w~n\",[Bytes]),",nl}); -dbdec(Type) -> - demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[Bytes]),",nl}). - -gen_decode_user(Erules,D) when record(D,typedef) -> - CurrMod = get(currmod), - Typename = [D#typedef.name], - Def = D#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Def#type.def), - case asn1ct_gen:type(InnerType) of - {primitive,bif} -> - gen_dec_prim(Erules,Def,"Bytes"), - emit({".",nl,nl}); - 'ASN1_OPEN_TYPE' -> - gen_dec_prim(Erules,Def#type{def='ASN1_OPEN_TYPE'},"Bytes"), - emit({".",nl,nl}); - {constructed,bif} -> - asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,D); - #typereference{val=Dname} -> - emit({"'dec_",Dname,"'(Bytes,telltype)"}), - emit({".",nl,nl}); - #'Externaltypereference'{module=CurrMod,type=Etype} -> - emit({"'dec_",Etype,"'(Bytes,telltype).",nl,nl}); - #'Externaltypereference'{module=Emod,type=Etype} -> - emit({"'",Emod,"':'dec_",Etype,"'(Bytes,telltype).",nl,nl}); - Other -> - exit({error,{asn1,{unknown,Other}}}) - end. - - - -gen_dec_prim(_Erules,Att,BytesVar) -> - Typename = Att#type.def, - Constraint = Att#type.constraint, - case Typename of - 'INTEGER' -> - EffectiveConstr = effective_constraint(integer,Constraint), - emit_dec_integer(EffectiveConstr,BytesVar); -% emit({"?RT_PER:decode_integer(",BytesVar,",", -% {asis,EffectiveConstr},")"}); - {'INTEGER',NamedNumberList} -> - EffectiveConstr = effective_constraint(integer,Constraint), - emit_dec_integer(EffectiveConstr,BytesVar,NamedNumberList); -% emit({"?RT_PER:decode_integer(",BytesVar,",", -% {asis,EffectiveConstr},",", -% {asis,NamedNumberList},")"}); - {'BIT STRING',NamedNumberList} -> - case get(compact_bit_string) of - true -> - emit({"?RT_PER:decode_compact_bit_string(", - BytesVar,",",{asis,Constraint},",", - {asis,NamedNumberList},")"}); - _ -> - emit({"?RT_PER:decode_bit_string(",BytesVar,",", - {asis,Constraint},",", - {asis,NamedNumberList},")"}) - end; - 'NULL' -> - emit({"?RT_PER:decode_null(", - BytesVar,")"}); - 'OBJECT IDENTIFIER' -> - emit({"?RT_PER:decode_object_identifier(", - BytesVar,")"}); - 'ObjectDescriptor' -> - emit({"?RT_PER:decode_ObjectDescriptor(", - BytesVar,")"}); - {'ENUMERATED',{NamedNumberList1,NamedNumberList2}} -> - NewTup = {list_to_tuple([X||{X,_} <- NamedNumberList1]), - list_to_tuple([X||{X,_} <- NamedNumberList2])}, - NewC = [{'ValueRange',{0,size(element(1,NewTup))-1}}], - emit({"?RT_PER:decode_enumerated(",BytesVar,",", - {asis,NewC},",", - {asis,NewTup},")"}); - {'ENUMERATED',NamedNumberList} -> - %NewTup = list_to_tuple([X||{X,Y} <- NamedNumberList]), - NewNNL = [X||{X,_} <- NamedNumberList], - NewC = effective_constraint(integer, - [{'ValueRange',{0,length(NewNNL)-1}}]), - emit_dec_enumerated(BytesVar,NewC,NewNNL); -% emit({"?RT_PER:decode_enumerated(",BytesVar,",", -% {asis,NewC},",", -% {asis,NewTup},")"}); - 'BOOLEAN'-> - emit({"?RT_PER:decode_boolean(",BytesVar,")"}); - 'OCTET STRING' -> - emit_dec_octet_string(Constraint,BytesVar); -% emit({"?RT_PER:decode_octet_string(",BytesVar,",", -% {asis,Constraint},")"}); - 'NumericString' -> - emit_dec_known_multiplier_string('NumericString', - Constraint,BytesVar); -% emit({"?RT_PER:decode_NumericString(",BytesVar,",", -% {asis,Constraint},")"}); - 'TeletexString' -> - emit({"?RT_PER:decode_TeletexString(",BytesVar,",", - {asis,Constraint},")"}); - 'VideotexString' -> - emit({"?RT_PER:decode_VideotexString(",BytesVar,",", - {asis,Constraint},")"}); - 'UTCTime' -> - emit_dec_known_multiplier_string('VisibleString', - Constraint,BytesVar); -% emit({"?RT_PER:decode_VisibleString(",BytesVar,",", -% {asis,Constraint},")"}); - 'GeneralizedTime' -> - emit_dec_known_multiplier_string('VisibleString', - Constraint,BytesVar); -% emit({"?RT_PER:decode_VisibleString(",BytesVar,",", -% {asis,Constraint},")"}); - 'GraphicString' -> - emit({"?RT_PER:decode_GraphicString(",BytesVar,",", - {asis,Constraint},")"}); - 'VisibleString' -> - emit_dec_known_multiplier_string('VisibleString', - Constraint,BytesVar); -% emit({"?RT_PER:decode_VisibleString(",BytesVar,",", -% {asis,Constraint},")"}); - 'GeneralString' -> - emit({"?RT_PER:decode_GeneralString(",BytesVar,",", - {asis,Constraint},")"}); - 'PrintableString' -> - emit_dec_known_multiplier_string('PrintableString', - Constraint,BytesVar); -% emit({"?RT_PER:decode_PrintableString(",BytesVar,",",{asis,Constraint},")"}); - 'IA5String' -> - emit_dec_known_multiplier_string('IA5String',Constraint,BytesVar); -% emit({"?RT_PER:decode_IA5String(",BytesVar,",",{asis,Constraint},")"}); - 'BMPString' -> - emit_dec_known_multiplier_string('BMPString',Constraint,BytesVar); -% emit({"?RT_PER:decode_BMPString(",BytesVar,",",{asis,Constraint},")"}); - 'UniversalString' -> - emit_dec_known_multiplier_string('UniversalString', - Constraint,BytesVar); -% emit({"?RT_PER:decode_UniversalString(",BytesVar,",",{asis,Constraint},")"}); - 'ANY' -> - emit(["?RT_PER:decode_open_type(",BytesVar,",", - {asis,Constraint}, ")"]); - 'ASN1_OPEN_TYPE' -> - case Constraint of - [#'Externaltypereference'{type=Tname}] -> - emit(["fun(FBytes) ->",nl, - " {XTerm,XBytes} = "]), - emit(["?RT_PER:decode_open_type(FBytes,[]),",nl]), - emit([" {YTerm,_} = dec_",Tname,"(XTerm,mandatory),",nl]), - emit([" {YTerm,XBytes} end(",BytesVar,")"]); - [#type{def=#'Externaltypereference'{type=Tname}}] -> - emit(["fun(FBytes) ->",nl, - " {XTerm,XBytes} = "]), - emit(["?RT_PER:decode_open_type(FBytes,[]),",nl]), - emit([" {YTerm,_} = dec_",Tname,"(XTerm,mandatory),",nl]), - emit([" {YTerm,XBytes} end(",BytesVar,")"]); - _ -> - emit(["?RT_PER:decode_open_type(",BytesVar,",[])"]) - end; - Other -> - exit({'cant decode' ,Other}) - end. - - -emit_dec_integer(C,BytesVar,NNL) -> - asn1ct_name:new(tmpterm), - asn1ct_name:new(buffer), - Tmpterm = asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)), - Buffer = asn1ct_gen:mk_var(asn1ct_name:curr(buffer)), - emit({" begin {",{curr,tmpterm},",",{curr,buffer},"} = ",nl}), - emit_dec_integer(C,BytesVar), - emit({",",nl," case ",Tmpterm," of",nl}), - lists:map(fun({Name,Int})->emit({" ",Int," -> {",{asis,Name},",", - Buffer,"};",nl}); - (_)-> exit({error,{asn1,{"error in named number list",NNL}}}) - end, - NNL), - emit({" _ -> {",Tmpterm,",",Buffer,"}",nl}), - emit({" end",nl}), % end of case - emit(" end"). % end of begin - -emit_dec_integer([{'SingleValue',Int}],BytesVar) when integer(Int) -> - emit(["{",Int,",",BytesVar,"}"]); -emit_dec_integer([{_,{Lb,_Ub},_Range,{BitsOrOctets,N}}],BytesVar) -> - GetBorO = - case BitsOrOctets of - bits -> "getbits"; - _ -> "getoctets" - end, - asn1ct_name:new(tmpterm), - asn1ct_name:new(tmpremain), - emit({" begin",nl," {",{curr,tmpterm},",",{curr,tmpremain},"}=", - "?RT_PER:",GetBorO,"(",BytesVar,",",N,"),",nl}), - emit({" {",{curr,tmpterm},"+",Lb,",",{curr,tmpremain},"}",nl, - " end"}); -emit_dec_integer([{_,{'MIN',_}}],BytesVar) -> - emit({"?RT_PER:decode_unconstrained_number(",BytesVar,")"}); -emit_dec_integer([{_,{Lb,'MAX'}}],BytesVar) -> - emit({"?RT_PER:decode_semi_constrained_number(",BytesVar,",",Lb,")"}); -emit_dec_integer([{'ValueRange',VR={Lb,Ub}}],BytesVar) -> - Range = Ub-Lb+1, - emit({"?RT_PER:decode_constrained_number(",BytesVar,",", - {asis,VR},",",Range,")"}); -emit_dec_integer(C=[{Rc,_}],BytesVar) when tuple(Rc) -> - emit({"?RT_PER:decode_integer(",BytesVar,",",{asis,C},")"}); -emit_dec_integer(_,BytesVar) -> - emit({"?RT_PER:decode_unconstrained_number(",BytesVar,")"}). - - -emit_dec_enumerated(BytesVar,C,NamedNumberList) -> - emit_dec_enumerated_begin(),% emits a begin if component - asn1ct_name:new(tmpterm), - Tmpterm = asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)), - asn1ct_name:new(tmpremain), - Tmpremain = asn1ct_gen:mk_var(asn1ct_name:curr(tmpremain)), - emit({" {",{curr,tmpterm},",",{curr,tmpremain},"} =",nl}), - emit_dec_integer(C,BytesVar), - emit({",",nl," case ",Tmpterm," of "}), -% Cases=lists:flatten(dec_enumerated_cases(NamedNumberList,asn1ct_gen:mk_var(asn1ct_name:curr(tmpremain)),0)), - Cases=lists:flatten(dec_enumerated_cases(NamedNumberList,Tmpremain,0)), - emit({Cases++"_->exit({error,{asn1,{decode_enumerated,{",Tmpterm, - ",",{asis,NamedNumberList},"}}}}) end",nl}), - emit_dec_enumerated_end(). - -emit_dec_enumerated_begin() -> - case get(component_type) of - {true,_} -> - emit({" begin",nl}); - _ -> ok - end. - -emit_dec_enumerated_end() -> - case get(component_type) of - {true,_} -> - emit(" end"); - _ -> ok - end. - -% dec_enumerated_cases(NNL,Tmpremain,No) -> -% Cases=dec_enumerated_cases1(NNL,Tmpremain,0), -% lists:flatten(io_lib:format("(case ~s "++Cases++ -% "~s when atom(~s)->exit({error,{asn1,{namednumber,~s}}});_->~s end)",[Value,"TmpVal","TmpVal","TmpVal",Value])). - -dec_enumerated_cases([Name|Rest],Tmpremain,No) -> - io_lib:format("~w->{~w,~s};",[No,Name,Tmpremain])++ - dec_enumerated_cases(Rest,Tmpremain,No+1); -dec_enumerated_cases([],_,_) -> - "". - - -% more_genfields(_Fields,[]) -> -% false; -% more_genfields(Fields,[{FieldName,_}|T]) -> -% case is_typefield(Fields,FieldName) of -% true -> true; -% {false,objectfield} -> true; -% {false,_} -> more_genfields(Fields,T) -% end. diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_name.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_name.erl deleted file mode 100644 index 03252bd7d9..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_name.erl +++ /dev/null @@ -1,225 +0,0 @@ -%% ``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: asn1ct_name.erl,v 1.1 2008/12/17 09:53:30 mikpe Exp $ -%% --module(asn1ct_name). - -%%-compile(export_all). --export([name_server_loop/1, - start/0, - stop/0, - push/1, - pop/1, - curr/1, - clear/0, - delete/1, - active/1, - prev/1, - next/1, - all/1, - new/1]). - -start() -> - start_server(asn1_ns, asn1ct_name,name_server_loop,[[]]). - -stop() -> stop_server(asn1_ns). - -name_server_loop(Vars) -> -%% io:format("name -- ~w~n",[Vars]), - receive - {From,{current,Variable}} -> - From ! {asn1_ns,get_curr(Vars,Variable)}, - name_server_loop(Vars); - {From,{pop,Variable}} -> - From ! {asn1_ns,done}, - name_server_loop(pop_var(Vars,Variable)); - {From,{push,Variable}} -> - From ! {asn1_ns,done}, - name_server_loop(push_var(Vars,Variable)); - {From,{delete,Variable}} -> - From ! {asn1_ns,done}, - name_server_loop(delete_var(Vars,Variable)); - {From,{new,Variable}} -> - From ! {asn1_ns,done}, - name_server_loop(new_var(Vars,Variable)); - {From,{prev,Variable}} -> - From ! {asn1_ns,get_prev(Vars,Variable)}, - name_server_loop(Vars); - {From,{next,Variable}} -> - From ! {asn1_ns,get_next(Vars,Variable)}, - name_server_loop(Vars); - {From,stop} -> - From ! {asn1_ns,stopped}, - exit(normal) - end. - -active(V) -> - case curr(V) of - nil -> false; - _ -> true - end. - -req(Req) -> - asn1_ns ! {self(), Req}, - receive {asn1_ns, Reply} -> Reply end. - -pop(V) -> req({pop,V}). -push(V) -> req({push,V}). -clear() -> req(stop), start(). -curr(V) -> req({current,V}). -new(V) -> req({new,V}). -delete(V) -> req({delete,V}). -prev(V) -> - case req({prev,V}) of - none -> - exit('cant get prev of none'); - Rep -> Rep - end. - -next(V) -> - case req({next,V}) of - none -> - exit('cant get next of none'); - Rep -> Rep - end. - -all(V) -> - Curr = curr(V), - if Curr == V -> []; - true -> - lists:reverse(generate(V,last(Curr),[],0)) - end. - -generate(V,Number,Res,Pos) -> - Ell = Pos+1, - if - Ell > Number -> - Res; - true -> - generate(V,Number,[list_to_atom(lists:concat([V,Ell]))|Res],Ell) - end. - -last(V) -> - last2(lists:reverse(atom_to_list(V))). - -last2(RevL) -> - list_to_integer(lists:reverse(get_digs(RevL))). - - -get_digs([H|T]) -> - if - H < $9+1, - H > $0-1 -> - [H|get_digs(T)]; - true -> - [] - end. - -push_var(Vars,Variable) -> - case lists:keysearch(Variable,1,Vars) of - false -> - [{Variable,[0]}|Vars]; - {value,{Variable,[Digit|Drest]}} -> - NewVars = lists:keydelete(Variable,1,Vars), - [{Variable,[Digit,Digit|Drest]}|NewVars] - end. - -pop_var(Vars,Variable) -> - case lists:keysearch(Variable,1,Vars) of - false -> - ok; - {value,{Variable,[_Dig]}} -> - lists:keydelete(Variable,1,Vars); - {value,{Variable,[_Dig|Digits]}} -> - NewVars = lists:keydelete(Variable,1,Vars), - [{Variable,Digits}|NewVars] - end. - -get_curr([],Variable) -> - Variable; -get_curr([{Variable,[0|_Drest]}|_Tail],Variable) -> - Variable; -get_curr([{Variable,[Digit|_Drest]}|_Tail],Variable) -> - list_to_atom(lists:concat([Variable,integer_to_list(Digit)])); - -get_curr([_|Tail],Variable) -> - get_curr(Tail,Variable). - -new_var(Vars,Variable) -> - case lists:keysearch(Variable,1,Vars) of - false -> - [{Variable,[1]}|Vars]; - {value,{Variable,[Digit|Drest]}} -> - NewVars = lists:keydelete(Variable,1,Vars), - [{Variable,[Digit+1|Drest]}|NewVars] - end. - -delete_var(Vars,Variable) -> - case lists:keysearch(Variable,1,Vars) of - false -> - Vars; - {value,{Variable,[N]}} when N =< 1 -> - lists:keydelete(Variable,1,Vars); - {value,{Variable,[Digit|Drest]}} -> - case Digit of - 0 -> - Vars; - _ -> - NewVars = lists:keydelete(Variable,1,Vars), - [{Variable,[Digit-1|Drest]}|NewVars] - end - end. - -get_prev(Vars,Variable) -> - case lists:keysearch(Variable,1,Vars) of - false -> - none; - {value,{Variable,[Digit|_]}} when Digit =< 1 -> - Variable; - {value,{Variable,[Digit|_]}} when Digit > 1 -> - list_to_atom(lists:concat([Variable, - integer_to_list(Digit-1)])); - _ -> - none - end. - -get_next(Vars,Variable) -> - case lists:keysearch(Variable,1,Vars) of - false -> - list_to_atom(lists:concat([Variable,"1"])); - {value,{Variable,[Digit|_]}} when Digit >= 0 -> - list_to_atom(lists:concat([Variable, - integer_to_list(Digit+1)])); - _ -> - none - end. - - -stop_server(Name) -> - stop_server(Name, whereis(Name)). -stop_server(_Name, undefined) -> stopped; -stop_server(Name, _Pid) -> - Name ! {self(), stop}, - receive {Name, _} -> stopped end. - - -start_server(Name,Mod,Fun,Args) -> - case whereis(Name) of - undefined -> - register(Name, spawn(Mod,Fun, Args)); - _Pid -> - already_started - end. diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_parser.yrl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_parser.yrl deleted file mode 100644 index df74685cb7..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_parser.yrl +++ /dev/null @@ -1,1175 +0,0 @@ -%% ``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: asn1ct_parser.yrl,v 1.1 2008/12/17 09:53:30 mikpe Exp $
-%%
-Nonterminals
-ModuleDefinition ModuleIdentifier DefinitiveIdentifier DefinitiveObjIdComponentList
-DefinitiveObjIdComponent TagDefault ExtensionDefault
-ModuleBody Exports SymbolsExported Imports SymbolsImported
-SymbolsFromModuleList SymbolsFromModule GlobalModuleReference AssignedIdentifier SymbolList
-Symbol Reference AssignmentList Assignment
-ExtensionAndException
-ComponentTypeLists
-Externaltypereference Externalvaluereference DefinedType DefinedValue
-AbsoluteReference ItemSpec ItemId ComponentId TypeAssignment
-ValueAssignment
-% ValueSetTypeAssignment
-ValueSet
-Type BuiltinType NamedType ReferencedType
-Value ValueNotNull BuiltinValue ReferencedValue NamedValue
-% BooleanType
-BooleanValue IntegerType NamedNumberList NamedNumber SignedNumber
-% inlined IntegerValue
-EnumeratedType
-% inlined Enumerations
-Enumeration EnumerationItem
-% inlined EnumeratedValue
-% RealType
-RealValue NumericRealValue SpecialRealValue BitStringType
-% inlined BitStringValue
-IdentifierList
-% OctetStringType
-% inlined OctetStringValue
-% NullType NullValue
-SequenceType ComponentTypeList ComponentType
-% SequenceValue SequenceOfValue
-ComponentValueList SequenceOfType
-SAndSOfValue ValueList SetType
-% SetValue SetOfValue
-SetOfType
-ChoiceType
-% AlternativeTypeList made common with ComponentTypeList
-ChoiceValue
-AnyValue
-AnyDefBy
-SelectionType
-TaggedType Tag ClassNumber Class
-% redundant TaggedValue
-% EmbeddedPDVType EmbeddedPDVValue ExternalType ExternalValue ObjectIdentifierType
-ObjectIdentifierValue ObjIdComponentList ObjIdComponent
-% NameForm NumberForm NameAndNumberForm
-CharacterStringType
-RestrictedCharacterStringValue CharacterStringList
-% CharSyms CharsDefn
-Quadruple
-% Group Plane Row Cell
-Tuple
-% TableColumn TableRow
-% UnrestrictedCharacterString
-CharacterStringValue
-% UnrestrictedCharacterStringValue
-ConstrainedType Constraint ConstraintSpec TypeWithConstraint
-ElementSetSpecs ElementSetSpec
-%GeneralConstraint
-UserDefinedConstraint UserDefinedConstraintParameter
-UserDefinedConstraintParameters
-ExceptionSpec
-ExceptionIdentification
-Unions
-UnionMark
-UElems
-Intersections
-IntersectionElements
-IntersectionMark
-IElems
-Elements
-Elems
-SubTypeElements
-Exclusions
-LowerEndpoint
-UpperEndpoint
-LowerEndValue
-UpperEndValue
-TypeConstraints NamedConstraint PresenceConstraint
-
-ParameterizedTypeAssignment
-ParameterList
-Parameters
-Parameter
-ParameterizedType
-
-% X.681
-ObjectClassAssignment ObjectClass ObjectClassDefn
-FieldSpecs FieldSpec OptionalitySpec WithSyntaxSpec
-TokenOrGroupSpecs TokenOrGroupSpec
-SyntaxList OptionalGroup RequiredToken Word
-TypeOptionalitySpec
-ValueOrObjectOptSpec
-VSetOrOSetOptSpec
-ValueOptionalitySpec
-ObjectOptionalitySpec
-ValueSetOptionalitySpec
-ObjectSetOptionalitySpec
-% X.681 chapter 15
-InformationFromObjects
-ValueFromObject
-%ValueSetFromObjects
-TypeFromObject
-%ObjectFromObject
-%ObjectSetFromObjects
-ReferencedObjects
-FieldName
-PrimitiveFieldName
-
-ObjectAssignment
-ObjectSetAssignment
-ObjectSet
-ObjectSetElements
-Object
-ObjectDefn
-DefaultSyntax
-DefinedSyntax
-FieldSettings
-FieldSetting
-DefinedSyntaxTokens
-DefinedSyntaxToken
-Setting
-DefinedObject
-ObjectFromObject
-ObjectSetFromObjects
-ParameterizedObject
-ExternalObjectReference
-DefinedObjectSet
-DefinedObjectClass
-ExternalObjectClassReference
-
-% X.682
-TableConstraint
-ComponentRelationConstraint
-ComponentIdList
-
-% X.683
-ActualParameter
-.
-
-%UsefulType.
-
-Terminals
-'ABSENT' 'ABSTRACT-SYNTAX' 'ALL' 'ANY'
-'APPLICATION' 'AUTOMATIC' 'BEGIN' 'BIT'
-'BOOLEAN' 'BY' 'CHARACTER' 'CHOICE' 'CLASS' 'COMPONENT'
-'COMPONENTS' 'CONSTRAINED' 'DEFAULT' 'DEFINED' 'DEFINITIONS'
-'EMBEDDED' 'END' 'ENUMERATED' 'EXCEPT' 'EXPLICIT'
-'EXPORTS' 'EXTENSIBILITY' 'EXTERNAL' 'FALSE' 'FROM' 'GeneralizedTime'
-'TYPE-IDENTIFIER'
-'IDENTIFIER' 'IMPLICIT' 'IMPLIED' 'IMPORTS'
-'INCLUDES' 'INSTANCE' 'INTEGER' 'INTERSECTION'
-'MAX' 'MIN' 'MINUS-INFINITY' 'NULL'
-'OBJECT' 'ObjectDescriptor' 'OCTET' 'OF' 'OPTIONAL' 'PDV' 'PLUS-INFINITY'
-'PRESENT' 'PRIVATE' 'REAL' 'SEQUENCE' 'SET' 'SIZE'
-'STRING' 'SYNTAX' 'TAGS' 'TRUE' 'UNION'
-'UNIQUE' 'UNIVERSAL' 'UTCTime' 'WITH'
-'{' '}' '(' ')' '.' '::=' ';' ',' '@' '*' '-' '[' ']'
-'!' '..' '...' '|' '<' ':' '^'
-number identifier typereference restrictedcharacterstringtype
-bstring hstring cstring typefieldreference valuefieldreference
-objectclassreference word.
-
-Rootsymbol ModuleDefinition.
-Endsymbol '$end'.
-
-Left 300 'EXCEPT'.
-Left 200 '^'.
-Left 200 'INTERSECTION'.
-Left 100 '|'.
-Left 100 'UNION'.
-
-
-ModuleDefinition -> ModuleIdentifier
- 'DEFINITIONS'
- TagDefault
- ExtensionDefault
- '::='
- 'BEGIN'
- ModuleBody
- 'END' :
- {'ModuleBody',Ex,Im,Types} = '$7',
- {{typereference,Pos,Name},Defid} = '$1',
- #module{
- pos= Pos,
- name= Name,
- defid= Defid,
- tagdefault='$3',
- extensiondefault='$4',
- exports=Ex,
- imports=Im,
- typeorval=Types}.
-% {module, '$1','$3','$6'}.
-% Results always in a record of type module defined in asn_records.hlr
-
-ModuleIdentifier -> typereference DefinitiveIdentifier :
- put(asn1_module,'$1'#typereference.val),
- {'$1','$2'}.
-
-DefinitiveIdentifier -> '{' DefinitiveObjIdComponentList '}' : '$2' .
-DefinitiveIdentifier -> '$empty': [].
-
-DefinitiveObjIdComponentList -> DefinitiveObjIdComponent : ['$1'].
-DefinitiveObjIdComponentList -> DefinitiveObjIdComponent DefinitiveObjIdComponentList : ['$1'|'$2'].
-
-DefinitiveObjIdComponent -> identifier : '$1' . %expanded->
-% DefinitiveObjIdComponent -> NameForm : '$1' .
-DefinitiveObjIdComponent -> number : '$1' . %expanded->
-% DefinitiveObjIdComponent -> DefinitiveNumberForm : 'fix' .
-DefinitiveObjIdComponent -> identifier '(' number ')' : {'$1','$3'} . %expanded->
-% DefinitiveObjIdComponent -> DefinitiveNameAndNumberForm : {'$1','$3'} .
-
-% DefinitiveNumberForm -> number : 'fix' .
-
-% DefinitiveNameAndNumberForm -> identifier '(' DefinitiveNumberForm ')' : 'fix' .
-
-TagDefault -> 'EXPLICIT' 'TAGS' : put(tagdefault,'EXPLICIT'),'EXPLICIT' .
-TagDefault -> 'IMPLICIT' 'TAGS' : put(tagdefault,'IMPLICIT'),'IMPLICIT' .
-TagDefault -> 'AUTOMATIC' 'TAGS' : put(tagdefault,'AUTOMATIC'),'AUTOMATIC' .
-TagDefault -> '$empty': put(tagdefault,'EXPLICIT'),'EXPLICIT'. % because this is the default
-
-ExtensionDefault -> 'EXTENSIBILITY' 'IMPLIED' : 'IMPLIED'.
-ExtensionDefault -> '$empty' : 'false'. % because this is the default
-
-ModuleBody -> Exports Imports AssignmentList : {'ModuleBody','$1','$2','$3'}.
-ModuleBody -> '$empty' : {'ModuleBody',nil,nil,[]}.
-
-Exports -> 'EXPORTS' SymbolList ';' : {exports,'$2'}.
-Exports -> 'EXPORTS' ';' : {exports,[]}.
-Exports -> '$empty' : {exports,all} .
-
-% inlined above SymbolsExported -> SymbolList : '$1'.
-% inlined above SymbolsExported -> '$empty' : [].
-
-Imports -> 'IMPORTS' SymbolsFromModuleList ';' : {imports,'$2'}.
-Imports -> 'IMPORTS' ';' : {imports,[]}.
-Imports -> '$empty' : {imports,[]} .
-
-% inlined above SymbolsImported -> SymbolsFromModuleList : '$1'.
-% inlined above SymbolsImported -> '$empty' : [].
-
-SymbolsFromModuleList -> SymbolsFromModule :['$1'].
-% SymbolsFromModuleList -> SymbolsFromModuleList SymbolsFromModule :$1.%changed
-SymbolsFromModuleList -> SymbolsFromModule SymbolsFromModuleList :['$1'|'$2'].
-
-% expanded SymbolsFromModule -> SymbolList 'FROM' GlobalModuleReference : #'SymbolsFromModule'{symbols = '$1',module='$3'}.
-SymbolsFromModule -> SymbolList 'FROM' typereference : #'SymbolsFromModule'{symbols = '$1',module='$3'}.
-SymbolsFromModule -> SymbolList 'FROM' typereference '{' ValueList '}': #'SymbolsFromModule'{symbols = '$1',module='$3'}.
-%SymbolsFromModule -> SymbolList 'FROM' typereference identifier: #'SymbolsFromModule'{symbols = '$1',module='$3'}.
-%SymbolsFromModule -> SymbolList 'FROM' typereference Externalvaluereference: #'SymbolsFromModule'{symbols = '$1',module='$3'}.
-%SymbolsFromModule -> SymbolList 'FROM' typereference DefinedValue: #'SymbolsFromModule'{symbols = '$1',module='$3'}.
-
-% inlined GlobalModuleReference -> typereference AssignedIdentifier : {'$1','$2'} .
-
-% inlined above AssignedIdentifier -> '{' ValueList '}' : '$2'.
-% replaced AssignedIdentifier -> '{' DefinedValue ObjIdComponentList '}' :{'$2','$3'}.
-% not necessary , replaced by SAndSOfValue AssignedIdentifier -> ObjectIdentifierValue :'$1'.
-% AssignedIdentifier -> DefinedValue : '$1'.
-% inlined AssignedIdentifier -> '$empty' : undefined.
-
-SymbolList -> Symbol : ['$1'].
-SymbolList -> Symbol ',' SymbolList :['$1'|'$3'].
-
-Symbol -> Reference :'$1'.
-% later Symbol -> ParameterizedReference :'$1'.
-
-Reference -> typereference :'$1'.
-Reference -> identifier:'$1'.
-Reference -> typereference '{' '}':'$1'.
-Reference -> Externaltypereference '{' '}':'$1'.
-
-% later Reference -> objectclassreference :'$1'.
-% later Reference -> objectreference :'$1'.
-% later Reference -> objectsetreference :'$1'.
-
-AssignmentList -> Assignment : ['$1'].
-% modified AssignmentList -> AssignmentList Assignment : '$1'.
-AssignmentList -> Assignment AssignmentList : ['$1'|'$2'].
-
-Assignment -> TypeAssignment : '$1'.
-Assignment -> ValueAssignment : '$1'.
-% later Assignment -> ValueSetTypeAssignment : '$1'.
-Assignment -> ObjectClassAssignment : '$1'.
-% later Assignment -> ObjectAssignment : '$1'.
-% combined with ValueAssignment Assignment -> ObjectAssignment : '$1'.
-Assignment -> ObjectSetAssignment : '$1'.
-Assignment -> ParameterizedTypeAssignment : '$1'.
-%Assignment -> ParameterizedValueAssignment : '$1'.
-%Assignment -> ParameterizedValueSetTypeAssignment : '$1'.
-%Assignment -> ParameterizedObjectClassAssignment : '$1'.
-
-ObjectClassAssignment -> typereference '::=' 'CLASS' '{' FieldSpecs '}' :
-%ObjectClassAssignment -> objectclassreference '::=' 'CLASS' '{' FieldSpecs '}' :
- #typedef{pos=element(2,'$1'),name=element(3,'$1'),typespec={'CLASS','$5',[]}}.
-ObjectClassAssignment -> typereference '::=' 'CLASS' '{' FieldSpecs '}' WithSyntaxSpec :
-%ObjectClassAssignment -> objectclassreference '::=' 'CLASS' '{' FieldSpecs '}' WithSyntaxSpec :
- #typedef{pos=element(2,'$1'),name=element(3,'$1'),typespec={'CLASS','$5','$7'}}.
-
-FieldSpecs -> FieldSpec : ['$1'].
-FieldSpecs -> FieldSpec ',' FieldSpecs : ['$1'|'$3'].
-
-FieldSpec -> typefieldreference TypeOptionalitySpec : {typefield,'$1','$2'}.
-
-FieldSpec -> valuefieldreference Type 'UNIQUE' ValueOrObjectOptSpec :
- {fixedtypevaluefield,'$1','$2','UNIQUE','$4'}.
-FieldSpec -> valuefieldreference Type ValueOrObjectOptSpec :
- {fixedtypevaluefield,'$1','$2',undefined,'$3'}.
-
-FieldSpec -> valuefieldreference typefieldreference ValueOrObjectOptSpec :
- {variabletypevaluefield, '$1','$2','$3'}.
-
-FieldSpec -> typefieldreference typefieldreference VSetOrOSetOptSpec :
- {variabletypevaluesetfield, '$1','$2','$3'}.
-
-FieldSpec -> typefieldreference Type VSetOrOSetOptSpec :
- {fixedtypevaluesetfield, '$1','$2','$3'}.
-
-TypeOptionalitySpec -> 'DEFAULT' Type : {'DEFAULT','$2'}.
-TypeOptionalitySpec -> 'OPTIONAL' : 'OPTIONAL'.
-TypeOptionalitySpec -> '$empty' : 'MANDATORY'.
-
-ValueOrObjectOptSpec -> ValueOptionalitySpec : '$1'.
-ValueOrObjectOptSpec -> ObjectOptionalitySpec : '$1'.
-ValueOrObjectOptSpec -> 'OPTIONAL' : 'OPTIONAL'.
-ValueOrObjectOptSpec -> '$empty' : 'MANDATORY'.
-
-ValueOptionalitySpec -> 'DEFAULT' Value :
- case '$2' of
- {identifier,_,Id} -> {'DEFAULT',Id};
- _ -> {'DEFAULT','$2'}
- end.
-
-%ObjectOptionalitySpec -> 'DEFAULT' Object :{'DEFAULT','$1'}.
-ObjectOptionalitySpec -> 'DEFAULT' '{' FieldSetting ',' FieldSettings '}' :
- {'DEFAULT',{object,['$2'|'$4']}}.
-ObjectOptionalitySpec -> 'DEFAULT' '{' FieldSetting '}' :
- {'DEFAULT',{object, ['$2']}}.
-%ObjectOptionalitySpec -> 'DEFAULT' '{' DefinedSyntaxTokens '}' :
-% {'DEFAULT',{object, '$2'}}.
-ObjectOptionalitySpec -> 'DEFAULT' ObjectFromObject :
- {'DEFAULT',{object, '$2'}}.
-
-
-VSetOrOSetOptSpec -> ValueSetOptionalitySpec : '$1'.
-%VSetOrOSetOptSpec -> ObjectSetOptionalitySpec : '$1'.
-VSetOrOSetOptSpec -> 'OPTIONAL' : 'OPTIONAL'.
-VSetOrOSetOptSpec -> '$empty' : 'MANDATORY'.
-
-ValueSetOptionalitySpec -> 'DEFAULT' ValueSet : {'DEFAULT','$1'}.
-
-%ObjectSetOptionalitySpec -> 'DEFAULT' ObjectSet : {'DEFAULT','$1'}.
-
-OptionalitySpec -> 'DEFAULT' Type : {'DEFAULT','$2'}.
-OptionalitySpec -> 'DEFAULT' ValueNotNull :
- case '$2' of
- {identifier,_,Id} -> {'DEFAULT',Id};
- _ -> {'DEFAULT','$2'}
- end.
-OptionalitySpec -> 'OPTIONAL' : 'OPTIONAL'.
-OptionalitySpec -> '$empty' : 'MANDATORY'.
-
-WithSyntaxSpec -> 'WITH' 'SYNTAX' SyntaxList : {'WITH SYNTAX','$3'}.
-
-SyntaxList -> '{' TokenOrGroupSpecs '}' : '$2'.
-SyntaxList -> '{' '}' : [].
-
-TokenOrGroupSpecs -> TokenOrGroupSpec : ['$1'].
-TokenOrGroupSpecs -> TokenOrGroupSpec TokenOrGroupSpecs : ['$1'|'$2'].
-
-TokenOrGroupSpec -> RequiredToken : '$1'.
-TokenOrGroupSpec -> OptionalGroup : '$1'.
-
-OptionalGroup -> '[' TokenOrGroupSpecs ']' : '$2'.
-
-RequiredToken -> typereference : '$1'.
-RequiredToken -> Word : '$1'.
-RequiredToken -> ',' : '$1'.
-RequiredToken -> PrimitiveFieldName : '$1'.
-
-Word -> 'BY' : 'BY'.
-
-ParameterizedTypeAssignment -> typereference ParameterList '::=' Type :
- #ptypedef{pos=element(2,'$1'),name=element(3,'$1'),
- args='$2', typespec='$4'}.
-
-ParameterList -> '{' Parameters '}':'$2'.
-
-Parameters -> Parameter: ['$1'].
-Parameters -> Parameter ',' Parameters: ['$1'|'$3'].
-
-Parameter -> typereference: '$1'.
-Parameter -> Value: '$1'.
-Parameter -> Type ':' typereference: {'$1','$3'}.
-Parameter -> Type ':' Value: {'$1','$3'}.
-Parameter -> '{' typereference '}': {objectset,'$2'}.
-
-
-% Externaltypereference -> modulereference '.' typereference : {'$1','$3'} .
-Externaltypereference -> typereference '.' typereference : #'Externaltypereference'{pos=element(2,'$1'),module=element(3,'$1'),type=element(3,'$3')}.
-
-% Externalvaluereference -> modulereference '.' valuereference : {'$1','$3'} .
-% inlined Externalvaluereference -> typereference '.' identifier : #'Externalvaluereference'{pos=element(2,'$1'),module=element(3,'$1'),value=element(3,'$3')}.
-
-
-DefinedType -> Externaltypereference : '$1' .
-DefinedType -> typereference :
- #'Externaltypereference'{pos='$1'#typereference.pos,
- module= get(asn1_module),
- type= '$1'#typereference.val} .
-DefinedType -> typereference ParameterList : {pt,'$1','$2'}.
-DefinedType -> Externaltypereference ParameterList : {pt,'$1','$2'}.
-
-% ActualParameterList -> '{' ActualParameters '}' : '$1'.
-
-% ActualParameters -> ActualParameter : ['$1'].
-% ActualParameters -> ActualParameter ',' ActualParameters : ['$1'|'$3'].
-
-ActualParameter -> Type : '$1'.
-ActualParameter -> ValueNotNull : '$1'.
-ActualParameter -> ValueSet : '$1'.
-% later DefinedType -> ParameterizedType : '$1' .
-% later DefinedType -> ParameterizedValueSetType : '$1' .
-
-% inlined DefinedValue -> Externalvaluereference :'$1'.
-% inlined DefinedValue -> identifier :'$1'.
-% later DefinedValue -> ParameterizedValue :'$1'.
-
-% not referenced yet AbsoluteReference -> '@' GlobalModuleReference '.' ItemSpec :{'$2','$4'}.
-
-% not referenced yet ItemSpec -> typereference :'$1'.
-% not referenced yet ItemSpec -> ItemId '.' ComponentId : {'$1','$3'}.
-
-% not referenced yet ItemId -> ItemSpec : '$1'.
-
-% not referenced yet ComponentId -> identifier :'$1'.
-% not referenced yet ComponentId -> number :'$1'.
-% not referenced yet ComponentId -> '*' :'$1'.
-
-TypeAssignment -> typereference '::=' Type :
- #typedef{pos=element(2,'$1'),name=element(3,'$1'),typespec='$3'}.
-
-ValueAssignment -> identifier Type '::=' Value :
- #valuedef{pos=element(2,'$1'),name=element(3,'$1'),type='$2',value='$4'}.
-
-% later ValueSetTypeAssignment -> typereference Type '::=' ValueSet :{'ValueSetTypeAssignment','$1','$2','$4'}.
-
-
-ValueSet -> '{' ElementSetSpec '}' : {valueset,'$2'}.
-
-% record(type,{tag,def,constraint}).
-Type -> BuiltinType :#type{def='$1'}.
-Type -> 'NULL' :#type{def='NULL'}.
-Type -> TaggedType:'$1'.
-Type -> ReferencedType:#type{def='$1'}. % change notag later
-Type -> ConstrainedType:'$1'.
-
-%ANY is here for compatibility with the old ASN.1 standard from 1988
-BuiltinType -> 'ANY' AnyDefBy:
- case '$2' of
- [] -> 'ANY';
- _ -> {'ANY DEFINED BY','$2'}
- end.
-BuiltinType -> BitStringType :'$1'.
-BuiltinType -> 'BOOLEAN' :element(1,'$1').
-BuiltinType -> CharacterStringType :'$1'.
-BuiltinType -> ChoiceType :'$1'.
-BuiltinType -> 'EMBEDDED' 'PDV' :'EMBEDDED PDV'.
-BuiltinType -> EnumeratedType :'$1'.
-BuiltinType -> 'EXTERNAL' :element(1,'$1').
-% later BuiltinType -> InstanceOfType :'$1'.
-BuiltinType -> IntegerType :'$1'.
-% BuiltinType -> 'NULL' :element(1,'$1').
-% later BuiltinType -> ObjectClassFieldType :'$1'.
-BuiltinType -> 'OBJECT' 'IDENTIFIER' :'OBJECT IDENTIFIER'.
-BuiltinType -> 'OCTET' 'STRING' :'OCTET STRING'.
-BuiltinType -> 'REAL' :element(1,'$1').
-BuiltinType -> SequenceType :'$1'.
-BuiltinType -> SequenceOfType :'$1'.
-BuiltinType -> SetType :'$1'.
-BuiltinType -> SetOfType :'$1'.
-% The so called Useful types
-BuiltinType -> 'GeneralizedTime': 'GeneralizedTime'.
-BuiltinType -> 'UTCTime' :'UTCTime'.
-BuiltinType -> 'ObjectDescriptor' : 'ObjectDescriptor'.
-
-% moved BuiltinType -> TaggedType :'$1'.
-
-
-AnyDefBy -> 'DEFINED' 'BY' identifier: '$3'.
-AnyDefBy -> '$empty': [].
-
-NamedType -> identifier Type :
-%{_,Pos,Val} = '$1',
-%{'NamedType',Pos,{Val,'$2'}}.
-V1 = '$1',
-{'NamedType',V1#identifier.pos,{V1#identifier.val,'$2'}}.
-NamedType -> SelectionType :'$1'.
-
-ReferencedType -> DefinedType : '$1'.
-% redundant ReferencedType -> UsefulType : 'fix'.
-ReferencedType -> SelectionType : '$1'.
-ReferencedType -> TypeFromObject : '$1'.
-% later ReferencedType -> ValueSetFromObjects : 'fix'.
-
-% to much conflicts Value -> AnyValue :'$1'.
-Value -> ValueNotNull : '$1'.
-Value -> 'NULL' :element(1,'$1').
-
-ValueNotNull -> BuiltinValue :'$1'.
-% inlined Value -> DefinedValue :'$1'. % DefinedValue , identifier
-% inlined Externalvaluereference -> Externalvaluereference :'$1'.
-ValueNotNull -> typereference '.' identifier :
- #'Externalvaluereference'{pos=element(2,'$1'),module=element(3,'$1'),
- value=element(3,'$3')}.
-ValueNotNull -> identifier :'$1'.
-
-
-%tmp Value -> NamedNumber: '$1'. % not a value but part of ObjIdC
-% redundant BuiltinValue -> BitStringValue :'$1'.
-BuiltinValue -> BooleanValue :'$1'.
-BuiltinValue -> CharacterStringValue :'$1'.
-BuiltinValue -> ChoiceValue :'$1'.
-% BuiltinValue -> EmbeddedPDVValue :'$1'. ==SequenceValue
-% BuiltinValue -> EnumeratedValue :'$1'. identifier
-% BuiltinValue -> ExternalValue :'$1'. ==SequenceValue
-% later BuiltinValue -> InstanceOfValue :'$1'.
-BuiltinValue -> SignedNumber :'$1'.
-% BuiltinValue -> 'NULL' :'$1'.
-% later BuiltinValue -> ObjectClassFieldValue :'$1'.
-% replaced by SAndSOfValue BuiltinValue -> ObjectIdentifierValue :'$1'.
-BuiltinValue -> bstring :element(3,'$1').
-BuiltinValue -> hstring :element(3,'$1').
-% conflict BuiltinValue -> RealValue :'$1'.
-BuiltinValue -> SAndSOfValue :'$1'.
-% replaced BuiltinValue -> SequenceOfValue :'$1'.
-% replaced BuiltinValue -> SequenceValue :'$1'.
-% replaced BuiltinValue -> SetValue :'$1'.
-% replaced BuiltinValue -> SetOfValue :'$1'.
-% conflict redundant BuiltinValue -> TaggedValue :'$1'.
-
-% inlined ReferencedValue -> DefinedValue:'$1'.
-% ReferencedValue -> Externalvaluereference:'$1'.
-% ReferencedValue -> identifier :'$1'.
-% later ReferencedValue -> ValueFromObject:'$1'.
-
-% inlined BooleanType -> BOOLEAN :'BOOLEAN'.
-
-% to much conflicts AnyValue -> Type ':' Value : {'ANYVALUE',{'$1','$3'}}.
-
-BooleanValue -> TRUE :true.
-BooleanValue -> FALSE :false.
-
-IntegerType -> 'INTEGER' : 'INTEGER'.
-IntegerType -> 'INTEGER' '{' NamedNumberList '}' : {'INTEGER','$3'}.
-
-NamedNumberList -> NamedNumber :['$1'].
-% modified NamedNumberList -> NamedNumberList ',' NamedNumber :'fix'.
-NamedNumberList -> NamedNumber ',' NamedNumberList :['$1'|'$3'].
-
-NamedNumber -> identifier '(' SignedNumber ')' : {'NamedNumber',element(3,'$1'),'$3'}.
-NamedNumber -> identifier '(' typereference '.' identifier ')' : {'NamedNumber',element(3,'$1'),{'ExternalValue',element(3,'$3'),element(3,'$5')}}.
-NamedNumber -> identifier '(' identifier ')' : {'NamedNumber',element(3,'$1'),element(3,'$3')}.
-
-%NamedValue -> identifier Value :
-% {'NamedValue',element(2,'$1'),element(3,'$1'),'$2'}.
-
-
-SignedNumber -> number : element(3,'$1').
-SignedNumber -> '-' number : - element(3,'$1').
-
-% inlined IntegerValue -> SignedNumber :'$1'.
-% conflict moved to Value IntegerValue -> identifier:'$1'.
-
-EnumeratedType -> ENUMERATED '{' Enumeration '}' :{'ENUMERATED','$3'}.
-
-% inlined Enumerations -> Enumeration :{'$1','false',[]}.
-% inlined Enumerations -> Enumeration ',' '...' : {'$1','true',[]}.
-% inlined Enumerations -> Enumeration ',' '...' ',' Enumeration : {'$1','true','$5'}.
-
-Enumeration -> EnumerationItem :['$1'].
-% modified Enumeration -> EnumerationItem ',' Enumeration :'fix'.
-Enumeration -> EnumerationItem ',' Enumeration :['$1'|'$3'].
-
-EnumerationItem -> identifier:element(3,'$1').
-EnumerationItem -> NamedNumber :'$1'.
-EnumerationItem -> '...' :'EXTENSIONMARK'.
-
-% conflict moved to Value EnumeratedValue -> identifier:'$1'.
-
-% inlined RealType -> REAL:'REAL'.
-
-RealValue -> NumericRealValue :'$1'.
-RealValue -> SpecialRealValue:'$1'.
-
-% ?? NumericRealValue -> number:'$1'. % number MUST BE '0'
-NumericRealValue -> SAndSOfValue : '$1'. % Value of the associated sequence type
-
-SpecialRealValue -> 'PLUS-INFINITY' :'$1'.
-SpecialRealValue -> 'MINUS-INFINITY' :'$1'.
-
-BitStringType -> 'BIT' 'STRING' :{'BIT STRING',[]}.
-BitStringType -> 'BIT' 'STRING' '{' NamedNumberList '}' :{'BIT STRING','$4'}.
-% NamedBitList replaced by NamedNumberList to reduce the grammar
-% Must check later that all "numbers" are positive
-
-% inlined BitStringValue -> bstring:'$1'.
-% inlined BitStringValue -> hstring:'$1'.
-% redundant use SequenceValue BitStringValue -> '{' IdentifierList '}' :$2.
-% redundant use SequenceValue BitStringValue -> '{' '}' :'fix'.
-
-IdentifierList -> identifier :[element(3,'$1')].
-% modified IdentifierList -> IdentifierList ',' identifier :'$1'.
-IdentifierList -> identifier ',' IdentifierList :[element(3,'$1')|'$3'].
-
-% inlined OctetStringType -> 'OCTET' 'STRING' :'OCTET STRING'.
-
-% inlined OctetStringValue -> bstring:'$1'.
-% inlined OctetStringValue -> hstring:'$1'.
-
-% inlined NullType -> 'NULL':'NULL'.
-
-% inlined NullValue -> NULL:'NULL'.
-
-% result is {'SEQUENCE',Optionals,Extensionmark,Componenttypelist}.
-SequenceType -> SEQUENCE '{' ComponentTypeList '}' :{'SEQUENCE','$3'}.
-% SequenceType -> SEQUENCE '{' ComponentTypeLists '}' :{'SEQUENCE','$3'}.
-% SequenceType -> SEQUENCE '{' ExtensionAndException '}' :{'SEQUENCE','$3'}.
-SequenceType -> SEQUENCE '{' '}' :{'SEQUENCE',[]}.
-
-% result is {RootComponentList,ExtensionAndException,AdditionalComponentTypeList}.
-%ComponentTypeLists -> ComponentTypeList ',' ExtensionAndException :{'$1','$3',[]}.
-%ComponentTypeLists -> ComponentTypeList :{'$1','false',[]}.
-%ComponentTypeLists -> ComponentTypeList ',' ExtensionAndException
-% ',' ComponentTypeList :{'$1','$3', '$5'}.
-%ComponentTypeLists -> ExtensionAndException ',' ComponentTypeList :{[],'$1','$3'}.
-
-ComponentTypeList -> ComponentType :['$1'].
-% modified below ComponentTypeList -> ComponentTypeList ',' ComponentType :'$1'.
-ComponentTypeList -> ComponentType ',' ComponentTypeList :['$1'|'$3'].
-
-% -record('ComponentType',{pos,name,type,attrib}).
-ComponentType -> '...' ExceptionSpec :{'EXTENSIONMARK',element(2,'$1'),'$2'}.
-ComponentType -> NamedType :
- {'NamedType',Pos,{Name,Type}} = '$1',
- #'ComponentType'{pos=Pos,name=Name,typespec=Type,prop=mandatory}.
-ComponentType -> NamedType 'OPTIONAL' :
- {'NamedType',Pos,{Name,Type}} = '$1',
- #'ComponentType'{pos=Pos,name=Name,typespec=Type,prop='OPTIONAL'}.
-ComponentType -> NamedType 'DEFAULT' Value:
- {'NamedType',Pos,{Name,Type}} = '$1',
- #'ComponentType'{pos=Pos,name=Name,typespec=Type,prop={'DEFAULT','$3'}}.
-ComponentType -> 'COMPONENTS' 'OF' Type :{'COMPONENTS OF','$3'}.
-
-% redundant ExtensionAndException -> '...' : extensionmark.
-% ExtensionAndException -> '...' ExceptionSpec : {extensionmark,'$2'}.
-
-% replaced SequenceValue -> '{' ComponentValueList '}':'$2'.
-% replaced SequenceValue -> '{' '}':[].
-
-ValueList -> Value :['$1'].
-ValueList -> NamedNumber :['$1'].
-% modified ValueList -> ValueList ',' Value :'$1'.
-ValueList -> Value ',' ValueList :['$1'|'$3'].
-ValueList -> Value ',' '...' :['$1' |[]].
-ValueList -> Value ValueList : ['$1',space|'$2'].
-ValueList -> NamedNumber ValueList: ['$1',space|'$2'].
-
-%ComponentValueList -> identifier ObjIdComponent:[{'NamedValue','$1','$2'}].
-%ComponentValueList -> NamedValue :['$1'].
-%ComponentValueList -> NamedValue ',' ComponentValueList:['$1'|'$3'].
-%ComponentValueList -> identifier ObjIdComponent ',' ComponentValueList :[{'NamedValue', '$1','$2'}|'$4'].
-
-SequenceOfType -> SEQUENCE OF Type : {'SEQUENCE OF','$3'}.
-
-% replaced SequenceOfValue with SAndSOfValue
-
-SAndSOfValue -> '{' ValueList '}' :'$2'.
-%SAndSOfValue -> '{' ComponentValueList '}' :'$2'.
-SAndSOfValue -> '{' '}' :[].
-
-% save for later SetType ->
-% result is {'SET',Optionals,Extensionmark,Componenttypelist}.
-SetType -> SET '{' ComponentTypeList '}' :{'SET','$3'}.
-% SetType -> SET '{' ExtensionAndException '}' :{'SET','$3'}.
-SetType -> SET '{' '}' :{'SET',[]}.
-
-% replaced SetValue with SAndSOfValue
-
-SetOfType -> SET OF Type : {'SET OF','$3'}.
-
-% replaced SetOfValue with SAndSOfValue
-
-ChoiceType -> 'CHOICE' '{' ComponentTypeList '}' :{'CHOICE','$3'}.
-% AlternativeTypeList is replaced by ComponentTypeList
-ChoiceValue -> identifier ':' Value : {'ChoiceValue',element(3,'$1'),'$3'}.
-% save for later SelectionType ->
-
-TaggedType -> Tag Type : '$2'#type{tag=['$1'#tag{type={default,get(tagdefault)}}]}.
-TaggedType -> Tag IMPLICIT Type :'$3'#type{tag=['$1'#tag{type='IMPLICIT'}]}.
-TaggedType -> Tag EXPLICIT Type :'$3'#type{tag=['$1'#tag{type='EXPLICIT'}]}.
-
-Tag -> '[' Class ClassNumber ']': #tag{class='$2',number='$3'}.
-Tag -> '[' Class typereference '.' identifier ']':
- #tag{class='$2',number=#'Externalvaluereference'{pos=element(2,'$3'),module=element(3,'$3'),
- value=element(3,'$5')}}.
-Tag -> '[' Class number ']': #tag{class='$2',number=element(3,'$3')}.
-Tag -> '[' Class identifier ']': #tag{class='$2',number=element(3,'$3')}.
-
-ClassNumber -> number :element(3,'$1').
-% inlined above ClassNumber -> typereference '.' identifier :{'Externalvaluereference',element(3,'$1'),element(3,'$3')}.
-ClassNumber -> identifier :element(3,'$1').
-
-Class -> 'UNIVERSAL' :element(1,'$1').
-Class -> 'APPLICATION' :element(1,'$1').
-Class -> 'PRIVATE' :element(1,'$1').
-Class -> '$empty' :'CONTEXT'.
-
-% conflict redundant TaggedValue -> Value:'$1'.
-
-% inlined EmbeddedPDVType -> 'EMBEDDED' 'PDV' :'EMBEDDED PDV'.
-
-% inlined EmbeddedPDVValue -> SequenceValue:'$1'.
-
-% inlined ExternalType -> 'EXTERNAL' :'EXTERNAL'.
-
-% inlined ExternalValue -> SequenceValue :'$1'.
-
-% inlined ObjectIdentifierType -> 'OBJECT' 'IDENTIFIER' :'OBJECT IDENTIFIER'.
-
-ObjectIdentifierValue -> '{' ObjIdComponentList '}' :'$2'.
-% inlined ObjectIdentifierValue -> SequenceAndSequenceOfValue :'$1'.
-% ObjectIdentifierValue -> '{' identifier ObjIdComponentList '}' :{'ObjectIdentifierValue','$2','$3'}.
-% ObjectIdentifierValue -> '{' typereference '.' identifier ObjIdComponentList '}' :{'ObjectIdentifierValue',{'$2','$4'},'$5'}.
-
-ObjIdComponentList -> Value:'$1'.
-ObjIdComponentList -> Value ObjIdComponentList :['$1'|'$2'].
-%ObjIdComponentList -> DefinedValue:'$1'.
-%ObjIdComponentList -> number:'$1'.
-%ObjIdComponentList -> DefinedValue ObjIdComponentList :['$1'|'$2'].
-%ObjIdComponentList -> number ObjIdComponentList :['$1'|'$2'].
-%ObjIdComponentList -> ObjIdComponent ObjIdComponentList :['$1'|'$2'].
-%ObjIdComponentList -> ObjIdComponent ObjIdComponentList :['$1'|'$2'].
-
-% redundant ObjIdComponent -> NameForm :'$1'. % expanded
-% replaced by 2 ObjIdComponent -> NumberForm :'$1'.
-% ObjIdComponent -> number :'$1'.
-% ObjIdComponent -> DefinedValue :'$1'. % means DefinedValue
-% ObjIdComponent -> NameAndNumberForm :'$1'.
-% ObjIdComponent -> NamedNumber :'$1'.
-% NamedBit replaced by NamedNumber to reduce grammar
-% must check later that "number" is positive
-
-% NameForm -> identifier:'$1'.
-
-% inlined NumberForm -> number :'$1'.
-% inlined NumberForm -> DefinedValue :'$1'.
-
-% replaced by NamedBit NameAndNumberForm -> identifier '(' NumberForm ')'.
-% NameAndNumberForm -> NamedBit:'$1'.
-
-
-CharacterStringType -> restrictedcharacterstringtype :element(3,'$1').
-CharacterStringType -> 'CHARACTER' 'STRING' :'CHARACTER STRING'.
-
-RestrictedCharacterStringValue -> cstring :element(3, '$1').
-% modified below RestrictedCharacterStringValue -> CharacterStringList :'$1'.
-% conflict vs BuiltinValue RestrictedCharacterStringValue -> SequenceAndSequenceOfValue :'$1'.
-RestrictedCharacterStringValue -> Quadruple :'$1'.
-RestrictedCharacterStringValue -> Tuple :'$1'.
-
-% redundant CharacterStringList -> '{' ValueList '}' :'$2'. % modified
-
-% redundant CharSyms -> CharsDefn :'$1'.
-% redundant CharSyms -> CharSyms ',' CharsDefn :['$1'|'$3'].
-
-% redundant CharsDefn -> cstring :'$1'.
-% temporary replaced see below CharsDefn -> DefinedValue :'$1'.
-% redundant CharsDefn -> Value :'$1'.
-
-Quadruple -> '{' number ',' number ',' number ',' number '}' :{'Quadruple','$2','$4','$6','$8'}.
-% {Group,Plane,Row,Cell}
-
-Tuple -> '{' number ',' number '}' :{'Tuple', '$2','$4'}.
-% {TableColumn,TableRow}
-
-% inlined UnrestrictedCharacterString -> 'CHARACTER' 'STRING' :'CHARACTER STRING'.
-
-CharacterStringValue -> RestrictedCharacterStringValue :'$1'.
-% conflict vs BuiltinValue CharacterStringValue -> SequenceValue :'$1'. % UnrestrictedCharacterStringValue
-
-% inlined UsefulType -> typereference :'$1'.
-
-SelectionType -> identifier '<' Type : {'SelectionType',element(3,'$1'),'$3'}.
-
-ConstrainedType -> Type Constraint :
- '$1'#type{constraint=merge_constraints(['$2'])}.
-ConstrainedType -> Type Constraint Constraint :
- '$1'#type{constraint=merge_constraints(['$2','$3'])}.
-ConstrainedType -> Type Constraint Constraint Constraint:
- '$1'#type{constraint=merge_constraints(['$2','$3','$4'])}.
-ConstrainedType -> Type Constraint Constraint Constraint Constraint:
- '$1'#type{constraint=merge_constraints(['$2','$3','$4','$5'])}.
-%ConstrainedType -> Type Constraint :'$1'#type{constraint='$2'}.
-%ConstrainedType -> Type Constraint :'$1'#type{constraint='$2'}.
-ConstrainedType -> TypeWithConstraint :'$1'.
-
-TypeWithConstraint -> 'SET' Constraint 'OF' Type :
- #type{def = {'SET OF','$4'},constraint=merge_constraints(['$2'])}.
-TypeWithConstraint -> 'SET' 'SIZE' Constraint 'OF' Type :
- #type{def = {'SET OF','$5'},constraint = merge_constraints([#constraint{c={'SizeConstraint','$3'#constraint.c}}])}.
-TypeWithConstraint -> 'SEQUENCE' Constraint 'OF' Type :
- #type{def = {'SEQUENCE OF','$4'},constraint =
- merge_constraints(['$2'])}.
-TypeWithConstraint -> 'SEQUENCE' 'SIZE' Constraint 'OF' Type :
- #type{def = {'SEQUENCE OF','$5'},constraint = merge_constraints([#constraint{c={'SizeConstraint','$3'#constraint.c}}])}.
-
-
-Constraint -> '(' ConstraintSpec ExceptionSpec ')' :
- #constraint{c='$2',e='$3'}.
-
-% inlined Constraint -> SubTypeConstraint :'$1'.
-ConstraintSpec -> ElementSetSpecs :'$1'.
-ConstraintSpec -> UserDefinedConstraint :'$1'.
-ConstraintSpec -> TableConstraint :'$1'.
-
-TableConstraint -> ComponentRelationConstraint : '$1'.
-TableConstraint -> ObjectSet : '$1'.
-%TableConstraint -> '{' typereference '}' :tableconstraint.
-
-ComponentRelationConstraint -> '{' typereference '}' '{' '@' ComponentIdList '}' : componentrelation.
-ComponentRelationConstraint -> '{' typereference '}' '{' '@' '.' ComponentIdList '}' : componentrelation.
-
-ComponentIdList -> identifier: ['$1'].
-ComponentIdList -> identifier '.' ComponentIdList: ['$1'| '$3'].
-
-
-% later ConstraintSpec -> GeneralConstraint :'$1'.
-
-% from X.682
-UserDefinedConstraint -> 'CONSTRAINED' 'BY' '{' '}' : {constrained_by,[]}.
-UserDefinedConstraint -> 'CONSTRAINED' 'BY'
- '{' UserDefinedConstraintParameters '}' : {constrained_by,'$4'}.
-
-UserDefinedConstraintParameters -> UserDefinedConstraintParameter : ['$1'].
-UserDefinedConstraintParameters ->
- UserDefinedConstraintParameter ','
- UserDefinedConstraintParameters: ['$1'|'$3'].
-
-UserDefinedConstraintParameter -> Type '.' ActualParameter : {'$1','$3'}.
-UserDefinedConstraintParameter -> ActualParameter : '$1'.
-
-
-
-ExceptionSpec -> '!' ExceptionIdentification : '$1'.
-ExceptionSpec -> '$empty' : undefined.
-
-ExceptionIdentification -> SignedNumber : '$1'.
-% inlined ExceptionIdentification -> DefinedValue : '$1'.
-ExceptionIdentification -> typereference '.' identifier :
- #'Externalvaluereference'{pos=element(2,'$1'),module=element(3,'$1'),
- value=element(3,'$1')}.
-ExceptionIdentification -> identifier :'$1'.
-ExceptionIdentification -> Type ':' Value : {'$1','$3'}.
-
-% inlined SubTypeConstraint -> ElementSetSpec
-
-ElementSetSpecs -> ElementSetSpec : '$1'.
-ElementSetSpecs -> ElementSetSpec ',' '...': {'$1',[]}.
-ElementSetSpecs -> '...' ',' ElementSetSpec : {[],'$3'}.
-ElementSetSpecs -> ElementSetSpec ',' '...' ',' ElementSetSpec : {'$1','$5'}.
-
-ElementSetSpec -> Unions : '$1'.
-ElementSetSpec -> 'ALL' Exclusions : {'ALL','$2'}.
-
-Unions -> Intersections : '$1'.
-Unions -> UElems UnionMark IntersectionElements :
- case {'$1','$3'} of
- {{'SingleValue',V1},{'SingleValue',V2}} ->
- {'SingleValue',ordsets:union(to_set(V1),to_set(V2))}
- end.
-
-UElems -> Unions :'$1'.
-
-Intersections -> IntersectionElements :'$1'.
-Intersections -> IElems IntersectionMark IntersectionElements :
- case {'$1','$3'} of
- {{'SingleValue',V1},{'SingleValue',V2}} ->
- {'SingleValue',ordsets:intersection(to_set(V1),to_set(V2))};
- {V1,V2} when list(V1) ->
- V1 ++ [V2];
- {V1,V2} ->
- [V1,V2]
- end.
-%Intersections -> IElems '^' IntersectionElements :{'INTERSECTION','$1','$3'}.
-%Intersections -> IElems 'INTERSECTION' IntersectionElements :{'INTERSECTION','$1','$3'}.
-
-IElems -> Intersections :'$1'.
-
-IntersectionElements -> Elements :'$1'.
-IntersectionElements -> Elems Exclusions :{'$1','$2'}.
-
-Elems -> Elements :'$1'.
-
-Exclusions -> 'EXCEPT' Elements :{'EXCEPT','$2'}.
-
-IntersectionMark -> 'INTERSECTION':'$1'.
-IntersectionMark -> '^':'$1'.
-UnionMark -> 'UNION':'$1'.
-UnionMark -> '|':'$1'.
-
-
-Elements -> SubTypeElements : '$1'.
-%Elements -> ObjectSetElements : '$1'.
-Elements -> '(' ElementSetSpec ')' : '$2'.
-Elements -> ReferencedType : '$1'.
-
-SubTypeElements -> ValueList : {'SingleValue','$1'}. % NOTE it must be a Value
-% The rule above modifyed only because of conflicts
-SubTypeElements -> 'INCLUDES' Type : {'ContainedSubType','$2'}.
-%not lalr1 if this is activated SubTypeElements -> Type : {'TypeConstraint','$1'}.
-SubTypeElements -> LowerEndpoint '..' UpperEndpoint : {'ValueRange',{'$1','$3'}}.
-SubTypeElements -> 'FROM' Constraint : {'PermittedAlphabet','$2'#constraint.c}.
-SubTypeElements -> 'SIZE' Constraint: {'SizeConstraint','$2'#constraint.c}.
-% later will introduce conflicts related to NULL SubTypeElements -> Type : {'TypeConstraint','$1'}.
-SubTypeElements -> 'WITH' 'COMPONENT' Constraint:{'WITH COMPONENT','$3'}.
-SubTypeElements -> 'WITH' 'COMPONENTS' '{' TypeConstraints '}':{'WITH COMPONENTS',{'FullSpecification','$4'}}.
-SubTypeElements -> 'WITH' 'COMPONENTS' '{' '...' ',' TypeConstraints '}' :{'WITH COMPONENTS',{'PartialSpecification','$3'}}.
-
-% inlined above InnerTypeConstraints ::=
-% inlined above SingleTypeConstraint::= Constraint
-% inlined above MultipleTypeConstraints ::= FullSpecification | PartialSpecification
-% inlined above FullSpecification ::= "{" TypeConstraints "}"
-% inlined above PartialSpecification ::= "{" "..." "," TypeConstraints "}"
-% TypeConstraints -> identifier : [{'NamedConstraint',element(3,'$1'),undefined,undefined}]. % is this really meaningful or allowed
-TypeConstraints -> NamedConstraint : ['$1'].
-TypeConstraints -> NamedConstraint ',' TypeConstraints : ['$1'|'$3'].
-TypeConstraints -> identifier : ['$1'].
-TypeConstraints -> identifier ',' TypeConstraints : ['$1'|'$3'].
-
-NamedConstraint -> identifier Constraint PresenceConstraint :{'NamedConstraint',element(3,'$1'),'$2','$3'}.
-NamedConstraint -> identifier Constraint :{'NamedConstraint',element(3,'$1'),'$2',undefined}.
-NamedConstraint -> identifier PresenceConstraint :{'NamedConstraint',element(3,'$1'),undefined,'$2'}.
-
-PresenceConstraint -> 'PRESENT' : 'PRESENT'.
-PresenceConstraint -> 'ABSENT' : 'ABSENT'.
-PresenceConstraint -> 'OPTIONAL' : 'OPTIONAL'.
-
-
-
-LowerEndpoint -> LowerEndValue :'$1'.
-%LowerEndpoint -> LowerEndValue '<':{gt,'$1'}.
-LowerEndpoint -> LowerEndValue '<':('$1'+1).
-
-UpperEndpoint -> UpperEndValue :'$1'.
-%UpperEndpoint -> '<' UpperEndValue :{lt,'$2'}.
-UpperEndpoint -> '<' UpperEndValue :('$2'-1).
-
-LowerEndValue -> Value :'$1'.
-LowerEndValue -> 'MIN' :'MIN'.
-
-UpperEndValue -> Value :'$1'.
-UpperEndValue -> 'MAX' :'MAX'.
-
-
-% X.681
-
-
-% X.681 chap 15
-
-%TypeFromObject -> ReferencedObjects '.' FieldName : {'$1','$3'}.
-TypeFromObject -> typereference '.' FieldName : {'$1','$3'}.
-
-ReferencedObjects -> typereference : '$1'.
-%ReferencedObjects -> ParameterizedObject
-%ReferencedObjects -> DefinedObjectSet
-%ReferencedObjects -> ParameterizedObjectSet
-
-FieldName -> typefieldreference : ['$1'].
-FieldName -> valuefieldreference : ['$1'].
-FieldName -> FieldName '.' FieldName : ['$1' | '$3'].
-
-PrimitiveFieldName -> typefieldreference : '$1'.
-PrimitiveFieldName -> valuefieldreference : '$1'.
-
-%ObjectSetAssignment -> typereference DefinedObjectClass '::=' ObjectSet: null.
-ObjectSetAssignment -> typereference typereference '::=' ObjectSet :
- #typedef{pos=element(2,'$1'),name=element(3,'$1'),typespec={'ObjectSet',element(3,'$2'), '$4'}}.
-ObjectSetAssignment -> typereference typereference '.' typereference '::=' ObjectSet.
-
-ObjectSet -> '{' ElementSetSpecs '}' : '$2'.
-ObjectSet -> '{' '...' '}' : ['EXTENSIONMARK'].
-
-%ObjectSetElements -> Object.
-% ObjectSetElements -> identifier : '$1'.
-%ObjectSetElements -> DefinedObjectSet.
-%ObjectSetElements -> ObjectSetFromObjects.
-%ObjectSetElements -> ParameterizedObjectSet.
-
-%ObjectAssignment -> identifier DefinedObjectClass '::=' Object.
-ObjectAssignment -> ValueAssignment.
-%ObjectAssignment -> identifier typereference '::=' Object.
-%ObjectAssignment -> identifier typereference '.' typereference '::=' Object.
-
-%Object -> DefinedObject: '$1'.
-%Object -> ExternalObjectReference: '$1'.%Object -> DefinedObject: '$1'.
-Object -> typereference '.' identifier: '$1'.%Object -> DefinedObject: '$1'.
-Object -> identifier: '$1'.%Object -> DefinedObject: '$1'.
-
-%Object -> ObjectDefn -> DefaultSyntax: '$1'.
-Object -> '{' FieldSetting ',' FieldSettings '}' : ['$2'|'$4'].
-Object -> '{' FieldSetting '}' :['$2'].
-
-%% For User-friendly notation
-%% Object -> ObjectDefn -> DefinedSyntax
-Object -> '{' '}'.
-Object -> '{' DefinedSyntaxTokens '}'.
-
-% later Object -> ParameterizedObject: '$1'. look in x.683
-
-%DefinedObject -> ExternalObjectReference: '$1'.
-%DefinedObject -> identifier: '$1'.
-
-DefinedObjectClass -> typereference.
-%DefinedObjectClass -> objectclassreference.
-DefinedObjectClass -> ExternalObjectClassReference.
-%DefinedObjectClass -> typereference '.' objectclassreference.
-%%DefinedObjectClass -> UsefulObjectClassReference.
-
-ExternalObjectReference -> typereference '.' identifier.
-ExternalObjectClassReference -> typereference '.' typereference.
-%%ExternalObjectClassReference -> typereference '.' objectclassreference.
-
-ObjectDefn -> DefaultSyntax: '$1'.
-%ObjectDefn -> DefinedSyntax: '$1'.
-
-ObjectFromObject -> ReferencedObjects '.' FieldName : {'ObjectFromObject','$1','$3'}.
-
-% later look in x.683 ParameterizedObject ->
-
-%DefaultSyntax -> '{' '}'.
-%DefaultSyntax -> '{' FieldSettings '}': '$2'.
-DefaultSyntax -> '{' FieldSetting ',' FieldSettings '}': '$2'.
-DefaultSyntax -> '{' FieldSetting '}': '$2'.
-
-FieldSetting -> PrimitiveFieldName Setting: {'$1','$2'}.
-
-FieldSettings -> FieldSetting ',' FieldSettings: ['$1'|'$3'].
-FieldSettings -> FieldSetting ',' FieldSettings: ['$1'|'$3'].
-FieldSettings -> FieldSetting: '$1'.
-
-%DefinedSyntax -> '{' '}'.
-DefinedSyntax -> '{' DefinedSyntaxTokens '}': '$2'.
-
-DefinedSyntaxTokens -> DefinedSyntaxToken: '$1'.
-DefinedSyntaxTokens -> DefinedSyntaxToken DefinedSyntaxTokens: ['$1'|'$2'].
-
-% expanded DefinedSyntaxToken -> Literal: '$1'.
-%DefinedSyntaxToken -> typereference: '$1'.
-DefinedSyntaxToken -> word: '$1'.
-DefinedSyntaxToken -> ',': '$1'.
-DefinedSyntaxToken -> Setting: '$1'.
-%DefinedSyntaxToken -> '$empty': nil .
-
-% Setting ::= Type|Value|ValueSet|Object|ObjectSet
-Setting -> Type: '$1'.
-%Setting -> Value: '$1'.
-%Setting -> ValueNotNull: '$1'.
-Setting -> BuiltinValue: '$1'.
-Setting -> ValueSet: '$1'.
-%Setting -> Object: '$1'.
-%Setting -> ExternalObjectReference.
-Setting -> typereference '.' identifier.
-Setting -> identifier.
-Setting -> ObjectDefn.
-
-Setting -> ObjectSet: '$1'.
-
-
-Erlang code.
-%%-author('[email protected]').
--copyright('Copyright (c) 1991-99 Ericsson Telecom AB').
--vsn('$Revision: 1.1 $').
--include("asn1_records.hrl").
-
-to_set(V) when list(V) ->
- ordsets:list_to_set(V);
-to_set(V) ->
- ordsets:list_to_set([V]).
-
-merge_constraints({Rlist,ExtList}) -> % extensionmarker in constraint
- {merge_constraints(Rlist,[],[]),
- merge_constraints(ExtList,[],[])};
-
-merge_constraints(Clist) ->
- merge_constraints(Clist, [], []).
-
-merge_constraints([Ch|Ct],Cacc, Eacc) ->
- NewEacc = case Ch#constraint.e of
- undefined -> Eacc;
- E -> [E|Eacc]
- end,
- merge_constraints(Ct,[fixup_constraint(Ch#constraint.c)|Cacc],NewEacc);
-
-merge_constraints([],Cacc,[]) ->
- lists:flatten(Cacc);
-merge_constraints([],Cacc,Eacc) ->
- lists:flatten(Cacc) ++ [{'Errors',Eacc}].
-
-fixup_constraint(C) ->
- case C of
- {'SingleValue',V} when list(V) ->
- [C,
- {'ValueRange',{lists:min(V),lists:max(V)}}];
- {'PermittedAlphabet',{'SingleValue',V}} when list(V) ->
- V2 = {'SingleValue',
- ordsets:list_to_set(lists:flatten(V))},
- {'PermittedAlphabet',V2};
- {'PermittedAlphabet',{'SingleValue',V}} ->
- V2 = {'SingleValue',[V]},
- {'PermittedAlphabet',V2};
- {'SizeConstraint',Sc} ->
- {'SizeConstraint',fixup_size_constraint(Sc)};
-
- List when list(List) ->
- [fixup_constraint(Xc)||Xc <- List];
- Other ->
- Other
- end.
-
-fixup_size_constraint({'ValueRange',{Lb,Ub}}) ->
- {Lb,Ub};
-fixup_size_constraint({{'ValueRange',R},[]}) ->
- {R,[]};
-fixup_size_constraint({[],{'ValueRange',R}}) ->
- {[],R};
-fixup_size_constraint({{'ValueRange',R1},{'ValueRange',R2}}) ->
- {R1,R2};
-fixup_size_constraint({'SingleValue',[Sv]}) ->
- fixup_size_constraint({'SingleValue',Sv});
-fixup_size_constraint({'SingleValue',L}) when list(L) ->
- ordsets:list_to_set(L);
-fixup_size_constraint({'SingleValue',L}) ->
- {L,L};
-fixup_size_constraint({C1,C2}) ->
- {fixup_size_constraint(C1), fixup_size_constraint(C2)}.
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_parser2.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_parser2.erl deleted file mode 100644 index 639dcc6622..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_parser2.erl +++ /dev/null @@ -1,2764 +0,0 @@ -%% ``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 2000, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id: asn1ct_parser2.erl,v 1.1 2008/12/17 09:53:30 mikpe Exp $ -%% --module(asn1ct_parser2). - --export([parse/1]). --include("asn1_records.hrl"). - -%% parse all types in module -parse(Tokens) -> - case catch parse_ModuleDefinition(Tokens) of - {'EXIT',Reason} -> - {error,{{undefined,get(asn1_module), - [internal,error,'when',parsing,module,definition,Reason]}, - hd(Tokens)}}; - {asn1_error,Reason} -> - {error,{Reason,hd(Tokens)}}; - {ModuleDefinition,Rest1} -> - {Types,Rest2} = parse_AssignmentList(Rest1), - case Rest2 of - [{'END',_}|_Rest3] -> - {ok,ModuleDefinition#module{typeorval = Types}}; - _ -> - {error,{{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'END']}, - hd(Rest2)}} - end - end. - -parse_ModuleDefinition([{typereference,L1,ModuleIdentifier}|Rest0]) -> - put(asn1_module,ModuleIdentifier), - {_DefinitiveIdentifier,Rest02} = - case Rest0 of - [{'{',_}|_Rest01] -> - parse_ObjectIdentifierValue(Rest0); - _ -> - {[],Rest0} - end, - Rest = case Rest02 of - [{'DEFINITIONS',_}|Rest03] -> - Rest03; - _ -> - throw({asn1_error,{get_line(hd(Rest02)),get(asn1_module), - [got,get_token(hd(Rest02)), - expected,'DEFINITIONS']}}) - end, - {TagDefault,Rest2} = - case Rest of - [{'EXPLICIT',_L3},{'TAGS',_L4}|Rest1] -> - put(tagdefault,'EXPLICIT'), {'EXPLICIT',Rest1}; - [{'IMPLICIT',_L3},{'TAGS',_L4}|Rest1] -> - put(tagdefault,'IMPLICIT'), {'IMPLICIT',Rest1}; - [{'AUTOMATIC',_L3},{'TAGS',_L4}|Rest1] -> - put(tagdefault,'AUTOMATIC'), {'AUTOMATIC',Rest1}; - Rest1 -> - put(tagdefault,'EXPLICIT'), {'EXPLICIT',Rest1} % The default - end, - {ExtensionDefault,Rest3} = - case Rest2 of - [{'EXTENSIBILITY',_L5}, {'IMPLIED',_L6}|Rest21] -> - {'IMPLIED',Rest21}; - _ -> {false,Rest2} - end, - case Rest3 of - [{'::=',_L7}, {'BEGIN',_L8}|Rest4] -> - {Exports, Rest5} = parse_Exports(Rest4), - {Imports, Rest6} = parse_Imports(Rest5), - {#module{ pos = L1, - name = ModuleIdentifier, - defid = [], % fix this - tagdefault = TagDefault, - extensiondefault = ExtensionDefault, - exports = Exports, - imports = Imports},Rest6}; - _ -> throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module), - [got,get_token(hd(Rest3)),expected,"::= BEGIN"]}}) - end; -parse_ModuleDefinition(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,typereference]}}). - -parse_Exports([{'EXPORTS',_L1},{';',_L2}|Rest]) -> - {{exports,[]},Rest}; -parse_Exports([{'EXPORTS',_L1}|Rest]) -> - {SymbolList,Rest2} = parse_SymbolList(Rest), - case Rest2 of - [{';',_}|Rest3] -> - {{exports,SymbolList},Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,';']}}) - end; -parse_Exports(Rest) -> - {{exports,all},Rest}. - -parse_SymbolList(Tokens) -> - parse_SymbolList(Tokens,[]). - -parse_SymbolList(Tokens,Acc) -> - {Symbol,Rest} = parse_Symbol(Tokens), - case Rest of - [{',',_L1}|Rest2] -> - parse_SymbolList(Rest2,[Symbol|Acc]); - Rest2 -> - {lists:reverse([Symbol|Acc]),Rest2} - end. - -parse_Symbol(Tokens) -> - parse_Reference(Tokens). - -parse_Reference([{typereference,L1,TrefName},{'{',_L2},{'}',_L3}|Rest]) -> -% {Tref,Rest}; - {tref2Exttref(L1,TrefName),Rest}; -parse_Reference([Tref1 = {typereference,_,_},{'.',_},Tref2 = {typereference,_,_}, - {'{',_L2},{'}',_L3}|Rest]) -> -% {{Tref1,Tref2},Rest}; - {{tref2Exttref(Tref1),tref2Exttref(Tref2)},Rest}; -parse_Reference([Tref = {typereference,_L1,_TrefName}|Rest]) -> - {tref2Exttref(Tref),Rest}; -parse_Reference([Vref = {identifier,_L1,_VName}|Rest]) -> - {identifier2Extvalueref(Vref),Rest}; -parse_Reference(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [typereference,identifier]]}}). - -parse_Imports([{'IMPORTS',_L1},{';',_L2}|Rest]) -> - {{imports,[]},Rest}; -parse_Imports([{'IMPORTS',_L1}|Rest]) -> - {SymbolsFromModuleList,Rest2} = parse_SymbolsFromModuleList(Rest), - case Rest2 of - [{';',_L2}|Rest3] -> - {{imports,SymbolsFromModuleList},Rest3}; - Rest3 -> - throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module), - [got,get_token(hd(Rest3)),expected,';']}}) - end; -parse_Imports(Tokens) -> - {{imports,[]},Tokens}. - -parse_SymbolsFromModuleList(Tokens) -> - parse_SymbolsFromModuleList(Tokens,[]). - -parse_SymbolsFromModuleList(Tokens,Acc) -> - {SymbolsFromModule,Rest} = parse_SymbolsFromModule(Tokens), - case (catch parse_SymbolsFromModule(Rest)) of - {Sl,_Rest2} when record(Sl,'SymbolsFromModule') -> - parse_SymbolsFromModuleList(Rest,[SymbolsFromModule|Acc]); - _ -> - {lists:reverse([SymbolsFromModule|Acc]),Rest} - end. - -parse_SymbolsFromModule(Tokens) -> - SetRefModuleName = - fun(N) -> - fun(X) when record(X,'Externaltypereference')-> - X#'Externaltypereference'{module=N}; - (X) when record(X,'Externalvaluereference')-> - X#'Externalvaluereference'{module=N} - end - end, - {SymbolList,Rest} = parse_SymbolList(Tokens), - case Rest of - %%How does this case correspond to x.680 ? - [{'FROM',_L1},Tref = {typereference,_,_},Ref={identifier,_L2,_Id},C={',',_}|Rest2] -> - {#'SymbolsFromModule'{symbols=SymbolList, - module=tref2Exttref(Tref)},[Ref,C|Rest2]}; - %%How does this case correspond to x.680 ? - [{'FROM',_L1},Tref = {typereference,_,_},{identifier,_L2,_Id}|Rest2] -> - {#'SymbolsFromModule'{symbols=SymbolList, - module=tref2Exttref(Tref)},Rest2}; - [{'FROM',_L1},Tref = {typereference,_,Name},Brace = {'{',_}|Rest2] -> - {_ObjIdVal,Rest3} = parse_ObjectIdentifierValue([Brace|Rest2]), % value not used yet, fix me - NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList), - {#'SymbolsFromModule'{symbols=NewSymbolList, - module=tref2Exttref(Tref)},Rest3}; - [{'FROM',_L1},Tref = {typereference,_,Name}|Rest2] -> - NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList), - {#'SymbolsFromModule'{symbols=NewSymbolList, - module=tref2Exttref(Tref)},Rest2}; - _ -> - throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), - [got,get_token(hd(Rest)),expected, - ['FROM typerefernece identifier ,', - 'FROM typereference identifier', - 'FROM typereference {', - 'FROM typereference']]}}) - end. - -parse_ObjectIdentifierValue([{'{',_}|Rest]) -> - parse_ObjectIdentifierValue(Rest,[]). - -parse_ObjectIdentifierValue([{number,_,Num}|Rest],Acc) -> - parse_ObjectIdentifierValue(Rest,[Num|Acc]); -parse_ObjectIdentifierValue([{identifier,_,Id},{'(',_}, {number,_,Num}, {')',_}|Rest],Acc) -> - parse_ObjectIdentifierValue(Rest,[{'NamedNumber',Id,Num}|Acc]); -parse_ObjectIdentifierValue([{identifier,_,Id},{'(',_}, {identifier,_,Id2}, {')',_}|Rest],Acc) -> - parse_ObjectIdentifierValue(Rest,[{'NamedNumber',Id,Id2}|Acc]); -parse_ObjectIdentifierValue([{identifier,_,Id},{'(',_}, {typereference,_,Tref},{'.',_},{identifier,_,Id2}, {')',_}|Rest],Acc) -> - parse_ObjectIdentifierValue(Rest,[{'NamedNumber',Id,{'ExternalValue',Tref,Id2}}|Acc]); -parse_ObjectIdentifierValue([Id = {identifier,_,_}|Rest],Acc) -> - parse_ObjectIdentifierValue(Rest,[identifier2Extvalueref(Id)|Acc]); -parse_ObjectIdentifierValue([{'}',_}|Rest],Acc) -> - {lists:reverse(Acc),Rest}; -parse_ObjectIdentifierValue([H|_T],_Acc) -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected, - ['{ some of the following }',number,'identifier ( number )', - 'identifier ( identifier )', - 'identifier ( typereference.identifier)',identifier]]}}). - -parse_AssignmentList(Tokens = [{'END',_}|_Rest]) -> - {[],Tokens}; -parse_AssignmentList(Tokens = [{'$end',_}|_Rest]) -> - {[],Tokens}; -parse_AssignmentList(Tokens) -> - parse_AssignmentList(Tokens,[]). - -parse_AssignmentList(Tokens= [{'END',_}|_Rest],Acc) -> - {lists:reverse(Acc),Tokens}; -parse_AssignmentList(Tokens= [{'$end',_}|_Rest],Acc) -> - {lists:reverse(Acc),Tokens}; -parse_AssignmentList(Tokens,Acc) -> - case (catch parse_Assignment(Tokens)) of - {'EXIT',Reason} -> - exit(Reason); - {asn1_error,R} -> -% [H|T] = Tokens, - throw({error,{R,hd(Tokens)}}); - {Assignment,Rest} -> - parse_AssignmentList(Rest,[Assignment|Acc]) - end. - -parse_Assignment(Tokens) -> - Flist = [fun parse_TypeAssignment/1, - fun parse_ValueAssignment/1, - fun parse_ObjectClassAssignment/1, - fun parse_ObjectAssignment/1, - fun parse_ObjectSetAssignment/1, - fun parse_ParameterizedAssignment/1, - fun parse_ValueSetTypeAssignment/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - {asn1_assignment_error,Reason} -> - throw({asn1_error,Reason}); - Result -> - Result - end. - - -parse_or(Tokens,Flist) -> - parse_or(Tokens,Flist,[]). - -parse_or(_Tokens,[],ErrList) -> - case ErrList of - [] -> - throw({asn1_error,{parse_or,ErrList}}); - L when list(L) -> -%%% throw({asn1_error,{parse_or,hd(lists:reverse(ErrList))}}); - %% chose to throw 1) the error with the highest line no, - %% 2) the last error which is not a asn1_assignment_error or - %% 3) the last error. - throw(prioritize_error(ErrList)); - Other -> - throw({asn1_error,{parse_or,Other}}) - end; -parse_or(Tokens,[Fun|Frest],ErrList) -> - case (catch Fun(Tokens)) of - Exit = {'EXIT',_Reason} -> - parse_or(Tokens,Frest,[Exit|ErrList]); - AsnErr = {asn1_error,_} -> - parse_or(Tokens,Frest,[AsnErr|ErrList]); - AsnAssErr = {asn1_assignment_error,_} -> - parse_or(Tokens,Frest,[AsnAssErr|ErrList]); - Result = {_,L} when list(L) -> - Result; -% Result -> -% Result - Error -> - parse_or(Tokens,Frest,[Error|ErrList]) - end. - -parse_TypeAssignment([{typereference,L1,Tref},{'::=',_}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - {#typedef{pos=L1,name=Tref,typespec=Type},Rest2}; -parse_TypeAssignment([H1,H2|_Rest]) -> - throw({asn1_assignment_error,{get_line(H1),get(asn1_module), - [got,[get_token(H1),get_token(H2)], expected, - typereference,'::=']}}); -parse_TypeAssignment([H|_T]) -> - throw({asn1_assignment_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected, - typereference]}}). - -parse_Type(Tokens) -> - {Tag,Rest3} = case Tokens of - [Lbr= {'[',_}|Rest] -> - parse_Tag([Lbr|Rest]); - Rest-> {[],Rest} - end, - {Tag2,Rest4} = case Rest3 of - [{'IMPLICIT',_}|Rest31] when record(Tag,tag)-> - {[Tag#tag{type='IMPLICIT'}],Rest31}; - [{'EXPLICIT',_}|Rest31] when record(Tag,tag)-> - {[Tag#tag{type='EXPLICIT'}],Rest31}; - Rest31 when record(Tag,tag) -> - {[Tag#tag{type={default,get(tagdefault)}}],Rest31}; - Rest31 -> - {Tag,Rest31} - end, - Flist = [fun parse_BuiltinType/1,fun parse_ReferencedType/1,fun parse_TypeWithConstraint/1], - {Type,Rest5} = case (catch parse_or(Rest4,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_Reason} -> - throw(AsnErr); - Result -> - Result - end, - case hd(Rest5) of - {'(',_} -> - {Constraints,Rest6} = parse_Constraints(Rest5), - if record(Type,type) -> - {Type#type{constraint=merge_constraints(Constraints), - tag=Tag2},Rest6}; - true -> - {#type{def=Type,constraint=merge_constraints(Constraints), - tag=Tag2},Rest6} - end; - _ -> - if record(Type,type) -> - {Type#type{tag=Tag2},Rest5}; - true -> - {#type{def=Type,tag=Tag2},Rest5} - end - end. - -parse_BuiltinType([{'BIT',_},{'STRING',_}|Rest]) -> - case Rest of - [{'{',_}|Rest2] -> - {NamedNumberList,Rest3} = parse_NamedNumberList(Rest2), - case Rest3 of - [{'}',_}|Rest4] -> - {#type{def={'BIT STRING',NamedNumberList}},Rest4}; - _ -> - throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module), - [got,get_token(hd(Rest3)),expected,'}']}}) - end; - _ -> - {{'BIT STRING',[]},Rest} - end; -parse_BuiltinType([{'BOOLEAN',_}|Rest]) -> - {#type{def='BOOLEAN'},Rest}; -%% CharacterStringType ::= RestrictedCharacterStringType | -%% UnrestrictedCharacterStringType -parse_BuiltinType([{restrictedcharacterstringtype,_,StringName}|Rest]) -> - {#type{def=StringName},Rest}; -parse_BuiltinType([{'CHARACTER',_},{'STRING',_}|Rest]) -> - {#type{def='CHARACTER STRING'},Rest}; - -parse_BuiltinType([{'CHOICE',_},{'{',_}|Rest]) -> - {AlternativeTypeLists,Rest2} = parse_AlternativeTypeLists(Rest), - case Rest2 of - [{'}',_}|Rest3] -> - {#type{def={'CHOICE',AlternativeTypeLists}},Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) - end; -parse_BuiltinType([{'EMBEDDED',_},{'PDV',_}|Rest]) -> - {#type{def='EMBEDDED PDV'},Rest}; -parse_BuiltinType([{'ENUMERATED',_},{'{',_}|Rest]) -> - {Enumerations,Rest2} = parse_Enumerations(Rest), - case Rest2 of - [{'}',_}|Rest3] -> - {#type{def={'ENUMERATED',Enumerations}},Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) - end; -parse_BuiltinType([{'EXTERNAL',_}|Rest]) -> - {#type{def='EXTERNAL'},Rest}; - -% InstanceOfType -parse_BuiltinType([{'INSTANCE',_},{'OF',_}|Rest]) -> - {DefinedObjectClass,Rest2} = parse_DefinedObjectClass(Rest), - case Rest2 of - [{'(',_}|_] -> - {Constraint,Rest3} = parse_Constraint(Rest2), - {#type{def={'INSTANCE OF',DefinedObjectClass,Constraint}},Rest3}; - _ -> - {#type{def={'INSTANCE OF',DefinedObjectClass,[]}},Rest2} - end; - -% parse_BuiltinType(Tokens) -> - -parse_BuiltinType([{'INTEGER',_}|Rest]) -> - case Rest of - [{'{',_}|Rest2] -> - {NamedNumberList,Rest3} = parse_NamedNumberList(Rest2), - case Rest3 of - [{'}',_}|Rest4] -> - {#type{def={'INTEGER',NamedNumberList}},Rest4}; - _ -> - throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module), - [got,get_token(hd(Rest3)),expected,'}']}}) - end; - _ -> - {#type{def='INTEGER'},Rest} - end; -parse_BuiltinType([{'NULL',_}|Rest]) -> - {#type{def='NULL'},Rest}; - -% ObjectClassFieldType fix me later - -parse_BuiltinType([{'OBJECT',_},{'IDENTIFIER',_}|Rest]) -> - {#type{def='OBJECT IDENTIFIER'},Rest}; -parse_BuiltinType([{'OCTET',_},{'STRING',_}|Rest]) -> - {#type{def='OCTET STRING'},Rest}; -parse_BuiltinType([{'REAL',_}|Rest]) -> - {#type{def='REAL'},Rest}; -parse_BuiltinType([{'SEQUENCE',_},{'{',_},{'...',Line},{'}',_}|Rest]) -> - {#type{def=#'SEQUENCE'{components=[{'EXTENSIONMARK',Line,undefined}]}}, - Rest}; -parse_BuiltinType([{'SEQUENCE',_},{'{',_},{'...',Line},{'!',_}|Rest]) -> - {ExceptionIdentification,Rest2} = parse_ExceptionIdentification(Rest), - case Rest2 of - [{'}',_}|Rest3] -> - {#type{def=#'SEQUENCE'{components=[{'EXTENSIONMARK', - Line, - ExceptionIdentification}]}}, - Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) - end; -parse_BuiltinType([{'SEQUENCE',_},{'{',_}|Rest]) -> - {ComponentTypeLists,Rest2} = parse_ComponentTypeLists(Rest), - case Rest2 of - [{'}',_}|Rest3] -> - {#type{def=#'SEQUENCE'{components=ComponentTypeLists}},Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) - end; -parse_BuiltinType([{'SEQUENCE',_},{'OF',_}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - {#type{def={'SEQUENCE OF',Type}},Rest2}; - - -parse_BuiltinType([{'SET',_},{'{',_},{'...',Line},{'}',_}|Rest]) -> - {#type{def=#'SET'{components=[{'EXTENSIONMARK',Line,undefined}]}},Rest}; -parse_BuiltinType([{'SET',_},{'{',_},{'...',Line},{'!',_}|Rest]) -> - {ExceptionIdentification,Rest2} = parse_ExceptionIdentification(Rest), - case Rest2 of - [{'}',_}|Rest3] -> - {#type{def=#'SET'{components= - [{'EXTENSIONMARK',Line,ExceptionIdentification}]}}, - Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) - end; -parse_BuiltinType([{'SET',_},{'{',_}|Rest]) -> - {ComponentTypeLists,Rest2} = parse_ComponentTypeLists(Rest), - case Rest2 of - [{'}',_}|Rest3] -> - {#type{def=#'SET'{components=ComponentTypeLists}},Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) - end; -parse_BuiltinType([{'SET',_},{'OF',_}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - {#type{def={'SET OF',Type}},Rest2}; - -%% The so called Useful types -parse_BuiltinType([{'GeneralizedTime',_}|Rest]) -> - {#type{def='GeneralizedTime'},Rest}; -parse_BuiltinType([{'UTCTime',_}|Rest]) -> - {#type{def='UTCTime'},Rest}; -parse_BuiltinType([{'ObjectDescriptor',_}|Rest]) -> - {#type{def='ObjectDescriptor'},Rest}; - -%% For compatibility with old standard -parse_BuiltinType([{'ANY',_},{'DEFINED',_},{'BY',_},{identifier,_,Id}|Rest]) -> - {#type{def={'ANY_DEFINED_BY',Id}},Rest}; -parse_BuiltinType([{'ANY',_}|Rest]) -> - {#type{def='ANY'},Rest}; - -parse_BuiltinType(Tokens) -> - parse_ObjectClassFieldType(Tokens). -% throw({asn1_error,unhandled_type}). - - -parse_TypeWithConstraint([{'SEQUENCE',_},Lpar = {'(',_}|Rest]) -> - {Constraint,Rest2} = parse_Constraint([Lpar|Rest]), - case Rest2 of - [{'OF',_}|Rest3] -> - {Type,Rest4} = parse_Type(Rest3), - {#type{def = {'SEQUENCE OF',Type}, constraint = merge_constraints([Constraint])},Rest4}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'OF']}}) - end; -parse_TypeWithConstraint([{'SEQUENCE',_},{'SIZE',_},Lpar = {'(',_}|Rest]) -> - {Constraint,Rest2} = parse_Constraint([Lpar|Rest]), - Constraint2 = - case Constraint of - #constraint{c=C} -> - Constraint#constraint{c={'SizeConstraint',C}}; - _ -> Constraint - end, - case Rest2 of - [{'OF',_}|Rest3] -> - {Type,Rest4} = parse_Type(Rest3), - {#type{def = {'SEQUENCE OF',Type}, constraint = merge_constraints([Constraint2])},Rest4}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'OF']}}) - end; -parse_TypeWithConstraint([{'SET',_},Lpar = {'(',_}|Rest]) -> - {Constraint,Rest2} = parse_Constraint([Lpar|Rest]), - case Rest2 of - [{'OF',_}|Rest3] -> - {Type,Rest4} = parse_Type(Rest3), - {#type{def = {'SET OF',Type}, constraint = merge_constraints([Constraint])},Rest4}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'OF']}}) - end; -parse_TypeWithConstraint([{'SET',_},{'SIZE',_},Lpar = {'(',_}|Rest]) -> - {Constraint,Rest2} = parse_Constraint([Lpar|Rest]), - Constraint2 = - case Constraint of - #constraint{c=C} -> - Constraint#constraint{c={'SizeConstraint',C}}; - _ -> Constraint - end, - case Rest2 of - [{'OF',_}|Rest3] -> - {Type,Rest4} = parse_Type(Rest3), - {#type{def = {'SET OF',Type}, constraint = merge_constraints([Constraint2])},Rest4}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'OF']}}) - end; -parse_TypeWithConstraint(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - ['SEQUENCE','SEQUENCE SIZE','SET','SET SIZE'], - followed,by,a,constraint]}}). - - -%% -------------------------- - -parse_ReferencedType(Tokens) -> - Flist = [fun parse_DefinedType/1, - fun parse_SelectionType/1, - fun parse_TypeFromObject/1, - fun parse_ValueSetFromObjects/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_DefinedType(Tokens=[{typereference,_,_},{'{',_}|_Rest]) -> - parse_ParameterizedType(Tokens); -parse_DefinedType(Tokens=[{typereference,L1,TypeName}, - T2={typereference,_,_},T3={'{',_}|Rest]) -> - case (catch parse_ParameterizedType(Tokens)) of - {'EXIT',_Reason} -> - Rest2 = [T2,T3|Rest], - {#type{def = #'Externaltypereference'{pos=L1, - module=get(asn1_module), - type=TypeName}},Rest2}; - {asn1_error,_} -> - Rest2 = [T2,T3|Rest], - {#type{def = #'Externaltypereference'{pos=L1, - module=get(asn1_module), - type=TypeName}},Rest2}; - Result -> - Result - end; -parse_DefinedType([{typereference,L1,Module},{'.',_},{typereference,_,TypeName}|Rest]) -> - {#type{def = #'Externaltypereference'{pos=L1,module=Module,type=TypeName}},Rest}; -parse_DefinedType([{typereference,L1,TypeName}|Rest]) -> - {#type{def = #'Externaltypereference'{pos=L1,module=get(asn1_module), - type=TypeName}},Rest}; -parse_DefinedType(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [typereference,'typereference.typereference', - 'typereference typereference']]}}). - -parse_SelectionType([{identifier,_,Name},{'<',_}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - {{'SelectionType',Name,Type},Rest2}; -parse_SelectionType(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'identifier <']}}). - - -%% -------------------------- - - -%% This should probably be removed very soon -% parse_ConstrainedType(Tokens) -> -% case (catch parse_TypeWithConstraint(Tokens)) of -% {'EXIT',Reason} -> -% {Type,Rest} = parse_Type(Tokens), -% {Constraint,Rest2} = parse_Constraint(Rest), -% {Type#type{constraint=Constraint},Rest2}; -% {asn1_error,Reason2} -> -% {Type,Rest} = parse_Type(Tokens), -% {Constraint,Rest2} = parse_Constraint(Rest), -% {Type#type{constraint=Constraint},Rest2}; -% Result -> -% Result -% end. - -parse_Constraints(Tokens) -> - parse_Constraints(Tokens,[]). - -parse_Constraints(Tokens,Acc) -> - {Constraint,Rest} = parse_Constraint(Tokens), - case Rest of - [{'(',_}|_Rest2] -> - parse_Constraints(Rest,[Constraint|Acc]); - _ -> - {lists:reverse([Constraint|Acc]),Rest} - end. - -parse_Constraint([{'(',_}|Rest]) -> - {Constraint,Rest2} = parse_ConstraintSpec(Rest), - {Exception,Rest3} = parse_ExceptionSpec(Rest2), - case Rest3 of - [{')',_}|Rest4] -> - {#constraint{c=Constraint,e=Exception},Rest4}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,')']}}) - end; -parse_Constraint(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'(']}}). - -parse_ConstraintSpec(Tokens) -> - Flist = [fun parse_GeneralConstraint/1, - fun parse_SubtypeConstraint/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - {asn1_error,Reason2} -> - throw({asn1_error,Reason2}); - Result -> - Result - end. - -parse_ExceptionSpec([LPar={')',_}|Rest]) -> - {undefined,[LPar|Rest]}; -parse_ExceptionSpec([{'!',_}|Rest]) -> - parse_ExceptionIdentification(Rest); -parse_ExceptionSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,[')','!']]}}). - -parse_ExceptionIdentification(Tokens) -> - Flist = [fun parse_SignedNumber/1, - fun parse_DefinedValue/1, - fun parse_TypeColonValue/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - {asn1_error,Reason2} -> - throw({asn1_error,Reason2}); - Result -> - Result - end. - -parse_TypeColonValue(Tokens) -> - {Type,Rest} = parse_Type(Tokens), - case Rest of - [{':',_}|Rest2] -> - {Value,Rest3} = parse_Value(Rest2), - {{Type,Value},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,':']}}) - end. - -parse_SubtypeConstraint(Tokens) -> - parse_ElementSetSpecs(Tokens). - -parse_ElementSetSpecs([{'...',_}|Rest]) -> - {Elements,Rest2} = parse_ElementSetSpec(Rest), - {{[],Elements},Rest2}; -parse_ElementSetSpecs(Tokens) -> - {RootElems,Rest} = parse_ElementSetSpec(Tokens), - case Rest of - [{',',_},{'...',_},{',',_}|Rest2] -> - {AdditionalElems,Rest3} = parse_ElementSetSpec(Rest2), - {{RootElems,AdditionalElems},Rest3}; - [{',',_},{'...',_}|Rest2] -> - {{RootElems,[]},Rest2}; - _ -> - {RootElems,Rest} - end. - -parse_ElementSetSpec([{'ALL',_},{'EXCEPT',_}|Rest]) -> - {Exclusions,Rest2} = parse_Elements(Rest), - {{'ALL',{'EXCEPT',Exclusions}},Rest2}; -parse_ElementSetSpec(Tokens) -> - parse_Unions(Tokens). - - -parse_Unions(Tokens) -> - {InterSec,Rest} = parse_Intersections(Tokens), - {Unions,Rest2} = parse_UnionsRec(Rest), - case {InterSec,Unions} of - {InterSec,[]} -> - {InterSec,Rest2}; - {{'SingleValue',V1},{'SingleValue',V2}} -> - {{'SingleValue',ordsets:union(to_set(V1),to_set(V2))},Rest2}; - {V1,V2} when list(V2) -> - {[V1] ++ [union|V2],Rest2}; - {V1,V2} -> - {[V1,union,V2],Rest2} -% Other -> -% throw(Other) - end. - -parse_UnionsRec([{'|',_}|Rest]) -> - {InterSec,Rest2} = parse_Intersections(Rest), - {URec,Rest3} = parse_UnionsRec(Rest2), - case {InterSec,URec} of - {V1,[]} -> - {V1,Rest3}; - {{'SingleValue',V1},{'SingleValue',V2}} -> - {{'SingleValue',ordsets:union(to_set(V1),to_set(V2))},Rest3}; - {V1,V2} when list(V2) -> - {[V1] ++ V2,Rest3}; - {V1,V2} -> - {[V1,V2],Rest3} - end; -parse_UnionsRec([{'UNION',_}|Rest]) -> - {InterSec,Rest2} = parse_Intersections(Rest), - {URec,Rest3} = parse_UnionsRec(Rest2), - case {InterSec,URec} of - {V1,[]} -> - {V1,Rest3}; - {{'SingleValue',V1},{'SingleValue',V2}} -> - {{'SingleValue',ordsets:union(to_set(V1),to_set(V2))},Rest3}; - {V1,V2} when list(V2) -> - {[V1] ++ V2,Rest3}; - {V1,V2} -> - {[V1,V2],Rest3} - end; -parse_UnionsRec(Tokens) -> - {[],Tokens}. - -parse_Intersections(Tokens) -> - {InterSec,Rest} = parse_IntersectionElements(Tokens), - {IRec,Rest2} = parse_IElemsRec(Rest), - case {InterSec,IRec} of - {V1,[]} -> - {V1,Rest2}; - {{'SingleValue',V1},{'SingleValue',V2}} -> - {{'SingleValue', - ordsets:intersection(to_set(V1),to_set(V2))},Rest2}; - {V1,V2} when list(V2) -> - {[V1] ++ [intersection|V2],Rest2}; - {V1,V2} -> - {[V1,intersection,V2],Rest2}; - _ -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'a Union']}}) - end. - -parse_IElemsRec([{'^',_}|Rest]) -> - {InterSec,Rest2} = parse_IntersectionElements(Rest), - {IRec,Rest3} = parse_IElemsRec(Rest2), - case {InterSec,IRec} of - {{'SingleValue',V1},{'SingleValue',V2}} -> - {{'SingleValue', - ordsets:intersection(to_set(V1),to_set(V2))},Rest3}; - {V1,[]} -> - {V1,Rest3}; - {V1,V2} when list(V2) -> - {[V1] ++ V2,Rest3}; - {V1,V2} -> - {[V1,V2],Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), - [got,get_token(hd(Rest)),expected,'an Intersection']}}) - end; -parse_IElemsRec([{'INTERSECTION',_}|Rest]) -> - {InterSec,Rest2} = parse_IntersectionElements(Rest), - {IRec,Rest3} = parse_IElemsRec(Rest2), - case {InterSec,IRec} of - {{'SingleValue',V1},{'SingleValue',V2}} -> - {{'SingleValue', - ordsets:intersection(to_set(V1),to_set(V2))},Rest3}; - {V1,[]} -> - {V1,Rest3}; - {V1,V2} when list(V2) -> - {[V1] ++ V2,Rest3}; - {V1,V2} -> - {[V1,V2],Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), - [got,get_token(hd(Rest)),expected,'an Intersection']}}) - end; -parse_IElemsRec(Tokens) -> - {[],Tokens}. - -parse_IntersectionElements(Tokens) -> - {InterSec,Rest} = parse_Elements(Tokens), - case Rest of - [{'EXCEPT',_}|Rest2] -> - {Exclusion,Rest3} = parse_Elements(Rest2), - {{InterSec,{'EXCEPT',Exclusion}},Rest3}; - Rest -> - {InterSec,Rest} - end. - -parse_Elements([{'(',_}|Rest]) -> - {Elems,Rest2} = parse_ElementSetSpec(Rest), - case Rest2 of - [{')',_}|Rest3] -> - {Elems,Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,')']}}) - end; -parse_Elements(Tokens) -> - Flist = [fun parse_SubtypeElements/1, - fun parse_ObjectSetElements/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - Err = {asn1_error,_} -> - throw(Err); - Result -> - Result - end. - - - - -%% -------------------------- - -parse_DefinedObjectClass([{typereference,_,_ModName},{'.',_},Tr={typereference,_,_ObjClName}|Rest]) -> -%% {{objectclassname,ModName,ObjClName},Rest}; -% {{objectclassname,tref2Exttref(Tr)},Rest}; - {tref2Exttref(Tr),Rest}; -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, - ['typereference . typereference', - typereference, - 'TYPE-IDENTIFIER', - 'ABSTRACT-SYNTAX']]}}). - -parse_ObjectClassAssignment([{typereference,L1,ObjClName},{'::=',_}|Rest]) -> - {Type,Rest2} = parse_ObjectClass(Rest), - {#classdef{pos=L1,name=ObjClName,typespec=Type},Rest2}; -parse_ObjectClassAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - 'typereference ::=']}}). - -parse_ObjectClass(Tokens) -> - Flist = [fun parse_DefinedObjectClass/1, - fun parse_ObjectClassDefn/1, - fun parse_ParameterizedObjectClass/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - {asn1_error,Reason2} -> - throw({asn1_error,Reason2}); - Result -> - Result - end. - -parse_ObjectClassDefn([{'CLASS',_},{'{',_}|Rest]) -> - {Type,Rest2} = parse_FieldSpec(Rest), - {WithSyntaxSpec,Rest3} = parse_WithSyntaxSpec(Rest2), - {#objectclass{fields=Type,syntax=WithSyntaxSpec},Rest3}; -parse_ObjectClassDefn(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'CLASS {']}}). - -parse_FieldSpec(Tokens) -> - parse_FieldSpec(Tokens,[]). - -parse_FieldSpec(Tokens,Acc) -> - Flist = [fun parse_FixedTypeValueFieldSpec/1, - fun parse_VariableTypeValueFieldSpec/1, - fun parse_ObjectFieldSpec/1, - fun parse_FixedTypeValueSetFieldSpec/1, - fun parse_VariableTypeValueSetFieldSpec/1, - fun parse_TypeFieldSpec/1, - fun parse_ObjectSetFieldSpec/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - {Type,[{'}',_}|Rest]} -> - {lists:reverse([Type|Acc]),Rest}; - {Type,[{',',_}|Rest2]} -> - parse_FieldSpec(Rest2,[Type|Acc]); - {_,[H|_T]} -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'}']}}) - end. - -parse_PrimitiveFieldName([{typefieldreference,_,FieldName}|Rest]) -> - {{typefieldreference,FieldName},Rest}; -parse_PrimitiveFieldName([{valuefieldreference,_,FieldName}|Rest]) -> - {{valuefieldreference,FieldName},Rest}; -parse_PrimitiveFieldName(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [typefieldreference,valuefieldreference]]}}). - -parse_FieldName(Tokens) -> - {Field,Rest} = parse_PrimitiveFieldName(Tokens), - parse_FieldName(Rest,[Field]). - -parse_FieldName([{'.',_}|Rest],Acc) -> - case (catch parse_PrimitiveFieldName(Rest)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - {FieldName,Rest2} -> - parse_FieldName(Rest2,[FieldName|Acc]) - end; -parse_FieldName(Tokens,Acc) -> - {lists:reverse(Acc),Tokens}. - -parse_FixedTypeValueFieldSpec([{valuefieldreference,L1,VFieldName}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - {Unique,Rest3} = - case Rest2 of - [{'UNIQUE',_}|Rest4] -> - {'UNIQUE',Rest4}; - _ -> - {undefined,Rest2} - end, - {OptionalitySpec,Rest5} = parse_ValueOptionalitySpec(Rest3), - case Unique of - 'UNIQUE' -> - case OptionalitySpec of - {'DEFAULT',_} -> - throw({asn1_error, - {L1,get(asn1_module), - ['UNIQUE and DEFAULT in same field',VFieldName]}}); - _ -> - {{fixedtypevaluefield,VFieldName,Type,Unique,OptionalitySpec},Rest5} - end; - _ -> - {{object_or_fixedtypevalue_field,VFieldName,Type,Unique,OptionalitySpec},Rest5} - end; -parse_FixedTypeValueFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,valuefieldreference]}}). - -parse_VariableTypeValueFieldSpec([{valuefieldreference,_,VFieldName}|Rest]) -> - {FieldRef,Rest2} = parse_FieldName(Rest), - {OptionalitySpec,Rest3} = parse_ValueOptionalitySpec(Rest2), - {{variabletypevaluefield,VFieldName,FieldRef,OptionalitySpec},Rest3}; -parse_VariableTypeValueFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,valuefieldreference]}}). - -parse_ObjectFieldSpec([{valuefieldreference,_,VFieldName}|Rest]) -> - {Class,Rest2} = parse_DefinedObjectClass(Rest), - {OptionalitySpec,Rest3} = parse_ObjectOptionalitySpec(Rest2), - {{objectfield,VFieldName,Class,OptionalitySpec},Rest3}; -parse_ObjectFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,valuefieldreference]}}). - -parse_TypeFieldSpec([{typefieldreference,_,TFieldName}|Rest]) -> - {OptionalitySpec,Rest2} = parse_TypeOptionalitySpec(Rest), - {{typefield,TFieldName,OptionalitySpec},Rest2}; -parse_TypeFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,typefieldreference]}}). - -parse_FixedTypeValueSetFieldSpec([{typefieldreference,_,TFieldName}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - {OptionalitySpec,Rest3} = parse_ValueSetOptionalitySpec(Rest2), - {{objectset_or_fixedtypevalueset_field,TFieldName,Type, - OptionalitySpec},Rest3}; -parse_FixedTypeValueSetFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,typefieldreference]}}). - -parse_VariableTypeValueSetFieldSpec([{typefieldreference,_,TFieldName}|Rest]) -> - {FieldRef,Rest2} = parse_FieldName(Rest), - {OptionalitySpec,Rest3} = parse_ValueSetOptionalitySpec(Rest2), - {{variabletypevaluesetfield,TFieldName,FieldRef,OptionalitySpec},Rest3}; -parse_VariableTypeValueSetFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,typefieldreference]}}). - -parse_ObjectSetFieldSpec([{typefieldreference,_,TFieldName}|Rest]) -> - {Class,Rest2} = parse_DefinedObjectClass(Rest), - {OptionalitySpec,Rest3} = parse_ObjectSetOptionalitySpec(Rest2), - {{objectsetfield,TFieldName,Class,OptionalitySpec},Rest3}; -parse_ObjectSetFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,typefieldreference]}}). - -parse_ValueOptionalitySpec(Tokens)-> - case Tokens of - [{'OPTIONAL',_}|Rest] -> {'OPTIONAL',Rest}; - [{'DEFAULT',_}|Rest] -> - {Value,Rest2} = parse_Value(Rest), - {{'DEFAULT',Value},Rest2}; - _ -> {'MANDATORY',Tokens} - end. - -parse_ObjectOptionalitySpec(Tokens) -> - case Tokens of - [{'OPTIONAL',_}|Rest] -> {'OPTIONAL',Rest}; - [{'DEFAULT',_}|Rest] -> - {Object,Rest2} = parse_Object(Rest), - {{'DEFAULT',Object},Rest2}; - _ -> {'MANDATORY',Tokens} - end. - -parse_TypeOptionalitySpec(Tokens) -> - case Tokens of - [{'OPTIONAL',_}|Rest] -> {'OPTIONAL',Rest}; - [{'DEFAULT',_}|Rest] -> - {Type,Rest2} = parse_Type(Rest), - {{'DEFAULT',Type},Rest2}; - _ -> {'MANDATORY',Tokens} - end. - -parse_ValueSetOptionalitySpec(Tokens) -> - case Tokens of - [{'OPTIONAL',_}|Rest] -> {'OPTIONAL',Rest}; - [{'DEFAULT',_}|Rest] -> - {ValueSet,Rest2} = parse_ValueSet(Rest), - {{'DEFAULT',ValueSet},Rest2}; - _ -> {'MANDATORY',Tokens} - end. - -parse_ObjectSetOptionalitySpec(Tokens) -> - case Tokens of - [{'OPTIONAL',_}|Rest] -> {'OPTIONAL',Rest}; - [{'DEFAULT',_}|Rest] -> - {ObjectSet,Rest2} = parse_ObjectSet(Rest), - {{'DEFAULT',ObjectSet},Rest2}; - _ -> {'MANDATORY',Tokens} - end. - -parse_WithSyntaxSpec([{'WITH',_},{'SYNTAX',_}|Rest]) -> - {SyntaxList,Rest2} = parse_SyntaxList(Rest), - {{'WITH SYNTAX',SyntaxList},Rest2}; -parse_WithSyntaxSpec(Tokens) -> - {[],Tokens}. - -parse_SyntaxList([{'{',_},{'}',_}|Rest]) -> - {[],Rest}; -parse_SyntaxList([{'{',_}|Rest]) -> - parse_SyntaxList(Rest,[]); -parse_SyntaxList(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,['{}','{']]}}). - -parse_SyntaxList(Tokens,Acc) -> - {SyntaxList,Rest} = parse_TokenOrGroupSpec(Tokens), - case Rest of - [{'}',_}|Rest2] -> - {lists:reverse([SyntaxList|Acc]),Rest2}; - _ -> - parse_SyntaxList(Rest,[SyntaxList|Acc]) - end. - -parse_TokenOrGroupSpec(Tokens) -> - Flist = [fun parse_RequiredToken/1, - fun parse_OptionalGroup/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_RequiredToken([{typereference,L1,WordName}|Rest]) -> - case is_word(WordName) of - false -> - throw({asn1_error,{L1,get(asn1_module), - [got,WordName,expected,a,'Word']}}); - true -> - {WordName,Rest} - end; -parse_RequiredToken([{',',L1}|Rest]) -> - {{',',L1},Rest}; -parse_RequiredToken([{WordName,L1}|Rest]) -> - case is_word(WordName) of - false -> - throw({asn1_error,{L1,get(asn1_module), - [got,WordName,expected,a,'Word']}}); - true -> - {WordName,Rest} - end; -parse_RequiredToken(Tokens) -> - parse_PrimitiveFieldName(Tokens). - -parse_OptionalGroup([{'[',_}|Rest]) -> - {Spec,Rest2} = parse_TokenOrGroupSpec(Rest), - {SpecList,Rest3} = parse_OptionalGroup(Rest2,[Spec]), - {SpecList,Rest3}. - -parse_OptionalGroup([{']',_}|Rest],Acc) -> - {lists:reverse(Acc),Rest}; -parse_OptionalGroup(Tokens,Acc) -> - {Spec,Rest} = parse_TokenOrGroupSpec(Tokens), - parse_OptionalGroup(Rest,[Spec|Acc]). - -parse_DefinedObject([Id={identifier,_,_ObjName}|Rest]) -> - {{object,identifier2Extvalueref(Id)},Rest}; -parse_DefinedObject([{typereference,L1,ModName},{'.',_},{identifier,_,ObjName}|Rest]) -> - {{object, #'Externaltypereference'{pos=L1,module=ModName,type=ObjName}},Rest}; -parse_DefinedObject(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [identifier,'typereference.identifier']]}}). - -parse_ObjectAssignment([{identifier,L1,ObjName}|Rest]) -> - {Class,Rest2} = parse_DefinedObjectClass(Rest), - case Rest2 of - [{'::=',_}|Rest3] -> - {Object,Rest4} = parse_Object(Rest3), - {#typedef{pos=L1,name=ObjName, - typespec=#'Object'{classname=Class,def=Object}},Rest4}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}); - Other -> - throw({asn1_error,{L1,get(asn1_module), - [got,Other,expected,'::=']}}) - end; -parse_ObjectAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). - -parse_Object(Tokens) -> - Flist=[fun parse_ObjectDefn/1, - fun parse_ObjectFromObject/1, - fun parse_ParameterizedObject/1, - fun parse_DefinedObject/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_ObjectDefn(Tokens) -> - Flist=[fun parse_DefaultSyntax/1, - fun parse_DefinedSyntax/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_DefaultSyntax([{'{',_},{'}',_}|Rest]) -> - {{object,defaultsyntax,[]},Rest}; -parse_DefaultSyntax([{'{',_}|Rest]) -> - parse_DefaultSyntax(Rest,[]); -parse_DefaultSyntax(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,['{}','{']]}}). - -parse_DefaultSyntax(Tokens,Acc) -> - {Setting,Rest} = parse_FieldSetting(Tokens), - case Rest of - [{',',_}|Rest2] -> - parse_DefaultSyntax(Rest2,[Setting|Acc]); - [{'}',_}|Rest3] -> - {{object,defaultsyntax,lists:reverse([Setting|Acc])},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,[',','}']]}}) - end. - -parse_FieldSetting(Tokens) -> - {{_,PrimFieldName},Rest} = parse_PrimitiveFieldName(Tokens), - {Setting,Rest2} = parse_Setting(Rest), - {{PrimFieldName,Setting},Rest2}. - -parse_DefinedSyntax([{'{',_}|Rest]) -> - parse_DefinedSyntax(Rest,[]). - -parse_DefinedSyntax(Tokens,Acc) -> - case Tokens of - [{'}',_}|Rest2] -> - {{object,definedsyntax,lists:reverse(Acc)},Rest2}; - _ -> - {DefSynTok,Rest3} = parse_DefinedSyntaxToken(Tokens), - parse_DefinedSyntax(Rest3,[DefSynTok|Acc]) - end. - -parse_DefinedSyntaxToken([{',',L1}|Rest]) -> - {{',',L1},Rest}; -parse_DefinedSyntaxToken([{typereference,L1,Name}|Rest]) -> - case is_word(Name) of - false -> - {{setting,L1,Name},Rest}; - true -> - {{word_or_setting,L1,Name},Rest} - end; -parse_DefinedSyntaxToken(Tokens) -> - case catch parse_Setting(Tokens) of - {asn1_error,_} -> - parse_Word(Tokens); - {'EXIT',Reason} -> - exit(Reason); - Result -> - Result - end. - -parse_Word([{Name,Pos}|Rest]) -> - case is_word(Name) of - false -> - throw({asn1_error,{Pos,get(asn1_module), - [got,Name, expected,a,'Word']}}); - true -> - {{word_or_setting,Pos,Name},Rest} - end. - -parse_Setting(Tokens) -> - Flist = [fun parse_Type/1, - fun parse_Value/1, - fun parse_Object/1, - fun parse_ObjectSet/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_DefinedObjectSet([{typereference,L1,ModuleName},{'.',_}, - {typereference,L2,ObjSetName}|Rest]) -> - {{objectset,L1,#'Externaltypereference'{pos=L2,module=ModuleName, - type=ObjSetName}},Rest}; -parse_DefinedObjectSet([{typereference,L1,ObjSetName}|Rest]) -> - {{objectset,L1,#'Externaltypereference'{pos=L1,module=get(asn1_module), - type=ObjSetName}},Rest}; -parse_DefinedObjectSet(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [typereference,'typereference.typereference']]}}). - -parse_ObjectSetAssignment([{typereference,L1,ObjSetName}|Rest]) -> - {Class,Rest2} = parse_DefinedObjectClass(Rest), - case Rest2 of - [{'::=',_}|Rest3] -> - {ObjectSet,Rest4} = parse_ObjectSet(Rest3), - {#typedef{pos=L1,name=ObjSetName, - typespec=#'ObjectSet'{class=Class, - set=ObjectSet}},Rest4}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) -%%% Other -> -%%% throw(Other) - end; -parse_ObjectSetAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - typereference]}}). - -parse_ObjectSet([{'{',_}|Rest]) -> - {ObjSetSpec,Rest2} = parse_ObjectSetSpec(Rest), - case Rest2 of - [{'}',_}|Rest3] -> - {ObjSetSpec,Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'}']}}) - end; -parse_ObjectSet(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). - -parse_ObjectSetSpec([{'...',_}|Rest]) -> - {['EXTENSIONMARK'],Rest}; -parse_ObjectSetSpec(Tokens) -> - parse_ElementSetSpecs(Tokens). - -parse_ObjectSetElements(Tokens) -> - Flist = [fun parse_Object/1, - fun parse_DefinedObjectSet/1, - fun parse_ObjectSetFromObjects/1, - fun parse_ParameterizedObjectSet/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_ObjectClassFieldType(Tokens) -> - {Class,Rest} = parse_DefinedObjectClass(Tokens), - case Rest of - [{'.',_}|Rest2] -> - {FieldName,Rest3} = parse_FieldName(Rest2), - OCFT = #'ObjectClassFieldType'{ - classname=Class, - class=Class,fieldname=FieldName}, - {#type{def=OCFT},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'.']}}) -%%% Other -> -%%% throw(Other) - end. - -%parse_ObjectClassFieldValue(Tokens) -> -% Flist = [fun parse_OpenTypeFieldVal/1, -% fun parse_FixedTypeFieldVal/1], -% case (catch parse_or(Tokens,Flist)) of -% {'EXIT',Reason} -> -% throw(Reason); -% AsnErr = {asn1_error,_} -> -% throw(AsnErr); -% Result -> -% Result -% end. - -parse_ObjectClassFieldValue(Tokens) -> - parse_OpenTypeFieldVal(Tokens). - -parse_OpenTypeFieldVal(Tokens) -> - {Type,Rest} = parse_Type(Tokens), - case Rest of - [{':',_}|Rest2] -> - {Value,Rest3} = parse_Value(Rest2), - {{opentypefieldvalue,Type,Value},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,':']}}) - end. - -% parse_FixedTypeFieldVal(Tokens) -> -% parse_Value(Tokens). - -% parse_InformationFromObjects(Tokens) -> -% Flist = [fun parse_ValueFromObject/1, -% fun parse_ValueSetFromObjects/1, -% fun parse_TypeFromObject/1, -% fun parse_ObjectFromObject/1], -% case (catch parse_or(Tokens,Flist)) of -% {'EXIT',Reason} -> -% throw(Reason); -% AsnErr = {asn1_error,_} -> -% throw(AsnErr); -% Result -> -% Result -% end. - -parse_ReferencedObjects(Tokens) -> - Flist = [fun parse_DefinedObject/1, - fun parse_DefinedObjectSet/1, - fun parse_ParameterizedObject/1, - fun parse_ParameterizedObjectSet/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_ValueFromObject(Tokens) -> - {Objects,Rest} = parse_ReferencedObjects(Tokens), - case Rest of - [{'.',_}|Rest2] -> - {Name,Rest3} = parse_FieldName(Rest2), - case lists:last(Name) of - {valuefieldreference,_} -> - {{'ValueFromObject',Objects,Name},Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,typefieldreference,expected, - valuefieldreference]}}) - end; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'.']}}) -%%% Other -> -%%% throw({asn1_error,{got,Other,expected,'.'}}) - end. - -parse_ValueSetFromObjects(Tokens) -> - {Objects,Rest} = parse_ReferencedObjects(Tokens), - case Rest of - [{'.',_}|Rest2] -> - {Name,Rest3} = parse_FieldName(Rest2), - case lists:last(Name) of - {typefieldreference,_FieldName} -> - {{'ValueSetFromObjects',Objects,Name},Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected, - typefieldreference]}}) - end; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'.']}}) -%%% Other -> -%%% throw({asn1_error,{got,Other,expected,'.'}}) - end. - -parse_TypeFromObject(Tokens) -> - {Objects,Rest} = parse_ReferencedObjects(Tokens), - case Rest of - [{'.',_}|Rest2] -> - {Name,Rest3} = parse_FieldName(Rest2), - case lists:last(Name) of - {typefieldreference,_FieldName} -> - {{'TypeFromObject',Objects,Name},Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected, - typefieldreference]}}) - end; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'.']}}) -%%% Other -> -%%% throw({asn1_error,{got,Other,expected,'.'}}) - end. - -parse_ObjectFromObject(Tokens) -> - {Objects,Rest} = parse_ReferencedObjects(Tokens), - case Rest of - [{'.',_}|Rest2] -> - {Name,Rest3} = parse_FieldName(Rest2), - {{'ObjectFromObject',Objects,Name},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'.']}}) -%%% Other -> -%%% throw({asn1_error,{got,Other,expected,'.'}}) - end. - -parse_ObjectSetFromObjects(Tokens) -> - {Objects,Rest} = parse_ReferencedObjects(Tokens), - case Rest of - [{'.',_}|Rest2] -> - {Name,Rest3} = parse_FieldName(Rest2), - {{'ObjectSetFromObjects',Objects,Name},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'.']}}) -%%% Other -> -%%% throw({asn1_error,{got,Other,expected,'.'}}) - end. - -% parse_InstanceOfType([{'INSTANCE',_},{'OF',_}|Rest]) -> -% {Class,Rest2} = parse_DefinedObjectClass(Rest), -% {{'InstanceOfType',Class},Rest2}. - -% parse_InstanceOfValue(Tokens) -> -% parse_Value(Tokens). - - - -%% X.682 constraint specification - -parse_GeneralConstraint(Tokens) -> - Flist = [fun parse_UserDefinedConstraint/1, - fun parse_TableConstraint/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_UserDefinedConstraint([{'CONSTRAINED',_},{'BY',_},{'{',_},{'}',_}|Rest])-> - {{constrained_by,[]},Rest}; -parse_UserDefinedConstraint([{'CONSTRAINED',_}, - {'BY',_}, - {'{',_}|Rest]) -> - {Param,Rest2} = parse_UserDefinedConstraintParameter(Rest), - case Rest2 of - [{'}',_}|Rest3] -> - {{constrained_by,Param},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'}']}}) - end; -parse_UserDefinedConstraint(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - ['CONSTRAINED BY {}','CONSTRAINED BY {']]}}). - -parse_UserDefinedConstraintParameter(Tokens) -> - parse_UserDefinedConstraintParameter(Tokens,[]). -parse_UserDefinedConstraintParameter(Tokens,Acc) -> - Flist = [fun parse_GovernorAndActualParameter/1, - fun parse_ActualParameter/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - {Result,Rest} -> - case Rest of - [{',',_}|_Rest2] -> - parse_UserDefinedConstraintParameter(Tokens,[Result|Acc]); - _ -> - {lists:reverse([Result|Acc]),Rest} - end - end. - -parse_GovernorAndActualParameter(Tokens) -> - {Governor,Rest} = parse_Governor(Tokens), - case Rest of - [{':',_}|Rest2] -> - {Params,Rest3} = parse_ActualParameter(Rest2), - {{'Governor_Params',Governor,Params},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,':']}}) - end. - -parse_TableConstraint(Tokens) -> - Flist = [fun parse_ComponentRelationConstraint/1, - fun parse_SimpleTableConstraint/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_SimpleTableConstraint(Tokens) -> - {ObjectSet,Rest} = parse_ObjectSet(Tokens), - {{simpletable,ObjectSet},Rest}. - -parse_ComponentRelationConstraint([{'{',_}|Rest]) -> - {ObjectSet,Rest2} = parse_DefinedObjectSet(Rest), - case Rest2 of - [{'}',_},{'{',_}|Rest3] -> - {AtNot,Rest4} = parse_AtNotationList(Rest3,[]), - case Rest4 of - [{'}',_}|Rest5] -> - {{componentrelation,ObjectSet,AtNot},Rest5}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'}']}}) - end; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected, - 'ComponentRelationConstraint',ended,with,'}']}}) -%%% Other -> -%%% throw(Other) - end; -parse_ComponentRelationConstraint(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). - -parse_AtNotationList(Tokens,Acc) -> - {AtNot,Rest} = parse_AtNotation(Tokens), - case Rest of - [{',',_}|Rest2] -> - parse_AtNotationList(Rest2,[AtNot|Acc]); - _ -> - {lists:reverse([AtNot|Acc]),Rest} - end. - -parse_AtNotation([{'@',_},{'.',_}|Rest]) -> - {CIdList,Rest2} = parse_ComponentIdList(Rest), - {{innermost,CIdList},Rest2}; -parse_AtNotation([{'@',_}|Rest]) -> - {CIdList,Rest2} = parse_ComponentIdList(Rest), - {{outermost,CIdList},Rest2}; -parse_AtNotation(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,['@','@.']]}}). - -parse_ComponentIdList(Tokens) -> - parse_ComponentIdList(Tokens,[]). - -parse_ComponentIdList([Id = {identifier,_,_},{'.',_}|Rest],Acc) -> - parse_ComponentIdList(Rest,[identifier2Extvalueref(Id)|Acc]); -parse_ComponentIdList([Id = {identifier,_,_}|Rest],Acc) -> - {lists:reverse([identifier2Extvalueref(Id)|Acc]),Rest}; -parse_ComponentIdList(Tokens,_) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [identifier,'identifier.']]}}). - - - - - -% X.683 Parameterization of ASN.1 specifications - -parse_Governor(Tokens) -> - Flist = [fun parse_Type/1, - fun parse_DefinedObjectClass/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_ActualParameter(Tokens) -> - Flist = [fun parse_Type/1, - fun parse_Value/1, - fun parse_ValueSet/1, - fun parse_DefinedObjectClass/1, - fun parse_Object/1, - fun parse_ObjectSet/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_ParameterizedAssignment(Tokens) -> - Flist = [fun parse_ParameterizedTypeAssignment/1, - fun parse_ParameterizedValueAssignment/1, - fun parse_ParameterizedValueSetTypeAssignment/1, - fun parse_ParameterizedObjectClassAssignment/1, - fun parse_ParameterizedObjectAssignment/1, - fun parse_ParameterizedObjectSetAssignment/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - AsnAssErr = {asn1_assignment_error,_} -> - throw(AsnAssErr); - Result -> - Result - end. - -parse_ParameterizedTypeAssignment([{typereference,L1,Name}|Rest]) -> - {ParameterList,Rest2} = parse_ParameterList(Rest), - case Rest2 of - [{'::=',_}|Rest3] -> - {Type,Rest4} = parse_Type(Rest3), - {#ptypedef{pos=L1,name=Name,args=ParameterList,typespec=Type}, - Rest4}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) - end; -parse_ParameterizedTypeAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - typereference]}}). - -parse_ParameterizedValueAssignment([{identifier,L1,Name}|Rest]) -> - {ParameterList,Rest2} = parse_ParameterList(Rest), - {Type,Rest3} = parse_Type(Rest2), - case Rest3 of - [{'::=',_}|Rest4] -> - {Value,Rest5} = parse_Value(Rest4), - {#pvaluedef{pos=L1,name=Name,args=ParameterList,type=Type, - value=Value},Rest5}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) - end; -parse_ParameterizedValueAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). - -parse_ParameterizedValueSetTypeAssignment([{typereference,L1,Name}|Rest]) -> - {ParameterList,Rest2} = parse_ParameterList(Rest), - {Type,Rest3} = parse_Type(Rest2), - case Rest3 of - [{'::=',_}|Rest4] -> - {ValueSet,Rest5} = parse_ValueSet(Rest4), - {#pvaluesetdef{pos=L1,name=Name,args=ParameterList, - type=Type,valueset=ValueSet},Rest5}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) - end; -parse_ParameterizedValueSetTypeAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - typereference]}}). - -parse_ParameterizedObjectClassAssignment([{typereference,L1,Name}|Rest]) -> - {ParameterList,Rest2} = parse_ParameterList(Rest), - case Rest2 of - [{'::=',_}|Rest3] -> - {Class,Rest4} = parse_ObjectClass(Rest3), - {#ptypedef{pos=L1,name=Name,args=ParameterList,typespec=Class}, - Rest4}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) - end; -parse_ParameterizedObjectClassAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - typereference]}}). - -parse_ParameterizedObjectAssignment([{identifier,L1,Name}|Rest]) -> - {ParameterList,Rest2} = parse_ParameterList(Rest), - {Class,Rest3} = parse_DefinedObjectClass(Rest2), - case Rest3 of - [{'::=',_}|Rest4] -> - {Object,Rest5} = parse_Object(Rest4), - {#pobjectdef{pos=L1,name=Name,args=ParameterList, - class=Class,def=Object},Rest5}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) -%%% Other -> -%%% throw(Other) - end; -parse_ParameterizedObjectAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). - -parse_ParameterizedObjectSetAssignment([{typereference,L1,Name}|Rest]) -> - {ParameterList,Rest2} = parse_ParameterList(Rest), - {Class,Rest3} = parse_DefinedObjectClass(Rest2), - case Rest3 of - [{'::=',_}|Rest4] -> - {ObjectSet,Rest5} = parse_ObjectSet(Rest4), - {#pobjectsetdef{pos=L1,name=Name,args=ParameterList, - class=Class,def=ObjectSet},Rest5}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) -%%% Other -> -%%% throw(Other) - end; -parse_ParameterizedObjectSetAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - typereference]}}). - -parse_ParameterList([{'{',_}|Rest]) -> - parse_ParameterList(Rest,[]); -parse_ParameterList(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). - -parse_ParameterList(Tokens,Acc) -> - {Parameter,Rest} = parse_Parameter(Tokens), - case Rest of - [{',',_}|Rest2] -> - parse_ParameterList(Rest2,[Parameter|Acc]); - [{'}',_}|Rest3] -> - {lists:reverse([Parameter|Acc]),Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,[',','}']]}}) - end. - -parse_Parameter(Tokens) -> - Flist = [fun parse_ParamGovAndRef/1, - fun parse_Reference/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_ParamGovAndRef(Tokens) -> - {ParamGov,Rest} = parse_ParamGovernor(Tokens), - case Rest of - [{':',_}|Rest2] -> - {Ref,Rest3} = parse_Reference(Rest2), - {{ParamGov,Ref},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,':']}}) - end. - -parse_ParamGovernor(Tokens) -> - Flist = [fun parse_Governor/1, - fun parse_Reference/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -% parse_ParameterizedReference(Tokens) -> -% {Ref,Rest} = parse_Reference(Tokens), -% case Rest of -% [{'{',_},{'}',_}|Rest2] -> -% {{ptref,Ref},Rest2}; -% _ -> -% {{ptref,Ref},Rest} -% end. - -parse_SimpleDefinedType([{typereference,L1,ModuleName},{'.',_}, - {typereference,_,TypeName}|Rest]) -> - {#'Externaltypereference'{pos=L1,module=ModuleName, - type=TypeName},Rest}; -parse_SimpleDefinedType([Tref={typereference,_,_}|Rest]) -> -% {#'Externaltypereference'{pos=L2,module=get(asn1_module), -% type=TypeName},Rest}; - {tref2Exttref(Tref),Rest}; -parse_SimpleDefinedType(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [typereference,'typereference.typereference']]}}). - -parse_SimpleDefinedValue([{typereference,L1,ModuleName},{'.',_}, - {identifier,_,Value}|Rest]) -> - {{simpledefinedvalue,#'Externalvaluereference'{pos=L1,module=ModuleName, - value=Value}},Rest}; -parse_SimpleDefinedValue([{identifier,L2,Value}|Rest]) -> - {{simpledefinedvalue,L2,Value},Rest}; -parse_SimpleDefinedValue(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - ['typereference.identifier',identifier]]}}). - -parse_ParameterizedType(Tokens) -> - {Type,Rest} = parse_SimpleDefinedType(Tokens), - {Params,Rest2} = parse_ActualParameterList(Rest), - {{pt,Type,Params},Rest2}. - -parse_ParameterizedValue(Tokens) -> - {Value,Rest} = parse_SimpleDefinedValue(Tokens), - {Params,Rest2} = parse_ActualParameterList(Rest), - {{pv,Value,Params},Rest2}. - -parse_ParameterizedObjectClass(Tokens) -> - {Type,Rest} = parse_DefinedObjectClass(Tokens), - {Params,Rest2} = parse_ActualParameterList(Rest), - {{poc,Type,Params},Rest2}. - -parse_ParameterizedObjectSet(Tokens) -> - {ObjectSet,Rest} = parse_DefinedObjectSet(Tokens), - {Params,Rest2} = parse_ActualParameterList(Rest), - {{pos,ObjectSet,Params},Rest2}. - -parse_ParameterizedObject(Tokens) -> - {Object,Rest} = parse_DefinedObject(Tokens), - {Params,Rest2} = parse_ActualParameterList(Rest), - {{po,Object,Params},Rest2}. - -parse_ActualParameterList([{'{',_}|Rest]) -> - parse_ActualParameterList(Rest,[]); -parse_ActualParameterList(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). - -parse_ActualParameterList(Tokens,Acc) -> - {Parameter,Rest} = parse_ActualParameter(Tokens), - case Rest of - [{',',_}|Rest2] -> - parse_ActualParameterList(Rest2,[Parameter|Acc]); - [{'}',_}|Rest3] -> - {lists:reverse([Parameter|Acc]),Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,[',','}']]}}) -%%% Other -> -%%% throw(Other) - end. - - - - - - - -%------------------------- - -is_word(Token) -> - case not_allowed_word(Token) of - true -> false; - _ -> - if - atom(Token) -> - Item = atom_to_list(Token), - is_word(Item); - list(Token), length(Token) == 1 -> - check_one_char_word(Token); - list(Token) -> - [A|Rest] = Token, - case check_first(A) of - true -> - check_rest(Rest); - _ -> - false - end - end - end. - -not_allowed_word(Name) -> - lists:member(Name,["BIT", - "BOOLEAN", - "CHARACTER", - "CHOICE", - "EMBEDDED", - "END", - "ENUMERATED", - "EXTERNAL", - "FALSE", - "INSTANCE", - "INTEGER", - "INTERSECTION", - "MINUS-INFINITY", - "NULL", - "OBJECT", - "OCTET", - "PLUS-INFINITY", - "REAL", - "SEQUENCE", - "SET", - "TRUE", - "UNION"]). - -check_one_char_word([A]) when $A =< A, $Z >= A -> - true; -check_one_char_word([_]) -> - false. %% unknown item in SyntaxList - -check_first(A) when $A =< A, $Z >= A -> - true; -check_first(_) -> - false. %% unknown item in SyntaxList - -check_rest([R,R|_Rs]) when $- == R -> - false; %% two consecutive hyphens are not allowed in a word -check_rest([R]) when $- == R -> - false; %% word cannot end with hyphen -check_rest([R|Rs]) when $A=<R, $Z>=R; $-==R -> - check_rest(Rs); -check_rest([]) -> - true; -check_rest(_) -> - false. - - -to_set(V) when list(V) -> - ordsets:list_to_set(V); -to_set(V) -> - ordsets:list_to_set([V]). - - -parse_AlternativeTypeLists(Tokens) -> - {AlternativeTypeList,Rest1} = parse_AlternativeTypeList(Tokens), - {ExtensionAndException,Rest2} = - case Rest1 of - [{',',_},{'...',L1},{'!',_}|Rest12] -> - {_,Rest13} = parse_ExceptionIdentification(Rest12), - %% Exception info is currently thrown away - {[#'EXTENSIONMARK'{pos=L1}],Rest13}; - [{',',_},{'...',L1}|Rest12] -> - {[#'EXTENSIONMARK'{pos=L1}],Rest12}; - _ -> - {[],Rest1} - end, - case ExtensionAndException of - [] -> - {AlternativeTypeList,Rest2}; - _ -> - {ExtensionAddition,Rest3} = - case Rest2 of - [{',',_}|Rest23] -> - parse_ExtensionAdditionAlternativeList(Rest23); - _ -> - {[],Rest2} - end, - {OptionalExtensionMarker,Rest4} = - case Rest3 of - [{',',_},{'...',L3}|Rest31] -> - {[#'EXTENSIONMARK'{pos=L3}],Rest31}; - _ -> - {[],Rest3} - end, - {AlternativeTypeList ++ ExtensionAndException ++ ExtensionAddition ++ OptionalExtensionMarker, Rest4} - end. - - -parse_AlternativeTypeList(Tokens) -> - parse_AlternativeTypeList(Tokens,[]). - -parse_AlternativeTypeList(Tokens,Acc) -> - {NamedType,Rest} = parse_NamedType(Tokens), - case Rest of - [{',',_},Id = {identifier,_,_}|Rest2] -> - parse_AlternativeTypeList([Id|Rest2],[NamedType|Acc]); - _ -> - {lists:reverse([NamedType|Acc]),Rest} - end. - - - -parse_ExtensionAdditionAlternativeList(Tokens) -> - parse_ExtensionAdditionAlternativeList(Tokens,[]). - -parse_ExtensionAdditionAlternativeList(Tokens,Acc) -> - {Element,Rest0} = - case Tokens of - [{identifier,_,_}|_Rest] -> - parse_NamedType(Tokens); - [{'[[',_}|_] -> - parse_ExtensionAdditionAlternatives(Tokens) - end, - case Rest0 of - [{',',_}|Rest01] -> - parse_ExtensionAdditionAlternativeList(Rest01,[Element|Acc]); - _ -> - {lists:reverse([Element|Acc]),Rest0} - end. - -parse_ExtensionAdditionAlternatives([{'[[',_}|Rest]) -> - parse_ExtensionAdditionAlternatives(Rest,[]); -parse_ExtensionAdditionAlternatives(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'[[']}}). - -parse_ExtensionAdditionAlternatives([Id = {identifier,_,_}|Rest],Acc) -> - {NamedType, Rest2} = parse_NamedType([Id|Rest]), - case Rest2 of - [{',',_}|Rest21] -> - parse_ExtensionAdditionAlternatives(Rest21,[NamedType|Acc]); - [{']]',_}|Rest21] -> - {lists:reverse(Acc),Rest21}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,[',',']]']]}}) - end. - -parse_NamedType([{identifier,L1,Idname}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - {#'ComponentType'{pos=L1,name=Idname,typespec=Type,prop=mandatory},Rest2}; -parse_NamedType(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). - - -parse_ComponentTypeLists(Tokens) -> -% Resulting tuple {ComponentTypeList,Rest1} is returned - case Tokens of - [{identifier,_,_}|_Rest0] -> - {Clist,Rest01} = parse_ComponentTypeList(Tokens), - case Rest01 of - [{',',_}|Rest02] -> - parse_ComponentTypeLists(Rest02,Clist); - _ -> - {Clist,Rest01} - end; - [{'COMPONENTS',_},{'OF',_}|_Rest] -> - {Clist,Rest01} = parse_ComponentTypeList(Tokens), - case Rest01 of - [{',',_}|Rest02] -> - parse_ComponentTypeLists(Rest02,Clist); - _ -> - {Clist,Rest01} - end; - _ -> - parse_ComponentTypeLists(Tokens,[]) - end. - -parse_ComponentTypeLists([{'...',L1},{'!',_}|Rest],Clist1) -> - {_,Rest2} = parse_ExceptionIdentification(Rest), - %% Exception info is currently thrown away - parse_ComponentTypeLists2(Rest2,Clist1++[#'EXTENSIONMARK'{pos=L1}]); -parse_ComponentTypeLists([{'...',L1}|Rest],Clist1) -> - parse_ComponentTypeLists2(Rest,Clist1++[#'EXTENSIONMARK'{pos=L1}]); -parse_ComponentTypeLists(Tokens,Clist1) -> - {Clist1,Tokens}. - - -parse_ComponentTypeLists2(Tokens,Clist1) -> - {ExtensionAddition,Rest2} = - case Tokens of - [{',',_}|Rest1] -> - parse_ExtensionAdditionList(Rest1); - _ -> - {[],Tokens} - end, - {OptionalExtensionMarker,Rest3} = - case Rest2 of - [{',',_},{'...',L2}|Rest21] -> - {[#'EXTENSIONMARK'{pos=L2}],Rest21}; - _ -> - {[],Rest2} - end, - {RootComponentTypeList,Rest4} = - case Rest3 of - [{',',_}|Rest31] -> - parse_ComponentTypeList(Rest31); - _ -> - {[],Rest3} - end, - {Clist1 ++ ExtensionAddition ++ OptionalExtensionMarker ++ RootComponentTypeList, Rest4}. - - -parse_ComponentTypeList(Tokens) -> - parse_ComponentTypeList(Tokens,[]). - -parse_ComponentTypeList(Tokens,Acc) -> - {ComponentType,Rest} = parse_ComponentType(Tokens), - case Rest of - [{',',_},Id = {identifier,_,_}|Rest2] -> - parse_ComponentTypeList([Id|Rest2],[ComponentType|Acc]); - [{',',_},C1={'COMPONENTS',_},C2={'OF',_}|Rest2] -> - parse_ComponentTypeList([C1,C2|Rest2],[ComponentType|Acc]); -% _ -> -% {lists:reverse([ComponentType|Acc]),Rest} - [{'}',_}|_] -> - {lists:reverse([ComponentType|Acc]),Rest}; - [{',',_},{'...',_}|_] -> - {lists:reverse([ComponentType|Acc]),Rest}; - _ -> - throw({asn1_error, - {get_line(hd(Tokens)),get(asn1_module), - [got,[get_token(hd(Rest)),get_token(hd(tl(Rest)))], - expected,['}',', identifier']]}}) - end. - - -parse_ExtensionAdditionList(Tokens) -> - parse_ExtensionAdditionList(Tokens,[]). - -parse_ExtensionAdditionList(Tokens,Acc) -> - {Element,Rest0} = - case Tokens of - [{identifier,_,_}|_Rest] -> - parse_ComponentType(Tokens); - [{'[[',_}|_] -> - parse_ExtensionAdditions(Tokens); - _ -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [identifier,'[[']]}}) - end, - case Rest0 of - [{',',_}|Rest01] -> - parse_ExtensionAdditionList(Rest01,[Element|Acc]); - _ -> - {lists:reverse([Element|Acc]),Rest0} - end. - -parse_ExtensionAdditions([{'[[',_}|Rest]) -> - parse_ExtensionAdditions(Rest,[]); -parse_ExtensionAdditions(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'[[']}}). - -parse_ExtensionAdditions([Id = {identifier,_,_}|Rest],Acc) -> - {ComponentType, Rest2} = parse_ComponentType([Id|Rest]), - case Rest2 of - [{',',_}|Rest21] -> - parse_ExtensionAdditions(Rest21,[ComponentType|Acc]); - [{']]',_}|Rest21] -> - {lists:reverse(Acc),Rest21}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,[',',']]']]}}) - end; -parse_ExtensionAdditions(Tokens,_) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). - -parse_ComponentType([{'COMPONENTS',_},{'OF',_}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - {{'COMPONENTS OF',Type},Rest2}; -parse_ComponentType(Tokens) -> - {NamedType,Rest} = parse_NamedType(Tokens), - case Rest of - [{'OPTIONAL',_}|Rest2] -> - {NamedType#'ComponentType'{prop='OPTIONAL'},Rest2}; - [{'DEFAULT',_}|Rest2] -> - {Value,Rest21} = parse_Value(Rest2), - {NamedType#'ComponentType'{prop={'DEFAULT',Value}},Rest21}; - _ -> - {NamedType,Rest} - end. - - - -parse_SignedNumber([{number,_,Value}|Rest]) -> - {Value,Rest}; -parse_SignedNumber([{'-',_},{number,_,Value}|Rest]) -> - {-Value,Rest}; -parse_SignedNumber(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [number,'-number']]}}). - -parse_Enumerations(Tokens=[{identifier,_,_}|_Rest]) -> - parse_Enumerations(Tokens,[]); -parse_Enumerations([H|_T]) -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,identifier]}}). - -parse_Enumerations(Tokens = [{identifier,_,_},{'(',_}|_Rest], Acc) -> - {NamedNumber,Rest2} = parse_NamedNumber(Tokens), - case Rest2 of - [{',',_}|Rest3] -> - parse_Enumerations(Rest3,[NamedNumber|Acc]); - _ -> - {lists:reverse([NamedNumber|Acc]),Rest2} - end; -parse_Enumerations([{identifier,_,Id}|Rest], Acc) -> - case Rest of - [{',',_}|Rest2] -> - parse_Enumerations(Rest2,[Id|Acc]); - _ -> - {lists:reverse([Id|Acc]),Rest} - end; -parse_Enumerations([{'...',_}|Rest], Acc) -> - case Rest of - [{',',_}|Rest2] -> - parse_Enumerations(Rest2,['EXTENSIONMARK'|Acc]); - _ -> - {lists:reverse(['EXTENSIONMARK'|Acc]),Rest} - end; -parse_Enumerations([H|_T],_) -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,identifier]}}). - -parse_NamedNumberList(Tokens) -> - parse_NamedNumberList(Tokens,[]). - -parse_NamedNumberList(Tokens,Acc) -> - {NamedNum,Rest} = parse_NamedNumber(Tokens), - case Rest of - [{',',_}|Rest2] -> - parse_NamedNumberList(Rest2,[NamedNum|Acc]); - _ -> - {lists:reverse([NamedNum|Acc]),Rest} - end. - -parse_NamedNumber([{identifier,_,Name},{'(',_}|Rest]) -> - Flist = [fun parse_SignedNumber/1, - fun parse_DefinedValue/1], - case (catch parse_or(Rest,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - {NamedNum,[{')',_}|Rest2]} -> - {{'NamedNumber',Name,NamedNum},Rest2}; - _ -> - throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), - [got,get_token(hd(Rest)),expected,'NamedNumberList']}}) - end; -parse_NamedNumber(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). - - -parse_Tag([{'[',_}|Rest]) -> - {Class,Rest2} = parse_Class(Rest), - {ClassNumber,Rest3} = - case Rest2 of - [{number,_,Num}|Rest21] -> - {Num,Rest21}; - _ -> - parse_DefinedValue(Rest2) - end, - case Rest3 of - [{']',_}|Rest4] -> - {#tag{class=Class,number=ClassNumber},Rest4}; - _ -> - throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module), - [got,get_token(hd(Rest3)),expected,']']}}) - end; -parse_Tag(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'[']}}). - -parse_Class([{'UNIVERSAL',_}|Rest]) -> - {'UNIVERSAL',Rest}; -parse_Class([{'APPLICATION',_}|Rest]) -> - {'APPLICATION',Rest}; -parse_Class([{'PRIVATE',_}|Rest]) -> - {'PRIVATE',Rest}; -parse_Class(Tokens) -> - {'CONTEXT',Tokens}. - -parse_Value(Tokens) -> - Flist = [fun parse_BuiltinValue/1, - fun parse_ValueFromObject/1, - fun parse_DefinedValue/1], - - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. - -parse_BuiltinValue([{bstring,_,Bstr}|Rest]) -> - {{bstring,Bstr},Rest}; -parse_BuiltinValue([{hstring,_,Hstr}|Rest]) -> - {{hstring,Hstr},Rest}; -parse_BuiltinValue([{'{',_},{'}',_}|Rest]) -> - {[],Rest}; -parse_BuiltinValue(Tokens = [{'{',_}|_Rest]) -> - Flist = [ - fun parse_SequenceOfValue/1, - fun parse_SequenceValue/1, - fun parse_ObjectIdentifierValue/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end; -parse_BuiltinValue([{identifier,_,IdName},{':',_}|Rest]) -> - {Value,Rest2} = parse_Value(Rest), - {{'CHOICE',{IdName,Value}},Rest2}; -parse_BuiltinValue([{'NULL',_}|Rest]) -> - {'NULL',Rest}; -parse_BuiltinValue([{'TRUE',_}|Rest]) -> - {true,Rest}; -parse_BuiltinValue([{'FALSE',_}|Rest]) -> - {false,Rest}; -parse_BuiltinValue([{'PLUS-INFINITY',_}|Rest]) -> - {'PLUS-INFINITY',Rest}; -parse_BuiltinValue([{'MINUS-INFINITY',_}|Rest]) -> - {'MINUS-INFINITY',Rest}; -parse_BuiltinValue([{cstring,_,Cstr}|Rest]) -> - {Cstr,Rest}; -parse_BuiltinValue([{number,_,Num}|Rest]) -> - {Num,Rest}; -parse_BuiltinValue([{'-',_},{number,_,Num}|Rest]) -> - {- Num,Rest}; -parse_BuiltinValue(Tokens) -> - parse_ObjectClassFieldValue(Tokens). - -%% Externalvaluereference -parse_DefinedValue([{typereference,L1,Tname},{'.',_},{identifier,_,Idname}|Rest]) -> - {#'Externalvaluereference'{pos=L1,module=Tname,value=Idname},Rest}; -%% valuereference -parse_DefinedValue([Id = {identifier,_,_}|Rest]) -> - {identifier2Extvalueref(Id),Rest}; -%% ParameterizedValue -parse_DefinedValue(Tokens) -> - parse_ParameterizedValue(Tokens). - - -parse_SequenceValue([{'{',_}|Tokens]) -> - parse_SequenceValue(Tokens,[]); -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) -> - {Value,Rest2} = parse_Value(Rest), - case Rest2 of - [{',',_}|Rest3] -> - parse_SequenceValue(Rest3,[{IdName,Value}|Acc]); - [{'}',_}|Rest3] -> - {lists:reverse([{IdName,Value}|Acc]),Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) - end; -parse_SequenceValue(Tokens,_Acc) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). - -parse_SequenceOfValue([{'{',_}|Tokens]) -> - parse_SequenceOfValue(Tokens,[]); -parse_SequenceOfValue(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). - -parse_SequenceOfValue(Tokens,Acc) -> - {Value,Rest2} = parse_Value(Tokens), - case Rest2 of - [{',',_}|Rest3] -> - parse_SequenceOfValue(Rest3,[Value|Acc]); - [{'}',_}|Rest3] -> - {lists:reverse([Value|Acc]),Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) - end. - -parse_ValueSetTypeAssignment([{typereference,L1,Name}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - case Rest2 of - [{'::=',_}|Rest3] -> - {ValueSet,Rest4} = parse_ValueSet(Rest3), - {#valuedef{pos=L1,name=Name,type=Type,value=ValueSet},Rest4}; - [H|_T] -> - throw({asn1_error,{get_line(L1),get(asn1_module), - [got,get_token(H),expected,'::=']}}) - end; -parse_ValueSetTypeAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - typereference]}}). - -parse_ValueSet([{'{',_}|Rest]) -> - {Elems,Rest2} = parse_ElementSetSpecs(Rest), - case Rest2 of - [{'}',_}|Rest3] -> - {{valueset,Elems},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'}']}}) - end; -parse_ValueSet(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). - -parse_ValueAssignment([{identifier,L1,IdName}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - case Rest2 of - [{'::=',_}|Rest3] -> - {Value,Rest4} = parse_Value(Rest3), - case lookahead_assignment(Rest4) of - ok -> - {#valuedef{pos=L1,name=IdName,type=Type,value=Value},Rest4}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'::=']}}) - end; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'::=']}}) - end; -parse_ValueAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). - -%% SizeConstraint -parse_SubtypeElements([{'SIZE',_}|Tokens]) -> - {Constraint,Rest} = parse_Constraint(Tokens), - {{'SizeConstraint',Constraint#constraint.c},Rest}; -%% PermittedAlphabet -parse_SubtypeElements([{'FROM',_}|Tokens]) -> - {Constraint,Rest} = parse_Constraint(Tokens), - {{'PermittedAlphabet',Constraint#constraint.c},Rest}; -%% InnerTypeConstraints -parse_SubtypeElements([{'WITH',_},{'COMPONENT',_}|Tokens]) -> - {Constraint,Rest} = parse_Constraint(Tokens), - {{'WITH COMPONENT',Constraint},Rest}; -parse_SubtypeElements([{'WITH',_},{'COMPONENTS',_},{'{',_},{'...',_},{',',_}|Tokens]) -> - {Constraint,Rest} = parse_TypeConstraints(Tokens), - case Rest of - [{'}',_}|Rest2] -> - {{'WITH COMPONENTS',{'PartialSpecification',Constraint}},Rest2}; - _ -> - throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), - [got,get_token(hd(Rest)),expected,'}']}}) - end; -parse_SubtypeElements([{'WITH',_},{'COMPONENTS',_},{'{',_}|Tokens]) -> - {Constraint,Rest} = parse_TypeConstraints(Tokens), - case Rest of - [{'}',_}|Rest2] -> - {{'WITH COMPONENTS',{'FullSpecification',Constraint}},Rest2}; - _ -> - throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), - [got,get_token(hd(Rest)),expected,'}']}}) - end; -%% SingleValue -%% ContainedSubtype -%% ValueRange -%% TypeConstraint -parse_SubtypeElements(Tokens) -> - Flist = [fun parse_ContainedSubtype/1, - fun parse_Value/1, - fun([{'MIN',_}|T]) -> {'MIN',T} end, - fun parse_Type/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - {asn1_error,Reason} -> - throw(Reason); - Result = {Val,_} when record(Val,type) -> - Result; - {Lower,[{'..',_}|Rest]} -> - {Upper,Rest2} = parse_UpperEndpoint(Rest), - {{'ValueRange',{Lower,Upper}},Rest2}; - {Lower,[{'<',_},{'..',_}|Rest]} -> - {Upper,Rest2} = parse_UpperEndpoint(Rest), - {{'ValueRange',{{gt,Lower},Upper}},Rest2}; - {Res={'ContainedSubtype',_Type},Rest} -> - {Res,Rest}; - {Value,Rest} -> - {{'SingleValue',Value},Rest} - end. - -parse_ContainedSubtype([{'INCLUDES',_}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - {{'ContainedSubtype',Type},Rest2}; -parse_ContainedSubtype(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'INCLUDES']}}). -%%parse_ContainedSubtype(Tokens) -> %this option is moved to parse_SubtypeElements -%% parse_Type(Tokens). - -parse_UpperEndpoint([{'<',_}|Rest]) -> - parse_UpperEndpoint(lt,Rest); -parse_UpperEndpoint(Tokens) -> - parse_UpperEndpoint(false,Tokens). - -parse_UpperEndpoint(Lt,Tokens) -> - Flist = [ fun([{'MAX',_}|T]) -> {'MAX',T} end, - fun parse_Value/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - {Value,Rest2} when Lt == lt -> - {{lt,Value},Rest2}; - {Value,Rest2} -> - {Value,Rest2} - end. - -parse_TypeConstraints(Tokens) -> - parse_TypeConstraints(Tokens,[]). - -parse_TypeConstraints([{identifier,_,_}|Rest],Acc) -> - {ComponentConstraint,Rest2} = parse_ComponentConstraint(Rest), - case Rest2 of - [{',',_}|Rest3] -> - parse_TypeConstraints(Rest3,[ComponentConstraint|Acc]); - _ -> - {lists:reverse([ComponentConstraint|Acc]),Rest2} - end; -parse_TypeConstraints([H|_T],_) -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,identifier]}}). - -parse_ComponentConstraint(Tokens = [{'(',_}|_Rest]) -> - {ValueConstraint,Rest2} = parse_Constraint(Tokens), - {PresenceConstraint,Rest3} = parse_PresenceConstraint(Rest2), - {{ValueConstraint,PresenceConstraint},Rest3}; -parse_ComponentConstraint(Tokens) -> - {PresenceConstraint,Rest} = parse_PresenceConstraint(Tokens), - {{asn1_empty,PresenceConstraint},Rest}. - -parse_PresenceConstraint([{'PRESENT',_}|Rest]) -> - {'PRESENT',Rest}; -parse_PresenceConstraint([{'ABSENT',_}|Rest]) -> - {'ABSENT',Rest}; -parse_PresenceConstraint([{'OPTIONAL',_}|Rest]) -> - {'OPTIONAL',Rest}; -parse_PresenceConstraint(Tokens) -> - {asn1_empty,Tokens}. - - -merge_constraints({Rlist,ExtList}) -> % extensionmarker in constraint - {merge_constraints(Rlist,[],[]), - merge_constraints(ExtList,[],[])}; - -merge_constraints(Clist) -> - merge_constraints(Clist, [], []). - -merge_constraints([Ch|Ct],Cacc, Eacc) -> - NewEacc = case Ch#constraint.e of - undefined -> Eacc; - E -> [E|Eacc] - end, - merge_constraints(Ct,[fixup_constraint(Ch#constraint.c)|Cacc],NewEacc); - -merge_constraints([],Cacc,[]) -> -%% lists:flatten(Cacc); - lists:reverse(Cacc); -merge_constraints([],Cacc,Eacc) -> -%% lists:flatten(Cacc) ++ [{'Errors',Eacc}]. - lists:reverse(Cacc) ++ [{'Errors',Eacc}]. - -fixup_constraint(C) -> - case C of - {'SingleValue',SubType} when element(1,SubType) == 'ContainedSubtype' -> - SubType; - {'SingleValue',V} when list(V) -> - C; - %% [C,{'ValueRange',{lists:min(V),lists:max(V)}}]; - %% bug, turns wrong when an element in V is a reference to a defined value - {'PermittedAlphabet',{'SingleValue',V}} when list(V) -> - %%sort and remove duplicates - V2 = {'SingleValue', - ordsets:list_to_set(lists:flatten(V))}, - {'PermittedAlphabet',V2}; - {'PermittedAlphabet',{'SingleValue',V}} -> - V2 = {'SingleValue',[V]}, - {'PermittedAlphabet',V2}; - {'SizeConstraint',Sc} -> - {'SizeConstraint',fixup_size_constraint(Sc)}; - - List when list(List) -> %% In This case maybe a union or intersection - [fixup_constraint(Xc)||Xc <- List]; - Other -> - Other - end. - -fixup_size_constraint({'ValueRange',{Lb,Ub}}) -> - {Lb,Ub}; -fixup_size_constraint({{'ValueRange',R},[]}) -> - {R,[]}; -fixup_size_constraint({[],{'ValueRange',R}}) -> - {[],R}; -fixup_size_constraint({{'ValueRange',R1},{'ValueRange',R2}}) -> - {R1,R2}; -fixup_size_constraint({'SingleValue',[Sv]}) -> - fixup_size_constraint({'SingleValue',Sv}); -fixup_size_constraint({'SingleValue',L}) when list(L) -> - ordsets:list_to_set(L); -fixup_size_constraint({'SingleValue',L}) -> - {L,L}; -fixup_size_constraint({C1,C2}) -> - {fixup_size_constraint(C1), fixup_size_constraint(C2)}. - -get_line({_,Pos,Token}) when integer(Pos),atom(Token) -> - Pos; -get_line({Token,Pos}) when integer(Pos),atom(Token) -> - Pos; -get_line(_) -> - undefined. - -get_token({_,Pos,Token}) when integer(Pos),atom(Token) -> - Token; -get_token({'$end',Pos}) when integer(Pos) -> - undefined; -get_token({Token,Pos}) when integer(Pos),atom(Token) -> - Token; -get_token(_) -> - undefined. - -prioritize_error(ErrList) -> - case lists:keymember(asn1_error,1,ErrList) of - false -> % only asn1_assignment_error -> take the last - lists:last(ErrList); - true -> % contains errors from deeper in a Type - NewErrList = [_Err={_,_}|_RestErr] = - lists:filter(fun({asn1_error,_})->true;(_)->false end, - ErrList), - SplitErrs = - lists:splitwith(fun({_,X})-> - case element(1,X) of - Int when integer(Int) -> true; - _ -> false - end - end, - NewErrList), - case SplitErrs of - {[],UndefPosErrs} -> % if no error with Positon exists - lists:last(UndefPosErrs); - {IntPosErrs,_} -> - IntPosReasons = lists:map(fun(X)->element(2,X) end,IntPosErrs), - SortedReasons = lists:keysort(1,IntPosReasons), - {asn1_error,lists:last(SortedReasons)} - end - end. - -%% most_prio_error([H={_,Reason}|T],Atom,Err) when atom(Atom) -> -%% most_prio_error(T,element(1,Reason),H); -%% most_prio_error([H={_,Reason}|T],Greatest,Err) -> -%% case element(1,Reason) of -%% Pos when integer(Pos),Pos>Greatest -> -%% most_prio_error( - - -tref2Exttref(#typereference{pos=Pos,val=Name}) -> - #'Externaltypereference'{pos=Pos, - module=get(asn1_module), - type=Name}. - -tref2Exttref(Pos,Name) -> - #'Externaltypereference'{pos=Pos, - module=get(asn1_module), - type=Name}. - -identifier2Extvalueref(#identifier{pos=Pos,val=Name}) -> - #'Externalvaluereference'{pos=Pos, - module=get(asn1_module), - value=Name}. - -%% lookahead_assignment/1 checks that the next sequence of tokens -%% in Token contain a valid assignment or the -%% 'END' token. Otherwise an exception is thrown. -lookahead_assignment([{'END',_}|_Rest]) -> - ok; -lookahead_assignment(Tokens) -> - parse_Assignment(Tokens), - ok. - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_pretty_format.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_pretty_format.erl deleted file mode 100644 index e0abcd36ec..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_pretty_format.erl +++ /dev/null @@ -1,199 +0,0 @@ -%% ``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: asn1ct_pretty_format.erl,v 1.1 2008/12/17 09:53:30 mikpe Exp $ -%% - -%% usage: pretty_format:term(Term) -> PNF list of characters -%% -%% Note: this is usually used in expressions like: -%% io:format('~s\n',[pretty_format:term(Term)]). -%% -%% Uses the following simple heuristics -%% -%% 1) Simple tuples are printed across the page -%% (Simple means *all* the elements are "flat") -%% 2) The Complex tuple {Arg1, Arg2, Arg3,....} is printed thus: -%% {Arg1, -%% Arg2, -%% Arg3, -%% ...} -%% 3) Lists are treated as for tuples -%% 4) Lists of printable characters are treated as strings -%% -%% This method seems to work reasonable well for {Tag, ...} type -%% data structures - --module(asn1ct_pretty_format). - --export([term/1]). - --import(io_lib, [write/1, write_string/1]). - -term(Term) -> - element(2, term(Term, 0)). - -%%______________________________________________________________________ -%% pretty_format:term(Term, Indent} -> {Indent', Chars} -%% Format <Term> -- use <Indent> to indent the *next* line -%% Note: Indent' is a new indentaion level (sometimes printing <Term> -%% the next line to need an "extra" indent!). - -term([], Indent) -> - {Indent, [$[,$]]}; -term(L, Indent) when is_list(L) -> - case is_string(L) of - true -> - {Indent, write_string(L)}; - false -> - case complex_list(L) of - true -> - write_complex_list(L, Indent); - false -> - write_simple_list(L, Indent) - end - end; -term(T, Indent) when is_tuple(T) -> - case complex_tuple(T) of - true -> - write_complex_tuple(T, Indent); - false -> - write_simple_tuple(T, Indent) - end; -term(A, Indent) -> - {Indent, write(A)}. - -%%______________________________________________________________________ -%% write_simple_list([H|T], Indent) -> {Indent', Chars} - -write_simple_list([H|T], Indent) -> - {_, S1} = term(H, Indent), - {_, S2} = write_simple_list_tail(T, Indent), - {Indent, [$[,S1|S2]}. - -write_simple_list_tail([H|T], Indent) -> - {_, S1} = term(H, Indent), - {_, S2} = write_simple_list_tail(T, Indent), - {Indent, [$,,S1| S2]}; -write_simple_list_tail([], Indent) -> - {Indent, "]"}; -write_simple_list_tail(Other, Indent) -> - {_, S} = term(Other, Indent), - {Indent, [$|,S,$]]}. - -%%______________________________________________________________________ -%% write_complex_list([H|T], Indent) -> {Indent', Chars} - -write_complex_list([H|T], Indent) -> - {I1, S1} = term(H, Indent+1), - {_, S2} = write_complex_list_tail(T, I1), - {Indent, [$[,S1|S2]}. - -write_complex_list_tail([H|T], Indent) -> - {I1, S1} = term(H, Indent), - {_, S2} = write_complex_list_tail(T, I1), - {Indent, [$,,nl_indent(Indent),S1,S2]}; -write_complex_list_tail([], Indent) -> - {Indent, "]"}; -write_complex_list_tail(Other, Indent) ->$,, - {_, S} = term(Other, Indent), - {Indent, [$|,S,$]]}. - -%%______________________________________________________________________ -%% complex_list(List) -> true | false -%% returns true if the list is complex otherwise false - -complex_list([]) -> - false; -complex_list([H|T]) when is_number(H); is_atom(H) -> - complex_list(T); -complex_list([H|T]) -> - case is_string(H) of - true -> - complex_list(T); - false -> - true - end; -complex_list(_) -> true. - -%%______________________________________________________________________ -%% complex_tuple(Tuple) -> true | false -%% returns true if the tuple is complex otherwise false - -complex_tuple(T) -> - complex_list(tuple_to_list(T)). - -%%______________________________________________________________________ -%% write_simple_tuple(Tuple, Indent} -> {Indent', Chars} - -write_simple_tuple({}, Indent) -> - {Indent, "{}"}; -write_simple_tuple(Tuple, Indent) -> - {_, S} = write_simple_tuple_args(tuple_to_list(Tuple), Indent), - {Indent, [${, S, $}]}. - -write_simple_tuple_args([X], Indent) -> - term(X, Indent); -write_simple_tuple_args([H|T], Indent) -> - {_, SH} = term(H, Indent), - {_, ST} = write_simple_tuple_args(T, Indent), - {Indent, [SH, $,, ST]}. - -%%______________________________________________________________________ -%% write_complex_tuple(Tuple, Indent} -> {Indent', Chars} - -write_complex_tuple(Tuple, Indent) -> - [H|T] = tuple_to_list(Tuple), - {I1, SH} = term(H, Indent+2), - {_, ST} = write_complex_tuple_args(T, I1), - {Indent, [${, SH, ST, $}]}. - -write_complex_tuple_args([X], Indent) -> - {_, S} = term(X, Indent), - {Indent, [$,, nl_indent(Indent), S]}; -write_complex_tuple_args([H|T], Indent) -> - {I1, SH} = term(H, Indent), - {_, ST} = write_complex_tuple_args(T, I1), - {Indent, [$,, nl_indent(Indent) , SH, ST]}; -write_complex_tuple_args([], Indent) -> - {Indent, []}. - -%%______________________________________________________________________ -%% utilities - -nl_indent(I) when I >= 0 -> - ["\n"|indent(I)]; -nl_indent(_) -> - [$\s]. - -indent(I) when I >= 8 -> - [$\t|indent(I-8)]; -indent(I) when I > 0 -> - [$\s|indent(I-1)]; -indent(_) -> - []. - -is_string([9|T]) -> - is_string(T); -is_string([10|T]) -> - is_string(T); -is_string([H|T]) when H >31, H < 127 -> - is_string(T); -is_string([]) -> - true; -is_string(_) -> - false. - - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_tok.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_tok.erl deleted file mode 100644 index 3ac1b68b37..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_tok.erl +++ /dev/null @@ -1,351 +0,0 @@ -%% ``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: asn1ct_tok.erl,v 1.1 2008/12/17 09:53:30 mikpe Exp $ -%% --module(asn1ct_tok). - -%% Tokenize ASN.1 code (input to parser generated with yecc) - --export([get_name/2,tokenise/2, file/1]). - - -file(File) -> - case file:open(File, [read]) of - {error, Reason} -> - {error,{File,file:format_error(Reason)}}; - {ok,Stream} -> - process0(Stream) - end. - -process0(Stream) -> - process(Stream,0,[]). - -process(Stream,Lno,R) -> - process(io:get_line(Stream, ''), Stream,Lno+1,R). - -process(eof, Stream,Lno,R) -> - file:close(Stream), - lists:flatten(lists:reverse([{'$end',Lno}|R])); - - -process(L, Stream,Lno,R) when list(L) -> - %%io:format('read:~s',[L]), - case catch tokenise(L,Lno) of - {'ERR',Reason} -> - io:format("Tokeniser error on line: ~w ~w~n",[Lno,Reason]), - exit(0); - T -> - %%io:format('toks:~w~n',[T]), - process(Stream,Lno,[T|R]) - end. - - -tokenise([H|T],Lno) when $a =< H , H =< $z -> - {X, T1} = get_name(T, [H]), - [{identifier,Lno, list_to_atom(X)}|tokenise(T1,Lno)]; - -tokenise([$&,H|T],Lno) when $A =< H , H =< $Z -> - {Y, T1} = get_name(T, [H]), - X = list_to_atom(Y), - [{typefieldreference, Lno, X} | tokenise(T1, Lno)]; - -tokenise([$&,H|T],Lno) when $a =< H , H =< $z -> - {Y, T1} = get_name(T, [H]), - X = list_to_atom(Y), - [{valuefieldreference, Lno, X} | tokenise(T1, Lno)]; - -tokenise([H|T],Lno) when $A =< H , H =< $Z -> - {Y, T1} = get_name(T, [H]), - X = list_to_atom(Y), - case reserved_word(X) of - true -> - [{X,Lno}|tokenise(T1,Lno)]; - false -> - [{typereference,Lno,X}|tokenise(T1,Lno)]; - rstrtype -> - [{restrictedcharacterstringtype,Lno,X}|tokenise(T1,Lno)] - end; - -tokenise([$-,H|T],Lno) when $0 =< H , H =< $9 -> - {X, T1} = get_number(T, [H]), - [{number,Lno,-1 * list_to_integer(X)}|tokenise(T1,Lno)]; - -tokenise([H|T],Lno) when $0 =< H , H =< $9 -> - {X, T1} = get_number(T, [H]), - [{number,Lno,list_to_integer(X)}|tokenise(T1,Lno)]; - -tokenise([$-,$-|T],Lno) -> - tokenise(skip_comment(T),Lno); -tokenise([$:,$:,$=|T],Lno) -> - [{'::=',Lno}|tokenise(T,Lno)]; - -tokenise([$'|T],Lno) -> - case catch collect_quoted(T,Lno,[]) of - {'ERR',_} -> - throw({'ERR','bad_quote'}); - {Thing, T1} -> - [Thing|tokenise(T1,Lno)] - end; - -tokenise([$"|T],Lno) -> - collect_string(T,Lno); - -tokenise([${|T],Lno) -> - [{'{',Lno}|tokenise(T,Lno)]; - -tokenise([$}|T],Lno) -> - [{'}',Lno}|tokenise(T,Lno)]; - -tokenise([$]|T],Lno) -> - [{']',Lno}|tokenise(T,Lno)]; - -tokenise([$[|T],Lno) -> - [{'[',Lno}|tokenise(T,Lno)]; - -tokenise([$,|T],Lno) -> - [{',',Lno}|tokenise(T,Lno)]; - -tokenise([$(|T],Lno) -> - [{'(',Lno}|tokenise(T,Lno)]; -tokenise([$)|T],Lno) -> - [{')',Lno}|tokenise(T,Lno)]; - -tokenise([$.,$.,$.|T],Lno) -> - [{'...',Lno}|tokenise(T,Lno)]; - -tokenise([$.,$.|T],Lno) -> - [{'..',Lno}|tokenise(T,Lno)]; - -tokenise([$.|T],Lno) -> - [{'.',Lno}|tokenise(T,Lno)]; -tokenise([$^|T],Lno) -> - [{'^',Lno}|tokenise(T,Lno)]; -tokenise([$!|T],Lno) -> - [{'!',Lno}|tokenise(T,Lno)]; -tokenise([$||T],Lno) -> - [{'|',Lno}|tokenise(T,Lno)]; - - -tokenise([H|T],Lno) -> - case white_space(H) of - true -> - tokenise(T,Lno); - false -> - [{list_to_atom([H]),Lno}|tokenise(T,Lno)] - end; -tokenise([],_) -> - []. - - -collect_string(L,Lno) -> - collect_string(L,Lno,[]). - -collect_string([],_,_) -> - throw({'ERR','bad_quote found eof'}); - -collect_string([H|T],Lno,Str) -> - case H of - $" -> - [{cstring,1,lists:reverse(Str)}|tokenise(T,Lno)]; - Ch -> - collect_string(T,Lno,[Ch|Str]) - end. - - - -% <name> is letters digits hyphens -% hypen is not the last character. Hypen hyphen is NOT allowed -% -% <identifier> ::= <lowercase> <name> - -get_name([$-,Char|T], L) -> - case isalnum(Char) of - true -> - get_name(T,[Char,$-|L]); - false -> - {lists:reverse(L),[$-,Char|T]} - end; -get_name([$-|T], L) -> - {lists:reverse(L),[$-|T]}; -get_name([Char|T], L) -> - case isalnum(Char) of - true -> - get_name(T,[Char|L]); - false -> - {lists:reverse(L),[Char|T]} - end; -get_name([], L) -> - {lists:reverse(L), []}. - - -isalnum(H) when $A =< H , H =< $Z -> - true; -isalnum(H) when $a =< H , H =< $z -> - true; -isalnum(H) when $0 =< H , H =< $9 -> - true; -isalnum(_) -> - false. - -isdigit(H) when $0 =< H , H =< $9 -> - true; -isdigit(_) -> - false. - -white_space(9) -> true; -white_space(10) -> true; -white_space(13) -> true; -white_space(32) -> true; -white_space(_) -> false. - - -get_number([H|T], L) -> - case isdigit(H) of - true -> - get_number(T, [H|L]); - false -> - {lists:reverse(L), [H|T]} - end; -get_number([], L) -> - {lists:reverse(L), []}. - -skip_comment([]) -> - []; -skip_comment([$-,$-|T]) -> - T; -skip_comment([_|T]) -> - skip_comment(T). - -collect_quoted([$',$B|T],Lno, L) -> - case check_bin(L) of - true -> - {{bstring,Lno, lists:reverse(L)}, T}; - false -> - throw({'ERR',{invalid_binary_number, lists:reverse(L)}}) - end; -collect_quoted([$',$H|T],Lno, L) -> - case check_hex(L) of - true -> - {{hstring,Lno, lists:reverse(L)}, T}; - false -> - throw({'ERR',{invalid_binary_number, lists:reverse(L)}}) - end; -collect_quoted([H|T], Lno, L) -> - collect_quoted(T, Lno,[H|L]); -collect_quoted([], _, _) -> % This should be allowed FIX later - throw({'ERR',{eol_in_token}}). - -check_bin([$0|T]) -> - check_bin(T); -check_bin([$1|T]) -> - check_bin(T); -check_bin([]) -> - true; -check_bin(_) -> - false. - -check_hex([H|T]) when $0 =< H , H =< $9 -> - check_hex(T); -check_hex([H|T]) when $A =< H , H =< $F -> - check_hex(T); -check_hex([]) -> - true; -check_hex(_) -> - false. - - -%% reserved_word(A) -> true|false|rstrtype -%% A = atom() -%% returns true if A is a reserved ASN.1 word -%% returns false if A is not a reserved word -%% 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; -reserved_word('AUTOMATIC') -> true; -reserved_word('BEGIN') -> true; -reserved_word('BIT') -> true; -reserved_word('BMPString') -> rstrtype; -reserved_word('BOOLEAN') -> true; -reserved_word('BY') -> true; -reserved_word('CHARACTER') -> true; -reserved_word('CHOICE') -> true; -reserved_word('CLASS') -> true; -reserved_word('COMPONENT') -> true; -reserved_word('COMPONENTS') -> true; -reserved_word('CONSTRAINED') -> true; -reserved_word('DEFAULT') -> true; -reserved_word('DEFINED') -> true; -reserved_word('DEFINITIONS') -> true; -reserved_word('EMBEDDED') -> true; -reserved_word('END') -> true; -reserved_word('ENUMERATED') -> true; -reserved_word('EXCEPT') -> true; -reserved_word('EXPLICIT') -> true; -reserved_word('EXPORTS') -> true; -reserved_word('EXTERNAL') -> true; -reserved_word('FALSE') -> true; -reserved_word('FROM') -> true; -reserved_word('GeneralizedTime') -> true; -reserved_word('GeneralString') -> rstrtype; -reserved_word('GraphicString') -> rstrtype; -reserved_word('IA5String') -> rstrtype; -% reserved_word('TYPE-IDENTIFIER') -> true; % impl as predef item -reserved_word('IDENTIFIER') -> true; -reserved_word('IMPLICIT') -> true; -reserved_word('IMPORTS') -> true; -reserved_word('INCLUDES') -> true; -reserved_word('INSTANCE') -> true; -reserved_word('INTEGER') -> true; -reserved_word('INTERSECTION') -> true; -reserved_word('ISO646String') -> rstrtype; -reserved_word('MAX') -> true; -reserved_word('MIN') -> true; -reserved_word('MINUS-INFINITY') -> true; -reserved_word('NULL') -> true; -reserved_word('NumericString') -> rstrtype; -reserved_word('OBJECT') -> true; -reserved_word('ObjectDescriptor') -> true; -reserved_word('OCTET') -> true; -reserved_word('OF') -> true; -reserved_word('OPTIONAL') -> true; -reserved_word('PDV') -> true; -reserved_word('PLUS-INFINITY') -> true; -reserved_word('PRESENT') -> true; -reserved_word('PrintableString') -> rstrtype; -reserved_word('PRIVATE') -> true; -reserved_word('REAL') -> true; -reserved_word('SEQUENCE') -> true; -reserved_word('SET') -> true; -reserved_word('SIZE') -> true; -reserved_word('STRING') -> true; -reserved_word('SYNTAX') -> true; -reserved_word('T61String') -> rstrtype; -reserved_word('TAGS') -> true; -reserved_word('TeletexString') -> rstrtype; -reserved_word('TRUE') -> true; -reserved_word('UNION') -> true; -reserved_word('UNIQUE') -> true; -reserved_word('UNIVERSAL') -> true; -reserved_word('UniversalString') -> rstrtype; -reserved_word('UTCTime') -> true; -reserved_word('VideotexString') -> rstrtype; -reserved_word('VisibleString') -> rstrtype; -reserved_word('WITH') -> true; -reserved_word(_) -> false. diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_value.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_value.erl deleted file mode 100644 index 9510e4b341..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_value.erl +++ /dev/null @@ -1,330 +0,0 @@ -%% ``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: asn1ct_value.erl,v 1.1 2008/12/17 09:53:30 mikpe Exp $ -%% --module(asn1ct_value). - -%% Generate Erlang values for ASN.1 types. -%% The value is randomized within it's constraints - --include("asn1_records.hrl"). -%-compile(export_all). - --export([get_type/3]). - - - -%% Generate examples of values ****************************** -%%****************************************x - - -get_type(M,Typename,Tellname) -> - case asn1_db:dbget(M,Typename) of - undefined -> - {asn1_error,{not_found,{M,Typename}}}; - Tdef when record(Tdef,typedef) -> - Type = Tdef#typedef.typespec, - get_type(M,[Typename],Type,Tellname); - Err -> - {asn1_error,{other,Err}} - end. - -get_type(M,Typename,Type,Tellname) when record(Type,type) -> - InnerType = get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - #'Externaltypereference'{module=Emod,type=Etype} -> - get_type(Emod,Etype,Tellname); - {_,user} -> - case Tellname of - yes -> {Typename,get_type(M,InnerType,no)}; - no -> get_type(M,InnerType,no) - end; - {notype,_} -> - true; - {primitive,bif} -> - get_type_prim(Type); - 'ASN1_OPEN_TYPE' -> - case Type#type.constraint of - [#'Externaltypereference'{type=TrefConstraint}] -> - get_type(M,TrefConstraint,no); - _ -> - "open_type" - end; - {constructed,bif} -> - get_type_constructed(M,Typename,InnerType,Type) - end; -get_type(M,Typename,#'ComponentType'{name = Name,typespec = Type},_) -> - get_type(M,[Name|Typename],Type,no); -get_type(_,_,_,_) -> % 'EXTENSIONMARK' - undefined. - -get_inner(A) when atom(A) -> A; -get_inner(Ext) when record(Ext,'Externaltypereference') -> Ext; -get_inner({typereference,_Pos,Name}) -> Name; -get_inner(T) when tuple(T) -> - case asn1ct_gen:get_inner(T) of - {fixedtypevaluefield,_,Type} -> - Type#type.def; - {typefield,_FieldName} -> - 'ASN1_OPEN_TYPE'; - Other -> - Other - end. -%%get_inner(T) when tuple(T) -> element(1,T). - - - -get_type_constructed(M,Typename,InnerType,D) when record(D,type) -> - case InnerType of - 'SET' -> - get_sequence(M,Typename,D); - 'SEQUENCE' -> - get_sequence(M,Typename,D); - 'CHOICE' -> - get_choice(M,Typename,D); - 'SEQUENCE OF' -> - {_,Type} = D#type.def, - NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def), - get_sequence_of(M,Typename,D,NameSuffix); - 'SET OF' -> - {_,Type} = D#type.def, - NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def), - get_sequence_of(M,Typename,D,NameSuffix); - _ -> - exit({nyi,InnerType}) - end. - -get_sequence(M,Typename,Type) -> - {_SEQorSET,CompList} = - case Type#type.def of - #'SEQUENCE'{components=Cl} -> {'SEQUENCE',Cl}; - #'SET'{components=Cl} -> {'SET',Cl} - end, - case get_components(M,Typename,CompList) of - [] -> - {list_to_atom(asn1ct_gen:list2rname(Typename))}; - C -> - list_to_tuple([list_to_atom(asn1ct_gen:list2rname(Typename))|C]) - end. - -get_components(M,Typename,{Root,Ext}) -> - get_components(M,Typename,Root++Ext); - -%% Should enhance this *** HERE *** with proper handling of extensions - -get_components(M,Typename,[H|T]) -> - [get_type(M,Typename,H,no)| - get_components(M,Typename,T)]; -get_components(_,_,[]) -> - []. - -get_choice(M,Typename,Type) -> - {'CHOICE',TCompList} = Type#type.def, - case TCompList of - [] -> - {asn1_EMPTY,asn1_EMPTY}; - {CompList,ExtList} -> % Should be enhanced to handle extensions too - CList = CompList ++ ExtList, - C = lists:nth(random(length(CList)),CList), - {C#'ComponentType'.name,get_type(M,Typename,C,no)}; - CompList when list(CompList) -> - C = lists:nth(random(length(CompList)),CompList), - {C#'ComponentType'.name,get_type(M,Typename,C,no)} - end. - -get_sequence_of(M,Typename,Type,TypeSuffix) -> - %% should generate length according to constraints later - {_,Oftype} = Type#type.def, - C = Type#type.constraint, - S = size_random(C), - NewTypeName = [TypeSuffix|Typename], - gen_list(M,NewTypeName,Oftype,no,S). - -gen_list(_,_,_,_,0) -> - []; -gen_list(M,Typename,Oftype,Tellname,N) -> - [get_type(M,Typename,Oftype,no)|gen_list(M,Typename,Oftype,Tellname,N-1)]. - -get_type_prim(D) -> - C = D#type.constraint, - case D#type.def of - 'INTEGER' -> - i_random(C); - {'INTEGER',NamedNumberList} -> - NN = [X||{X,_} <- NamedNumberList], - case NN of - [] -> - i_random(C); - _ -> - lists:nth(random(length(NN)),NN) - end; - Enum when tuple(Enum),element(1,Enum)=='ENUMERATED' -> - NamedNumberList = - case Enum of - {_,_,NNL} -> NNL; - {_,NNL} -> NNL - end, - NNew= - case NamedNumberList of - {N1,N2} -> - N1 ++ N2; - _-> - NamedNumberList - end, - NN = [X||{X,_} <- NNew], - case NN of - [] -> - asn1_EMPTY; - _ -> - lists:nth(random(length(NN)),NN) - end; - {'BIT STRING',NamedNumberList} -> -%% io:format("get_type_prim 1: ~w~n",[NamedNumberList]), - NN = [X||{X,_} <- NamedNumberList], - case NN of - [] -> - Bl1 =lists:reverse(adjust_list(size_random(C),[1,0,1,1])), - lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end,Bl1)); - _ -> -%% io:format("get_type_prim 2: ~w~n",[NN]), - [lists:nth(random(length(NN)),NN)] - end; - 'ANY' -> - exit({asn1_error,nyi,'ANY'}); - 'NULL' -> - 'NULL'; - 'OBJECT IDENTIFIER' -> - Len = random(3), - Olist = [(random(1000)-1)||_X <-lists:seq(1,Len)], - list_to_tuple([random(3)-1,random(40)-1|Olist]); - 'ObjectDescriptor' -> - object_descriptor_nyi; - 'BOOLEAN' -> - true; - 'OCTET STRING' -> - adjust_list(size_random(C),c_string(C,"OCTET STRING")); - 'NumericString' -> - adjust_list(size_random(C),c_string(C,"0123456789")); - 'TeletexString' -> - adjust_list(size_random(C),c_string(C,"TeletexString")); - 'VideotexString' -> - adjust_list(size_random(C),c_string(C,"VideotexString")); - 'UTCTime' -> - "97100211-0500"; - 'GeneralizedTime' -> - "19971002103130.5"; - 'GraphicString' -> - adjust_list(size_random(C),c_string(C,"GraphicString")); - 'VisibleString' -> - adjust_list(size_random(C),c_string(C,"VisibleString")); - 'GeneralString' -> - adjust_list(size_random(C),c_string(C,"GeneralString")); - 'PrintableString' -> - adjust_list(size_random(C),c_string(C,"PrintableString")); - 'IA5String' -> - adjust_list(size_random(C),c_string(C,"IA5String")); - 'BMPString' -> - adjust_list(size_random(C),c_string(C,"BMPString")); - 'UniversalString' -> - adjust_list(size_random(C),c_string(C,"UniversalString")); - XX -> - exit({asn1_error,nyi,XX}) - end. - -c_string(undefined,Default) -> - Default; -c_string(C,Default) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} when list(Sv) -> - Sv; - {'SingleValue',V} when integer(V) -> - [V]; - no -> - Default - end. - -random(Upper) -> - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), - random:uniform(Upper). - -size_random(C) -> - case get_constraint(C,'SizeConstraint') of - no -> - c_random({0,5},no); - {Lb,Ub} when Ub-Lb =< 4 -> - c_random({Lb,Ub},no); - {Lb,_} -> - c_random({Lb,Lb+4},no); - Sv -> - c_random(no,Sv) - end. - -i_random(C) -> - c_random(get_constraint(C,'ValueRange'),get_constraint(C,'SingleValue')). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% c_random(Range,SingleValue) -%% only called from other X_random functions - -c_random(VRange,Single) -> - case {VRange,Single} of - {no,no} -> - random(16#fffffff) - (16#fffffff bsr 1); - {R,no} -> - case R of - {Lb,Ub} when integer(Lb),integer(Ub) -> - Range = Ub - Lb +1, - Lb + (random(Range)-1); - {Lb,'MAX'} -> - Lb + random(16#fffffff)-1; - {'MIN',Ub} -> - Ub - random(16#fffffff)-1; - {A,{'ASN1_OK',B}} -> - Range = B - A +1, - A + (random(Range)-1) - end; - {_,S} when integer(S) -> - S; - {_,S} when list(S) -> - lists:nth(random(length(S)),S) -%% {S1,S2} -> -%% io:format("asn1ct_value: hejsan hoppsan~n"); -%% _ -> -%% io:format("asn1ct_value: hejsan hoppsan 2~n") -%% io:format("asn1ct_value: c_random/2: S1 = ~w~n" -%% "S2 = ~w,~n",[S1,S2]) -%% exit(self(),goodbye) - end. - -adjust_list(Len,Orig) -> - adjust_list1(Len,Orig,Orig,[]). - -adjust_list1(0,_Orig,[_Oh|_Ot],Acc) -> - lists:reverse(Acc); -adjust_list1(Len,Orig,[],Acc) -> - adjust_list1(Len,Orig,Orig,Acc); -adjust_list1(Len,Orig,[Oh|Ot],Acc) -> - adjust_list1(Len-1,Orig,Ot,[Oh|Acc]). - - -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt.erl deleted file mode 100644 index 1d73927052..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt.erl +++ /dev/null @@ -1,69 +0,0 @@ -%% ``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: asn1rt.erl,v 1.1 2008/12/17 09:53:30 mikpe Exp $ -%% --module(asn1rt). - -%% Runtime functions for ASN.1 (i.e encode, decode) - --export([encode/2,encode/3,decode/3,load_driver/0,unload_driver/0,info/1]). - -encode(Module,{Type,Term}) -> - encode(Module,Type,Term). - -encode(Module,Type,Term) -> - case catch apply(Module,encode,[Type,Term]) of - {'EXIT',undef} -> - {error,{asn1,{undef,Module,Type}}}; - Result -> - Result - end. - -decode(Module,Type,Bytes) -> - case catch apply(Module,decode,[Type,Bytes]) of - {'EXIT',undef} -> - {error,{asn1,{undef,Module,Type}}}; - Result -> - Result - end. - -load_driver() -> - asn1rt_driver_handler:load_driver(), - receive - driver_ready -> - ok; - Err={error,_Reason} -> - Err; - Error -> - {error,Error} - end. - -unload_driver() -> - case catch asn1rt_driver_handler:unload_driver() of - ok -> - ok; - Error -> - {error,Error} - end. - - -info(Module) -> - case catch apply(Module,info,[]) of - {'EXIT',{undef,_Reason}} -> - {error,{asn1,{undef,Module,info}}}; - Result -> - {ok,Result} - end. diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_ber_bin.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_ber_bin.erl deleted file mode 100644 index 4f4574513e..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_ber_bin.erl +++ /dev/null @@ -1,2310 +0,0 @@ -%% ``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: asn1rt_ber_bin.erl,v 1.1 2008/12/17 09:53:30 mikpe Exp $ -%% --module(asn1rt_ber_bin). - -%% encoding / decoding of BER - --export([decode/1]). --export([fixoptionals/2,split_list/2,cindex/3,restbytes2/3, - list_to_record/2, - encode_tag_val/1,decode_tag/1,peek_tag/1, - check_tags/3, encode_tags/3]). --export([encode_boolean/2,decode_boolean/3, - encode_integer/3,encode_integer/4, - decode_integer/4,decode_integer/5,encode_enumerated/2, - encode_enumerated/4,decode_enumerated/5, - encode_real/2,decode_real/4, - encode_bit_string/4,decode_bit_string/6, - decode_compact_bit_string/6, - encode_octet_string/3,decode_octet_string/5, - encode_null/2,decode_null/3, - encode_object_identifier/2,decode_object_identifier/3, - encode_restricted_string/4,decode_restricted_string/6, - encode_universal_string/3,decode_universal_string/5, - encode_BMP_string/3,decode_BMP_string/5, - encode_generalized_time/3,decode_generalized_time/5, - encode_utc_time/3,decode_utc_time/5, - encode_length/1,decode_length/1, - check_if_valid_tag/3, - decode_tag_and_length/1, decode_components/6, - decode_components/7, decode_set/6]). - --export([encode_open_type/1,encode_open_type/2,decode_open_type/1,decode_open_type/2,decode_open_type/3]). --export([skipvalue/1, skipvalue/2]). - --include("asn1_records.hrl"). - -% the encoding of class of tag bits 8 and 7 --define(UNIVERSAL, 0). --define(APPLICATION, 16#40). --define(CONTEXT, 16#80). --define(PRIVATE, 16#C0). - -%%% primitive or constructed encoding % bit 6 --define(PRIMITIVE, 0). --define(CONSTRUCTED, 2#00100000). - -%%% The tag-number for universal types --define(N_BOOLEAN, 1). --define(N_INTEGER, 2). --define(N_BIT_STRING, 3). --define(N_OCTET_STRING, 4). --define(N_NULL, 5). --define(N_OBJECT_IDENTIFIER, 6). --define(N_OBJECT_DESCRIPTOR, 7). --define(N_EXTERNAL, 8). --define(N_REAL, 9). --define(N_ENUMERATED, 10). --define(N_EMBEDDED_PDV, 11). --define(N_SEQUENCE, 16). --define(N_SET, 17). --define(N_NumericString, 18). --define(N_PrintableString, 19). --define(N_TeletexString, 20). --define(N_VideotexString, 21). --define(N_IA5String, 22). --define(N_UTCTime, 23). --define(N_GeneralizedTime, 24). --define(N_GraphicString, 25). --define(N_VisibleString, 26). --define(N_GeneralString, 27). --define(N_UniversalString, 28). --define(N_BMPString, 30). - - -% the complete tag-word of built-in types --define(T_BOOLEAN, ?UNIVERSAL bor ?PRIMITIVE bor 1). --define(T_INTEGER, ?UNIVERSAL bor ?PRIMITIVE bor 2). --define(T_BIT_STRING, ?UNIVERSAL bor ?PRIMITIVE bor 3). % can be CONSTRUCTED --define(T_OCTET_STRING, ?UNIVERSAL bor ?PRIMITIVE bor 4). % can be CONSTRUCTED --define(T_NULL, ?UNIVERSAL bor ?PRIMITIVE bor 5). --define(T_OBJECT_IDENTIFIER,?UNIVERSAL bor ?PRIMITIVE bor 6). --define(T_OBJECT_DESCRIPTOR,?UNIVERSAL bor ?PRIMITIVE bor 7). --define(T_EXTERNAL, ?UNIVERSAL bor ?PRIMITIVE bor 8). --define(T_REAL, ?UNIVERSAL bor ?PRIMITIVE bor 9). --define(T_ENUMERATED, ?UNIVERSAL bor ?PRIMITIVE bor 10). --define(T_EMBEDDED_PDV, ?UNIVERSAL bor ?PRIMITIVE bor 11). --define(T_SEQUENCE, ?UNIVERSAL bor ?CONSTRUCTED bor 16). --define(T_SET, ?UNIVERSAL bor ?CONSTRUCTED bor 17). --define(T_NumericString, ?UNIVERSAL bor ?PRIMITIVE bor 18). %can be constructed --define(T_PrintableString, ?UNIVERSAL bor ?PRIMITIVE bor 19). %can be constructed --define(T_TeletexString, ?UNIVERSAL bor ?PRIMITIVE bor 20). %can be constructed --define(T_VideotexString, ?UNIVERSAL bor ?PRIMITIVE bor 21). %can be constructed --define(T_IA5String, ?UNIVERSAL bor ?PRIMITIVE bor 22). %can be constructed --define(T_UTCTime, ?UNIVERSAL bor ?PRIMITIVE bor 23). --define(T_GeneralizedTime, ?UNIVERSAL bor ?PRIMITIVE bor 24). --define(T_GraphicString, ?UNIVERSAL bor ?PRIMITIVE bor 25). %can be constructed --define(T_VisibleString, ?UNIVERSAL bor ?PRIMITIVE bor 26). %can be constructed --define(T_GeneralString, ?UNIVERSAL bor ?PRIMITIVE bor 27). %can be constructed --define(T_UniversalString, ?UNIVERSAL bor ?PRIMITIVE bor 28). %can be constructed --define(T_BMPString, ?UNIVERSAL bor ?PRIMITIVE bor 30). %can be constructed - - -decode(Bin) -> - decode_primitive(Bin). - -decode_primitive(Bin) -> - {Tlv = {Tag,Len,V},<<>>} = decode_tlv(Bin), - case element(2,Tag) of - ?CONSTRUCTED -> - {Tag,Len,decode_constructed(V)}; - _ -> - Tlv - end. - -decode_constructed(<<>>) -> - []; -decode_constructed(Bin) -> - {Tlv = {Tag,Len,V},Rest} = decode_tlv(Bin), - NewTlv = - case element(2,Tag) of - ?CONSTRUCTED -> - {Tag,Len,decode_constructed(V)}; - _ -> - Tlv - end, - [NewTlv|decode_constructed(Rest)]. - -decode_tlv(Bin) -> - {Tag,Bin1,_Rb1} = decode_tag(Bin), - {{Len,Bin2},_Rb2} = decode_length(Bin1), - <<V:Len/binary,Bin3/binary>> = Bin2, - {{Tag,Len,V},Bin3}. - - - -%%%%%%%%%%%%% -% split_list(List,HeadLen) -> {HeadList,TailList} -% -% splits List into HeadList (Length=HeadLen) and TailList -% if HeadLen == indefinite -> return {List,indefinite} -split_list(List,indefinite) -> - {List, indefinite}; -split_list(Bin, Len) when binary(Bin) -> - split_binary(Bin,Len); -split_list(List,Len) -> - {lists:sublist(List,Len),lists:nthtail(Len,List)}. - - -%%% new function which fixes a bug regarding indefinite length decoding -restbytes2(indefinite,<<0,0,RemBytes/binary>>,_) -> - {RemBytes,2}; -restbytes2(indefinite,RemBytes,ext) -> - skipvalue(indefinite,RemBytes); -restbytes2(RemBytes,<<>>,_) -> - {RemBytes,0}; -restbytes2(_RemBytes,Bytes,noext) -> - exit({error,{asn1, {unexpected,Bytes}}}); -restbytes2(RemBytes,_Bytes,ext) -> - {RemBytes,0}. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% skipvalue(Length, Bytes) -> {RemainingBytes, RemovedNumberOfBytes} -%% -%% skips the one complete (could be nested) TLV from Bytes -%% handles both definite and indefinite length encodings -%% - -skipvalue(L, Bytes) -> - skipvalue(L, Bytes, 0). - -skipvalue(indefinite, Bytes, Rb) -> - {_T,Bytes2,R2} = decode_tag(Bytes), - {{L,Bytes3},R3} = decode_length(Bytes2), - {Bytes4,Rb4} = case L of - indefinite -> - skipvalue(indefinite,Bytes3,R2+R3); - _ -> - <<_:L/binary, RestBytes/binary>> = Bytes3, - {RestBytes, R2+R3+L} - end, - case Bytes4 of - <<0,0,Bytes5/binary>> -> - {Bytes5,Rb+Rb4+2}; - _ -> skipvalue(indefinite,Bytes4,Rb+Rb4) - end; -skipvalue(L, Bytes, Rb) -> -% <<Skip:L/binary, RestBytes/binary>> = Bytes, - <<_:L/binary, RestBytes/binary>> = Bytes, - {RestBytes,Rb+L}. - -%%skipvalue(indefinite, Bytes, Rb) -> -%% {T,Bytes2,R2} = decode_tag(Bytes), -%% {L,Bytes3,R3} = decode_length(Bytes2), -%% {Bytes4,Rb4} = case L of -%% indefinite -> -%% skipvalue(indefinite,Bytes3,R2+R3); -%% _ -> -%% lists:nthtail(L,Bytes3) %% konstigt !? -%% end, -%% case Bytes4 of -%% [0,0|Bytes5] -> -%% {Bytes5,Rb4+2}; -%% _ -> skipvalue(indefinite,Bytes4,Rb4) -%% end; -%%skipvalue(L, Bytes, Rb) -> -%% {lists:nthtail(L,Bytes),Rb+L}. - -skipvalue(Bytes) -> - {_T,Bytes2,R2} = decode_tag(Bytes), - {{L,Bytes3},R3} = decode_length(Bytes2), - skipvalue(L,Bytes3,R2+R3). - - -cindex(Ix,Val,Cname) -> - case element(Ix,Val) of - {Cname,Val2} -> Val2; - X -> X - end. - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Optionals, preset not filled optionals with asn1_NOVALUE -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -% converts a list to a record if necessary -list_to_record(Name,List) when list(List) -> - list_to_tuple([Name|List]); -list_to_record(_Name,Tuple) when tuple(Tuple) -> - Tuple. - - -fixoptionals(OptList,Val) when list(Val) -> - fixoptionals(OptList,Val,1,[],[]). - -fixoptionals([{Name,Pos}|Ot],[{Name,Val}|Vt],_Opt,Acc1,Acc2) -> - fixoptionals(Ot,Vt,Pos+1,[1|Acc1],[{Name,Val}|Acc2]); -fixoptionals([{_Name,Pos}|Ot],V,Pos,Acc1,Acc2) -> - fixoptionals(Ot,V,Pos+1,[0|Acc1],[asn1_NOVALUE|Acc2]); -fixoptionals(O,[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals(O,Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals([],[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals([],Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals([],[],_,_Acc1,Acc2) -> - % return Val as a record - list_to_tuple([asn1_RECORDNAME|lists:reverse(Acc2)]). - - -%%encode_tag(TagClass(?UNI, APP etc), Form (?PRIM etx), TagInteger) -> -%% 8bit Int | binary -encode_tag_val({Class, Form, TagNo}) when (TagNo =< 30) -> - <<(Class bsr 6):2,(Form bsr 5):1,TagNo:5>>; - -encode_tag_val({Class, Form, TagNo}) -> - {Octets,_Len} = mk_object_val(TagNo), - BinOct = list_to_binary(Octets), - <<(Class bsr 6):2, (Form bsr 5):1, 31:5,BinOct/binary>>; - -%% asumes whole correct tag bitpattern, multiple of 8 -encode_tag_val(Tag) when (Tag =< 255) -> Tag; %% anv�nds denna funktion??!! -%% asumes correct bitpattern of 0-5 -encode_tag_val(Tag) -> encode_tag_val2(Tag,[]). - -encode_tag_val2(Tag, OctAck) when (Tag =< 255) -> - [Tag | OctAck]; -encode_tag_val2(Tag, OctAck) -> - encode_tag_val2(Tag bsr 8, [255 band Tag | OctAck]). - - -%%%encode_tag(TagClass(?UNI, APP etc), Form (?PRIM etx), TagInteger) -> -%%% 8bit Int | [list of octets] -%encode_tag_val({Class, Form, TagNo}) when (TagNo =< 30) -> -%%% <<Class:2,Form:1,TagNo:5>>; -% [Class bor Form bor TagNo]; -%encode_tag_val({Class, Form, TagNo}) -> -% {Octets,L} = mk_object_val(TagNo), -% [Class bor Form bor 31 | Octets]; - - -%%============================================================================\%% Peek on the initial tag -%% peek_tag(Bytes) -> TagBytes -%% interprets the first byte and possible second, third and fourth byte as -%% a tag and returns all the bytes comprising the tag, the constructed/primitive bit (6:th bit of first byte) is normalised to 0 -%% - -peek_tag(<<B7_6:2,_:1,31:5,Buffer/binary>>) -> - Bin = peek_tag(Buffer, <<>>), - <<B7_6:2,31:6,Bin/binary>>; -%% single tag (tagno < 31) -peek_tag(<<B7_6:2,_:1,B4_0:5,_Buffer/binary>>) -> - <<B7_6:2,B4_0:6>>. - -peek_tag(<<0:1,PartialTag:7,_Buffer/binary>>, TagAck) -> - <<TagAck/binary,PartialTag>>; -peek_tag(<<PartialTag,Buffer/binary>>, TagAck) -> - peek_tag(Buffer,<<TagAck/binary,PartialTag>>); -peek_tag(_,TagAck) -> - exit({error,{asn1, {invalid_tag,TagAck}}}). -%%peek_tag([Tag|Buffer]) when (Tag band 31) == 31 -> -%% [Tag band 2#11011111 | peek_tag(Buffer,[])]; -%%%% single tag (tagno < 31) -%%peek_tag([Tag|Buffer]) -> -%% [Tag band 2#11011111]. - -%%peek_tag([PartialTag|Buffer], TagAck) when (PartialTag < 128 ) -> -%% lists:reverse([PartialTag|TagAck]); -%%peek_tag([PartialTag|Buffer], TagAck) -> -%% peek_tag(Buffer,[PartialTag|TagAck]); -%%peek_tag(Buffer,TagAck) -> -%% exit({error,{asn1, {invalid_tag,lists:reverse(TagAck)}}}). - - -%%=============================================================================== -%% Decode a tag -%% -%% decode_tag(OctetListBuffer) -> {{Class, Form, TagNo}, RestOfBuffer, RemovedBytes} -%%=============================================================================== - -%% multiple octet tag -decode_tag(<<Class:2, Form:1, 31:5, Buffer/binary>>) -> - {TagNo, Buffer1, RemovedBytes} = decode_tag(Buffer, 0, 1), - {{(Class bsl 6), (Form bsl 5), TagNo}, Buffer1, RemovedBytes}; - -%% single tag (< 31 tags) -decode_tag(<<Class:2,Form:1,TagNo:5, Buffer/binary>>) -> - {{(Class bsl 6), (Form bsl 5), TagNo}, Buffer, 1}. - -%% last partial tag -decode_tag(<<0:1,PartialTag:7, Buffer/binary>>, TagAck, RemovedBytes) -> - TagNo = (TagAck bsl 7) bor PartialTag, - %%<<TagNo>> = <<TagAck:1, PartialTag:7>>, - {TagNo, Buffer, RemovedBytes+1}; -% more tags -decode_tag(<<_:1,PartialTag:7, Buffer/binary>>, TagAck, RemovedBytes) -> - TagAck1 = (TagAck bsl 7) bor PartialTag, - %%<<TagAck1:16>> = <<TagAck:1, PartialTag:7,0:8>>, - decode_tag(Buffer, TagAck1, RemovedBytes+1). - -%%------------------------------------------------------------------ -%% check_tags_i is the same as check_tags except that it stops and -%% returns the remaining tags not checked when it encounters an -%% indefinite length field -%% only called internally within this module - -check_tags_i([Tag], Buffer, OptOrMand) -> % optimized very usual case - {[],check_one_tag(Tag, Buffer, OptOrMand)}; -check_tags_i(Tags, Buffer, OptOrMand) -> - check_tags_i(Tags, Buffer, 0, OptOrMand). - -check_tags_i([Tag1,Tag2|TagRest], Buffer, Rb, OptOrMand) - when Tag1#tag.type == 'IMPLICIT' -> - check_tags_i([Tag1#tag{type=Tag2#tag.type}|TagRest], Buffer, Rb, OptOrMand); - -check_tags_i([Tag1|TagRest], Buffer, Rb, OptOrMand) -> - {Form_Length,Buffer2,Rb1} = check_one_tag(Tag1, Buffer, OptOrMand), - case TagRest of - [] -> {TagRest, {Form_Length, Buffer2, Rb + Rb1}}; - _ -> - case Form_Length of - {?CONSTRUCTED,_} -> - {TagRest, {Form_Length, Buffer2, Rb + Rb1}}; - _ -> - check_tags_i(TagRest, Buffer2, Rb + Rb1, mandatory) - end - end; - -check_tags_i([], Buffer, Rb, _) -> - {[],{{0,0},Buffer,Rb}}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% This function is called from generated code - -check_tags([Tag], Buffer, OptOrMand) -> % optimized very usual case - check_one_tag(Tag, Buffer, OptOrMand); -check_tags(Tags, Buffer, OptOrMand) -> - check_tags(Tags, Buffer, 0, OptOrMand). - -check_tags([Tag1,Tag2|TagRest], Buffer, Rb, OptOrMand) - when Tag1#tag.type == 'IMPLICIT' -> - check_tags([Tag1#tag{type=Tag2#tag.type}|TagRest], Buffer, Rb, OptOrMand); - -check_tags([Tag1|TagRest], Buffer, Rb, OptOrMand) -> - {Form_Length,Buffer2,Rb1} = check_one_tag(Tag1, Buffer, OptOrMand), - case TagRest of - [] -> {Form_Length, Buffer2, Rb + Rb1}; - _ -> check_tags(TagRest, Buffer2, Rb + Rb1, mandatory) - end; - -check_tags([], Buffer, Rb, _) -> - {{0,0},Buffer,Rb}. - -check_one_tag(Tag=#tag{class=ExpectedClass,number=ExpectedNumber}, Buffer, OptOrMand) -> - case catch decode_tag(Buffer) of - {'EXIT',_Reason} -> - tag_error(no_data,Tag,Buffer,OptOrMand); - {{ExpectedClass,Form,ExpectedNumber},Buffer2,Rb} -> - {{L,Buffer3},RemBytes2} = decode_length(Buffer2), - {{Form,L}, Buffer3, RemBytes2+Rb}; - {ErrorTag,_,_} -> - tag_error(ErrorTag, Tag, Buffer, OptOrMand) - end. - -tag_error(ErrorTag, Tag, Buffer, OptOrMand) -> - case OptOrMand of - mandatory -> - exit({error,{asn1, {invalid_tag, - {ErrorTag, Tag, Buffer}}}}); - _ -> - exit({error,{asn1, {no_optional_tag, - {ErrorTag, Tag, Buffer}}}}) - end. -%%======================================================================= -%% -%% Encode all tags in the list Tags and return a possibly deep list of -%% bytes with tag and length encoded -%% -%% prepend_tags(Tags, BytesSoFar, LenSoFar) -> {Bytes, Len} -encode_tags(Tags, BytesSoFar, LenSoFar) -> - NewTags = encode_tags1(Tags, []), - %% NewTags contains the resulting tags in reverse order - encode_tags2(NewTags, BytesSoFar, LenSoFar). - -%encode_tags2([#tag{class=?UNIVERSAL,number=No}|Trest], BytesSoFar, LenSoFar) -> -% {Bytes2,L2} = encode_length(LenSoFar), -% encode_tags2(Trest,[[No|Bytes2],BytesSoFar], LenSoFar + 1 + L2); -encode_tags2([Tag|Trest], BytesSoFar, LenSoFar) -> - {Bytes1,L1} = encode_one_tag(Tag), - {Bytes2,L2} = encode_length(LenSoFar), - encode_tags2(Trest, [Bytes1,Bytes2|BytesSoFar], - LenSoFar + L1 + L2); -encode_tags2([], BytesSoFar, LenSoFar) -> - {BytesSoFar,LenSoFar}. - -encode_tags1([Tag1, Tag2| Trest], Acc) - when Tag1#tag.type == 'IMPLICIT' -> - encode_tags1([Tag1#tag{type=Tag2#tag.type,form=Tag2#tag.form}|Trest],Acc); -encode_tags1([Tag1 | Trest], Acc) -> - encode_tags1(Trest, [Tag1|Acc]); -encode_tags1([], Acc) -> - Acc. % the resulting tags are returned in reverse order - -encode_one_tag(Bin) when binary(Bin) -> - {Bin,size(Bin)}; -encode_one_tag(#tag{class=Class,number=No,type=Type, form = Form}) -> - NewForm = case Type of - 'EXPLICIT' -> - ?CONSTRUCTED; - _ -> - Form - end, - Bytes = encode_tag_val({Class,NewForm,No}), - {Bytes,size(Bytes)}. - -%%=============================================================================== -%% Change the tag (used when an implicit tagged type has a reference to something else) -%% The constructed bit in the tag is taken from the tag to be replaced. -%% -%% change_tag(NewTag,[Tag,Buffer]) -> [NewTag,Buffer] -%%=============================================================================== - -%change_tag({NewClass,NewTagNr}, Buffer) -> -% {{OldClass, OldForm, OldTagNo}, Buffer1, RemovedBytes} = decode_tag(lists:flatten(Buffer)), -% [encode_tag_val({NewClass, OldForm, NewTagNr}) | Buffer1]. - - - - - - - -%%=============================================================================== -%% -%% This comment is valid for all the encode/decode functions -%% -%% C = Constraint -> typically {'ValueRange',LowerBound,UpperBound} -%% used for PER-coding but not for BER-coding. -%% -%% Val = Value. If Val is an atom then it is a symbolic integer value -%% (i.e the atom must be one of the names in the NamedNumberList). -%% The NamedNumberList is used to translate the atom to an integer value -%% before encoding. -%% -%%=============================================================================== - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_open_type(Value) -> CompleteList -%% Value = list of bytes of an already encoded value (the list must be flat) -%% | binary - -%% This version does not consider Explicit tagging of the open type. It -%% is only left because of backward compatibility. -encode_open_type(Val) when list(Val) -> - {Val,size(list_to_binary(Val))}; -encode_open_type(Val) -> - {Val, size(Val)}. - -%% -encode_open_type(Val, []) when list(Val) -> - {Val,size(list_to_binary(Val))}; -encode_open_type(Val,[]) -> - {Val, size(Val)}; -encode_open_type(Val, Tag) when list(Val) -> - encode_tags(Tag,Val,size(list_to_binary(Val))); -encode_open_type(Val,Tag) -> - encode_tags(Tag,Val, size(Val)). - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_open_type(Buffer) -> Value -%% Bytes = [byte] with BER encoded data -%% Value = [byte] with decoded data (which must be decoded again as some type) -%% -decode_open_type(Bytes) -> - {_Tag, Len, _RemainingBuffer, RemovedBytes} = decode_tag_and_length(Bytes), - N = Len + RemovedBytes, - <<Val:N/binary, RemainingBytes/binary>> = Bytes, - {Val, RemainingBytes, Len + RemovedBytes}. - -decode_open_type(Bytes,ExplTag) -> - {Tag, Len, RemainingBuffer, RemovedBytes} = decode_tag_and_length(Bytes), - case {Tag,ExplTag} of - {{Class,Form,No},[#tag{class=Class,number=No,form=Form}]} -> - {_Tag2, Len2, _RemainingBuffer2, RemovedBytes2} = decode_tag_and_length(RemainingBuffer), - N = Len2 + RemovedBytes2, - <<_:RemovedBytes/unit:8,Val:N/binary,RemainingBytes/binary>> = Bytes, - {Val, RemainingBytes, N + RemovedBytes}; - _ -> - N = Len + RemovedBytes, - <<Val:N/binary, RemainingBytes/binary>> = Bytes, - {Val, RemainingBytes, Len + RemovedBytes} - end. - -decode_open_type(ber_bin,Bytes,ExplTag) -> - decode_open_type(Bytes,ExplTag); -decode_open_type(ber,Bytes,ExplTag) -> - {Val,RemBytes,Len}=decode_open_type(Bytes,ExplTag), - {binary_to_list(Val),RemBytes,Len}. - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Boolean, ITU_T X.690 Chapter 8.2 -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% encode_boolean(Integer, tag | notag) -> [octet list] -%%=============================================================================== - -encode_boolean({Name, Val}, DoTag) when atom(Name) -> - dotag(DoTag, ?N_BOOLEAN, encode_boolean(Val)); -encode_boolean(true,[]) -> - {[1,1,16#FF],3}; -encode_boolean(false,[]) -> - {[1,1,0],3}; -encode_boolean(Val, DoTag) -> - dotag(DoTag, ?N_BOOLEAN, encode_boolean(Val)). - -%% encode_boolean(Boolean) -> [Len, Boolean] = [1, $FF | 0] -encode_boolean(true) -> {[16#FF],1}; -encode_boolean(false) -> {[0],1}; -encode_boolean(X) -> exit({error,{asn1, {encode_boolean, X}}}). - - -%%=============================================================================== -%% decode_boolean(BuffList, HasTag, TotalLen) -> {true, Remain, RemovedBytes} | -%% {false, Remain, RemovedBytes} -%%=============================================================================== - -decode_boolean(Buffer, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_BOOLEAN}), - decode_boolean_notag(Buffer, NewTags, OptOrMand). - -decode_boolean_notag(Buffer, Tags, OptOrMand) -> - {RestTags, {FormLen,Buffer0,Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val,Buffer1,Rb1} = decode_boolean_notag(Buffer00, RestTags, OptOrMand), - {Buffer2, Rb2} = restbytes2(RestBytes,Buffer1,noext), - {Val, Buffer2, Rb0+Rb1+Rb2}; - {_,_} -> - decode_boolean2(Buffer0, Rb0) - end. - -decode_boolean2(<<0:8, Buffer/binary>>, RemovedBytes) -> - {false, Buffer, RemovedBytes + 1}; -decode_boolean2(<<_:8, Buffer/binary>>, RemovedBytes) -> - {true, Buffer, RemovedBytes + 1}; -decode_boolean2(Buffer, _) -> - exit({error,{asn1, {decode_boolean, Buffer}}}). - - - - -%%=========================================================================== -%% Integer, ITU_T X.690 Chapter 8.3 - -%% encode_integer(Constraint, Value, Tag) -> [octet list] -%% encode_integer(Constraint, Name, NamedNumberList, Tag) -> [octet list] -%% Value = INTEGER | {Name,INTEGER} -%% Tag = tag | notag -%%=========================================================================== - -encode_integer(C, Val, []) when integer(Val) -> - {EncVal,Len}=encode_integer(C, Val), - dotag_universal(?N_INTEGER,EncVal,Len); -encode_integer(C, Val, Tag) when integer(Val) -> - dotag(Tag, ?N_INTEGER, encode_integer(C, Val)); -encode_integer(C,{Name,Val},Tag) when atom(Name) -> - encode_integer(C,Val,Tag); -encode_integer(_, Val, _) -> - exit({error,{asn1, {encode_integer, Val}}}). - - - -encode_integer(C, Val, NamedNumberList, Tag) when atom(Val) -> - case lists:keysearch(Val, 1, NamedNumberList) of - {value,{_, NewVal}} -> - dotag(Tag, ?N_INTEGER, encode_integer(C, NewVal)); - _ -> - exit({error,{asn1, {encode_integer_namednumber, Val}}}) - end; -encode_integer(C,{_,Val},NamedNumberList,Tag) -> - encode_integer(C,Val,NamedNumberList,Tag); -encode_integer(C, Val, _NamedNumberList, Tag) -> - dotag(Tag, ?N_INTEGER, encode_integer(C, Val)). - - - - -encode_integer(_C, Val) -> - Bytes = - if - Val >= 0 -> - encode_integer_pos(Val, []); - true -> - encode_integer_neg(Val, []) - end, - {Bytes,length(Bytes)}. - -encode_integer_pos(0, L=[B|_Acc]) when B < 128 -> - L; -encode_integer_pos(N, Acc) -> - encode_integer_pos((N bsr 8), [N band 16#ff| Acc]). - -encode_integer_neg(-1, L=[B1|_T]) when B1 > 127 -> - L; -encode_integer_neg(N, Acc) -> - encode_integer_neg(N bsr 8, [N band 16#ff|Acc]). - -%%=============================================================================== -%% decode integer -%% (Buffer, Range, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} -%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} -%%=============================================================================== - - -decode_integer(Buffer, Range, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_INTEGER}), - decode_integer_notag(Buffer, Range, [], NewTags, OptOrMand). - -decode_integer(Buffer, Range, NamedNumberList, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_INTEGER}), - decode_integer_notag(Buffer, Range, NamedNumberList, NewTags, OptOrMand). - -decode_integer_notag(Buffer, Range, NamedNumberList, NewTags, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(NewTags, Buffer, OptOrMand), -% Result = {Val, Buffer2, RemovedBytes} = - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00, RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_integer_notag(Buffer00, Range, NamedNumberList, - RestTags, OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_, Len} -> - Result = - decode_integer2(Len,Buffer0,Rb0+Len), - Result2 = check_integer_constraint(Result,Range), - resolve_named_value(Result2,NamedNumberList) - end. - -resolve_named_value(Result={Val,Buffer,RemBytes},NamedNumberList) -> - case NamedNumberList of - [] -> Result; - _ -> - NewVal = case lists:keysearch(Val, 2, NamedNumberList) of - {value,{NamedVal, _}} -> - NamedVal; - _ -> - Val - end, - {NewVal, Buffer, RemBytes} - end. - -check_integer_constraint(Result={Val, _Buffer,_},Range) -> - case Range of - [] -> % No length constraint - Result; - {Lb,Ub} when Val >= Lb, Ub >= Val -> % variable length constraint - Result; - Val -> % fixed value constraint - Result; - {_,_} -> - exit({error,{asn1,{integer_range,Range,Val}}}); - SingleValue when integer(SingleValue) -> - exit({error,{asn1,{integer_range,Range,Val}}}); - _ -> % some strange constraint that we don't support yet - Result - end. - -%%============================================================================ -%% Enumerated value, ITU_T X.690 Chapter 8.4 - -%% encode enumerated value -%%============================================================================ -encode_enumerated(Val, []) when integer(Val)-> - {EncVal,Len} = encode_integer(false,Val), - dotag_universal(?N_ENUMERATED,EncVal,Len); -encode_enumerated(Val, DoTag) when integer(Val)-> - dotag(DoTag, ?N_ENUMERATED, encode_integer(false,Val)); -encode_enumerated({Name,Val}, DoTag) when atom(Name) -> - encode_enumerated(Val, DoTag). - -%% The encode_enumerated functions below this line can be removed when the -%% new code generation is stable. (the functions might have to be kept here -%% a while longer for compatibility reasons) - -encode_enumerated(C, Val, {NamedNumberList,ExtList}, DoTag) when atom(Val) -> - case catch encode_enumerated(C, Val, NamedNumberList, DoTag) of - {'EXIT',_} -> encode_enumerated(C, Val, ExtList, DoTag); - Result -> Result - end; - -encode_enumerated(C, Val, NamedNumberList, DoTag) when atom(Val) -> - case lists:keysearch(Val, 1, NamedNumberList) of - {value, {_, NewVal}} when DoTag == []-> - {EncVal,Len} = encode_integer(C,NewVal), - dotag_universal(?N_ENUMERATED,EncVal,Len); - {value, {_, NewVal}} -> - dotag(DoTag, ?N_ENUMERATED, encode_integer(C, NewVal)); - _ -> - exit({error,{asn1, {enumerated_not_in_range, Val}}}) - end; - -encode_enumerated(C, {asn1_enum, Val}, {_,_}, DoTag) when integer(Val) -> - dotag(DoTag, ?N_ENUMERATED, encode_integer(C,Val)); - -encode_enumerated(C, {Name,Val}, NamedNumberList, DoTag) when atom(Name) -> - encode_enumerated(C, Val, NamedNumberList, DoTag); - -encode_enumerated(_, Val, _, _) -> - exit({error,{asn1, {enumerated_not_namednumber, Val}}}). - - - -%%============================================================================ -%% decode enumerated value -%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> -%% {Value, RemainingBuffer, RemovedBytes} -%%=========================================================================== -decode_enumerated(Buffer, Range, NamedNumberList, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_ENUMERATED}), - decode_enumerated_notag(Buffer, Range, NamedNumberList, - NewTags, OptOrMand). - -decode_enumerated_notag(Buffer, Range, NNList = {NamedNumberList,ExtList}, Tags, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_enumerated_notag(Buffer00, Range, NNList, RestTags, OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,Len} -> - {Val01, Buffer01, Rb01} = - decode_integer2(Len, Buffer0, Rb0+Len), - case decode_enumerated1(Val01, NamedNumberList) of - {asn1_enum,Val01} -> - {decode_enumerated1(Val01,ExtList), Buffer01, Rb01}; - Result01 -> - {Result01, Buffer01, Rb01} - end - end; - -decode_enumerated_notag(Buffer, Range, NNList, Tags, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_enumerated_notag(Buffer00, Range, NNList, RestTags, OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,Len} -> - {Val01, Buffer02, Rb02} = - decode_integer2(Len, Buffer0, Rb0+Len), - case decode_enumerated1(Val01, NNList) of - {asn1_enum,_} -> - exit({error,{asn1, {illegal_enumerated, Val01}}}); - Result01 -> - {Result01, Buffer02, Rb02} - end - end. - -decode_enumerated1(Val, NamedNumberList) -> - %% it must be a named integer - case lists:keysearch(Val, 2, NamedNumberList) of - {value,{NamedVal, _}} -> - NamedVal; - _ -> - {asn1_enum,Val} - end. - - -%%============================================================================ -%% -%% Real value, ITU_T X.690 Chapter 8.5 -%%============================================================================ -%% -%% encode real value -%%============================================================================ - -%% only base 2 internally so far!! -encode_real(0, DoTag) -> - dotag(DoTag, ?N_REAL, {[],0}); -encode_real('PLUS-INFINITY', DoTag) -> - dotag(DoTag, ?N_REAL, {[64],1}); -encode_real('MINUS-INFINITY', DoTag) -> - dotag(DoTag, ?N_REAL, {[65],1}); -encode_real(Val, DoTag) when tuple(Val)-> - dotag(DoTag, ?N_REAL, encode_real(Val)). - -%%%%%%%%%%%%%% -%% not optimal efficient.. -%% only base 2 of Mantissa encoding! -%% only base 2 of ExpBase encoding! -encode_real({Man, Base, Exp}) -> -%% io:format("Mantissa: ~w Base: ~w, Exp: ~w~n",[Man, Base, Exp]), - - OctExp = if Exp >= 0 -> list_to_binary(encode_integer_pos(Exp, [])); - true -> list_to_binary(encode_integer_neg(Exp, [])) - end, -%% ok = io:format("OctExp: ~w~n",[OctExp]), - SignBit = if Man > 0 -> 0; % bit 7 is pos or neg, no Zeroval - true -> 1 - end, -%% ok = io:format("SignBitMask: ~w~n",[SignBitMask]), - InBase = if Base =:= 2 -> 0; % bit 6,5: only base 2 this far! - true -> - exit({error,{asn1, {encode_real_non_supported_encodeing, Base}}}) - end, - SFactor = 0, % bit 4,3: no scaling since only base 2 - OctExpLen = size(OctExp), - if OctExpLen > 255 -> - exit({error,{asn1, {to_big_exp_in_encode_real, OctExpLen}}}); - true -> true %% make real assert later.. - end, - {LenCode, EOctets} = case OctExpLen of % bit 2,1 - 1 -> {0, OctExp}; - 2 -> {1, OctExp}; - 3 -> {2, OctExp}; - _ -> {3, <<OctExpLen, OctExp/binary>>} - end, - FirstOctet = <<1:1,SignBit:1,InBase:2,SFactor:2,LenCode:2>>, - OctMantissa = if Man > 0 -> list_to_binary(minimum_octets(Man)); - true -> list_to_binary(minimum_octets(-(Man))) % signbit keeps track of sign - end, - %% ok = io:format("LenMask: ~w EOctets: ~w~nFirstOctet: ~w OctMantissa: ~w OctExpLen: ~w~n", [LenMask, EOctets, FirstOctet, OctMantissa, OctExpLen]), - Bin = <<FirstOctet/binary, EOctets/binary, OctMantissa/binary>>, - {Bin, size(Bin)}. - - -%encode_real({Man, Base, Exp}) -> -%% io:format("Mantissa: ~w Base: ~w, Exp: ~w~n",[Man, Base, Exp]), - -% OctExp = if Exp >= 0 -> encode_integer_pos(Exp, []); -% true -> encode_integer_neg(Exp, []) -% end, -%% ok = io:format("OctExp: ~w~n",[OctExp]), -% SignBitMask = if Man > 0 -> 2#00000000; % bit 7 is pos or neg, no Zeroval -% true -> 2#01000000 -% end, -%% ok = io:format("SignBitMask: ~w~n",[SignBitMask]), -% InternalBaseMask = if Base =:= 2 -> 2#00000000; % bit 6,5: only base 2 this far! -% true -> -% exit({error,{asn1, {encode_real_non_supported_encodeing, Base}}}) -% end, -% ScalingFactorMask =2#00000000, % bit 4,3: no scaling since only base 2 -% OctExpLen = length(OctExp), -% if OctExpLen > 255 -> -% exit({error,{asn1, {to_big_exp_in_encode_real, OctExpLen}}}); -% true -> true %% make real assert later.. -% end, -% {LenMask, EOctets} = case OctExpLen of % bit 2,1 -% 1 -> {0, OctExp}; -% 2 -> {1, OctExp}; -% 3 -> {2, OctExp}; -% _ -> {3, [OctExpLen, OctExp]} -% end, -% FirstOctet = (SignBitMask bor InternalBaseMask bor -% ScalingFactorMask bor LenMask bor -% 2#10000000), % bit set for binary mantissa encoding! -% OctMantissa = if Man > 0 -> minimum_octets(Man); -% true -> minimum_octets(-(Man)) % signbit keeps track of sign -% end, -%% ok = io:format("LenMask: ~w EOctets: ~w~nFirstOctet: ~w OctMantissa: ~w OctExpLen: ~w~n", [LenMask, EOctets, FirstOctet, OctMantissa, OctExpLen]), -% {[FirstOctet, EOctets, OctMantissa], -% length(OctMantissa) + -% (if OctExpLen > 3 -> -% OctExpLen + 2; -% true -> -% OctExpLen + 1 -% end) -% }. - - -%%============================================================================ -%% decode real value -%% -%% decode_real([OctetBufferList], tuple|value, tag|notag) -> -%% {{Mantissa, Base, Exp} | realval | PLUS-INFINITY | MINUS-INFINITY | 0, -%% RestBuff} -%% -%% only for base 2 decoding sofar!! -%%============================================================================ - -decode_real(Buffer, Form, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_REAL}), - decode_real_notag(Buffer, Form, NewTags, OptOrMand). - -decode_real_notag(Buffer, Form, Tags, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_real_notag(Buffer00, Form, RestTags, OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,Len} -> - decode_real2(Buffer0, Form, Len, Rb0) - end. - -decode_real2(Buffer0, Form, Len, RemBytes1) -> - <<First, Buffer2/binary>> = Buffer0, - if - First =:= 2#01000000 -> {'PLUS-INFINITY', Buffer2}; - First =:= 2#01000001 -> {'MINUS-INFINITY', Buffer2}; - First =:= 2#00000000 -> {0, Buffer2}; - true -> - %% have some check here to verify only supported bases (2) - <<_B7:1,B6:1,B5_4:2,B3_2:2,B1_0:2>> = <<First>>, - Sign = B6, - Base = - case B5_4 of - 0 -> 2; % base 2, only one so far - _ -> exit({error,{asn1, {non_supported_base, First}}}) - end, -% ScalingFactor = - case B3_2 of - 0 -> 0; % no scaling so far - _ -> exit({error,{asn1, {non_supported_scaling, First}}}) - end, - % ok = io:format("Buffer2: ~w~n",[Buffer2]), - {FirstLen, {Exp, Buffer3}, RemBytes2} = - case B1_0 of - 0 -> {2, decode_integer2(1, Buffer2, RemBytes1), RemBytes1+1}; - 1 -> {3, decode_integer2(2, Buffer2, RemBytes1), RemBytes1+2}; - 2 -> {4, decode_integer2(3, Buffer2, RemBytes1), RemBytes1+3}; - 3 -> - <<ExpLen1,RestBuffer/binary>> = Buffer2, - { ExpLen1 + 2, - decode_integer2(ExpLen1, RestBuffer, RemBytes1), - RemBytes1+ExpLen1} - end, - % io:format("FirstLen: ~w, Exp: ~w, Buffer3: ~w ~n", - % [FirstLen, Exp, Buffer3]), - Length = Len - FirstLen, - <<LongInt:Length/unit:8,RestBuff/binary>> = Buffer3, - {{Mantissa, Buffer4}, RemBytes3} = - if Sign =:= 0 -> - % io:format("sign plus~n"), - {{LongInt, RestBuff}, 1 + Length}; - true -> - % io:format("sign minus~n"), - {{-LongInt, RestBuff}, 1 + Length} - end, - % io:format("Form: ~w~n",[Form]), - case Form of - tuple -> - {Val,Buf,_RemB} = Exp, - {{Mantissa, Base, {Val,Buf}}, Buffer4, RemBytes2+RemBytes3}; - _value -> - comming - end - end. - - -%%============================================================================ -%% Bitstring value, ITU_T X.690 Chapter 8.6 -%% -%% encode bitstring value -%% -%% bitstring NamedBitList -%% Val can be of: -%% - [identifiers] where only named identifers are set to one, -%% the Constraint must then have some information of the -%% bitlength. -%% - [list of ones and zeroes] all bits -%% - integer value representing the bitlist -%% C is constrint Len, only valid when identifiers -%%============================================================================ - -encode_bit_string(C,Bin={Unused,BinBits},NamedBitList,DoTag) when integer(Unused), binary(BinBits) -> - encode_bin_bit_string(C,Bin,NamedBitList,DoTag); -encode_bit_string(C, [FirstVal | RestVal], NamedBitList, DoTag) when atom(FirstVal) -> - encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, DoTag); - -encode_bit_string(C, [{bit,X} | RestVal], NamedBitList, DoTag) -> - encode_bit_string_named(C, [{bit,X} | RestVal], NamedBitList, DoTag); - -encode_bit_string(C, [FirstVal| RestVal], NamedBitList, DoTag) when integer(FirstVal) -> - encode_bit_string_bits(C, [FirstVal | RestVal], NamedBitList, DoTag); - -encode_bit_string(_, 0, _, []) -> - {[?N_BIT_STRING,1,0],3}; - -encode_bit_string(_, 0, _, DoTag) -> - dotag(DoTag, ?N_BIT_STRING, {<<0>>,1}); - -encode_bit_string(_, [], _, []) -> - {[?N_BIT_STRING,1,0],3}; - -encode_bit_string(_, [], _, DoTag) -> - dotag(DoTag, ?N_BIT_STRING, {<<0>>,1}); - -encode_bit_string(C, IntegerVal, NamedBitList, DoTag) when integer(IntegerVal) -> - BitListVal = int_to_bitlist(IntegerVal), - encode_bit_string_bits(C, BitListVal, NamedBitList, DoTag); - -encode_bit_string(C, {Name,BitList}, NamedBitList, DoTag) when atom(Name) -> - encode_bit_string(C, BitList, NamedBitList, DoTag). - - - -int_to_bitlist(0) -> - []; -int_to_bitlist(Int) when integer(Int), Int >= 0 -> - [Int band 1 | int_to_bitlist(Int bsr 1)]. - - -%%================================================================= -%% Encode BIT STRING of the form {Unused,BinBits}. -%% Unused is the number of unused bits in the last byte in BinBits -%% and BinBits is a binary representing the BIT STRING. -%%================================================================= -encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList,DoTag)-> - case get_constraint(C,'SizeConstraint') of - no -> - remove_unused_then_dotag(DoTag,?N_BIT_STRING,Unused,BinBits); - {_Min,Max} -> - BBLen = (size(BinBits)*8)-Unused, - if - BBLen > Max -> - exit({error,{asn1, - {bitstring_length, - {{was,BBLen},{maximum,Max}}}}}); - true -> - remove_unused_then_dotag(DoTag,?N_BIT_STRING, - Unused,BinBits) - end; - Size -> - case ((size(BinBits)*8)-Unused) of - BBSize when BBSize =< Size -> - remove_unused_then_dotag(DoTag,?N_BIT_STRING, - Unused,BinBits); - BBSize -> - exit({error,{asn1, - {bitstring_length, - {{was,BBSize},{should_be,Size}}}}}) - end - end. - -remove_unused_then_dotag(DoTag,StringType,Unused,BinBits) -> - case Unused of - 0 when (size(BinBits) == 0),DoTag==[] -> - %% time optimization of next case - {[StringType,1,0],3}; - 0 when (size(BinBits) == 0) -> - dotag(DoTag,StringType,{<<0>>,1}); - 0 when DoTag==[]-> % time optimization of next case - dotag_universal(StringType,[Unused|BinBits],size(BinBits)+1); -% {LenEnc,Len} = encode_legth(size(BinBits)+1), -% {[StringType,LenEnc,[Unused|BinBits]],size(BinBits)+1+Len+1}; - 0 -> - dotag(DoTag,StringType,<<Unused,BinBits/binary>>); - Num when DoTag == [] -> % time optimization of next case - N = (size(BinBits)-1), - <<BBits:N/binary,LastByte>> = BinBits, - dotag_universal(StringType, - [Unused,BBits,(LastByte bsr Num) bsl Num], - size(BinBits)+1); -% {LenEnc,Len} = encode_legth(size(BinBits)+1), -% {[StringType,LenEnc,[Unused,BBits,(LastByte bsr Num) bsl Num], -% 1+Len+size(BinBits)+1}; - Num -> - N = (size(BinBits)-1), - <<BBits:N/binary,LastByte>> = BinBits, - dotag(DoTag,StringType,{[Unused,binary_to_list(BBits) ++ - [(LastByte bsr Num) bsl Num]], - 1+size(BinBits)}) - end. - - -%%================================================================= -%% Encode named bits -%%================================================================= - -encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, DoTag) -> - {Len,Unused,OctetList} = - case get_constraint(C,'SizeConstraint') of - no -> - ToSetPos = get_all_bitposes([FirstVal | RestVal], - NamedBitList, []), - BitList = make_and_set_list(lists:max(ToSetPos)+1, - ToSetPos, 0), - encode_bitstring(BitList); - {_Min,Max} -> - ToSetPos = get_all_bitposes([FirstVal | RestVal], - NamedBitList, []), - BitList = make_and_set_list(Max, ToSetPos, 0), - encode_bitstring(BitList); - Size -> - ToSetPos = get_all_bitposes([FirstVal | RestVal], - NamedBitList, []), - BitList = make_and_set_list(Size, ToSetPos, 0), - encode_bitstring(BitList) - end, - case DoTag of - [] -> - dotag_universal(?N_BIT_STRING,[Unused|OctetList],Len+1); -% {EncLen,LenLen} = encode_length(Len+1), -% {[?N_BIT_STRING,EncLen,Unused,OctetList],1+LenLen+Len+1}; - _ -> - dotag(DoTag, ?N_BIT_STRING, {[Unused|OctetList],Len+1}) - end. - - -%%---------------------------------------- -%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> -%% [sorted_list_of_bitpositions_to_set] -%%---------------------------------------- - -get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); -get_all_bitposes([Val | Rest], NamedBitList, Ack) when atom(Val) -> - case lists:keysearch(Val, 1, NamedBitList) of - {value, {_ValName, ValPos}} -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); - _ -> - exit({error,{asn1, {bitstring_namedbit, Val}}}) - end; -get_all_bitposes([], _NamedBitList, Ack) -> - lists:sort(Ack). - - -%%---------------------------------------- -%% make_and_set_list(Len of list to return, [list of positions to set to 1])-> -%% returns list of Len length, with all in SetPos set. -%% in positioning in list the first element is 0, the second 1 etc.., but -%% Len will make a list of length Len, not Len + 1. -%% BitList = make_and_set_list(C, ToSetPos, 0), -%%---------------------------------------- - -make_and_set_list(0, [], _) -> []; -make_and_set_list(0, _, _) -> - exit({error,{asn1,bitstring_sizeconstraint}}); -make_and_set_list(Len, [XPos|SetPos], XPos) -> - [1 | make_and_set_list(Len - 1, SetPos, XPos + 1)]; -make_and_set_list(Len, [Pos|SetPos], XPos) -> - [0 | make_and_set_list(Len - 1, [Pos | SetPos], XPos + 1)]; -make_and_set_list(Len, [], XPos) -> - [0 | make_and_set_list(Len - 1, [], XPos + 1)]. - - - - - - -%%================================================================= -%% Encode bit string for lists of ones and zeroes -%%================================================================= -encode_bit_string_bits(C, BitListVal, _NamedBitList, DoTag) when list(BitListVal) -> - {Len,Unused,OctetList} = - case get_constraint(C,'SizeConstraint') of - no -> - encode_bitstring(BitListVal); - Constr={Min,Max} when integer(Min),integer(Max) -> - encode_constr_bit_str_bits(Constr,BitListVal,DoTag); - {Constr={_,_},[]} -> - %% constraint with extension mark - encode_constr_bit_str_bits(Constr,BitListVal,DoTag); - Constr={{_,_},{_,_}} ->%{{Min1,Max1},{Min2,Max2}} - %% constraint with extension mark - encode_constr_bit_str_bits(Constr,BitListVal,DoTag); - Size -> - case length(BitListVal) of - BitSize when BitSize == Size -> - encode_bitstring(BitListVal); - BitSize when BitSize < Size -> - PaddedList = - pad_bit_list(Size-BitSize,BitListVal), - encode_bitstring(PaddedList); - BitSize -> - exit({error, - {asn1, - {bitstring_length, - {{was,BitSize}, - {should_be,Size}}}}}) - end - end, - %%add unused byte to the Len - case DoTag of - [] -> - dotag_universal(?N_BIT_STRING,[Unused|OctetList],Len+1); -% {EncLen,LenLen}=encode_length(Len+1), -% {[?N_BIT_STRING,EncLen,Unused|OctetList],1+LenLen+Len+1}; - _ -> - dotag(DoTag, ?N_BIT_STRING, - {[Unused | OctetList],Len+1}) - end. - - -encode_constr_bit_str_bits({_Min,Max},BitListVal,_DoTag) -> - BitLen = length(BitListVal), - if - BitLen > Max -> - exit({error,{asn1,{bitstring_length,{{was,BitLen}, - {maximum,Max}}}}}); - true -> - encode_bitstring(BitListVal) - end; -encode_constr_bit_str_bits({{_Min1,Max1},{Min2,Max2}},BitListVal,_DoTag) -> - BitLen = length(BitListVal), - case BitLen of - Len when Len > Max2 -> - exit({error,{asn1,{bitstring_length,{{was,BitLen}, - {maximum,Max2}}}}}); - Len when Len > Max1, Len < Min2 -> - exit({error,{asn1,{bitstring_length,{{was,BitLen}, - {not_allowed_interval, - Max1,Min2}}}}}); - _ -> - encode_bitstring(BitListVal) - end. - -%% returns a list of length Size + length(BitListVal), with BitListVal -%% as the most significant elements followed by padded zero elements -pad_bit_list(Size,BitListVal) -> - Tail = lists:duplicate(Size,0), - lists:append(BitListVal,Tail). - -%%================================================================= -%% Do the actual encoding -%% ([bitlist]) -> {ListLen, UnusedBits, OctetList} -%%================================================================= - -encode_bitstring([B8, B7, B6, B5, B4, B3, B2, B1 | Rest]) -> - Val = (B8 bsl 7) bor (B7 bsl 6) bor (B6 bsl 5) bor (B5 bsl 4) bor - (B4 bsl 3) bor (B3 bsl 2) bor (B2 bsl 1) bor B1, - encode_bitstring(Rest, [Val], 1); -encode_bitstring(Val) -> - {Unused, Octet} = unused_bitlist(Val, 7, 0), - {1, Unused, [Octet]}. - -encode_bitstring([B8, B7, B6, B5, B4, B3, B2, B1 | Rest], Ack, Len) -> - Val = (B8 bsl 7) bor (B7 bsl 6) bor (B6 bsl 5) bor (B5 bsl 4) bor - (B4 bsl 3) bor (B3 bsl 2) bor (B2 bsl 1) bor B1, - encode_bitstring(Rest, [Ack | [Val]], Len + 1); -%%even multiple of 8 bits.. -encode_bitstring([], Ack, Len) -> - {Len, 0, Ack}; -%% unused bits in last octet -encode_bitstring(Rest, Ack, Len) -> -% io:format("uneven ~w ~w ~w~n",[Rest, Ack, Len]), - {Unused, Val} = unused_bitlist(Rest, 7, 0), - {Len + 1, Unused, [Ack | [Val]]}. - -%%%%%%%%%%%%%%%%%% -%% unused_bitlist([list of ones and zeros <= 7], 7, []) -> -%% {Unused bits, Last octet with bits moved to right} -unused_bitlist([], Trail, Ack) -> - {Trail + 1, Ack}; -unused_bitlist([Bit | Rest], Trail, Ack) -> -%% io:format("trail Bit: ~w Rest: ~w Trail: ~w Ack:~w~n",[Bit, Rest, Trail, Ack]), - unused_bitlist(Rest, Trail - 1, (Bit bsl Trail) bor Ack). - - -%%============================================================================ -%% decode bitstring value -%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} -%%============================================================================ - -decode_compact_bit_string(Buffer, Range, NamedNumberList, Tags, LenIn, OptOrMand) -> -% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_BIT_STRING}), - decode_restricted_string(Buffer, Range, ?N_BIT_STRING, Tags, LenIn, - NamedNumberList, OptOrMand,bin). - -decode_bit_string(Buffer, Range, NamedNumberList, Tags, LenIn, OptOrMand) -> -% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_BIT_STRING}), - decode_restricted_string(Buffer, Range, ?N_BIT_STRING, Tags, LenIn, - NamedNumberList, OptOrMand,old). - - -decode_bit_string2(1,<<0 ,Buffer/binary>>,_NamedNumberList,RemovedBytes,BinOrOld) -> - case BinOrOld of - bin -> - {{0,<<>>},Buffer,RemovedBytes}; - _ -> - {[], Buffer, RemovedBytes} - end; -decode_bit_string2(Len,<<Unused,Buffer/binary>>,NamedNumberList, - RemovedBytes,BinOrOld) -> - L = Len - 1, - <<Bits:L/binary,BufferTail/binary>> = Buffer, - case NamedNumberList of - [] -> - case BinOrOld of - bin -> - {{Unused,Bits},BufferTail,RemovedBytes}; - _ -> - BitString = decode_bitstring2(L, Unused, Buffer), - {BitString,BufferTail, RemovedBytes} - end; - _ -> - BitString = decode_bitstring2(L, Unused, Buffer), - {decode_bitstring_NNL(BitString,NamedNumberList), - BufferTail, - RemovedBytes} - end. - -%%---------------------------------------- -%% Decode the in buffer to bits -%%---------------------------------------- -decode_bitstring2(1,Unused,<<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,_/binary>>) -> - lists:sublist([B7,B6,B5,B4,B3,B2,B1,B0],8-Unused); -decode_bitstring2(Len, Unused, - <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,Buffer/binary>>) -> - [B7, B6, B5, B4, B3, B2, B1, B0 | - decode_bitstring2(Len - 1, Unused, Buffer)]. - -%%decode_bitstring2(1, Unused, Buffer) -> -%% make_bits_of_int(hd(Buffer), 128, 8-Unused); -%%decode_bitstring2(Len, Unused, [BitVal | Buffer]) -> -%% [B7, B6, B5, B4, B3, B2, B1, B0] = make_bits_of_int(BitVal, 128, 8), -%% [B7, B6, B5, B4, B3, B2, B1, B0 | -%% decode_bitstring2(Len - 1, Unused, Buffer)]. - - -%%make_bits_of_int(_, _, 0) -> -%% []; -%%make_bits_of_int(BitVal, MaskVal, Unused) when Unused > 0 -> -%% X = case MaskVal band BitVal of -%% 0 -> 0 ; -%% _ -> 1 -%% end, -%% [X | make_bits_of_int(BitVal, MaskVal bsr 1, Unused - 1)]. - - - -%%---------------------------------------- -%% Decode the bitlist to names -%%---------------------------------------- - - -decode_bitstring_NNL(BitList,NamedNumberList) -> - decode_bitstring_NNL(BitList,NamedNumberList,0,[]). - - -decode_bitstring_NNL([],_,_No,Result) -> - lists:reverse(Result); - -decode_bitstring_NNL([B|BitList],[{Name,No}|NamedNumberList],No,Result) -> - if - B == 0 -> - decode_bitstring_NNL(BitList,NamedNumberList,No+1,Result); - true -> - decode_bitstring_NNL(BitList,NamedNumberList,No+1,[Name|Result]) - end; -decode_bitstring_NNL([1|BitList],NamedNumberList,No,Result) -> - decode_bitstring_NNL(BitList,NamedNumberList,No+1,[{bit,No}|Result]); -decode_bitstring_NNL([0|BitList],NamedNumberList,No,Result) -> - decode_bitstring_NNL(BitList,NamedNumberList,No+1,Result). - - -%%============================================================================ -%% Octet string, ITU_T X.690 Chapter 8.7 -%% -%% encode octet string -%% The OctetList must be a flat list of integers in the range 0..255 -%% the function does not check this because it takes to much time -%%============================================================================ -encode_octet_string(_C, OctetList, []) when binary(OctetList) -> - dotag_universal(?N_OCTET_STRING,OctetList,size(OctetList)); -encode_octet_string(_C, OctetList, DoTag) when binary(OctetList) -> - dotag(DoTag, ?N_OCTET_STRING, {OctetList,size(OctetList)}); -encode_octet_string(_C, OctetList, DoTag) when list(OctetList) -> - case length(OctetList) of - Len when DoTag == [] -> - dotag_universal(?N_OCTET_STRING,OctetList,Len); - Len -> - dotag(DoTag, ?N_OCTET_STRING, {OctetList,Len}) - end; -% encode_octet_string(C, OctetList, DoTag) when list(OctetList) -> -% dotag(DoTag, ?N_OCTET_STRING, {OctetList,length(OctetList)}); -encode_octet_string(C, {Name,OctetList}, DoTag) when atom(Name) -> - encode_octet_string(C, OctetList, DoTag). - - -%%============================================================================ -%% decode octet string -%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} -%% -%% Octet string is decoded as a restricted string -%%============================================================================ -decode_octet_string(Buffer, Range, Tags, TotalLen, OptOrMand) -> -% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_OCTET_STRING}), - decode_restricted_string(Buffer, Range, ?N_OCTET_STRING, - Tags, TotalLen, [], OptOrMand,old). - -%%============================================================================ -%% Null value, ITU_T X.690 Chapter 8.8 -%% -%% encode NULL value -%%============================================================================ - -encode_null(_, []) -> - {[?N_NULL,0],2}; -encode_null(_, DoTag) -> - dotag(DoTag, ?N_NULL, {[],0}). - -%%============================================================================ -%% decode NULL value -%% (Buffer, HasTag, TotalLen) -> {NULL, Remain, RemovedBytes} -%%============================================================================ -decode_null(Buffer, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_NULL}), - decode_null_notag(Buffer, NewTags, OptOrMand). - -decode_null_notag(Buffer, Tags, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {_Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = decode_null_notag(Buffer0, RestTags, - OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,0} -> - {'NULL', Buffer0, Rb0}; - {_,Len} -> - exit({error,{asn1,{invalid_length,'NULL',Len}}}) - end. - - -%%============================================================================ -%% Object identifier, ITU_T X.690 Chapter 8.19 -%% -%% encode Object Identifier value -%%============================================================================ - -encode_object_identifier({Name,Val}, DoTag) when atom(Name) -> - encode_object_identifier(Val, DoTag); -encode_object_identifier(Val, []) -> - {EncVal,Len} = e_object_identifier(Val), - dotag_universal(?N_OBJECT_IDENTIFIER,EncVal,Len); -encode_object_identifier(Val, DoTag) -> - dotag(DoTag, ?N_OBJECT_IDENTIFIER, e_object_identifier(Val)). - -e_object_identifier({'OBJECT IDENTIFIER', V}) -> - e_object_identifier(V); -e_object_identifier({Cname, V}) when atom(Cname), tuple(V) -> - e_object_identifier(tuple_to_list(V)); -e_object_identifier({Cname, V}) when atom(Cname), list(V) -> - e_object_identifier(V); -e_object_identifier(V) when tuple(V) -> - e_object_identifier(tuple_to_list(V)); - -%%%%%%%%%%%%%%% -%% e_object_identifier([List of Obect Identifiers]) -> -%% {[Encoded Octetlist of ObjIds], IntLength} -%% -e_object_identifier([E1, E2 | Tail]) -> - Head = 40*E1 + E2, % wow! - {H,Lh} = mk_object_val(Head), - {R,Lr} = enc_obj_id_tail(Tail, [], 0), - {[H|R], Lh+Lr}. - -enc_obj_id_tail([], Ack, Len) -> - {lists:reverse(Ack), Len}; -enc_obj_id_tail([H|T], Ack, Len) -> - {B, L} = mk_object_val(H), - enc_obj_id_tail(T, [B|Ack], Len+L). - -%% e_object_identifier([List of Obect Identifiers]) -> -%% {[Encoded Octetlist of ObjIds], IntLength} -%% -%%e_object_identifier([E1, E2 | Tail]) -> -%% Head = 40*E1 + E2, % wow! -%% F = fun(Val, AckLen) -> -%% {L, Ack} = mk_object_val(Val), -%% {L, Ack + AckLen} -%% end, -%% {Octets, Len} = lists:mapfoldl(F, 0, [Head | Tail]). - -%%%%%%%%%%% -%% mk_object_val(Value) -> {OctetList, Len} -%% returns a Val as a list of octets, the 8 bit is allways set to one except -%% for the last octet, where its 0 -%% - - -mk_object_val(Val) when Val =< 127 -> - {[255 band Val], 1}; -mk_object_val(Val) -> - mk_object_val(Val bsr 7, [Val band 127], 1). -mk_object_val(0, Ack, Len) -> - {Ack, Len}; -mk_object_val(Val, Ack, Len) -> - mk_object_val(Val bsr 7, [((Val band 127) bor 128) | Ack], Len + 1). - - - -%%============================================================================ -%% decode Object Identifier value -%% (Buffer, HasTag, TotalLen) -> {{ObjId}, Remain, RemovedBytes} -%%============================================================================ - -decode_object_identifier(Buffer, Tags, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL, - number=?N_OBJECT_IDENTIFIER}), - decode_object_identifier_notag(Buffer, NewTags, OptOrMand). - -decode_object_identifier_notag(Buffer, Tags, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_object_identifier_notag(Buffer00, - RestTags, OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,Len} -> - {[AddedObjVal|ObjVals],Buffer01} = - dec_subidentifiers(Buffer0,0,[],Len), - {Val1, Val2} = if - AddedObjVal < 40 -> - {0, AddedObjVal}; - AddedObjVal < 80 -> - {1, AddedObjVal - 40}; - true -> - {2, AddedObjVal - 80} - end, - {list_to_tuple([Val1, Val2 | ObjVals]), Buffer01, - Rb0+Len} - end. - -dec_subidentifiers(Buffer,_Av,Al,0) -> - {lists:reverse(Al),Buffer}; -dec_subidentifiers(<<1:1,H:7,T/binary>>,Av,Al,Len) -> - dec_subidentifiers(T,(Av bsl 7) + H,Al,Len-1); -dec_subidentifiers(<<H,T/binary>>,Av,Al,Len) -> - dec_subidentifiers(T,0,[((Av bsl 7) + H)|Al],Len-1). - - -%%dec_subidentifiers(Buffer,Av,Al,0) -> -%% {lists:reverse(Al),Buffer}; -%%dec_subidentifiers([H|T],Av,Al,Len) when H >=16#80 -> -%% dec_subidentifiers(T,(Av bsl 7) + (H band 16#7F),Al,Len-1); -%%dec_subidentifiers([H|T],Av,Al,Len) -> -%% dec_subidentifiers(T,0,[(Av bsl 7) + H |Al],Len-1). - - -%%============================================================================ -%% Restricted character string types, ITU_T X.690 Chapter 8.20 -%% -%% encode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings -%%============================================================================ -encode_restricted_string(_C, OctetList, StringType, []) - when binary(OctetList) -> - dotag_universal(StringType,OctetList,size(OctetList)); -encode_restricted_string(_C, OctetList, StringType, DoTag) - when binary(OctetList) -> - dotag(DoTag, StringType, {OctetList, size(OctetList)}); -encode_restricted_string(_C, OctetList, StringType, []) - when list(OctetList) -> - dotag_universal(StringType,OctetList,length(OctetList)); -encode_restricted_string(_C, OctetList, StringType, DoTag) - when list(OctetList) -> - dotag(DoTag, StringType, {OctetList, length(OctetList)}); -encode_restricted_string(C,{Name,OctetL},StringType,DoTag) when atom(Name)-> - encode_restricted_string(C, OctetL, StringType, DoTag). - -%%============================================================================ -%% decode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings -%% (Buffer, Range, StringType, HasTag, TotalLen) -> -%% {String, Remain, RemovedBytes} -%%============================================================================ - -decode_restricted_string(Buffer, Range, StringType, Tags, LenIn, OptOrMand) -> - {Val,Buffer2,Rb} = - decode_restricted_string_tag(Buffer, Range, StringType, Tags, - LenIn, [], OptOrMand,old), - {check_and_convert_restricted_string(Val,StringType,Range,[],old), - Buffer2,Rb}. - - -decode_restricted_string(Buffer, Range, StringType, Tags, LenIn, NNList, OptOrMand, BinOrOld ) -> - {Val,Buffer2,Rb} = - decode_restricted_string_tag(Buffer, Range, StringType, Tags, - LenIn, NNList, OptOrMand, BinOrOld), - {check_and_convert_restricted_string(Val,StringType,Range,NNList,BinOrOld), - Buffer2,Rb}. - -decode_restricted_string_tag(Buffer, Range, StringType, TagsIn, LenIn, NNList, OptOrMand, BinOrOld ) -> - NewTags = new_tags(TagsIn, #tag{class=?UNIVERSAL,number=StringType}), - decode_restricted_string_notag(Buffer, Range, StringType, NewTags, - LenIn, NNList, OptOrMand, BinOrOld). - - - - -check_and_convert_restricted_string(Val,StringType,Range,NamedNumberList,_BinOrOld) -> - {StrLen,NewVal} = case StringType of - ?N_BIT_STRING when NamedNumberList /= [] -> - {no_check,Val}; - ?N_BIT_STRING when list(Val) -> - {length(Val),Val}; - ?N_BIT_STRING when tuple(Val) -> - {(size(element(2,Val))*8) - element(1,Val),Val}; - _ when binary(Val) -> - {size(Val),binary_to_list(Val)}; - _ when list(Val) -> - {length(Val), Val} - end, - case Range of - _ when StrLen == no_check -> - NewVal; - [] -> % No length constraint - NewVal; - {Lb,Ub} when StrLen >= Lb, Ub >= StrLen -> % variable length constraint - NewVal; - {{Lb,_Ub},[]} when StrLen >= Lb -> - NewVal; - {{Lb1,Ub1},{Lb2,Ub2}} when StrLen >= Lb1, StrLen =< Ub1; - StrLen =< Ub2, StrLen >= Lb2 -> - NewVal; - StrLen -> % fixed length constraint - NewVal; - {_,_} -> - exit({error,{asn1,{length,Range,Val}}}); - _Len when integer(_Len) -> - exit({error,{asn1,{length,Range,Val}}}); - _ -> % some strange constraint that we don't support yet - NewVal - end. - - -%%============================================================================= -%% Common routines for several string types including bit string -%% handles indefinite length -%%============================================================================= - - -decode_restricted_string_notag(Buffer, _Range, StringType, TagsIn, - _, NamedNumberList, OptOrMand,BinOrOld) -> - %%----------------------------------------------------------- - %% Get inner (the implicit tag or no tag) and - %% outer (the explicit tag) lengths. - %%----------------------------------------------------------- - {RestTags, {FormLength={_,_Len01}, Buffer0, Rb0}} = - check_tags_i(TagsIn, Buffer, OptOrMand), - - case FormLength of - {?CONSTRUCTED,Len} -> - {Buffer00, RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_restricted_parts(Buffer00, RestBytes, [], StringType, - RestTags, - Len, NamedNumberList, - OptOrMand, - BinOrOld, 0, []), - {Val01, Buffer01, Rb0+Rb01}; - {_, Len} -> - {Val01, Buffer01, Rb01} = - decode_restricted(Buffer0, Len, StringType, - NamedNumberList, BinOrOld), - {Val01, Buffer01, Rb0+Rb01} - end. - - -decode_restricted_parts(Buffer, RestBytes, [], StringType, RestTags, Len, NNList, - OptOrMand, BinOrOld, AccRb, AccVal) -> - DecodeFun = case RestTags of - [] -> fun decode_restricted_string_tag/8; - _ -> fun decode_restricted_string_notag/8 - end, - {Val, Buffer1, Rb} = - DecodeFun(Buffer, [], StringType, RestTags, - no_length, NNList, - OptOrMand, BinOrOld), - {Buffer2,More} = - case Buffer1 of - <<0,0,Buffer10/binary>> when Len == indefinite -> - {Buffer10,false}; - <<>> -> - {RestBytes,false}; - _ -> - {Buffer1,true} - end, - {NewVal, NewRb} = - case StringType of - ?N_BIT_STRING when BinOrOld == bin -> - {concat_bit_binaries(AccVal, Val), AccRb+Rb}; - _ when binary(Val),binary(AccVal) -> - {<<AccVal/binary,Val/binary>>,AccRb+Rb}; - _ when binary(Val), AccVal==[] -> - {Val,AccRb+Rb}; - _ -> - {AccVal++Val, AccRb+Rb} - end, - case More of - false -> - {NewVal, Buffer2, NewRb}; - true -> - decode_restricted_parts(Buffer2, RestBytes, [], StringType, RestTags, Len, NNList, - OptOrMand, BinOrOld, NewRb, NewVal) - end. - - - -decode_restricted(Buffer, InnerLen, StringType, NamedNumberList,BinOrOld) -> - - case StringType of - ?N_BIT_STRING -> - decode_bit_string2(InnerLen,Buffer,NamedNumberList,InnerLen,BinOrOld); - - ?N_UniversalString -> - <<PreBuff:InnerLen/binary,RestBuff/binary>> = Buffer,%%added for binary - UniString = mk_universal_string(binary_to_list(PreBuff)), - {UniString,RestBuff,InnerLen}; - ?N_BMPString -> - <<PreBuff:InnerLen/binary,RestBuff/binary>> = Buffer,%%added for binary - BMP = mk_BMP_string(binary_to_list(PreBuff)), - {BMP,RestBuff,InnerLen}; - _ -> - <<PreBuff:InnerLen/binary,RestBuff/binary>> = Buffer,%%added for binary - {PreBuff, RestBuff, InnerLen} - end. - - - -%%============================================================================ -%% encode Universal string -%%============================================================================ - -encode_universal_string(C, {Name, Universal}, DoTag) when atom(Name) -> - encode_universal_string(C, Universal, DoTag); -encode_universal_string(_C, Universal, []) -> - OctetList = mk_uni_list(Universal), - dotag_universal(?N_UniversalString,OctetList,length(OctetList)); -encode_universal_string(_C, Universal, DoTag) -> - OctetList = mk_uni_list(Universal), - dotag(DoTag, ?N_UniversalString, {OctetList,length(OctetList)}). - -mk_uni_list(In) -> - mk_uni_list(In,[]). - -mk_uni_list([],List) -> - lists:reverse(List); -mk_uni_list([{A,B,C,D}|T],List) -> - mk_uni_list(T,[D,C,B,A|List]); -mk_uni_list([H|T],List) -> - mk_uni_list(T,[H,0,0,0|List]). - -%%=========================================================================== -%% decode Universal strings -%% (Buffer, Range, StringType, HasTag, LenIn) -> -%% {String, Remain, RemovedBytes} -%%=========================================================================== - -decode_universal_string(Buffer, Range, Tags, LenIn, OptOrMand) -> -% NewTags = new_tags(HasTag, #tag{class=?UNIVERSAL,number=?N_UniversalString}), - decode_restricted_string(Buffer, Range, ?N_UniversalString, - Tags, LenIn, [], OptOrMand,old). - - -mk_universal_string(In) -> - mk_universal_string(In,[]). - -mk_universal_string([],Acc) -> - lists:reverse(Acc); -mk_universal_string([0,0,0,D|T],Acc) -> - mk_universal_string(T,[D|Acc]); -mk_universal_string([A,B,C,D|T],Acc) -> - mk_universal_string(T,[{A,B,C,D}|Acc]). - - -%%============================================================================ -%% encode BMP string -%%============================================================================ - -encode_BMP_string(C, {Name,BMPString}, DoTag) when atom(Name)-> - encode_BMP_string(C, BMPString, DoTag); -encode_BMP_string(_C, BMPString, []) -> - OctetList = mk_BMP_list(BMPString), - dotag_universal(?N_BMPString,OctetList,length(OctetList)); -encode_BMP_string(_C, BMPString, DoTag) -> - OctetList = mk_BMP_list(BMPString), - dotag(DoTag, ?N_BMPString, {OctetList,length(OctetList)}). - -mk_BMP_list(In) -> - mk_BMP_list(In,[]). - -mk_BMP_list([],List) -> - lists:reverse(List); -mk_BMP_list([{0,0,C,D}|T],List) -> - mk_BMP_list(T,[D,C|List]); -mk_BMP_list([H|T],List) -> - mk_BMP_list(T,[H,0|List]). - -%%============================================================================ -%% decode (OctetList, Range(ignored), tag|notag) -> {ValList, RestList} -%% (Buffer, Range, StringType, HasTag, TotalLen) -> -%% {String, Remain, RemovedBytes} -%%============================================================================ -decode_BMP_string(Buffer, Range, Tags, LenIn, OptOrMand) -> -% NewTags = new_tags(HasTag, #tag{class=?UNIVERSAL,number=?N_BMPString}), - decode_restricted_string(Buffer, Range, ?N_BMPString, - Tags, LenIn, [], OptOrMand,old). - -mk_BMP_string(In) -> - mk_BMP_string(In,[]). - -mk_BMP_string([],US) -> - lists:reverse(US); -mk_BMP_string([0,B|T],US) -> - mk_BMP_string(T,[B|US]); -mk_BMP_string([C,D|T],US) -> - mk_BMP_string(T,[{0,0,C,D}|US]). - - -%%============================================================================ -%% Generalized time, ITU_T X.680 Chapter 39 -%% -%% encode Generalized time -%%============================================================================ - -encode_generalized_time(C, {Name,OctetList}, DoTag) when atom(Name) -> - encode_generalized_time(C, OctetList, DoTag); -encode_generalized_time(_C, OctetList, []) -> - dotag_universal(?N_GeneralizedTime,OctetList,length(OctetList)); -encode_generalized_time(_C, OctetList, DoTag) -> - dotag(DoTag, ?N_GeneralizedTime, {OctetList,length(OctetList)}). - -%%============================================================================ -%% decode Generalized time -%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} -%%============================================================================ - -decode_generalized_time(Buffer, Range, Tags, TotalLen, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL, - number=?N_GeneralizedTime}), - decode_generalized_time_notag(Buffer, Range, NewTags, TotalLen, OptOrMand). - -decode_generalized_time_notag(Buffer, Range, Tags, TotalLen, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_generalized_time_notag(Buffer00, Range, - RestTags, TotalLen, - OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,Len} -> - <<PreBuff:Len/binary,RestBuff/binary>> = Buffer0, - {binary_to_list(PreBuff), RestBuff, Rb0+Len} - end. - -%%============================================================================ -%% Universal time, ITU_T X.680 Chapter 40 -%% -%% encode UTC time -%%============================================================================ - -encode_utc_time(C, {Name,OctetList}, DoTag) when atom(Name) -> - encode_utc_time(C, OctetList, DoTag); -encode_utc_time(_C, OctetList, []) -> - dotag_universal(?N_UTCTime, OctetList,length(OctetList)); -encode_utc_time(_C, OctetList, DoTag) -> - dotag(DoTag, ?N_UTCTime, {OctetList,length(OctetList)}). - -%%============================================================================ -%% decode UTC time -%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} -%%============================================================================ - -decode_utc_time(Buffer, Range, Tags, TotalLen, OptOrMand) -> - NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_UTCTime}), - decode_utc_time_notag(Buffer, Range, NewTags, TotalLen, OptOrMand). - -decode_utc_time_notag(Buffer, Range, Tags, TotalLen, OptOrMand) -> - {RestTags, {FormLen, Buffer0, Rb0}} = - check_tags_i(Tags, Buffer, OptOrMand), - - case FormLen of - {?CONSTRUCTED,Len} -> - {Buffer00,RestBytes} = split_list(Buffer0,Len), - {Val01, Buffer01, Rb01} = - decode_utc_time_notag(Buffer00, Range, - RestTags, TotalLen, - OptOrMand), - {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), - {Val01, Buffer02, Rb0+Rb01+Rb02}; - {_,Len} -> - <<PreBuff:Len/binary,RestBuff/binary>> = Buffer0, - {binary_to_list(PreBuff), RestBuff, Rb0+Len} - end. - - -%%============================================================================ -%% Length handling -%% -%% Encode length -%% -%% encode_length(Int | indefinite) -> -%% [<127]| [128 + Int (<127),OctetList] | [16#80] -%%============================================================================ - -encode_length(indefinite) -> - {[16#80],1}; % 128 -encode_length(L) when L =< 16#7F -> - {[L],1}; -encode_length(L) -> - Oct = minimum_octets(L), - Len = length(Oct), - if - Len =< 126 -> - {[ (16#80+Len) | Oct ],Len+1}; - true -> - exit({error,{asn1, to_long_length_oct, Len}}) - end. - - -%% Val must be >= 0 -minimum_octets(Val) -> - minimum_octets(Val,[]). - -minimum_octets(0,Acc) -> - Acc; -minimum_octets(Val, Acc) -> - minimum_octets((Val bsr 8),[Val band 16#FF | Acc]). - - -%%=========================================================================== -%% Decode length -%% -%% decode_length(OctetList) -> {{indefinite, RestOctetsL}, NoRemovedBytes} | -%% {{Length, RestOctetsL}, NoRemovedBytes} -%%=========================================================================== - -decode_length(<<1:1,0:7,T/binary>>) -> - {{indefinite, T}, 1}; -decode_length(<<0:1,Length:7,T/binary>>) -> - {{Length,T},1}; -decode_length(<<1:1,LL:7,T/binary>>) -> - <<Length:LL/unit:8,Rest/binary>> = T, - {{Length,Rest}, LL+1}. - -%decode_length([128 | T]) -> -% {{indefinite, T},1}; -%decode_length([H | T]) when H =< 127 -> -% {{H, T},1}; -%decode_length([H | T]) -> -% dec_long_length(H band 16#7F, T, 0, 1). - - -%%dec_long_length(0, Buffer, Acc, Len) -> -%% {{Acc, Buffer},Len}; -%%dec_long_length(Bytes, [H | T], Acc, Len) -> -%% dec_long_length(Bytes - 1, T, (Acc bsl 8) + H, Len+1). - -%%=========================================================================== -%% Decode tag and length -%% -%% decode_tag_and_length(Buffer) -> {Tag, Len, RemainingBuffer, RemovedBytes} -%% -%%=========================================================================== - -decode_tag_and_length(Buffer) -> - {Tag, Buffer2, RemBytesTag} = decode_tag(Buffer), - {{Len, Buffer3}, RemBytesLen} = decode_length(Buffer2), - {Tag, Len, Buffer3, RemBytesTag+RemBytesLen}. - - -%%============================================================================ -%% Check if valid tag -%% -%% check_if_valid_tag(Tag, List_of_valid_tags, OptOrMand) -> name of the tag -%%=============================================================================== - -check_if_valid_tag(<<0,0,_/binary>>,_,_) -> - asn1_EOC; -check_if_valid_tag(<<>>, _, OptOrMand) -> - check_if_valid_tag2(false,[],[],OptOrMand); -check_if_valid_tag(Bytes, ListOfTags, OptOrMand) when binary(Bytes) -> - {Tag, _, _} = decode_tag(Bytes), - check_if_valid_tag(Tag, ListOfTags, OptOrMand); - -%% This alternative should be removed in the near future -%% Bytes as input should be the only necessary call -check_if_valid_tag(Tag, ListOfTags, OptOrMand) -> - {Class, _Form, TagNo} = Tag, - C = code_class(Class), - T = case C of - 'UNIVERSAL' -> - code_type(TagNo); - _ -> - TagNo - end, - check_if_valid_tag2({C,T}, ListOfTags, Tag, OptOrMand). - -check_if_valid_tag2(_Class_TagNo, [], Tag, mandatory) -> - exit({error,{asn1,{invalid_tag,Tag}}}); -check_if_valid_tag2(_Class_TagNo, [], Tag, _) -> - exit({error,{asn1,{no_optional_tag,Tag}}}); - -check_if_valid_tag2(Class_TagNo, [{TagName,TagList}|T], Tag, OptOrMand) -> - case check_if_valid_tag_loop(Class_TagNo, TagList) of - true -> - TagName; - false -> - check_if_valid_tag2(Class_TagNo, T, Tag, OptOrMand) - end. - -check_if_valid_tag_loop(_Class_TagNo,[]) -> - false; -check_if_valid_tag_loop(Class_TagNo,[H|T]) -> - %% It is not possible to distinguish between SEQUENCE OF and SEQUENCE, and - %% between SET OF and SET because both are coded as 16 and 17, respectively. - H_without_OF = case H of - {C, 'SEQUENCE OF'} -> - {C, 'SEQUENCE'}; - {C, 'SET OF'} -> - {C, 'SET'}; - Else -> - Else - end, - - case H_without_OF of - Class_TagNo -> - true; - {_,_} -> - check_if_valid_tag_loop(Class_TagNo,T); - _ -> - check_if_valid_tag_loop(Class_TagNo,H), - check_if_valid_tag_loop(Class_TagNo,T) - end. - - - -code_class(0) -> 'UNIVERSAL'; -code_class(16#40) -> 'APPLICATION'; -code_class(16#80) -> 'CONTEXT'; -code_class(16#C0) -> 'PRIVATE'. - - -code_type(1) -> 'BOOLEAN'; -code_type(2) -> 'INTEGER'; -code_type(3) -> 'BIT STRING'; -code_type(4) -> 'OCTET STRING'; -code_type(5) -> 'NULL'; -code_type(6) -> 'OBJECT IDENTIFIER'; -code_type(7) -> 'OBJECT DESCRIPTOR'; -code_type(8) -> 'EXTERNAL'; -code_type(9) -> 'REAL'; -code_type(10) -> 'ENUMERATED'; -code_type(11) -> 'EMBEDDED_PDV'; -code_type(16) -> 'SEQUENCE'; -code_type(16) -> 'SEQUENCE OF'; -code_type(17) -> 'SET'; -code_type(17) -> 'SET OF'; -code_type(18) -> 'NumericString'; -code_type(19) -> 'PrintableString'; -code_type(20) -> 'TeletexString'; -code_type(21) -> 'VideotexString'; -code_type(22) -> 'IA5String'; -code_type(23) -> 'UTCTime'; -code_type(24) -> 'GeneralizedTime'; -code_type(25) -> 'GraphicString'; -code_type(26) -> 'VisibleString'; -code_type(27) -> 'GeneralString'; -code_type(28) -> 'UniversalString'; -code_type(30) -> 'BMPString'; -code_type(Else) -> exit({error,{asn1,{unrecognized_type,Else}}}). - -%%------------------------------------------------------------------------- -%% decoding of the components of a SET -%%------------------------------------------------------------------------- - -decode_set(Rb, indefinite, <<0,0,Bytes/binary>>, _OptOrMand, _Fun3, Acc) -> - {lists:reverse(Acc),Bytes,Rb+2}; - -decode_set(Rb, indefinite, Bytes, OptOrMand, Fun3, Acc) -> - {Term, Remain, Rb1} = Fun3(Bytes, OptOrMand), - decode_set(Rb+Rb1, indefinite, Remain, OptOrMand, Fun3, [Term|Acc]); - -decode_set(Rb, Num, Bytes, _OptOrMand, _Fun3, Acc) when Num == 0 -> - {lists:reverse(Acc), Bytes, Rb}; - -decode_set(_, Num, _, _, _, _) when Num < 0 -> - exit({error,{asn1,{length_error,'SET'}}}); - -decode_set(Rb, Num, Bytes, OptOrMand, Fun3, Acc) -> - {Term, Remain, Rb1} = Fun3(Bytes, OptOrMand), - decode_set(Rb+Rb1, Num-Rb1, Remain, OptOrMand, Fun3, [Term|Acc]). - - -%%------------------------------------------------------------------------- -%% decoding of SEQUENCE OF and SET OF -%%------------------------------------------------------------------------- - -decode_components(Rb, indefinite, <<0,0,Bytes/binary>>, _Fun3, _TagIn, Acc) -> - {lists:reverse(Acc),Bytes,Rb+2}; - -decode_components(Rb, indefinite, Bytes, Fun3, TagIn, Acc) -> - {Term, Remain, Rb1} = Fun3(Bytes, mandatory, TagIn), - decode_components(Rb+Rb1, indefinite, Remain, Fun3, TagIn, [Term|Acc]); - -decode_components(Rb, Num, Bytes, _Fun3, _TagIn, Acc) when Num == 0 -> - {lists:reverse(Acc), Bytes, Rb}; - -decode_components(_, Num, _, _, _, _) when Num < 0 -> - exit({error,{asn1,{length_error,'SET/SEQUENCE OF'}}}); - -decode_components(Rb, Num, Bytes, Fun3, TagIn, Acc) -> - {Term, Remain, Rb1} = Fun3(Bytes, mandatory, TagIn), - decode_components(Rb+Rb1, Num-Rb1, Remain, Fun3, TagIn, [Term|Acc]). - -%%decode_components(Rb, indefinite, [0,0|Bytes], _Fun3, _TagIn, Acc) -> -%% {lists:reverse(Acc),Bytes,Rb+2}; - -decode_components(Rb, indefinite, <<0,0,Bytes/binary>>, _Fun4, _TagIn, _Fun, Acc) -> - {lists:reverse(Acc),Bytes,Rb+2}; - -decode_components(Rb, indefinite, Bytes, _Fun4, TagIn, _Fun, Acc) -> - {Term, Remain, Rb1} = _Fun4(Bytes, mandatory, TagIn, _Fun), - decode_components(Rb+Rb1, indefinite, Remain, _Fun4, TagIn, _Fun, [Term|Acc]); - -decode_components(Rb, Num, Bytes, _Fun4, _TagIn, _Fun, Acc) when Num == 0 -> - {lists:reverse(Acc), Bytes, Rb}; - -decode_components(_, Num, _, _, _, _, _) when Num < 0 -> - exit({error,{asn1,{length_error,'SET/SEQUENCE OF'}}}); - -decode_components(Rb, Num, Bytes, _Fun4, TagIn, _Fun, Acc) -> - {Term, Remain, Rb1} = _Fun4(Bytes, mandatory, TagIn, _Fun), - decode_components(Rb+Rb1, Num-Rb1, Remain, _Fun4, TagIn, _Fun, [Term|Acc]). - - - -%%------------------------------------------------------------------------- -%% INTERNAL HELPER FUNCTIONS (not exported) -%%------------------------------------------------------------------------- - - -%%========================================================================== -%% Encode tag -%% -%% dotag(tag | notag, TagValpattern | TagValTuple, [Length, Value]) -> [Tag] -%% TagValPattern is a correct bitpattern for a tag -%% TagValTuple is a tuple of three bitpatterns, Class, Form and TagNo where -%% Class = UNIVERSAL | APPLICATION | CONTEXT | PRIVATE -%% Form = Primitive | Constructed -%% TagNo = Number of tag -%%========================================================================== - - -dotag([], Tag, {Bytes,Len}) -> - dotag_universal(Tag,Bytes,Len); -dotag(Tags, Tag, {Bytes,Len}) -> - encode_tags(Tags ++ [#tag{class=?UNIVERSAL,number=Tag,form=?PRIMITIVE}], - Bytes, Len); - -dotag(Tags, Tag, Bytes) -> - encode_tags(Tags ++ [#tag{class=?UNIVERSAL,number=Tag,form=?PRIMITIVE}], - Bytes, size(Bytes)). - -dotag_universal(UniversalTag,Bytes,Len) when Len =< 16#7F-> - {[UniversalTag,Len,Bytes],2+Len}; -dotag_universal(UniversalTag,Bytes,Len) -> - {EncLen,LenLen}=encode_length(Len), - {[UniversalTag,EncLen,Bytes],1+LenLen+Len}. - -%% decoding postitive integer values. -decode_integer2(Len,Bin = <<0:1,_:7,_Bs/binary>>,RemovedBytes) -> - <<Int:Len/unit:8,Buffer2/binary>> = Bin, - {Int,Buffer2,RemovedBytes}; -%% decoding negative integer values. -decode_integer2(Len,<<1:1,B2:7,Bs/binary>>,RemovedBytes) -> - <<N:Len/unit:8,Buffer2/binary>> = <<B2,Bs/binary>>, - Int = N - (1 bsl (8 * Len - 1)), - {Int,Buffer2,RemovedBytes}. - -%%decode_integer2(Len,Buffer,Acc,RemovedBytes) when (hd(Buffer) band 16#FF) =< 16#7F -> -%% {decode_integer_pos(Buffer, 8 * (Len - 1)),skip(Buffer,Len),RemovedBytes}; -%%decode_integer2(Len,Buffer,Acc,RemovedBytes) -> -%% {decode_integer_neg(Buffer, 8 * (Len - 1)),skip(Buffer,Len),RemovedBytes}. - -%%decode_integer_pos([Byte|Tail], Shift) -> -%% (Byte bsl Shift) bor decode_integer_pos(Tail, Shift-8); -%%decode_integer_pos([], _) -> 0. - - -%%decode_integer_neg([Byte|Tail], Shift) -> -%% (-128 + (Byte band 127) bsl Shift) bor decode_integer_pos(Tail, Shift-8). - - -concat_bit_binaries([],Bin={_,_}) -> - Bin; -concat_bit_binaries({0,B1},{U2,B2}) -> - {U2,<<B1/binary,B2/binary>>}; -concat_bit_binaries({U1,B1},{U2,B2}) -> - S1 = (size(B1) * 8) - U1, - S2 = (size(B2) * 8) - U2, - PadBits = 8 - ((S1+S2) rem 8), - {PadBits, <<B1:S1/binary-unit:1,B2:S2/binary-unit:1,0:PadBits>>}; -concat_bit_binaries(L1,L2) when list(L1),list(L2) -> - %% this case occur when decoding with NNL - L1 ++ L2. - - -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - -%%skip(Buffer, 0) -> -%% Buffer; -%%skip([H | T], Len) -> -%% skip(T, Len-1). - -new_tags([],LastTag) -> - [LastTag]; -new_tags(Tags=[#tag{type='IMPLICIT'}],_LastTag) -> - Tags; -new_tags([T1 = #tag{type='IMPLICIT'},#tag{type=T2Type}|Rest],LastTag) -> - new_tags([T1#tag{type=T2Type}|Rest],LastTag); -new_tags(Tags,LastTag) -> - case lists:last(Tags) of - #tag{type='IMPLICIT'} -> - Tags; - _ -> - Tags ++ [LastTag] - end. diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_ber_bin_v2.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_ber_bin_v2.erl deleted file mode 100644 index 7f7846184a..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_ber_bin_v2.erl +++ /dev/null @@ -1,1869 +0,0 @@ -%% ``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: asn1rt_ber_bin_v2.erl,v 1.1 2008/12/17 09:53:30 mikpe Exp $ -%% --module(asn1rt_ber_bin_v2). - -%% encoding / decoding of BER - --export([decode/1, decode/2, match_tags/2, encode/1]). --export([fixoptionals/2, cindex/3, - list_to_record/2, - encode_tag_val/1, - encode_tags/3]). --export([encode_boolean/2,decode_boolean/2, - encode_integer/3,encode_integer/4, - decode_integer/3, decode_integer/4, - encode_enumerated/2, - encode_enumerated/4,decode_enumerated/4, - encode_real/2,decode_real/3, - encode_bit_string/4,decode_bit_string/4, - decode_compact_bit_string/4, - encode_octet_string/3,decode_octet_string/3, - encode_null/2,decode_null/2, - encode_object_identifier/2,decode_object_identifier/2, - encode_restricted_string/4,decode_restricted_string/4, - encode_universal_string/3,decode_universal_string/3, - encode_BMP_string/3,decode_BMP_string/3, - encode_generalized_time/3,decode_generalized_time/3, - encode_utc_time/3,decode_utc_time/3, - encode_length/1,decode_length/1, - decode_tag_and_length/1]). - --export([encode_open_type/1,encode_open_type/2, - decode_open_type/2,decode_open_type_as_binary/2]). - --export([decode_primitive_incomplete/2]). - --include("asn1_records.hrl"). - -% the encoding of class of tag bits 8 and 7 --define(UNIVERSAL, 0). --define(APPLICATION, 16#40). --define(CONTEXT, 16#80). --define(PRIVATE, 16#C0). - -%%% primitive or constructed encoding % bit 6 --define(PRIMITIVE, 0). --define(CONSTRUCTED, 2#00100000). - -%%% The tag-number for universal types --define(N_BOOLEAN, 1). --define(N_INTEGER, 2). --define(N_BIT_STRING, 3). --define(N_OCTET_STRING, 4). --define(N_NULL, 5). --define(N_OBJECT_IDENTIFIER, 6). --define(N_OBJECT_DESCRIPTOR, 7). --define(N_EXTERNAL, 8). --define(N_REAL, 9). --define(N_ENUMERATED, 10). --define(N_EMBEDDED_PDV, 11). --define(N_SEQUENCE, 16). --define(N_SET, 17). --define(N_NumericString, 18). --define(N_PrintableString, 19). --define(N_TeletexString, 20). --define(N_VideotexString, 21). --define(N_IA5String, 22). --define(N_UTCTime, 23). --define(N_GeneralizedTime, 24). --define(N_GraphicString, 25). --define(N_VisibleString, 26). --define(N_GeneralString, 27). --define(N_UniversalString, 28). --define(N_BMPString, 30). - - -% the complete tag-word of built-in types --define(T_BOOLEAN, ?UNIVERSAL bor ?PRIMITIVE bor 1). --define(T_INTEGER, ?UNIVERSAL bor ?PRIMITIVE bor 2). --define(T_BIT_STRING, ?UNIVERSAL bor ?PRIMITIVE bor 3). % can be CONSTRUCTED --define(T_OCTET_STRING, ?UNIVERSAL bor ?PRIMITIVE bor 4). % can be CONSTRUCTED --define(T_NULL, ?UNIVERSAL bor ?PRIMITIVE bor 5). --define(T_OBJECT_IDENTIFIER,?UNIVERSAL bor ?PRIMITIVE bor 6). --define(T_OBJECT_DESCRIPTOR,?UNIVERSAL bor ?PRIMITIVE bor 7). --define(T_EXTERNAL, ?UNIVERSAL bor ?PRIMITIVE bor 8). --define(T_REAL, ?UNIVERSAL bor ?PRIMITIVE bor 9). --define(T_ENUMERATED, ?UNIVERSAL bor ?PRIMITIVE bor 10). --define(T_EMBEDDED_PDV, ?UNIVERSAL bor ?PRIMITIVE bor 11). --define(T_SEQUENCE, ?UNIVERSAL bor ?CONSTRUCTED bor 16). --define(T_SET, ?UNIVERSAL bor ?CONSTRUCTED bor 17). --define(T_NumericString, ?UNIVERSAL bor ?PRIMITIVE bor 18). %can be constructed --define(T_PrintableString, ?UNIVERSAL bor ?PRIMITIVE bor 19). %can be constructed --define(T_TeletexString, ?UNIVERSAL bor ?PRIMITIVE bor 20). %can be constructed --define(T_VideotexString, ?UNIVERSAL bor ?PRIMITIVE bor 21). %can be constructed --define(T_IA5String, ?UNIVERSAL bor ?PRIMITIVE bor 22). %can be constructed --define(T_UTCTime, ?UNIVERSAL bor ?PRIMITIVE bor 23). --define(T_GeneralizedTime, ?UNIVERSAL bor ?PRIMITIVE bor 24). --define(T_GraphicString, ?UNIVERSAL bor ?PRIMITIVE bor 25). %can be constructed --define(T_VisibleString, ?UNIVERSAL bor ?PRIMITIVE bor 26). %can be constructed --define(T_GeneralString, ?UNIVERSAL bor ?PRIMITIVE bor 27). %can be constructed --define(T_UniversalString, ?UNIVERSAL bor ?PRIMITIVE bor 28). %can be constructed --define(T_BMPString, ?UNIVERSAL bor ?PRIMITIVE bor 30). %can be constructed - -% encode(Tlv={_Tag={?PRIMITIVE,_},_VList}) -> -% encode_primitive(Tlv); -% encode(Tlv) -> -% encode_constructed(Tlv). - -encode([Tlv]) -> - encode(Tlv); -encode({TlvTag,TlvVal}) when list(TlvVal) -> - %% constructed form of value - encode_tlv(TlvTag,TlvVal,?CONSTRUCTED); -encode({TlvTag,TlvVal}) -> - encode_tlv(TlvTag,TlvVal,?PRIMITIVE); -encode(Bin) when binary(Bin) -> - Bin. - -encode_tlv(TlvTag,TlvVal,Form) -> - Tag = encode_tlv_tag(TlvTag,Form), - {Val,VLen} = encode_tlv_val(TlvVal), - {Len,_LLen} = encode_length(VLen), - BinLen = list_to_binary(Len), - <<Tag/binary,BinLen/binary,Val/binary>>. - -encode_tlv_tag(ClassTagNo,Form) -> - Class = ClassTagNo bsr 16, - case encode_tag_val({Class bsl 6,Form,(ClassTagNo - (Class bsl 16))}) of - T when list(T) -> - list_to_binary(T); - T -> - T - end. - -encode_tlv_val(TlvL) when list(TlvL) -> - encode_tlv_list(TlvL,[]); -encode_tlv_val(Bin) -> - {Bin,size(Bin)}. - -encode_tlv_list([Tlv|Tlvs],Acc) -> - EncTlv = encode(Tlv), - encode_tlv_list(Tlvs,[EncTlv|Acc]); -encode_tlv_list([],Acc) -> - Bin=list_to_binary(lists:reverse(Acc)), - {Bin,size(Bin)}. - -% encode_primitive({{_,ClassTagNo},V}) -> -% Len = size(V), % not sufficient as length encode -% Class = ClassTagNo bsr 16, -% {TagLen,Tag} = -% case encode_tag_val({Class,?PRIMITIVE,ClassTagNo - Class}) of -% T when list(T) -> -% {length(T),list_to_binary(T)}; -% T -> -% {1,T} -% end, - - -decode(B,driver) -> - case catch port_control(drv_complete,2,B) of - Bin when binary(Bin) -> - binary_to_term(Bin); - List when list(List) -> handle_error(List,B); - {'EXIT',{badarg,Reason}} -> - asn1rt_driver_handler:load_driver(), - receive - driver_ready -> - case catch port_control(drv_complete,2,B) of - Bin2 when binary(Bin2) -> binary_to_term(Bin2); - List when list(List) -> handle_error(List,B); - Error -> exit(Error) - end; - {error,Error} -> % error when loading driver - %% the driver could not be loaded - exit(Error); - Error={port_error,Reason} -> - exit(Error) - end; - {'EXIT',Reason} -> - exit(Reason) - end. - -handle_error([],_)-> - exit({error,{"memory allocation problem"}}); -handle_error([$1|_],L) -> % error in driver - exit({error,{asn1_error,L}}); -handle_error([$2|_],L) -> % error in driver due to wrong tag - exit({error,{asn1_error,{"bad tag",L}}}); -handle_error([$3|_],L) -> % error in driver due to length error - exit({error,{asn1_error,{"bad length field",L}}}); -handle_error([$4|_],L) -> % error in driver due to indefinite length error - exit({error,{asn1_error,{"indefinite length without end bytes",L}}}); -handle_error(ErrL,L) -> - exit({error,{unknown_error,ErrL,L}}). - - -decode(Bin) when binary(Bin) -> - decode_primitive(Bin); -decode(Tlv) -> % assume it is a tlv - {Tlv,<<>>}. - - -decode_primitive(Bin) -> - {{Form,TagNo,Len,V},Rest} = decode_tlv(Bin), - case Form of - 1 when Len == indefinite -> % constructed - {Vlist,Rest2} = decode_constructed_indefinite(V,[]), - {{TagNo,Vlist},Rest2}; - 1 -> % constructed - {{TagNo,decode_constructed(V)},Rest}; - 0 -> % primitive - {{TagNo,V},Rest} - end. - -decode_constructed(<<>>) -> - []; -decode_constructed(Bin) -> - {Tlv,Rest} = decode_primitive(Bin), - [Tlv|decode_constructed(Rest)]. - -decode_constructed_indefinite(<<0,0,Rest/binary>>,Acc) -> - {lists:reverse(Acc),Rest}; -decode_constructed_indefinite(Bin,Acc) -> - {Tlv,Rest} = decode_primitive(Bin), - decode_constructed_indefinite(Rest, [Tlv|Acc]). - -decode_tlv(Bin) -> - {Form,TagNo,Len,Bin2} = decode_tag_and_length(Bin), - case Len of - indefinite -> - {{Form,TagNo,Len,Bin2},[]}; - _ -> - <<V:Len/binary,Bin3/binary>> = Bin2, - {{Form,TagNo,Len,V},Bin3} - end. - -%% decode_primitive_incomplete/2 decodes an encoded message incomplete -%% by help of the pattern attribute (first argument). -decode_primitive_incomplete([[default,TagNo]],Bin) -> %default - case decode_tlv(Bin) of - {{Form,TagNo,Len,V},Rest} -> - decode_incomplete2(Form,TagNo,Len,V,[],Rest); - _ -> - %{asn1_DEFAULT,Bin} - asn1_NOVALUE - end; -decode_primitive_incomplete([[default,TagNo,Directives]],Bin) -> %default, constructed type, Directives points into this type - case decode_tlv(Bin) of - {{Form,TagNo,Len,V},Rest} -> - decode_incomplete2(Form,TagNo,Len,V,Directives,Rest); - _ -> - %{asn1_DEFAULT,Bin} - asn1_NOVALUE - end; -decode_primitive_incomplete([[opt,TagNo]],Bin) -> %optional - case decode_tlv(Bin) of - {{Form,TagNo,Len,V},Rest} -> - decode_incomplete2(Form,TagNo,Len,V,[],Rest); - _ -> - %{{TagNo,asn1_NOVALUE},Bin} - asn1_NOVALUE - end; -decode_primitive_incomplete([[opt,TagNo,Directives]],Bin) -> %optional - case decode_tlv(Bin) of - {{Form,TagNo,Len,V},Rest} -> - decode_incomplete2(Form,TagNo,Len,V,Directives,Rest); - _ -> - %{{TagNo,asn1_NOVALUE},Bin} - asn1_NOVALUE - end; -%% A choice alternative that shall be undecoded -decode_primitive_incomplete([[alt_undec,TagNo]|RestAlts],Bin) -> -% decode_incomplete_bin(Bin); - case decode_tlv(Bin) of - {{_Form,TagNo,_Len,_V},_R} -> - decode_incomplete_bin(Bin); - _ -> - decode_primitive_incomplete(RestAlts,Bin) - end; -decode_primitive_incomplete([[alt,TagNo]|RestAlts],Bin) -> - case decode_tlv(Bin) of - {{_Form,TagNo,_Len,V},Rest} -> - {{TagNo,V},Rest}; - _ -> - decode_primitive_incomplete(RestAlts,Bin) - end; -decode_primitive_incomplete([[alt,TagNo,Directives]|RestAlts],Bin) -> - case decode_tlv(Bin) of - {{Form,TagNo,Len,V},Rest} -> - decode_incomplete2(Form,TagNo,Len,V,Directives,Rest); - _ -> - decode_primitive_incomplete(RestAlts,Bin) - end; -decode_primitive_incomplete([[alt_parts,TagNo]|RestAlts],Bin) -> - case decode_tlv(Bin) of - {{_Form,TagNo,_Len,V},Rest} -> - {{TagNo,decode_parts_incomplete(V)},Rest}; - _ -> - decode_primitive_incomplete(RestAlts,Bin) - end; -decode_primitive_incomplete([[undec,_TagNo]|_RestTag],Bin) -> %incomlete decode - decode_incomplete_bin(Bin); %% use this if changing handling of -decode_primitive_incomplete([[parts,TagNo]|_RestTag],Bin) -> - case decode_tlv(Bin) of - {{_Form,TagNo,_Len,V},Rest} -> - {{TagNo,decode_parts_incomplete(V)},Rest}; - Err -> - {error,{asn1,"tag failure",TagNo,Err}} - end; -decode_primitive_incomplete([mandatory|RestTag],Bin) -> - case decode_tlv(Bin) of - {{Form,TagNo,Len,V},Rest} -> - decode_incomplete2(Form,TagNo,Len,V,RestTag,Rest); - _ -> - {error,{asn1,"partial incomplete decode failure"}} - end; -%% A choice that is a toptype or a mandatory component of a -%% SEQUENCE or SET. -decode_primitive_incomplete([[mandatory,Directives]],Bin) -> - case decode_tlv(Bin) of - {{Form,TagNo,Len,V},Rest} -> - decode_incomplete2(Form,TagNo,Len,V,Directives,Rest); - _ -> - {error,{asn1,"partial incomplete decode failure"}} - end; -decode_primitive_incomplete([],Bin) -> - decode_primitive(Bin). - -%% decode_parts_incomplete/1 receives a number of values encoded in -%% sequence and returns the parts as unencoded binaries -decode_parts_incomplete(<<>>) -> - []; -decode_parts_incomplete(Bin) -> - {ok,Rest} = skip_tag(Bin), - {ok,Rest2} = skip_length_and_value(Rest), - LenPart = size(Bin) - size(Rest2), - <<Part:LenPart/binary,RestBin/binary>> = Bin, - [Part|decode_parts_incomplete(RestBin)]. - - -%% decode_incomplete2 checks if V is a value of a constructed or -%% primitive type, and continues the decode propeerly. -decode_incomplete2(1,TagNo,indefinite,V,TagMatch,_) -> - %% constructed indefinite length - {Vlist,Rest2} = decode_constr_indef_incomplete(TagMatch,V,[]), - {{TagNo,Vlist},Rest2}; -decode_incomplete2(1,TagNo,_Len,V,TagMatch,Rest) -> - {{TagNo,decode_constructed_incomplete(TagMatch,V)},Rest}; -decode_incomplete2(0,TagNo,_Len,V,_TagMatch,Rest) -> - {{TagNo,V},Rest}. - -decode_constructed_incomplete(_TagMatch,<<>>) -> - []; -decode_constructed_incomplete([mandatory|RestTag],Bin) -> - {Tlv,Rest} = decode_primitive(Bin), - [Tlv|decode_constructed_incomplete(RestTag,Rest)]; -decode_constructed_incomplete(Directives=[[Alt,_]|_],Bin) - when Alt == alt_undec; Alt == alt -> - case decode_tlv(Bin) of - {{_Form,TagNo,_Len,V},Rest} -> - case incomplete_choice_alt(TagNo,Directives) of - alt_undec -> - LenA = size(Bin)-size(Rest), - <<A:LenA/binary,Rest/binary>> = Bin, - A; -% {UndecBin,_}=decode_incomplete_bin(Bin), -% UndecBin; -% [{TagNo,V}]; - alt -> - {Tlv,_} = decode_primitive(V), - [{TagNo,Tlv}]; - alt_parts -> - %{{TagNo,decode_parts_incomplete(V)},Rest}; % maybe wrong - [{TagNo,decode_parts_incomplete(V)}]; - Err -> - {error,{asn1,"partial incomplete decode failure",Err}} - end; - _ -> - {error,{asn1,"partial incomplete decode failure"}} - end; -decode_constructed_incomplete([TagNo|RestTag],Bin) -> -%% {Tlv,Rest} = decode_primitive_incomplete([TagNo],Bin), - case decode_primitive_incomplete([TagNo],Bin) of - {Tlv,Rest} -> - [Tlv|decode_constructed_incomplete(RestTag,Rest)]; - asn1_NOVALUE -> - decode_constructed_incomplete(RestTag,Bin) - end; -decode_constructed_incomplete([],Bin) -> - {Tlv,_Rest}=decode_primitive(Bin), - [Tlv]. - -decode_constr_indef_incomplete(_TagMatch,<<0,0,Rest/binary>>,Acc) -> - {lists:reverse(Acc),Rest}; -decode_constr_indef_incomplete([Tag|RestTags],Bin,Acc) -> -% {Tlv,Rest} = decode_primitive_incomplete([Tag],Bin), - case decode_primitive_incomplete([Tag],Bin) of - {Tlv,Rest} -> - decode_constr_indef_incomplete(RestTags,Rest,[Tlv|Acc]); - asn1_NOVALUE -> - decode_constr_indef_incomplete(RestTags,Bin,Acc) - end. - - -decode_incomplete_bin(Bin) -> - {ok,Rest} = skip_tag(Bin), - {ok,Rest2} = skip_length_and_value(Rest), - IncLen = size(Bin) - size(Rest2), - <<IncBin:IncLen/binary,Ret/binary>> = Bin, - {IncBin,Ret}. - -incomplete_choice_alt(TagNo,[[Alt,TagNo]|_Directives]) -> - Alt; -incomplete_choice_alt(TagNo,[_H|Directives]) -> - incomplete_choice_alt(TagNo,Directives); -incomplete_choice_alt(_,[]) -> - error. - - -%% skip_tag and skip_length_and_value are rutines used both by -%% decode_partial_incomplete and decode_partial (decode/2). - -skip_tag(<<_:3,31:5,Rest/binary>>)-> - skip_long_tag(Rest); -skip_tag(<<_:3,_Tag:5,Rest/binary>>) -> - {ok,Rest}. - -skip_long_tag(<<1:1,_:7,Rest/binary>>) -> - skip_long_tag(Rest); -skip_long_tag(<<0:1,_:7,Rest/binary>>) -> - {ok,Rest}. - -skip_length_and_value(Binary) -> - case decode_length(Binary) of - {indefinite,RestBinary} -> - skip_indefinite_value(RestBinary); - {Length,RestBinary} -> - <<_:Length/unit:8,Rest/binary>> = RestBinary, - {ok,Rest} - end. - -skip_indefinite_value(<<0,0,Rest/binary>>) -> - {ok,Rest}; -skip_indefinite_value(Binary) -> - {ok,RestBinary}=skip_tag(Binary), - {ok,RestBinary2} = skip_length_and_value(RestBinary), - skip_indefinite_value(RestBinary2). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% match_tags takes a Tlv (Tag, Length, Value) structure and matches -%% it with the tags in TagList. If the tags does not match the function -%% crashes otherwise it returns the remaining Tlv after that the tags have -%% been removed. -%% -%% match_tags(Tlv, TagList) -%% - - -match_tags({T,V}, [T|Tt]) -> - match_tags(V,Tt); -match_tags([{T,V}],[T|Tt]) -> - match_tags(V, Tt); -match_tags(Vlist = [{T,_V}|_], [T]) -> - Vlist; -match_tags(Tlv, []) -> - Tlv; -match_tags({Tag,_V},[T|_Tt]) -> - {error,{asn1,{wrong_tag,{Tag,T}}}}. - - -cindex(Ix,Val,Cname) -> - case element(Ix,Val) of - {Cname,Val2} -> Val2; - X -> X - end. - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Optionals, preset not filled optionals with asn1_NOVALUE -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -% converts a list to a record if necessary -list_to_record(Name,List) when list(List) -> - list_to_tuple([Name|List]); -list_to_record(_Name,Tuple) when tuple(Tuple) -> - Tuple. - - -fixoptionals(OptList,Val) when list(Val) -> - fixoptionals(OptList,Val,1,[],[]). - -fixoptionals([{Name,Pos}|Ot],[{Name,Val}|Vt],_Opt,Acc1,Acc2) -> - fixoptionals(Ot,Vt,Pos+1,[1|Acc1],[{Name,Val}|Acc2]); -fixoptionals([{_Name,Pos}|Ot],V,Pos,Acc1,Acc2) -> - fixoptionals(Ot,V,Pos+1,[0|Acc1],[asn1_NOVALUE|Acc2]); -fixoptionals(O,[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals(O,Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals([],[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals([],Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals([],[],_,_Acc1,Acc2) -> - % return Val as a record - list_to_tuple([asn1_RECORDNAME|lists:reverse(Acc2)]). - - -%%encode_tag(TagClass(?UNI, APP etc), Form (?PRIM etx), TagInteger) -> -%% 8bit Int | binary -encode_tag_val({Class, Form, TagNo}) when (TagNo =< 30) -> - <<(Class bsr 6):2,(Form bsr 5):1,TagNo:5>>; - -encode_tag_val({Class, Form, TagNo}) -> - {Octets,_Len} = mk_object_val(TagNo), - BinOct = list_to_binary(Octets), - <<(Class bsr 6):2, (Form bsr 5):1, 31:5,BinOct/binary>>; - -%% asumes whole correct tag bitpattern, multiple of 8 -encode_tag_val(Tag) when (Tag =< 255) -> Tag; %% anv�nds denna funktion??!! -%% asumes correct bitpattern of 0-5 -encode_tag_val(Tag) -> encode_tag_val2(Tag,[]). - -encode_tag_val2(Tag, OctAck) when (Tag =< 255) -> - [Tag | OctAck]; -encode_tag_val2(Tag, OctAck) -> - encode_tag_val2(Tag bsr 8, [255 band Tag | OctAck]). - - -%%=============================================================================== -%% Decode a tag -%% -%% decode_tag(OctetListBuffer) -> {{Form, (Class bsl 16)+ TagNo}, RestOfBuffer, RemovedBytes} -%%=============================================================================== - -decode_tag_and_length(<<Class:2, Form:1, TagNo:5, 0:1, Length:7, RestBuffer/binary>>) when TagNo < 31 -> - {Form, (Class bsl 16) + TagNo, Length, RestBuffer}; -decode_tag_and_length(<<Class:2, Form:1, TagNo:5, 1:1, 0:7, T/binary>>) when TagNo < 31 -> - {Form, (Class bsl 16) + TagNo, indefinite, T}; -decode_tag_and_length(<<Class:2, Form:1, TagNo:5, 1:1, LL:7, T/binary>>) when TagNo < 31 -> - <<Length:LL/unit:8,RestBuffer/binary>> = T, - {Form, (Class bsl 16) + TagNo, Length, RestBuffer}; -decode_tag_and_length(<<Class:2, Form:1, 31:5, 0:1, TagNo:7, 0:1, Length:7, RestBuffer/binary>>) -> - {Form, (Class bsl 16) + TagNo, Length, RestBuffer}; -decode_tag_and_length(<<Class:2, Form:1, 31:5, 0:1, TagNo:7, 1:1, 0:7, T/binary>>) -> - {Form, (Class bsl 16) + TagNo, indefinite, T}; -decode_tag_and_length(<<Class:2, Form:1, 31:5, 0:1, TagNo:7, 1:1, LL:7, T/binary>>) -> - <<Length:LL/unit:8,RestBuffer/binary>> = T, - {Form, (Class bsl 16) + TagNo, Length, RestBuffer}; -decode_tag_and_length(<<Class:2, Form:1, 31:5, Buffer/binary>>) -> - {TagNo, Buffer1} = decode_tag(Buffer, 0), - {Length, RestBuffer} = decode_length(Buffer1), - {Form, (Class bsl 16) + TagNo, Length, RestBuffer}. - - - -%% last partial tag -decode_tag(<<0:1,PartialTag:7, Buffer/binary>>, TagAck) -> - TagNo = (TagAck bsl 7) bor PartialTag, - %%<<TagNo>> = <<TagAck:1, PartialTag:7>>, - {TagNo, Buffer}; -% more tags -decode_tag(<<_:1,PartialTag:7, Buffer/binary>>, TagAck) -> - TagAck1 = (TagAck bsl 7) bor PartialTag, - %%<<TagAck1:16>> = <<TagAck:1, PartialTag:7,0:8>>, - decode_tag(Buffer, TagAck1). - - -%%======================================================================= -%% -%% Encode all tags in the list Tags and return a possibly deep list of -%% bytes with tag and length encoded -%% The taglist must be in reverse order (fixed by the asn1 compiler) -%% e.g [T1,T2] will result in -%% {[EncodedT2,EncodedT1|BytesSoFar],LenSoFar+LenT2+LenT1} -%% - -encode_tags([Tag|Trest], BytesSoFar, LenSoFar) -> -% remove {Bytes1,L1} = encode_one_tag(Tag), - {Bytes2,L2} = encode_length(LenSoFar), - encode_tags(Trest, [Tag,Bytes2|BytesSoFar], - LenSoFar + size(Tag) + L2); -encode_tags([], BytesSoFar, LenSoFar) -> - {BytesSoFar,LenSoFar}. - -encode_tags(TagIn, {BytesSoFar,LenSoFar}) -> - encode_tags(TagIn, BytesSoFar, LenSoFar). - -% encode_one_tag(#tag{class=Class,number=No,type=Type, form = Form}) -> -% NewForm = case Type of -% 'EXPLICIT' -> -% ?CONSTRUCTED; -% _ -> -% Form -% end, -% Bytes = encode_tag_val({Class,NewForm,No}), -% {Bytes,size(Bytes)}. - - -%%=============================================================================== -%% -%% This comment is valid for all the encode/decode functions -%% -%% C = Constraint -> typically {'ValueRange',LowerBound,UpperBound} -%% used for PER-coding but not for BER-coding. -%% -%% Val = Value. If Val is an atom then it is a symbolic integer value -%% (i.e the atom must be one of the names in the NamedNumberList). -%% The NamedNumberList is used to translate the atom to an integer value -%% before encoding. -%% -%%=============================================================================== - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_open_type(Value) -> io_list (i.e nested list with integers, binaries) -%% Value = list of bytes of an already encoded value (the list must be flat) -%% | binary - -%% -encode_open_type(Val) when list(Val) -> -% {Val,length(Val)}; - encode_open_type(list_to_binary(Val)); -encode_open_type(Val) -> - {Val, size(Val)}. - -%% -encode_open_type(Val, T) when list(Val) -> - encode_open_type(list_to_binary(Val),T); -encode_open_type(Val,[]) -> - {Val, size(Val)}; -encode_open_type(Val,Tag) -> - encode_tags(Tag,Val, size(Val)). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_open_type(Tlv, TagIn) -> Value -%% Tlv = {Tag,V} | V where V -> binary() -%% TagIn = [TagVal] where TagVal -> int() -%% Value = binary with decoded data (which must be decoded again as some type) -%% -decode_open_type(Tlv, TagIn) -> - case match_tags(Tlv,TagIn) of - Bin when binary(Bin) -> - {InnerTlv,_} = decode(Bin), - InnerTlv; - TlvBytes -> TlvBytes - end. - - -decode_open_type_as_binary(Tlv,TagIn)-> - case match_tags(Tlv,TagIn) of - V when binary(V) -> - V; - [Tlv2] -> encode(Tlv2); - Tlv2 -> encode(Tlv2) - end. - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Boolean, ITU_T X.690 Chapter 8.2 -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% encode_boolean(Integer, ReversedTagList) -> {[Octet],Len} -%%=============================================================================== - -encode_boolean({Name, Val}, TagIn) when atom(Name) -> - encode_boolean(Val, TagIn); -encode_boolean(true, TagIn) -> - encode_tags(TagIn, [16#FF],1); -encode_boolean(false, TagIn) -> - encode_tags(TagIn, [0],1); -encode_boolean(X,_) -> - exit({error,{asn1, {encode_boolean, X}}}). - - -%%=============================================================================== -%% decode_boolean(BuffList, HasTag, TotalLen) -> {true, Remain, RemovedBytes} | -%% {false, Remain, RemovedBytes} -%%=============================================================================== -decode_boolean(Tlv,TagIn) -> - Val = match_tags(Tlv, TagIn), - case Val of - <<0:8>> -> - false; - <<_:8>> -> - true; - _ -> - exit({error,{asn1, {decode_boolean, Val}}}) - end. - - -%%=========================================================================== -%% Integer, ITU_T X.690 Chapter 8.3 - -%% encode_integer(Constraint, Value, Tag) -> [octet list] -%% encode_integer(Constraint, Name, NamedNumberList, Tag) -> [octet list] -%% Value = INTEGER | {Name,INTEGER} -%% Tag = tag | notag -%%=========================================================================== - -encode_integer(C, Val, Tag) when integer(Val) -> - encode_tags(Tag, encode_integer(C, Val)); -encode_integer(C,{Name,Val},Tag) when atom(Name) -> - encode_integer(C,Val,Tag); -encode_integer(_C, Val, _Tag) -> - exit({error,{asn1, {encode_integer, Val}}}). - - - -encode_integer(C, Val, NamedNumberList, Tag) when atom(Val) -> - case lists:keysearch(Val, 1, NamedNumberList) of - {value,{_, NewVal}} -> - encode_tags(Tag, encode_integer(C, NewVal)); - _ -> - exit({error,{asn1, {encode_integer_namednumber, Val}}}) - end; -encode_integer(C,{_Name,Val},NamedNumberList,Tag) -> - encode_integer(C,Val,NamedNumberList,Tag); -encode_integer(C, Val, _NamedNumberList, Tag) -> - encode_tags(Tag, encode_integer(C, Val)). - - -encode_integer(_, Val) -> - Bytes = - if - Val >= 0 -> - encode_integer_pos(Val, []); - true -> - encode_integer_neg(Val, []) - end, - {Bytes,length(Bytes)}. - -encode_integer_pos(0, L=[B|_Acc]) when B < 128 -> - L; -encode_integer_pos(N, Acc) -> - encode_integer_pos((N bsr 8), [N band 16#ff| Acc]). - -encode_integer_neg(-1, L=[B1|_T]) when B1 > 127 -> - L; -encode_integer_neg(N, Acc) -> - encode_integer_neg(N bsr 8, [N band 16#ff|Acc]). - -%%=============================================================================== -%% decode integer -%% (Buffer, Range, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} -%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} -%%=============================================================================== - -decode_integer(Tlv,Range,NamedNumberList,TagIn) -> - V = match_tags(Tlv,TagIn), - Int = decode_integer(V), - range_check_integer(Int,Range), - number2name(Int,NamedNumberList). - -decode_integer(Tlv,Range,TagIn) -> - V = match_tags(Tlv, TagIn), - Int = decode_integer(V), - range_check_integer(Int,Range), - Int. - -%% decoding postitive integer values. -decode_integer(Bin = <<0:1,_:7,_/binary>>) -> - Len = size(Bin), -% <<Int:Len/unit:8,Buffer2/binary>> = Bin, - <<Int:Len/unit:8>> = Bin, - Int; -%% decoding negative integer values. -decode_integer(Bin = <<1:1,B2:7,Bs/binary>>) -> - Len = size(Bin), -% <<N:Len/unit:8,Buffer2/binary>> = <<B2,Bs/binary>>, - <<N:Len/unit:8>> = <<B2,Bs/binary>>, - Int = N - (1 bsl (8 * Len - 1)), - Int. - -range_check_integer(Int,Range) -> - case Range of - [] -> % No length constraint - Int; - {Lb,Ub} when Int >= Lb, Ub >= Int -> % variable length constraint - Int; - Int -> % fixed value constraint - Int; - {_,_} -> - exit({error,{asn1,{integer_range,Range,Int}}}); - SingleValue when integer(SingleValue) -> - exit({error,{asn1,{integer_range,Range,Int}}}); - _ -> % some strange constraint that we don't support yet - Int - end. - -number2name(Int,[]) -> - Int; -number2name(Int,NamedNumberList) -> - case lists:keysearch(Int, 2, NamedNumberList) of - {value,{NamedVal, _}} -> - NamedVal; - _ -> - Int - end. - - -%%============================================================================ -%% Enumerated value, ITU_T X.690 Chapter 8.4 - -%% encode enumerated value -%%============================================================================ -encode_enumerated(Val, TagIn) when integer(Val)-> - encode_tags(TagIn, encode_integer(false,Val)); -encode_enumerated({Name,Val}, TagIn) when atom(Name) -> - encode_enumerated(Val, TagIn). - -%% The encode_enumerated functions below this line can be removed when the -%% new code generation is stable. (the functions might have to be kept here -%% a while longer for compatibility reasons) - -encode_enumerated(C, Val, {NamedNumberList,ExtList}, TagIn) when atom(Val) -> - case catch encode_enumerated(C, Val, NamedNumberList, TagIn) of - {'EXIT',_} -> encode_enumerated(C, Val, ExtList, TagIn); - Result -> Result - end; - -encode_enumerated(C, Val, NamedNumberList, TagIn) when atom(Val) -> - case lists:keysearch(Val, 1, NamedNumberList) of - {value, {_, NewVal}} -> - encode_tags(TagIn, encode_integer(C, NewVal)); - _ -> - exit({error,{asn1, {enumerated_not_in_range, Val}}}) - end; - -encode_enumerated(C, {asn1_enum, Val}, {_,_}, TagIn) when integer(Val) -> - encode_tags(TagIn, encode_integer(C,Val)); - -encode_enumerated(C, {Name,Val}, NamedNumberList, TagIn) when atom(Name) -> - encode_enumerated(C, Val, NamedNumberList, TagIn); - -encode_enumerated(_C, Val, _NamedNumberList, _TagIn) -> - exit({error,{asn1, {enumerated_not_namednumber, Val}}}). - - - -%%============================================================================ -%% decode enumerated value -%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> Value -%%=========================================================================== -decode_enumerated(Tlv, Range, NamedNumberList, Tags) -> - Buffer = match_tags(Tlv,Tags), - decode_enumerated_notag(Buffer, Range, NamedNumberList, Tags). - -decode_enumerated_notag(Buffer, _Range, {NamedNumberList,ExtList}, _Tags) -> - - IVal = decode_integer2(size(Buffer), Buffer), - case decode_enumerated1(IVal, NamedNumberList) of - {asn1_enum,IVal} -> - decode_enumerated1(IVal,ExtList); - EVal -> - EVal - end; -decode_enumerated_notag(Buffer, _Range, NNList, _Tags) -> - IVal = decode_integer2(size(Buffer), 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:keysearch(Val, 2, NamedNumberList) of - {value,{NamedVal, _}} -> - NamedVal; - _ -> - {asn1_enum,Val} - end. - - -%%============================================================================ -%% -%% Real value, ITU_T X.690 Chapter 8.5 -%%============================================================================ -%% -%% encode real value -%%============================================================================ - -%% only base 2 internally so far!! -encode_real(0, TagIn) -> - encode_tags(TagIn, {[],0}); -encode_real('PLUS-INFINITY', TagIn) -> - encode_tags(TagIn, {[64],1}); -encode_real('MINUS-INFINITY', TagIn) -> - encode_tags(TagIn, {[65],1}); -encode_real(Val, TagIn) when tuple(Val)-> - encode_tags(TagIn, encode_real(Val)). - -%%%%%%%%%%%%%% -%% not optimal efficient.. -%% only base 2 of Mantissa encoding! -%% only base 2 of ExpBase encoding! -encode_real({Man, Base, Exp}) -> -%% io:format("Mantissa: ~w Base: ~w, Exp: ~w~n",[Man, Base, Exp]), - - OctExp = if Exp >= 0 -> list_to_binary(encode_integer_pos(Exp, [])); - true -> list_to_binary(encode_integer_neg(Exp, [])) - end, -%% ok = io:format("OctExp: ~w~n",[OctExp]), - SignBit = if Man > 0 -> 0; % bit 7 is pos or neg, no Zeroval - true -> 1 - end, -%% ok = io:format("SignBitMask: ~w~n",[SignBitMask]), - InBase = if Base =:= 2 -> 0; % bit 6,5: only base 2 this far! - true -> - exit({error,{asn1, {encode_real_non_supported_encodeing, Base}}}) - end, - SFactor = 0, % bit 4,3: no scaling since only base 2 - OctExpLen = size(OctExp), - if OctExpLen > 255 -> - exit({error,{asn1, {to_big_exp_in_encode_real, OctExpLen}}}); - true -> true %% make real assert later.. - end, - {LenCode, EOctets} = case OctExpLen of % bit 2,1 - 1 -> {0, OctExp}; - 2 -> {1, OctExp}; - 3 -> {2, OctExp}; - _ -> {3, <<OctExpLen, OctExp/binary>>} - end, - FirstOctet = <<1:1,SignBit:1,InBase:2,SFactor:2,LenCode:2>>, - OctMantissa = if Man > 0 -> list_to_binary(minimum_octets(Man)); - true -> list_to_binary(minimum_octets(-(Man))) % signbit keeps track of sign - end, - %% ok = io:format("LenMask: ~w EOctets: ~w~nFirstOctet: ~w OctMantissa: ~w OctExpLen: ~w~n", [LenMask, EOctets, FirstOctet, OctMantissa, OctExpLen]), - Bin = <<FirstOctet/binary, EOctets/binary, OctMantissa/binary>>, - {Bin, size(Bin)}. - - -%%============================================================================ -%% decode real value -%% -%% decode_real([OctetBufferList], tuple|value, tag|notag) -> -%% {{Mantissa, Base, Exp} | realval | PLUS-INFINITY | MINUS-INFINITY | 0, -%% RestBuff} -%% -%% only for base 2 decoding sofar!! -%%============================================================================ - -decode_real(Tlv, Form, Tags) -> - Buffer = match_tags(Tlv,Tags), - decode_real_notag(Buffer, Form). - -decode_real_notag(_Buffer, _Form) -> - exit({error,{asn1, {unimplemented,real}}}). -%% decode_real2(Buffer, Form, size(Buffer)). - -% decode_real2(Buffer, Form, Len) -> -% <<First, Buffer2/binary>> = Buffer, -% if -% First =:= 2#01000000 -> {'PLUS-INFINITY', Buffer2}; -% First =:= 2#01000001 -> {'MINUS-INFINITY', Buffer2}; -% First =:= 2#00000000 -> {0, Buffer2}; -% true -> -% %% have some check here to verify only supported bases (2) -% <<B7:1,B6:1,B5_4:2,B3_2:2,B1_0:2>> = <<First>>, -% Sign = B6, -% Base = -% case B5_4 of -% 0 -> 2; % base 2, only one so far -% _ -> exit({error,{asn1, {non_supported_base, First}}}) -% end, -% ScalingFactor = -% case B3_2 of -% 0 -> 0; % no scaling so far -% _ -> exit({error,{asn1, {non_supported_scaling, First}}}) -% end, - -% {FirstLen,Exp,Buffer3} = -% case B1_0 of -% 0 -> -% <<_:1/unit:8,Buffer21/binary>> = Buffer2, -% {2, decode_integer2(1, Buffer2),Buffer21}; -% 1 -> -% <<_:2/unit:8,Buffer21/binary>> = Buffer2, -% {3, decode_integer2(2, Buffer2)}; -% 2 -> -% <<_:3/unit:8,Buffer21/binary>> = Buffer2, -% {4, decode_integer2(3, Buffer2)}; -% 3 -> -% <<ExpLen1,RestBuffer/binary>> = Buffer2, -% <<_:ExpLen1/unit:8,RestBuffer2/binary>> = RestBuffer, -% { ExpLen1 + 2, -% decode_integer2(ExpLen1, RestBuffer, RemBytes1), -% RestBuffer2} -% end, -% Length = Len - FirstLen, -% <<LongInt:Length/unit:8,RestBuff/binary>> = Buffer3, -% {Mantissa, Buffer4} = -% if Sign =:= 0 -> - -% {LongInt, RestBuff};% sign plus, -% true -> - -% {-LongInt, RestBuff}% sign minus -% end, -% case Form of -% tuple -> -% {Val,Buf,RemB} = Exp, -% {{Mantissa, Base, {Val,Buf}}, Buffer4, RemBytes2+RemBytes3}; -% _value -> -% comming -% end -% end. - - -%%============================================================================ -%% Bitstring value, ITU_T X.690 Chapter 8.6 -%% -%% encode bitstring value -%% -%% bitstring NamedBitList -%% Val can be of: -%% - [identifiers] where only named identifers are set to one, -%% the Constraint must then have some information of the -%% bitlength. -%% - [list of ones and zeroes] all bits -%% - integer value representing the bitlist -%% C is constrint Len, only valid when identifiers -%%============================================================================ - -encode_bit_string(C,Bin={Unused,BinBits},NamedBitList,TagIn) when integer(Unused), binary(BinBits) -> - encode_bin_bit_string(C,Bin,NamedBitList,TagIn); -encode_bit_string(C, [FirstVal | RestVal], NamedBitList, TagIn) when atom(FirstVal) -> - encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn); - -encode_bit_string(C, [{bit,X} | RestVal], NamedBitList, TagIn) -> - encode_bit_string_named(C, [{bit,X} | RestVal], NamedBitList, TagIn); - -encode_bit_string(C, [FirstVal| RestVal], NamedBitList, TagIn) when integer(FirstVal) -> - encode_bit_string_bits(C, [FirstVal | RestVal], NamedBitList, TagIn); - -encode_bit_string(_C, 0, _NamedBitList, TagIn) -> - encode_tags(TagIn, <<0>>,1); - -encode_bit_string(_C, [], _NamedBitList, TagIn) -> - encode_tags(TagIn, <<0>>,1); - -encode_bit_string(C, IntegerVal, NamedBitList, TagIn) when integer(IntegerVal) -> - BitListVal = int_to_bitlist(IntegerVal), - encode_bit_string_bits(C, BitListVal, NamedBitList, TagIn); - -encode_bit_string(C, {Name,BitList}, NamedBitList, TagIn) when atom(Name) -> - encode_bit_string(C, BitList, NamedBitList, TagIn). - - - -int_to_bitlist(0) -> - []; -int_to_bitlist(Int) when integer(Int), Int >= 0 -> - [Int band 1 | int_to_bitlist(Int bsr 1)]. - - -%%================================================================= -%% Encode BIT STRING of the form {Unused,BinBits}. -%% Unused is the number of unused bits in the last byte in BinBits -%% and BinBits is a binary representing the BIT STRING. -%%================================================================= -encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList,TagIn)-> - case get_constraint(C,'SizeConstraint') of - no -> - remove_unused_then_dotag(TagIn, Unused, BinBits); - {_Min,Max} -> - BBLen = (size(BinBits)*8)-Unused, - if - BBLen > Max -> - exit({error,{asn1, - {bitstring_length, - {{was,BBLen},{maximum,Max}}}}}); - true -> - remove_unused_then_dotag(TagIn, Unused, BinBits) - end; - Size -> - case ((size(BinBits)*8)-Unused) of - BBSize when BBSize =< Size -> - remove_unused_then_dotag(TagIn, Unused, BinBits); - BBSize -> - exit({error,{asn1, - {bitstring_length, - {{was,BBSize},{should_be,Size}}}}}) - end - end. - -remove_unused_then_dotag(TagIn,Unused,BinBits) -> - case Unused of - 0 when (size(BinBits) == 0) -> - encode_tags(TagIn,<<0>>,1); - 0 -> - Bin = <<Unused,BinBits/binary>>, - encode_tags(TagIn,Bin,size(Bin)); - Num -> - N = (size(BinBits)-1), - <<BBits:N/binary,LastByte>> = BinBits, - encode_tags(TagIn, - [Unused,binary_to_list(BBits) ++[(LastByte bsr Num) bsl Num]], - 1+size(BinBits)) - end. - - -%%================================================================= -%% Encode named bits -%%================================================================= - -encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn) -> - ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []), - Size = - case get_constraint(C,'SizeConstraint') of - no -> - lists:max(ToSetPos)+1; - {_Min,Max} -> - Max; - TSize -> - TSize - end, - BitList = make_and_set_list(Size, ToSetPos, 0), - {Len, Unused, OctetList} = encode_bitstring(BitList), - encode_tags(TagIn, [Unused|OctetList],Len+1). - - -%%---------------------------------------- -%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> -%% [sorted_list_of_bitpositions_to_set] -%%---------------------------------------- - -get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); -get_all_bitposes([Val | Rest], NamedBitList, Ack) when atom(Val) -> - case lists:keysearch(Val, 1, NamedBitList) of - {value, {_ValName, ValPos}} -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); - _ -> - exit({error,{asn1, {bitstring_namedbit, Val}}}) - end; -get_all_bitposes([], _NamedBitList, Ack) -> - lists:sort(Ack). - - -%%---------------------------------------- -%% make_and_set_list(Len of list to return, [list of positions to set to 1])-> -%% returns list of Len length, with all in SetPos set. -%% in positioning in list the first element is 0, the second 1 etc.., but -%% Len will make a list of length Len, not Len + 1. -%% BitList = make_and_set_list(C, ToSetPos, 0), -%%---------------------------------------- - -make_and_set_list(0, [], _) -> []; -make_and_set_list(0, _, _) -> - exit({error,{asn1,bitstring_sizeconstraint}}); -make_and_set_list(Len, [XPos|SetPos], XPos) -> - [1 | make_and_set_list(Len - 1, SetPos, XPos + 1)]; -make_and_set_list(Len, [Pos|SetPos], XPos) -> - [0 | make_and_set_list(Len - 1, [Pos | SetPos], XPos + 1)]; -make_and_set_list(Len, [], XPos) -> - [0 | make_and_set_list(Len - 1, [], XPos + 1)]. - - - - - - -%%================================================================= -%% Encode bit string for lists of ones and zeroes -%%================================================================= -encode_bit_string_bits(C, BitListVal, _NamedBitList, TagIn) when list(BitListVal) -> - case get_constraint(C,'SizeConstraint') of - no -> - {Len, Unused, OctetList} = encode_bitstring(BitListVal), - %%add unused byte to the Len - encode_tags(TagIn, [Unused | OctetList], Len+1); - Constr={Min,Max} when integer(Min),integer(Max) -> - encode_constr_bit_str_bits(Constr,BitListVal,TagIn); - {Constr={_,_},[]} ->%Constr={Min,Max} - %% constraint with extension mark - encode_constr_bit_str_bits(Constr,BitListVal,TagIn); - Constr={{_,_},{_,_}} ->%{{Min1,Max1},{Min2,Max2}} - %% constraint with extension mark - encode_constr_bit_str_bits(Constr,BitListVal,TagIn); - Size -> - case length(BitListVal) of - BitSize when BitSize == Size -> - {Len, Unused, OctetList} = encode_bitstring(BitListVal), - %%add unused byte to the Len - encode_tags(TagIn, [Unused | OctetList], Len+1); - BitSize when BitSize < Size -> - PaddedList = pad_bit_list(Size-BitSize,BitListVal), - {Len, Unused, OctetList} = encode_bitstring(PaddedList), - %%add unused byte to the Len - encode_tags(TagIn, [Unused | OctetList], Len+1); - BitSize -> - exit({error,{asn1, - {bitstring_length, {{was,BitSize},{should_be,Size}}}}}) - end - - end. - -encode_constr_bit_str_bits({_Min,Max},BitListVal,TagIn) -> - BitLen = length(BitListVal), - if - BitLen > Max -> - exit({error,{asn1,{bitstring_length,{{was,BitLen}, - {maximum,Max}}}}}); - true -> - {Len, Unused, OctetList} = encode_bitstring(BitListVal), - %%add unused byte to the Len - encode_tags(TagIn, [Unused, OctetList], Len+1) - end; -encode_constr_bit_str_bits({{_Min1,Max1},{Min2,Max2}},BitListVal,TagIn) -> - BitLen = length(BitListVal), - case BitLen of - Len when Len > Max2 -> - exit({error,{asn1,{bitstring_length,{{was,BitLen}, - {maximum,Max2}}}}}); - Len when Len > Max1, Len < Min2 -> - exit({error,{asn1,{bitstring_length,{{was,BitLen}, - {not_allowed_interval, - Max1,Min2}}}}}); - _ -> - {Len, Unused, OctetList} = encode_bitstring(BitListVal), - %%add unused byte to the Len - encode_tags(TagIn, [Unused, OctetList], Len+1) - end. - -%% returns a list of length Size + length(BitListVal), with BitListVal -%% as the most significant elements followed by padded zero elements -pad_bit_list(Size,BitListVal) -> - Tail = lists:duplicate(Size,0), - lists:append(BitListVal,Tail). - -%%================================================================= -%% Do the actual encoding -%% ([bitlist]) -> {ListLen, UnusedBits, OctetList} -%%================================================================= - -encode_bitstring([B8, B7, B6, B5, B4, B3, B2, B1 | Rest]) -> - Val = (B8 bsl 7) bor (B7 bsl 6) bor (B6 bsl 5) bor (B5 bsl 4) bor - (B4 bsl 3) bor (B3 bsl 2) bor (B2 bsl 1) bor B1, - encode_bitstring(Rest, [Val], 1); -encode_bitstring(Val) -> - {Unused, Octet} = unused_bitlist(Val, 7, 0), - {1, Unused, [Octet]}. - -encode_bitstring([B8, B7, B6, B5, B4, B3, B2, B1 | Rest], Ack, Len) -> - Val = (B8 bsl 7) bor (B7 bsl 6) bor (B6 bsl 5) bor (B5 bsl 4) bor - (B4 bsl 3) bor (B3 bsl 2) bor (B2 bsl 1) bor B1, - encode_bitstring(Rest, [Ack | [Val]], Len + 1); -%%even multiple of 8 bits.. -encode_bitstring([], Ack, Len) -> - {Len, 0, Ack}; -%% unused bits in last octet -encode_bitstring(Rest, Ack, Len) -> -% io:format("uneven ~w ~w ~w~n",[Rest, Ack, Len]), - {Unused, Val} = unused_bitlist(Rest, 7, 0), - {Len + 1, Unused, [Ack | [Val]]}. - -%%%%%%%%%%%%%%%%%% -%% unused_bitlist([list of ones and zeros <= 7], 7, []) -> -%% {Unused bits, Last octet with bits moved to right} -unused_bitlist([], Trail, Ack) -> - {Trail + 1, Ack}; -unused_bitlist([Bit | Rest], Trail, Ack) -> -%% io:format("trail Bit: ~w Rest: ~w Trail: ~w Ack:~w~n",[Bit, Rest, Trail, Ack]), - unused_bitlist(Rest, Trail - 1, (Bit bsl Trail) bor Ack). - - -%%============================================================================ -%% decode bitstring value -%% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} -%%============================================================================ - -decode_compact_bit_string(Buffer, Range, NamedNumberList, Tags) -> -% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_BIT_STRING}), - decode_restricted_string(Buffer, Range, ?N_BIT_STRING, Tags, - NamedNumberList,bin). - -decode_bit_string(Buffer, Range, NamedNumberList, Tags) -> -% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_BIT_STRING}), - decode_restricted_string(Buffer, Range, ?N_BIT_STRING, Tags, - NamedNumberList,old). - - -decode_bit_string2(<<0>>,_NamedNumberList,BinOrOld) -> - case BinOrOld of - bin -> - {0,<<>>}; - _ -> - [] - end; -decode_bit_string2(<<Unused,Bits/binary>>,NamedNumberList,BinOrOld) -> - case NamedNumberList of - [] -> - case BinOrOld of - bin -> - {Unused,Bits}; - _ -> - decode_bitstring2(size(Bits), Unused, Bits) - end; - _ -> - BitString = decode_bitstring2(size(Bits), Unused, Bits), - decode_bitstring_NNL(BitString,NamedNumberList) - end. - -%%---------------------------------------- -%% Decode the in buffer to bits -%%---------------------------------------- -decode_bitstring2(1,Unused,<<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,_/binary>>) -> - lists:sublist([B7,B6,B5,B4,B3,B2,B1,B0],8-Unused); -decode_bitstring2(Len, Unused, - <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,Buffer/binary>>) -> - [B7, B6, B5, B4, B3, B2, B1, B0 | - decode_bitstring2(Len - 1, Unused, Buffer)]. - -%%decode_bitstring2(1, Unused, Buffer) -> -%% make_bits_of_int(hd(Buffer), 128, 8-Unused); -%%decode_bitstring2(Len, Unused, [BitVal | Buffer]) -> -%% [B7, B6, B5, B4, B3, B2, B1, B0] = make_bits_of_int(BitVal, 128, 8), -%% [B7, B6, B5, B4, B3, B2, B1, B0 | -%% decode_bitstring2(Len - 1, Unused, Buffer)]. - - -%%make_bits_of_int(_, _, 0) -> -%% []; -%%make_bits_of_int(BitVal, MaskVal, Unused) when Unused > 0 -> -%% X = case MaskVal band BitVal of -%% 0 -> 0 ; -%% _ -> 1 -%% end, -%% [X | make_bits_of_int(BitVal, MaskVal bsr 1, Unused - 1)]. - - - -%%---------------------------------------- -%% Decode the bitlist to names -%%---------------------------------------- - - -decode_bitstring_NNL(BitList,NamedNumberList) -> - decode_bitstring_NNL(BitList,NamedNumberList,0,[]). - - -decode_bitstring_NNL([],_,_No,Result) -> - lists:reverse(Result); - -decode_bitstring_NNL([B|BitList],[{Name,No}|NamedNumberList],No,Result) -> - if - B == 0 -> - decode_bitstring_NNL(BitList,NamedNumberList,No+1,Result); - true -> - decode_bitstring_NNL(BitList,NamedNumberList,No+1,[Name|Result]) - end; -decode_bitstring_NNL([1|BitList],NamedNumberList,No,Result) -> - decode_bitstring_NNL(BitList,NamedNumberList,No+1,[{bit,No}|Result]); -decode_bitstring_NNL([0|BitList],NamedNumberList,No,Result) -> - decode_bitstring_NNL(BitList,NamedNumberList,No+1,Result). - - -%%============================================================================ -%% Octet string, ITU_T X.690 Chapter 8.7 -%% -%% encode octet string -%% The OctetList must be a flat list of integers in the range 0..255 -%% the function does not check this because it takes to much time -%%============================================================================ -encode_octet_string(_C, OctetList, TagIn) when binary(OctetList) -> - encode_tags(TagIn, OctetList, size(OctetList)); -encode_octet_string(_C, OctetList, TagIn) when list(OctetList) -> - encode_tags(TagIn, OctetList, length(OctetList)); -encode_octet_string(C, {Name,OctetList}, TagIn) when atom(Name) -> - encode_octet_string(C, OctetList, TagIn). - - -%%============================================================================ -%% decode octet string -%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} -%% -%% Octet string is decoded as a restricted string -%%============================================================================ -decode_octet_string(Buffer, Range, Tags) -> -% NewTags = new_tags(HasTag,#tag{class=?UNIVERSAL,number=?N_OCTET_STRING}), - decode_restricted_string(Buffer, Range, ?N_OCTET_STRING, - Tags, [], old). - -%%============================================================================ -%% Null value, ITU_T X.690 Chapter 8.8 -%% -%% encode NULL value -%%============================================================================ - -encode_null({Name, _Val}, TagIn) when atom(Name) -> - encode_tags(TagIn, [], 0); -encode_null(_Val, TagIn) -> - encode_tags(TagIn, [], 0). - -%%============================================================================ -%% decode NULL value -%% (Buffer, HasTag, TotalLen) -> {NULL, Remain, RemovedBytes} -%%============================================================================ - -decode_null(Tlv, Tags) -> - Val = match_tags(Tlv, Tags), - case Val of - <<>> -> - 'NULL'; - _ -> - exit({error,{asn1,{decode_null,Val}}}) - end. - -%%============================================================================ -%% Object identifier, ITU_T X.690 Chapter 8.19 -%% -%% encode Object Identifier value -%%============================================================================ - -encode_object_identifier({Name,Val}, TagIn) when atom(Name) -> - encode_object_identifier(Val, TagIn); -encode_object_identifier(Val, TagIn) -> - encode_tags(TagIn, e_object_identifier(Val)). - -e_object_identifier({'OBJECT IDENTIFIER', V}) -> - e_object_identifier(V); -e_object_identifier({Cname, V}) when atom(Cname), tuple(V) -> - e_object_identifier(tuple_to_list(V)); -e_object_identifier({Cname, V}) when atom(Cname), list(V) -> - e_object_identifier(V); -e_object_identifier(V) when tuple(V) -> - e_object_identifier(tuple_to_list(V)); - -%%%%%%%%%%%%%%% -%% e_object_identifier([List of Obect Identifiers]) -> -%% {[Encoded Octetlist of ObjIds], IntLength} -%% -e_object_identifier([E1, E2 | Tail]) -> - Head = 40*E1 + E2, % wow! - {H,Lh} = mk_object_val(Head), - {R,Lr} = enc_obj_id_tail(Tail, [], 0), - {[H|R], Lh+Lr}. - -enc_obj_id_tail([], Ack, Len) -> - {lists:reverse(Ack), Len}; -enc_obj_id_tail([H|T], Ack, Len) -> - {B, L} = mk_object_val(H), - enc_obj_id_tail(T, [B|Ack], Len+L). - -%% e_object_identifier([List of Obect Identifiers]) -> -%% {[Encoded Octetlist of ObjIds], IntLength} -%% -%%e_object_identifier([E1, E2 | Tail]) -> -%% Head = 40*E1 + E2, % wow! -%% F = fun(Val, AckLen) -> -%% {L, Ack} = mk_object_val(Val), -%% {L, Ack + AckLen} -%% end, -%% {Octets, Len} = lists:mapfoldl(F, 0, [Head | Tail]). - -%%%%%%%%%%% -%% mk_object_val(Value) -> {OctetList, Len} -%% returns a Val as a list of octets, the 8 bit is allways set to one except -%% for the last octet, where its 0 -%% - - -mk_object_val(Val) when Val =< 127 -> - {[255 band Val], 1}; -mk_object_val(Val) -> - mk_object_val(Val bsr 7, [Val band 127], 1). -mk_object_val(0, Ack, Len) -> - {Ack, Len}; -mk_object_val(Val, Ack, Len) -> - mk_object_val(Val bsr 7, [((Val band 127) bor 128) | Ack], Len + 1). - - - -%%============================================================================ -%% decode Object Identifier value -%% (Buffer, HasTag, TotalLen) -> {{ObjId}, Remain, RemovedBytes} -%%============================================================================ - -decode_object_identifier(Tlv, Tags) -> - Val = match_tags(Tlv, Tags), - [AddedObjVal|ObjVals] = dec_subidentifiers(Val,0,[]), - {Val1, Val2} = if - AddedObjVal < 40 -> - {0, AddedObjVal}; - AddedObjVal < 80 -> - {1, AddedObjVal - 40}; - true -> - {2, AddedObjVal - 80} - end, - list_to_tuple([Val1, Val2 | ObjVals]). - -dec_subidentifiers(<<>>,_Av,Al) -> - lists:reverse(Al); -dec_subidentifiers(<<1:1,H:7,T/binary>>,Av,Al) -> - dec_subidentifiers(T,(Av bsl 7) + H,Al); -dec_subidentifiers(<<H,T/binary>>,Av,Al) -> - dec_subidentifiers(T,0,[((Av bsl 7) + H)|Al]). - - -%%============================================================================ -%% Restricted character string types, ITU_T X.690 Chapter 8.20 -%% -%% encode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings -%%============================================================================ -%% The StringType arg is kept for future use but might be removed -encode_restricted_string(_C, OctetList, _StringType, TagIn) - when binary(OctetList) -> - encode_tags(TagIn, OctetList, size(OctetList)); -encode_restricted_string(_C, OctetList, _StringType, TagIn) - when list(OctetList) -> - encode_tags(TagIn, OctetList, length(OctetList)); -encode_restricted_string(C,{Name,OctetL}, StringType, TagIn) when atom(Name)-> - encode_restricted_string(C, OctetL, StringType, TagIn). - -%%============================================================================ -%% decode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings -%% (Buffer, Range, StringType, HasTag, TotalLen) -> -%% {String, Remain, RemovedBytes} -%%============================================================================ - -decode_restricted_string(Buffer, Range, StringType, Tags) -> - decode_restricted_string(Buffer, Range, StringType, Tags, [], old). - - -decode_restricted_string(Tlv, Range, StringType, TagsIn, - NamedNumberList, BinOrOld) -> - Val = match_tags(Tlv, TagsIn), - Val2 = - case Val of - PartList = [_H|_T] -> % constructed val - Bin = collect_parts(PartList), - decode_restricted(Bin, StringType, - NamedNumberList, BinOrOld); - Bin -> - decode_restricted(Bin, StringType, - NamedNumberList, BinOrOld) - end, - check_and_convert_restricted_string(Val2,StringType,Range,NamedNumberList,BinOrOld). - - - -% case StringType of -% ?N_BIT_STRING when BinOrOld == bin -> -% {concat_bit_binaries(AccVal, Val), AccRb+Rb}; -% _ when binary(Val),binary(AccVal) -> -% {<<AccVal/binary,Val/binary>>,AccRb+Rb}; -% _ when binary(Val), AccVal==[] -> -% {Val,AccRb+Rb}; -% _ -> -% {AccVal++Val, AccRb+Rb} -% end, - - - -decode_restricted(Bin, StringType, NamedNumberList,BinOrOld) -> - case StringType of - ?N_BIT_STRING -> - decode_bit_string2(Bin, NamedNumberList, BinOrOld); - ?N_UniversalString -> - mk_universal_string(binary_to_list(Bin)); - ?N_BMPString -> - mk_BMP_string(binary_to_list(Bin)); - _ -> - Bin - end. - - -check_and_convert_restricted_string(Val,StringType,Range,NamedNumberList,_BinOrOld) -> - {StrLen,NewVal} = case StringType of - ?N_BIT_STRING when NamedNumberList /= [] -> - {no_check,Val}; - ?N_BIT_STRING when list(Val) -> - {length(Val),Val}; - ?N_BIT_STRING when tuple(Val) -> - {(size(element(2,Val))*8) - element(1,Val),Val}; - _ when binary(Val) -> - {size(Val),binary_to_list(Val)}; - _ when list(Val) -> - {length(Val), Val} - end, - case Range of - _ when StrLen == no_check -> - NewVal; - [] -> % No length constraint - NewVal; - {Lb,Ub} when StrLen >= Lb, Ub >= StrLen -> % variable length constraint - NewVal; - {{Lb,_Ub},[]} when StrLen >= Lb -> - NewVal; - {{Lb1,Ub1},{Lb2,Ub2}} when StrLen >= Lb1, StrLen =< Ub1; - StrLen =< Ub2, StrLen >= Lb2 -> - NewVal; - StrLen -> % fixed length constraint - NewVal; - {_,_} -> - exit({error,{asn1,{length,Range,Val}}}); - _Len when integer(_Len) -> - exit({error,{asn1,{length,Range,Val}}}); - _ -> % some strange constraint that we don't support yet - NewVal - end. - - -%%============================================================================ -%% encode Universal string -%%============================================================================ - -encode_universal_string(C, {Name, Universal}, TagIn) when atom(Name) -> - encode_universal_string(C, Universal, TagIn); -encode_universal_string(_C, Universal, TagIn) -> - OctetList = mk_uni_list(Universal), - encode_tags(TagIn, OctetList, length(OctetList)). - -mk_uni_list(In) -> - mk_uni_list(In,[]). - -mk_uni_list([],List) -> - lists:reverse(List); -mk_uni_list([{A,B,C,D}|T],List) -> - mk_uni_list(T,[D,C,B,A|List]); -mk_uni_list([H|T],List) -> - mk_uni_list(T,[H,0,0,0|List]). - -%%=========================================================================== -%% decode Universal strings -%% (Buffer, Range, StringType, HasTag, LenIn) -> -%% {String, Remain, RemovedBytes} -%%=========================================================================== - -decode_universal_string(Buffer, Range, Tags) -> - decode_restricted_string(Buffer, Range, ?N_UniversalString, - Tags, [], old). - - -mk_universal_string(In) -> - mk_universal_string(In,[]). - -mk_universal_string([],Acc) -> - lists:reverse(Acc); -mk_universal_string([0,0,0,D|T],Acc) -> - mk_universal_string(T,[D|Acc]); -mk_universal_string([A,B,C,D|T],Acc) -> - mk_universal_string(T,[{A,B,C,D}|Acc]). - - -%%============================================================================ -%% encode BMP string -%%============================================================================ - -encode_BMP_string(C, {Name,BMPString}, TagIn) when atom(Name)-> - encode_BMP_string(C, BMPString, TagIn); -encode_BMP_string(_C, BMPString, TagIn) -> - OctetList = mk_BMP_list(BMPString), - encode_tags(TagIn, OctetList, length(OctetList)). - -mk_BMP_list(In) -> - mk_BMP_list(In,[]). - -mk_BMP_list([],List) -> - lists:reverse(List); -mk_BMP_list([{0,0,C,D}|T],List) -> - mk_BMP_list(T,[D,C|List]); -mk_BMP_list([H|T],List) -> - mk_BMP_list(T,[H,0|List]). - -%%============================================================================ -%% decode (OctetList, Range(ignored), tag|notag) -> {ValList, RestList} -%% (Buffer, Range, StringType, HasTag, TotalLen) -> -%% {String, Remain, RemovedBytes} -%%============================================================================ -decode_BMP_string(Buffer, Range, Tags) -> - decode_restricted_string(Buffer, Range, ?N_BMPString, - Tags, [], old). - -mk_BMP_string(In) -> - mk_BMP_string(In,[]). - -mk_BMP_string([],US) -> - lists:reverse(US); -mk_BMP_string([0,B|T],US) -> - mk_BMP_string(T,[B|US]); -mk_BMP_string([C,D|T],US) -> - mk_BMP_string(T,[{0,0,C,D}|US]). - - -%%============================================================================ -%% Generalized time, ITU_T X.680 Chapter 39 -%% -%% encode Generalized time -%%============================================================================ - -encode_generalized_time(C, {Name,OctetList}, TagIn) when atom(Name) -> - encode_generalized_time(C, OctetList, TagIn); -encode_generalized_time(_C, OctetList, TagIn) -> - encode_tags(TagIn, OctetList, length(OctetList)). - -%%============================================================================ -%% decode Generalized time -%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} -%%============================================================================ - -decode_generalized_time(Tlv, _Range, Tags) -> - Val = match_tags(Tlv, Tags), - NewVal = case Val of - PartList = [_H|_T] -> % constructed - collect_parts(PartList); - Bin -> - Bin - end, - binary_to_list(NewVal). - -%%============================================================================ -%% Universal time, ITU_T X.680 Chapter 40 -%% -%% encode UTC time -%%============================================================================ - -encode_utc_time(C, {Name,OctetList}, TagIn) when atom(Name) -> - encode_utc_time(C, OctetList, TagIn); -encode_utc_time(_C, OctetList, TagIn) -> - encode_tags(TagIn, OctetList, length(OctetList)). - -%%============================================================================ -%% decode UTC time -%% (Buffer, Range, HasTag, TotalLen) -> {String, Remain, RemovedBytes} -%%============================================================================ - -decode_utc_time(Tlv, _Range, Tags) -> - Val = match_tags(Tlv, Tags), - NewVal = case Val of - PartList = [_H|_T] -> % constructed - collect_parts(PartList); - Bin -> - Bin - end, - binary_to_list(NewVal). - - -%%============================================================================ -%% Length handling -%% -%% Encode length -%% -%% encode_length(Int | indefinite) -> -%% [<127]| [128 + Int (<127),OctetList] | [16#80] -%%============================================================================ - -encode_length(indefinite) -> - {[16#80],1}; % 128 -encode_length(L) when L =< 16#7F -> - {[L],1}; -encode_length(L) -> - Oct = minimum_octets(L), - Len = length(Oct), - if - Len =< 126 -> - {[ (16#80+Len) | Oct ],Len+1}; - true -> - exit({error,{asn1, to_long_length_oct, Len}}) - end. - - -%% Val must be >= 0 -minimum_octets(Val) -> - minimum_octets(Val,[]). - -minimum_octets(0,Acc) -> - Acc; -minimum_octets(Val, Acc) -> - minimum_octets((Val bsr 8),[Val band 16#FF | Acc]). - - -%%=========================================================================== -%% Decode length -%% -%% decode_length(OctetList) -> {{indefinite, RestOctetsL}, NoRemovedBytes} | -%% {{Length, RestOctetsL}, NoRemovedBytes} -%%=========================================================================== - -decode_length(<<1:1,0:7,T/binary>>) -> - {indefinite, T}; -decode_length(<<0:1,Length:7,T/binary>>) -> - {Length,T}; -decode_length(<<1:1,LL:7,T/binary>>) -> - <<Length:LL/unit:8,Rest/binary>> = T, - {Length,Rest}. - - - -%%------------------------------------------------------------------------- -%% INTERNAL HELPER FUNCTIONS (not exported) -%%------------------------------------------------------------------------- - - -%% decoding postitive integer values. -decode_integer2(Len,Bin = <<0:1,_:7,_Bs/binary>>) -> - <<Int:Len/unit:8>> = Bin, - Int; -%% decoding negative integer values. -decode_integer2(Len,<<1:1,B2:7,Bs/binary>>) -> - <<N:Len/unit:8>> = <<B2,Bs/binary>>, - Int = N - (1 bsl (8 * Len - 1)), - Int. - -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - -collect_parts(TlvList) -> - collect_parts(TlvList,[]). - -collect_parts([{_,L}|Rest],Acc) when list(L) -> - collect_parts(Rest,[collect_parts(L)|Acc]); -collect_parts([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest],_Acc) -> - collect_parts_bit(Rest,[Bits],Unused); -collect_parts([{_T,V}|Rest],Acc) -> - collect_parts(Rest,[V|Acc]); -collect_parts([],Acc) -> - list_to_binary(lists:reverse(Acc)). - -collect_parts_bit([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest],Acc,Uacc) -> - collect_parts_bit(Rest,[Bits|Acc],Unused+Uacc); -collect_parts_bit([],Acc,Uacc) -> - list_to_binary([Uacc|lists:reverse(Acc)]). - - - - - - - - - - - - - - - - - - - - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_check.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_check.erl deleted file mode 100644 index bd3d5e6d8b..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_check.erl +++ /dev/null @@ -1,333 +0,0 @@ -%% ``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: asn1rt_check.erl,v 1.1 2008/12/17 09:53:30 mikpe Exp $ -%% --module(asn1rt_check). - --include("asn1_records.hrl"). - --export([check_bool/2, - check_int/3, - check_bitstring/3, - check_octetstring/2, - check_null/2, - check_objectidentifier/2, - check_objectdescriptor/2, - check_real/2, - check_enum/3, - check_restrictedstring/2]). - --export([transform_to_EXTERNAL1990/1, - transform_to_EXTERNAL1994/1]). - - -check_bool(_Bool,asn1_DEFAULT) -> - true; -check_bool(Bool,Bool) when Bool == true; Bool == false -> - true; -check_bool(_Bool1,Bool2) -> - throw({error,Bool2}). - -check_int(_,asn1_DEFAULT,_) -> - true; -check_int(Value,Value,_) when integer(Value) -> - true; -check_int(DefValue,Value,NNL) when atom(Value) -> - case lists:keysearch(Value,1,NNL) of - {value,{_,DefValue}} -> - true; - _ -> - throw({error,DefValue}) - end; -check_int(DefaultValue,_Value,_) -> - throw({error,DefaultValue}). - -% check_bitstring([H|T],[H|T],_) when integer(H) -> -% true; -% check_bitstring(V,V,_) when integer(V) -> -% true; -%% Two equal lists or integers -check_bitstring(_,asn1_DEFAULT,_) -> - true; -check_bitstring(V,V,_) -> - true; -%% Default value as a list of 1 and 0 and user value as an integer -check_bitstring(L=[H|T],Int,_) when integer(Int),integer(H) -> - case bit_list_to_int(L,length(T)) of - Int -> true; - _ -> throw({error,L,Int}) - end; -%% Default value as an integer, val as list -check_bitstring(Int,Val,NBL) when integer(Int),list(Val) -> - BL = int_to_bit_list(Int,[],length(Val)), - check_bitstring(BL,Val,NBL); -%% Default value and user value as lists of ones and zeros -check_bitstring(L1=[H1|_T1],L2=[H2|_T2],NBL=[_H|_T]) when integer(H1),integer(H2) -> - L2new = remove_trailing_zeros(L2), - check_bitstring(L1,L2new,NBL); -%% Default value as a list of 1 and 0 and user value as a list of atoms -check_bitstring(L1=[H1|_T1],L2=[H2|_T2],NBL) when integer(H1),atom(H2) -> - case bit_list_to_nbl(L1,NBL,0,[]) of - L3 -> check_bitstring(L3,L2,NBL); - _ -> throw({error,L2}) - end; -%% Both default value and user value as a list of atoms -check_bitstring(L1=[H1|T1],L2=[H2|_T2],_) when atom(H1),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_bitstring(L1=[H1|_T1],L2=[H2|_T2],NBL) when atom(H1),integer(H2) -> - case bit_list_to_nbl(L2,NBL,0,[]) of - L3 -> - check_bitstring(L1,L3,NBL); - _ -> throw({error,L2}) - end; -%% User value in compact format -check_bitstring(DefVal,CBS={_,_},NBL) -> - NewVal = cbs_to_bit_list(CBS), - check_bitstring(DefVal,NewVal,NBL); -check_bitstring(DV,V,_) -> - throw({error,DV,V}). - - -bit_list_to_int([0|Bs],ShL)-> - bit_list_to_int(Bs,ShL-1) + 0; -bit_list_to_int([1|Bs],ShL) -> - bit_list_to_int(Bs,ShL-1) + (1 bsl ShL); -bit_list_to_int([],_) -> - 0. - -int_to_bit_list(0,Acc,0) -> - Acc; -int_to_bit_list(Int,Acc,Len) -> - 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:keysearch(Pos,2,NBL) of - {value,{N,_}} -> - bit_list_to_nbl(T,NBL,Pos+1,[N|Acc]); - _ -> - 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 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 size(Bin) == 1 -> - Used = 8-Unused, - <<Int:Used,_:Unused>> = Bin, - int_to_bit_list(Int,[],Used). - - -check_octetstring(_,asn1_DEFAULT) -> - true; -check_octetstring(L,L) -> - true; -check_octetstring(L,Int) when list(L),integer(Int) -> - case integer_to_octetlist(Int) of - L -> true; - V -> throw({error,V}) - 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) -> - true; -check_null('NULL','NULL') -> - true; -check_null(_,V) -> - throw({error,V}). - -check_objectidentifier(_,asn1_DEFAULT) -> - true; -check_objectidentifier(OI,OI) -> - true; -check_objectidentifier(DOI,OI) when tuple(DOI),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}) - end; -check_objectidentifier1([],[],_) -> - 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_objectdescriptor(_,asn1_DEFAULT) -> - true; -check_objectdescriptor(OD,OD) -> - true; -check_objectdescriptor(OD,OD) -> - throw({error,{not_implemented_yet,check_objectdescriptor}}). - -check_real(_,asn1_DEFAULT) -> - true; -check_real(R,R) -> - true; -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 integer(Int),atom(Atom) -> - case lists:keysearch(Atom,1,Enumerations) of - {value,{_,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]) -> - check_restrictedstring(Rest1,Rest2); -check_restrictedstring([V1|Rest1],[V2|Rest2]) -> - check_restrictedstring(V1,V2), - check_restrictedstring(Rest1,Rest2); -%% tuple format of value -check_restrictedstring({V1,V2},[V1,V2]) -> - true; -check_restrictedstring([V1,V2],{V1,V2}) -> - true; -%% quadruple format of value -check_restrictedstring({V1,V2,V3,V4},[V1,V2,V3,V4]) -> - true; -check_restrictedstring([V1,V2,V3,V4],{V1,V2,V3,V4}) -> - true; -%% character string list -check_restrictedstring(V1,V2) when list(V1),tuple(V2) -> - check_restrictedstring(V1,tuple_to_list(V2)); -check_restrictedstring(V1,V2) -> - throw({error,{restricted,string,V1,V2}}). - -transform_to_EXTERNAL1990(Val) when tuple(Val),size(Val) == 4 -> - transform_to_EXTERNAL1990(tuple_to_list(Val),[]); -transform_to_EXTERNAL1990(Val) when tuple(Val) -> - %% Data already in ASN1 1990 format - Val. - -transform_to_EXTERNAL1990(['EXTERNAL'|Rest],Acc) -> - transform_to_EXTERNAL1990(Rest,['EXTERNAL'|Acc]); -transform_to_EXTERNAL1990([{syntax,Syntax}|Rest],Acc) -> - transform_to_EXTERNAL1990(Rest,[asn1_NOVALUE,Syntax|Acc]); -transform_to_EXTERNAL1990([{'presentation-context-id',PCid}|Rest],Acc) -> - transform_to_EXTERNAL1990(Rest,[PCid,asn1_NOVALUE|Acc]); -transform_to_EXTERNAL1990([{'context-negotiation',Context_negot}|Rest],Acc) -> - {_,Presentation_Cid,Transfer_syntax} = Context_negot, - transform_to_EXTERNAL1990(Rest,[Transfer_syntax,Presentation_Cid|Acc]); -transform_to_EXTERNAL1990([asn1_NOVALUE|Rest],Acc) -> - transform_to_EXTERNAL1990(Rest,[asn1_NOVALUE|Acc]); -transform_to_EXTERNAL1990([Data_val_desc,Data_value],Acc) when list(Data_value)-> - list_to_tuple(lists:reverse([{'octet-aligned',Data_value}, - Data_val_desc|Acc])); -transform_to_EXTERNAL1990([Data_value],Acc) when list(Data_value)-> - list_to_tuple(lists:reverse([{'octet-aligned',Data_value}|Acc])). - - -transform_to_EXTERNAL1994(V={'EXTERNAL',DRef,IndRef,Data_v_desc,Encoding}) -> - Identification = - case {DRef,IndRef} of - {DRef,asn1_NOVALUE} -> - {syntax,DRef}; - {asn1_NOVALUE,IndRef} -> - {'presentation-context-id',IndRef}; - _ -> - {'context-negotiation', - {'EXTERNAL_identification_context-negotiation',IndRef,DRef}} - end, - case Encoding of - {_,Val} when list(Val) -> - {'EXTERNAL',Identification,Data_v_desc,Val}; - _ -> - V - end. diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_driver_handler.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_driver_handler.erl deleted file mode 100644 index 7a986b5376..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_driver_handler.erl +++ /dev/null @@ -1,108 +0,0 @@ -%% ``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: asn1rt_driver_handler.erl,v 1.1 2008/12/17 09:53:30 mikpe Exp $ -%% - --module(asn1rt_driver_handler). - --export([init/1,load_driver/0,unload_driver/0]). - - -load_driver() -> - spawn(asn1rt_driver_handler, init, [self()]). - -init(From) -> - Port= - case load_driver("asn1_erl_drv") of - ok -> - open_named_port(From); - already_done -> - From ! driver_ready; - Error -> % if erl_ddll:load_driver fails - erl_ddll:unload_driver("asn1_erl_drv"), - From ! Error - end, - register_and_loop(Port). - -load_driver(DriverName) -> - case is_driver_loaded(DriverName) of - false -> - Dir = filename:join([code:priv_dir(asn1),"lib"]), - erl_ddll:load_driver(Dir,DriverName); - true -> - ok - end. - - -is_driver_loaded(_Name) -> - case whereis(asn1_driver_owner) of - undefined -> - false; - _ -> - true - end. - -open_named_port(From) -> - case is_port_open(drv_complete) of - false -> - case catch open_port({spawn,"asn1_erl_drv"},[]) of - {'EXIT',Reason} -> - From ! {port_error,Reason}; - Port -> - register(drv_complete,Port), - From ! driver_ready, - Port - end; - _ -> - From ! driver_ready, - ok - end. - -is_port_open(Name) -> - case whereis(Name) of - Port when port(Port) -> - true; - _ -> false - end. - -register_and_loop(Port) when port(Port) -> - register(asn1_driver_owner,self()), - loop(); -register_and_loop(_) -> - ok. - -loop() -> - receive - unload -> - case whereis(drv_complete) of - Port when port(Port) -> - port_close(Port); - _ -> ok - end, - erl_ddll:unload_driver("asn1_erl_drv"), - ok; - _ -> - loop() - end. - -unload_driver() -> - case whereis(asn1_driver_owner) of - Pid when pid(Pid) -> - Pid ! unload, - ok; - _ -> - ok - end. diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_per.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_per.erl deleted file mode 100644 index d531a165ae..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_per.erl +++ /dev/null @@ -1,1609 +0,0 @@ -%% ``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: asn1rt_per.erl,v 1.1 2008/12/17 09:53:31 mikpe Exp $ -%% --module(asn1rt_per). - -%% encoding / decoding of PER aligned - --include("asn1_records.hrl"). - --export([dec_fixup/3, cindex/3, list_to_record/2]). --export([setchoiceext/1, setext/1, fixoptionals/2, fixextensions/2, setoptionals/1, - getext/1, getextension/2, skipextensions/3, getbit/1, getchoice/3 ]). --export([getoptionals/3, set_choice/3, encode_integer/2, encode_integer/3 ]). --export([decode_integer/2, decode_integer/3, encode_boolean/1, - decode_boolean/1, encode_length/2, decode_length/1, decode_length/2, - encode_small_length/1, decode_small_length/1]). --export([encode_enumerated/3, decode_enumerated/3, - encode_bit_string/3, decode_bit_string/3 ]). --export([encode_octet_string/2, decode_octet_string/2, - encode_restricted_string/4, encode_restricted_string/5, - decode_restricted_string/4, decode_restricted_string/5, - encode_null/1, decode_null/1, - encode_object_identifier/1, decode_object_identifier/1, - complete/1]). - --export([encode_open_type/2, decode_open_type/2]). - --export([encode_UniversalString/2, decode_UniversalString/2, - encode_PrintableString/2, decode_PrintableString/2, - encode_GeneralString/2, decode_GeneralString/2, - encode_GraphicString/2, decode_GraphicString/2, - encode_TeletexString/2, decode_TeletexString/2, - encode_VideotexString/2, decode_VideotexString/2, - encode_VisibleString/2, decode_VisibleString/2, - encode_BMPString/2, decode_BMPString/2, - encode_IA5String/2, decode_IA5String/2, - encode_NumericString/2, decode_NumericString/2 - ]). - - -dec_fixup(Terms,Cnames,RemBytes) -> - dec_fixup(Terms,Cnames,RemBytes,[]). - -dec_fixup([novalue|T],[_Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,Acc); -dec_fixup([{_Name,novalue}|T],[_Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,Acc); -dec_fixup([H|T],[Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,[{Hc,H}|Acc]); -dec_fixup([],_Cnames,RemBytes,Acc) -> - {lists:reverse(Acc),RemBytes}. - -cindex(Ix,Val,Cname) -> - case element(Ix,Val) of - {Cname,Val2} -> Val2; - X -> X - end. - -% converts a list to a record if necessary -list_to_record(Name,List) when list(List) -> - list_to_tuple([Name|List]); -list_to_record(_Name,Tuple) when tuple(Tuple) -> - Tuple. - -%%-------------------------------------------------------- -%% setchoiceext(InRootSet) -> [{bit,X}] -%% X is set to 1 when InRootSet==false -%% X is set to 0 when InRootSet==true -%% -setchoiceext(true) -> - [{debug,choiceext},{bit,0}]; -setchoiceext(false) -> - [{debug,choiceext},{bit,1}]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% setext(true|false) -> CompleteList -%% - -setext(true) -> - [{debug,ext},{bit,1}]; -setext(false) -> - [{debug,ext},{bit,0}]. - -fixoptionals(OptList,Val) when tuple(Val) -> - fixoptionals(OptList,Val,[]); - -fixoptionals(OptList,Val) when list(Val) -> - fixoptionals(OptList,Val,1,[],[]). - -fixoptionals([],Val,Acc) -> - % return {Val,Opt} - {Val,lists:reverse(Acc)}; -fixoptionals([{_,Pos}|Ot],Val,Acc) -> - case element(Pos+1,Val) of - asn1_NOVALUE -> fixoptionals(Ot,Val,[0|Acc]); - asn1_DEFAULT -> fixoptionals(Ot,Val,[0|Acc]); - _ -> fixoptionals(Ot,Val,[1|Acc]) - end. - - -%setoptionals(OptList,Val) -> -% Vlist = tuple_to_list(Val), -% setoptionals(OptList,Vlist,1,[]). - -fixoptionals([{Name,Pos}|Ot],[{Name,Val}|Vt],_Opt,Acc1,Acc2) -> - fixoptionals(Ot,Vt,Pos+1,[1|Acc1],[{Name,Val}|Acc2]); -fixoptionals([{_Name,Pos}|Ot],V,Pos,Acc1,Acc2) -> - fixoptionals(Ot,V,Pos+1,[0|Acc1],[asn1_NOVALUE|Acc2]); -fixoptionals(O,[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals(O,Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals([],[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals([],Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals([],[],_,Acc1,Acc2) -> - % return {Val,Opt} - {list_to_tuple([asn1_RECORDNAME|lists:reverse(Acc2)]),lists:reverse(Acc1)}. - -setoptionals([H|T]) -> - [{bit,H}|setoptionals(T)]; -setoptionals([]) -> - [{debug,optionals}]. - -getext(Bytes) when tuple(Bytes) -> - getbit(Bytes); -getext(Bytes) when list(Bytes) -> - getbit({0,Bytes}). - -getextension(0, Bytes) -> - {{},Bytes}; -getextension(1, Bytes) -> - {Len,Bytes2} = decode_small_length(Bytes), - {Blist, Bytes3} = getbits_as_list(Len,Bytes2), - {list_to_tuple(Blist),Bytes3}. - -fixextensions({ext,ExtPos,ExtNum},Val) -> - case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of - 0 -> []; - ExtBits -> - [encode_small_length(ExtNum),{bits,ExtNum,ExtBits}] - end. - -fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> - Acc; -fixextensions(Pos,ExtPos,Val,Acc) -> - Bit = case catch(element(Pos+1,Val)) of - asn1_NOVALUE -> - 0; - asn1_NOEXTVALUE -> - 0; - {'EXIT',_} -> - 0; - _ -> - 1 - end, - fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). - -skipextensions(Bytes,Nr,ExtensionBitPattern) -> - case (catch element(Nr,ExtensionBitPattern)) of - 1 -> - {_,Bytes2} = decode_open_type(Bytes,[]), - skipextensions(Bytes2, Nr+1, ExtensionBitPattern); - 0 -> - skipextensions(Bytes, Nr+1, ExtensionBitPattern); - {'EXIT',_} -> % badarg, no more extensions - Bytes - end. - - -getchoice(Bytes,1,0) -> % only 1 alternative is not encoded - {0,Bytes}; -getchoice(Bytes,_NumChoices,1) -> - decode_small_number(Bytes); -getchoice(Bytes,NumChoices,0) -> - decode_integer(Bytes,[{'ValueRange',{0,NumChoices-1}}]). - -getoptionals(Bytes,L,NumComp) when list(L) -> - {Blist,Bytes1} = getbits_as_list(length(L),Bytes), - {list_to_tuple(comptuple(Blist,L,NumComp,1)),Bytes1}. - -comptuple([Bh|Bt],[{_Name,Nr}|T],NumComp,Nr) -> - [Bh|comptuple(Bt,T,NumComp-1,Nr+1)]; -comptuple(Bl,[{Name,Tnr}|Tl],NumComp,Nr) -> - [0|comptuple(Bl,[{Name,Tnr}|Tl],NumComp-1,Nr+1)]; -comptuple(_B,_L,0,_Nr) -> - []; -comptuple(B,O,N,Nr) -> - [0|comptuple(B,O,N-1,Nr+1)]. - -getbits_as_list(Num,Bytes) -> - getbits_as_list(Num,Bytes,[]). - -getbits_as_list(0,Bytes,Acc) -> - {lists:reverse(Acc),Bytes}; -getbits_as_list(Num,Bytes,Acc) -> - {Bit,NewBytes} = getbit(Bytes), - getbits_as_list(Num-1,NewBytes,[Bit|Acc]). - -getbit(Bytes) -> -% io:format("getbit:~p~n",[Bytes]), - getbit1(Bytes). - -getbit1({7,[H|T]}) -> - {H band 1,{0,T}}; -getbit1({Pos,[H|T]}) -> - {(H bsr (7-Pos)) band 1,{(Pos+1) rem 8,[H|T]}}; -getbit1(Bytes) when list(Bytes) -> - getbit1({0,Bytes}). - -%% This could be optimized -getbits(Buffer,Num) -> -% io:format("getbits:Buffer = ~p~nNum=~p~n",[Buffer,Num]), - getbits(Buffer,Num,0). - -getbits(Buffer,0,Acc) -> - {Acc,Buffer}; -getbits(Buffer,Num,Acc) -> - {B,NewBuffer} = getbit(Buffer), - getbits(NewBuffer,Num-1,B + (Acc bsl 1)). - - -getoctet(Bytes) when list(Bytes) -> - getoctet({0,Bytes}); -getoctet(Bytes) -> -% io:format("getoctet:Buffer = ~p~n",[Bytes]), - getoctet1(Bytes). - -getoctet1({0,[H|T]}) -> - {H,{0,T}}; -getoctet1({_Pos,[_,H|T]}) -> - {H,{0,T}}. - -align({0,L}) -> - {0,L}; -align({_Pos,[_H|T]}) -> - {0,T}; -align(Bytes) -> - {0,Bytes}. - -getoctets(Buffer,Num) -> -% io:format("getoctets:Buffer = ~p~nNum = ~p~n",[Buffer,Num]), - getoctets(Buffer,Num,0). - -getoctets(Buffer,0,Acc) -> - {Acc,Buffer}; -getoctets(Buffer,Num,Acc) -> - {Oct,NewBuffer} = getoctet(Buffer), - getoctets(NewBuffer,Num-1,(Acc bsl 8)+Oct). - -getoctets_as_list(Buffer,Num) -> - getoctets_as_list(Buffer,Num,[]). - -getoctets_as_list(Buffer,0,Acc) -> - {lists:reverse(Acc),Buffer}; -getoctets_as_list(Buffer,Num,Acc) -> - {Oct,NewBuffer} = getoctet(Buffer), - getoctets_as_list(NewBuffer,Num-1,[Oct|Acc]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings -%% Alt = atom() -%% Altnum = integer() | {integer(),integer()}% number of alternatives -%% Choices = [atom()] | {[atom()],[atom()]} -%% When Choices is a tuple the first list is the Rootset and the -%% second is the Extensions and then Altnum must also be a tuple with the -%% lengths of the 2 lists -%% -set_choice(Alt,{L1,L2},{Len1,_Len2}) -> - case set_choice_tag(Alt,L1) of - N when integer(N), Len1 > 1 -> - [{bit,0}, % the value is in the root set - encode_integer([{'ValueRange',{0,Len1-1}}],N)]; - N when integer(N) -> - [{bit,0}]; % no encoding if only 0 or 1 alternative - false -> - [{bit,1}, % extension value - case set_choice_tag(Alt,L2) of - N2 when integer(N2) -> - encode_small_number(N2); - false -> - unknown_choice_alt - end] - end; -set_choice(Alt,L,Len) -> - case set_choice_tag(Alt,L) of - N when integer(N), Len > 1 -> - encode_integer([{'ValueRange',{0,Len-1}}],N); - N when integer(N) -> - []; % no encoding if only 0 or 1 alternative - false -> - [unknown_choice_alt] - end. - -set_choice_tag(Alt,Choices) -> - set_choice_tag(Alt,Choices,0). - -set_choice_tag(Alt,[Alt|_Rest],Tag) -> - Tag; -set_choice_tag(Alt,[_H|Rest],Tag) -> - set_choice_tag(Alt,Rest,Tag+1); -set_choice_tag(_,[],_) -> - false. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_open_type(Constraint, Value) -> CompleteList -%% Value = list of bytes of an already encoded value (the list must be flat) -%% | binary -%% Contraint = not used in this version -%% -encode_open_type(_Constraint, Val) when list(Val) -> - [encode_length(undefined,length(Val)),align, - {octets,Val}]; -encode_open_type(_Constraint, Val) when binary(Val) -> - [encode_length(undefined,size(Val)),align, - {octets,binary_to_list(Val)}]. -%% the binary_to_list is not optimal but compatible with the current solution - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_open_type(Buffer,Constraint) -> Value -%% Constraint is not used in this version -%% Buffer = [byte] with PER encoded data -%% Value = [byte] with decoded data (which must be decoded again as some type) -%% -decode_open_type(Bytes, _Constraint) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - Bytes3 = align(Bytes2), - getoctets_as_list(Bytes3,Len). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_integer(Constraint,Value,NamedNumberList) -> CompleteList -%% encode_integer(Constraint,Value) -> CompleteList -%% encode_integer(Constraint,{Name,Value}) -> CompleteList -%% -%% -encode_integer(C,V,NamedNumberList) when atom(V) -> - case lists:keysearch(V,1,NamedNumberList) of - {value,{_,NewV}} -> - encode_integer(C,NewV); - _ -> - exit({error,{asn1,{namednumber,V}}}) - end; -encode_integer(C,V,_NamedNumberList) when integer(V) -> - encode_integer(C,V). - -encode_integer(C,{Name,Val}) when atom(Name) -> - encode_integer(C,Val); - -encode_integer({Rc,_Ec},Val) -> - case (catch encode_integer(Rc,Val)) of - {'EXIT',{error,{asn1,_}}} -> - [{bit,1},encode_unconstrained_number(Val)]; - Encoded -> - [{bit,0},Encoded] - end; -encode_integer(C,Val ) when list(C) -> - case get_constraint(C,'SingleValue') of - no -> - encode_integer1(C,Val); - V when integer(V),V == Val -> - []; % a type restricted to a single value encodes to nothing - V when list(V) -> - case lists:member(Val,V) of - true -> - encode_integer1(C,Val); - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end; - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end. - -encode_integer1(C, Val) -> - case VR = get_constraint(C,'ValueRange') of - no -> - encode_unconstrained_number(Val); - {Lb,'MAX'} -> - encode_semi_constrained_number(Lb,Val); - %% positive with range - {Lb,Ub} when Val >= Lb, - Ub >= Val -> - encode_constrained_number(VR,Val) - end. - -decode_integer(Buffer,Range,NamedNumberList) -> - {Val,Buffer2} = decode_integer(Buffer,Range), - case lists:keysearch(Val,2,NamedNumberList) of - {value,{NewVal,_}} -> {NewVal,Buffer2}; - _ -> {Val,Buffer2} - end. - -decode_integer(Buffer,{Rc,_Ec}) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> decode_integer(Buffer2,Rc); - 1 -> decode_unconstrained_number(Buffer2) - end; -decode_integer(Buffer,undefined) -> - decode_unconstrained_number(Buffer); -decode_integer(Buffer,C) -> - case get_constraint(C,'SingleValue') of - V when integer(V) -> - {V,Buffer}; - V when list(V) -> - {Val,Buffer2} = decode_integer1(Buffer,C), - case lists:member(Val,V) of - true -> - {Val,Buffer2}; - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end; - _ -> - decode_integer1(Buffer,C) - end. - -decode_integer1(Buffer,C) -> - case VR = get_constraint(C,'ValueRange') of - no -> - decode_unconstrained_number(Buffer); - {Lb, 'MAX'} -> - decode_semi_constrained_number(Buffer,Lb); - {_,_} -> - decode_constrained_number(Buffer,VR) - end. - -% X.691:10.6 Encoding of a normally small non-negative whole number -% Use this for encoding of CHOICE index if there is an extension marker in -% the CHOICE -encode_small_number({Name,Val}) when atom(Name) -> - encode_small_number(Val); -encode_small_number(Val) when Val =< 63 -> - [{bit,0},{bits,6,Val}]; -encode_small_number(Val) -> - [{bit,1},encode_semi_constrained_number(0,Val)]. - -decode_small_number(Bytes) -> - {Bit,Bytes2} = getbit(Bytes), - case Bit of - 0 -> - getbits(Bytes2,6); - 1 -> - decode_semi_constrained_number(Bytes2,{0,'MAX'}) - end. - -% X.691:10.7 Encoding of a semi-constrained whole number -%% might be an optimization encode_semi_constrained_number(0,Val) -> -encode_semi_constrained_number(C,{Name,Val}) when atom(Name) -> - encode_semi_constrained_number(C,Val); -encode_semi_constrained_number({Lb,'MAX'},Val) -> - encode_semi_constrained_number(Lb,Val); -encode_semi_constrained_number(Lb,Val) -> - Val2 = Val - Lb, - Octs = eint_positive(Val2), - [encode_length(undefined,length(Octs)),{octets,Octs}]. - -decode_semi_constrained_number(Bytes,{Lb,_}) -> - decode_semi_constrained_number(Bytes,Lb); -decode_semi_constrained_number(Bytes,Lb) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {V,Bytes3} = getoctets(Bytes2,Len), - {V+Lb,Bytes3}. - -encode_constrained_number(Range,{Name,Val}) when atom(Name) -> - encode_constrained_number(Range,Val); -encode_constrained_number({Lb,Ub},Val) when Val >= Lb, Ub >= Val -> - Range = Ub - Lb + 1, - Val2 = Val - Lb, - if - Range == 2 -> - {bits,1,Val2}; - Range =< 4 -> - {bits,2,Val2}; - Range =< 8 -> - {bits,3,Val2}; - Range =< 16 -> - {bits,4,Val2}; - Range =< 32 -> - {bits,5,Val2}; - Range =< 64 -> - {bits,6,Val2}; - Range =< 128 -> - {bits,7,Val2}; - Range =< 255 -> - {bits,8,Val2}; - Range =< 256 -> - {octets,1,Val2}; - Range =< 65536 -> - {octets,2,Val2}; - Range =< 16#1000000 -> - Octs = eint_positive(Val2), - [encode_length({1,3},length(Octs)),{octets,Octs}]; - Range =< 16#100000000 -> - Octs = eint_positive(Val2), - [encode_length({1,4},length(Octs)),{octets,Octs}]; - Range =< 16#10000000000 -> - Octs = eint_positive(Val2), - [encode_length({1,5},length(Octs)),{octets,Octs}]; - true -> - exit({not_supported,{integer_range,Range}}) - end. - -decode_constrained_number(Buffer,{Lb,Ub}) -> - Range = Ub - Lb + 1, -% Val2 = Val - Lb, - {Val,Remain} = - if - Range == 2 -> - getbits(Buffer,1); - Range =< 4 -> - getbits(Buffer,2); - Range =< 8 -> - getbits(Buffer,3); - Range =< 16 -> - getbits(Buffer,4); - Range =< 32 -> - getbits(Buffer,5); - Range =< 64 -> - getbits(Buffer,6); - Range =< 128 -> - getbits(Buffer,7); - Range =< 255 -> - getbits(Buffer,8); - Range =< 256 -> - getoctets(Buffer,1); - Range =< 65536 -> - getoctets(Buffer,2); - Range =< 16#1000000 -> - {Len,Bytes2} = decode_length(Buffer,{1,3}), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_pos_integer(Octs),Bytes3}; - Range =< 16#100000000 -> - {Len,Bytes2} = decode_length(Buffer,{1,4}), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_pos_integer(Octs),Bytes3}; - Range =< 16#10000000000 -> - {Len,Bytes2} = decode_length(Buffer,{1,5}), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_pos_integer(Octs),Bytes3}; - true -> - exit({not_supported,{integer_range,Range}}) - end, - {Val+Lb,Remain}. - -% X.691:10.8 Encoding of an unconstrained whole number - -encode_unconstrained_number(Val) when Val >= 0 -> - Oct = eint(Val,[]), - [{debug,unconstrained_number}, - encode_length({0,'MAX'},length(Oct)), - {octets,Oct}]; -encode_unconstrained_number(Val) -> % negative - Oct = enint(Val,[]), - [{debug,unconstrained_number}, - encode_length({0,'MAX'},length(Oct)), - {octets,Oct}]. - -%% used for positive Values which don't need a sign bit -eint_positive(Val) -> - case eint(Val,[]) of - [0,B1|T] -> - [B1|T]; - T -> - T - end. - -eint(0, [B|Acc]) when B < 128 -> - [B|Acc]; -eint(N, Acc) -> - eint(N bsr 8, [N band 16#ff| Acc]). - -enint(-1, [B1|T]) when B1 > 127 -> - [B1|T]; -enint(N, Acc) -> - enint(N bsr 8, [N band 16#ff|Acc]). - -%% used for signed positive values - -%eint(Val, Ack) -> -% X = Val band 255, -% Next = Val bsr 8, -% if -% Next == 0, X >= 127 -> -% [0,X|Ack]; -% Next == 0 -> -% [X|Ack]; -% true -> -% eint(Next,[X|Ack]) -% end. - -%%% used for signed negative values -%enint(Val, Acc) -> -% NumOctets = if -% -Val < 16#80 -> 1; -% -Val < 16#8000 ->2; -% -Val < 16#800000 ->3; -% -Val < 16#80000000 ->4; -% -Val < 16#8000000000 ->5; -% -Val < 16#800000000000 ->6; -% -Val < 16#80000000000000 ->7; -% -Val < 16#8000000000000000 ->8; -% -Val < 16#800000000000000000 ->9 -% end, -% enint(Val,Acc,NumOctets). - -%enint(Val, Acc,0) -> -% Acc; -%enint(Val, Acc,NumOctets) -> -% enint(Val bsr 8,[Val band 255|Acc],NumOctets-1). - - -decode_unconstrained_number(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Ints,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_integer(Ints),Bytes3}. - -dec_pos_integer(Ints) -> - decpint(Ints, 8 * (length(Ints) - 1)). -dec_integer(Ints) when hd(Ints) band 255 =< 127 -> %% Positive number - decpint(Ints, 8 * (length(Ints) - 1)); -dec_integer(Ints) -> %% Negative - decnint(Ints, 8 * (length(Ints) - 1)). - -decpint([Byte|Tail], Shift) -> - (Byte bsl Shift) bor decpint(Tail, Shift-8); -decpint([], _) -> 0. - -decnint([Byte|Tail], Shift) -> - (-128 + (Byte band 127) bsl Shift) bor decpint(Tail, Shift-8). - -minimum_octets(Val) -> - minimum_octets(Val,[]). - -minimum_octets(Val,Acc) when Val > 0 -> - minimum_octets((Val bsr 8),[Val band 16#FF|Acc]); -minimum_octets(0,Acc) -> - Acc. - - -%% X.691:10.9 Encoding of a length determinant -%%encode_small_length(undefined,Len) -> % null means no UpperBound -%% encode_small_number(Len). - -%% X.691:10.9.3.5 -%% X.691:10.9.3.7 -encode_length(undefined,Len) -> % un-constrained - if - Len < 128 -> - {octet,Len band 16#7F}; - Len < 16384 -> - {octets,2,2#1000000000000000 bor Len}; - true -> - exit({error,{asn1,{encode_length,{nyi,above_16k}}}}) - end; - -encode_length({0,'MAX'},Len) -> - encode_length(undefined,Len); -encode_length({Lb,Ub},Len) when Ub =< 65535 ,Lb >= 0 -> % constrained - encode_constrained_number({Lb,Ub},Len); -encode_length(SingleValue,_Len) when integer(SingleValue) -> - []. - -encode_small_length(Len) when Len =< 64 -> - [{bit,0},{bits,6,Len-1}]; -encode_small_length(Len) -> - [{bit,1},encode_length(undefined,Len)]. - -decode_small_length(Buffer) -> - case getbit(Buffer) of - {0,Remain} -> - {Bits,Remain2} = getbits(Remain,6), - {Bits+1,Remain2}; - {1,Remain} -> - decode_length(Remain,undefined) - end. - -decode_length(Buffer) -> - decode_length(Buffer,undefined). - -decode_length(Buffer,undefined) -> % un-constrained - Buffer2 = align(Buffer), - {Bits,_} = getbits(Buffer2,2), - case Bits of - 2 -> - {Val,Bytes3} = getoctets(Buffer2,2), - {(Val band 16#3FFF),Bytes3}; - 3 -> - exit({error,{asn1,{decode_length,{nyi,above_16k}}}}); - _ -> - {Val,Bytes3} = getoctet(Buffer2), - {Val band 16#7F,Bytes3} - end; - -decode_length(Buffer,{Lb,Ub}) when Ub =< 65535 ,Lb >= 0 -> % constrained - decode_constrained_number(Buffer,{Lb,Ub}); - % X.691:10.9.3.5 -decode_length(Buffer,{_,_Lb,_Ub}) -> %when Len =< 127 -> % Unconstrained or large Ub - case getbit(Buffer) of - {0,Remain} -> - getbits(Remain,7); - {1,_Remain} -> - {Val,Remain2} = getoctets(Buffer,2), - {Val band 2#0111111111111111, Remain2} - end; -decode_length(Buffer,SingleValue) when integer(SingleValue) -> - {SingleValue,Buffer}. - - -% X.691:11 -encode_boolean({Name,Val}) when atom(Name) -> - encode_boolean(Val); -encode_boolean(true) -> - {bit,1}; -encode_boolean(false) -> - {bit,0}; -encode_boolean(Val) -> - exit({error,{asn1,{encode_boolean,Val}}}). - - -decode_boolean(Buffer) -> %when record(Buffer,buffer) - case getbit(Buffer) of - {1,Remain} -> {true,Remain}; - {0,Remain} -> {false,Remain} - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% X.691:12 -%% ENUMERATED -%% -%% encode_enumerated(C,Value,NamedNumberTup) -> CompleteList -%% -%% - -encode_enumerated(C,{Name,Value},NamedNumberList) when - atom(Name),list(NamedNumberList) -> - encode_enumerated(C,Value,NamedNumberList); - -%% ENUMERATED with extension mark -encode_enumerated(_C,{asn1_enum,Value},{_Nlist1,Nlist2}) when Value >= length(Nlist2) -> - [{bit,1},encode_small_number(Value)]; -encode_enumerated(C,Value,{Nlist1,Nlist2}) -> - case enum_search(Value,Nlist1,0) of - NewV when integer(NewV) -> - [{bit,0},encode_integer(C,NewV)]; - false -> - case enum_search(Value,Nlist2,0) of - ExtV when integer(ExtV) -> - [{bit,1},encode_small_number(ExtV)]; - false -> - exit({error,{asn1,{encode_enumerated,Value}}}) - end - end; - -encode_enumerated(C,Value,NamedNumberList) when list(NamedNumberList) -> - case enum_search(Value,NamedNumberList,0) of - NewV when integer(NewV) -> - encode_integer(C,NewV); - false -> - exit({error,{asn1,{encode_enumerated,Value}}}) - end. - -%% returns the ordinal number from 0 ,1 ... in the list where Name is found -%% or false if not found -%% -enum_search(Name,[Name|_NamedNumberList],Acc) -> - Acc; -enum_search(Name,[_H|T],Acc) -> - enum_search(Name,T,Acc+1); -enum_search(_,[],_) -> - false. % name not found !error - -%% ENUMERATED with extension marker -decode_enumerated(Buffer,C,{Ntup1,Ntup2}) when tuple(Ntup1), tuple(Ntup2) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> % not an extension value - {Val,Buffer3} = decode_integer(Buffer2,C), - case catch (element(Val+1,Ntup1)) of - NewVal when atom(NewVal) -> {NewVal,Buffer3}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,[Ntup1,Ntup2]}}}}) - end; - 1 -> % this an extension value - {Val,Buffer3} = decode_small_number(Buffer2), - case catch (element(Val+1,Ntup2)) of - NewVal when atom(NewVal) -> {NewVal,Buffer3}; - _ -> {{asn1_enum,Val},Buffer3} - end - end; - -decode_enumerated(Buffer,C,NamedNumberTup) when tuple(NamedNumberTup) -> - {Val,Buffer2} = decode_integer(Buffer,C), - case catch (element(Val+1,NamedNumberTup)) of - NewVal when atom(NewVal) -> {NewVal,Buffer2}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,NamedNumberTup}}}}) - end. - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Bitstring value, ITU_T X.690 Chapter 8.5 -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% encode bitstring value -%%=============================================================================== - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% bitstring NamedBitList -%% Val can be of: -%% - [identifiers] where only named identifers are set to one, -%% the Constraint must then have some information of the -%% bitlength. -%% - [list of ones and zeroes] all bits -%% - integer value representing the bitlist -%% C is constraint Len, only valid when identifiers - -%% when the value is a list of named bits -encode_bit_string(C, [FirstVal | RestVal], NamedBitList) when atom(FirstVal) -> - ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string(C,BitList,NamedBitList); - -encode_bit_string(C, [{bit,No} | RestVal], NamedBitList) -> - ToSetPos = get_all_bitposes([{bit,No} | RestVal], NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string(C,BitList,NamedBitList); - -%% when the value is a list of ones and zeroes - -encode_bit_string(C, BitListValue, _NamedBitList) when list(BitListValue) -> - %% first remove any trailing zeroes - Bl1 = lists:dropwhile(fun(0)->true;(1)->false end,lists:reverse(BitListValue)), - BitList = [{bit,X} || X <- lists:reverse(Bl1)], - case get_constraint(C,'SizeConstraint') of - 0 -> % fixed length - []; % nothing to encode - V when integer(V),V=<16 -> % fixed length 16 bits or less - pad_list(V,BitList); - V when integer(V) -> % fixed length more than 16 bits - [align,pad_list(V,BitList)]; - {Lb,Ub} when integer(Lb),integer(Ub) -> - [encode_length({Lb,Ub},length(BitList)),align,BitList]; - no -> - [encode_length(undefined,length(BitList)),align,BitList] - end; - -%% when the value is an integer -encode_bit_string(C, IntegerVal, NamedBitList) -> - BitList = int_to_bitlist(IntegerVal), - encode_bit_string(C,BitList,NamedBitList). - - - - -%%%%%%%%%%%%%%% -%% The result is presented as a list of named bits (if possible) -%% else as a list of 0 and 1. -%% -decode_bit_string(Buffer, C, NamedNumberList) -> - case get_constraint(C,'SizeConstraint') of - 0 -> % fixed length - {[],Buffer}; % nothing to encode - V when integer(V),V=<16 -> % fixed length 16 bits or less - bit_list_to_named(Buffer,V,NamedNumberList); - V when integer(V) -> % fixed length 16 bits or less - Bytes2 = align(Buffer), - bit_list_to_named(Bytes2,V,NamedNumberList); - {Lb,Ub} when integer(Lb),integer(Ub) -> - {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), - Bytes3 = align(Bytes2), - bit_list_to_named(Bytes3,Len,NamedNumberList); - no -> - {Len,Bytes2} = decode_length(Buffer,undefined), - Bytes3 = align(Bytes2), - bit_list_to_named(Bytes3,Len,NamedNumberList) - end. - -%% if no named bits are declared we will return a -%% BitList = [0 | 1] - -bit_list_to_named(Buffer,Len,[]) -> - getbits_as_list(Len,Buffer); - -%% if there are named bits declared we will return a named -%% BitList where the names are atoms and unnamed bits represented -%% as {bit,Pos} -%% BitList = [atom() | {bit,Pos}] -%% Pos = integer() - -bit_list_to_named(Buffer,Len,NamedNumberList) -> - {BitList,Rest} = getbits_as_list(Len,Buffer), - {bit_list_to_named1(0,BitList,NamedNumberList,[]), Rest}. - -bit_list_to_named1(Pos,[0|Bt],Names,Acc) -> - bit_list_to_named1(Pos+1,Bt,Names,Acc); -bit_list_to_named1(Pos,[1|Bt],Names,Acc) -> - case lists:keysearch(Pos,2,Names) of - {value,{Name,_}} -> - bit_list_to_named1(Pos+1,Bt,Names,[Name|Acc]); - _ -> - bit_list_to_named1(Pos+1,Bt,Names,[{bit,Pos}|Acc]) - end; -bit_list_to_named1(_Pos,[],_Names,Acc) -> - lists:reverse(Acc). - - - -%%%%%%%%%%%%%%% -%% - -int_to_bitlist(0) -> - []; -int_to_bitlist(Int) when integer(Int), Int >= 0 -> - [Int band 1 | int_to_bitlist(Int bsr 1)]. - - -%%%%%%%%%%%%%%%%%% -%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> -%% [sorted_list_of_bitpositions_to_set] - -get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); - -get_all_bitposes([Val | Rest], NamedBitList, Ack) -> - case lists:keysearch(Val, 1, NamedBitList) of - {value, {_ValName, ValPos}} -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); - _ -> - exit({error,{asn1, {bitstring_namedbit, Val}}}) - end; -get_all_bitposes([], _NamedBitList, Ack) -> - lists:sort(Ack). - -%%%%%%%%%%%%%%%%%% -%% make_and_set_list([list of positions to set to 1])-> -%% returns list with all in SetPos set. -%% in positioning in list the first element is 0, the second 1 etc.., but -%% - -make_and_set_list([XPos|SetPos], XPos) -> - [1 | make_and_set_list(SetPos, XPos + 1)]; -make_and_set_list([Pos|SetPos], XPos) -> - [0 | make_and_set_list([Pos | SetPos], XPos + 1)]; -make_and_set_list([], _) -> - []. - -%%%%%%%%%%%%%%%%% -%% pad_list(N,BitList) -> PaddedList -%% returns a padded (with trailing {bit,0} elements) list of length N -%% if Bitlist contains more than N significant bits set an exit asn1_error -%% is generated - -pad_list(0,BitList) -> - case BitList of - [] -> []; - _ -> exit({error,{asn1,{range_error,{bit_string,BitList}}}}) - end; -pad_list(N,[Bh|Bt]) -> - [Bh|pad_list(N-1,Bt)]; -pad_list(N,[]) -> - [{bit,0},pad_list(N-1,[])]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% X.691:16 -%% encode_octet_string(Constraint,ExtensionMarker,Val) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -encode_octet_string(C,{Name,Val}) when atom(Name) -> - encode_octet_string(C,false,Val); -encode_octet_string(C,Val) -> - encode_octet_string(C,false,Val). - -encode_octet_string(_C,true,_Val) -> - exit({error,{asn1,{'not_supported',extensionmarker}}}); -encode_octet_string(C,false,Val) -> - case get_constraint(C,'SizeConstraint') of - 0 -> - []; - 1 -> - [V] = Val, - {bits,8,V}; - 2 -> - [V1,V2] = Val, - [{bits,8,V1},{bits,8,V2}]; - Sv when Sv =<65535, Sv == length(Val) -> % fixed length - [align,{octets,Val}]; - {Lb,Ub} -> - [encode_length({Lb,Ub},length(Val)),align, - {octets,Val}]; - Sv when list(Sv) -> - [encode_length({hd(Sv),lists:max(Sv)},length(Val)),align, - {octets,Val}]; - no -> - [encode_length(undefined,length(Val)),align, - {octets,Val}] - end. - -decode_octet_string(Bytes,Range) -> - decode_octet_string(Bytes,Range,false). - -decode_octet_string(Bytes,C,false) -> - case get_constraint(C,'SizeConstraint') of - 0 -> - {[],Bytes}; - 1 -> - {B1,Bytes2} = getbits(Bytes,8), - {[B1],Bytes2}; - 2 -> - {B1,Bytes2}= getbits(Bytes,8), - {B2,Bytes3}= getbits(Bytes2,8), - {[B1,B2],Bytes3}; - {_,0} -> - {[],Bytes}; - Sv when integer(Sv), Sv =<65535 -> % fixed length - Bytes2 = align(Bytes), - getoctets_as_list(Bytes2,Sv); - {Lb,Ub} -> - {Len,Bytes2} = decode_length(Bytes,{Lb,Ub}), - Bytes3 = align(Bytes2), - getoctets_as_list(Bytes3,Len); - Sv when list(Sv) -> - {Len,Bytes2} = decode_length(Bytes,{hd(Sv),lists:max(Sv)}), - Bytes3 = align(Bytes2), - getoctets_as_list(Bytes3,Len); - no -> - {Len,Bytes2} = decode_length(Bytes,undefined), - Bytes3 = align(Bytes2), - getoctets_as_list(Bytes3,Len) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Restricted char string types -%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) -%% X.691:26 and X.680:34-36 -%%encode_restricted_string(aligned,'BMPString',Constraints,Extension,Val) - -encode_restricted_string(aligned,StringType,C,Val) -> -encode_restricted_string(aligned,StringType,C,false,Val). - - -encode_restricted_string(aligned,StringType,C,_Ext,{Name,Val}) when atom(Name) -> - encode_restricted_string(aligned,StringType,C,false,Val); -encode_restricted_string(aligned,StringType,C,_Ext,Val) -> - Result = chars_encode(C,StringType,Val), - NumBits = get_NumBits(C,StringType), - case get_constraint(C,'SizeConstraint') of - Ub when integer(Ub), Ub*NumBits =< 16 -> - case {StringType,Result} of - {'BMPString',{octets,Ol}} -> - [{bits,8,Oct}||Oct <- Ol]; - _ -> - Result - end; - 0 -> - []; - Ub when integer(Ub),Ub =<65535 -> % fixed length - [align,Result]; - {Ub,Lb} -> - [encode_length({Ub,Lb},length(Val)),align,Result]; - Vl when list(Vl) -> - [encode_length({lists:min(Vl),lists:max(Vl)},length(Val)),align,Result]; - no -> - [encode_length(undefined,length(Val)),align,Result] - end. - -decode_restricted_string(Bytes,aligned,StringType,C) -> - decode_restricted_string(Bytes,aligned,StringType,C,false). - -decode_restricted_string(Bytes,aligned,StringType,C,_Ext) -> - NumBits = get_NumBits(C,StringType), - case get_constraint(C,'SizeConstraint') of - Ub when integer(Ub), Ub*NumBits =< 16 -> - chars_decode(Bytes,NumBits,StringType,C,Ub); - Ub when integer(Ub),Ub =<65535 -> % fixed length - Bytes1 = align(Bytes), - chars_decode(Bytes1,NumBits,StringType,C,Ub); - 0 -> - {[],Bytes}; - Vl when list(Vl) -> - {Len,Bytes1} = decode_length(Bytes,{hd(Vl),lists:max(Vl)}), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,C,Len); - no -> - {Len,Bytes1} = decode_length(Bytes,undefined), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,C,Len); - {Lb,Ub}-> - {Len,Bytes1} = decode_length(Bytes,{Lb,Ub}), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,C,Len) - end. - - - -encode_BMPString(C,Val) -> - encode_restricted_string(aligned,'BMPString',C,false,Val). -decode_BMPString(Bytes,C) -> - decode_restricted_string(Bytes,aligned,'BMPString',C,false). - -encode_GeneralString(C,Val) -> - encode_restricted_string(aligned,'GeneralString',C,false,Val). -decode_GeneralString(Bytes,C) -> - decode_restricted_string(Bytes,aligned,'GeneralString',C,false). - -encode_GraphicString(C,Val) -> - encode_restricted_string(aligned,'GraphicString',C,false,Val). -decode_GraphicString(Bytes,C) -> - decode_restricted_string(Bytes,aligned,'GraphicString',C,false). - -encode_IA5String(C,Val) -> - encode_restricted_string(aligned,'IA5String',C,false,Val). -decode_IA5String(Bytes,C) -> - decode_restricted_string(Bytes,aligned,'IA5String',C,false). - -encode_NumericString(C,Val) -> - encode_restricted_string(aligned,'NumericString',C,false,Val). -decode_NumericString(Bytes,C) -> - decode_restricted_string(Bytes,aligned,'NumericString',C,false). - -encode_PrintableString(C,Val) -> - encode_restricted_string(aligned,'PrintableString',C,false,Val). -decode_PrintableString(Bytes,C) -> - decode_restricted_string(Bytes,aligned,'PrintableString',C,false). - -encode_TeletexString(C,Val) -> % equivalent with T61String - encode_restricted_string(aligned,'TeletexString',C,false,Val). -decode_TeletexString(Bytes,C) -> - decode_restricted_string(Bytes,aligned,'TeletexString',C,false). - -encode_UniversalString(C,Val) -> - encode_restricted_string(aligned,'UniversalString',C,false,Val). -decode_UniversalString(Bytes,C) -> - decode_restricted_string(Bytes,aligned,'UniversalString',C,false). - -encode_VideotexString(C,Val) -> - encode_restricted_string(aligned,'VideotexString',C,false,Val). -decode_VideotexString(Bytes,C) -> - decode_restricted_string(Bytes,aligned,'VideotexString',C,false). - -encode_VisibleString(C,Val) -> % equivalent with ISO646String - encode_restricted_string(aligned,'VisibleString',C,false,Val). -decode_VisibleString(Bytes,C) -> - decode_restricted_string(Bytes,aligned,'VisibleString',C,false). - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% getBMPChars(Bytes,Len) ->{BMPcharList,RemainingBytes} -%% -getBMPChars(Bytes,1) -> - {O1,Bytes2} = getbits(Bytes,8), - {O2,Bytes3} = getbits(Bytes2,8), - if - O1 == 0 -> - {[O2],Bytes3}; - true -> - {[{O1,O2}],Bytes3} - end; -getBMPChars(Bytes,Len) -> - getBMPChars(Bytes,Len,[]). - -getBMPChars(Bytes,0,Acc) -> - {lists:reverse(Acc),Bytes}; -getBMPChars(Bytes,Len,Acc) -> - {Octs,Bytes1} = getoctets_as_list(Bytes,2), - case Octs of - [0,O2] -> - getBMPChars(Bytes1,Len-1,[O2|Acc]); - [O1,O2]-> - getBMPChars(Bytes1,Len-1,[{O1,O2}|Acc]) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% chars_encode(C,StringType,Value) -> ValueList -%% -%% encodes chars according to the per rules taking the constraint PermittedAlphabet -%% into account. -%% This function does only encode the value part and NOT the length - -chars_encode(C,StringType,Value) -> - case {StringType,get_constraint(C,'PermittedAlphabet')} of - {'UniversalString',{_,_Sv}} -> - exit({error,{asn1,{'not implemented',"UniversalString with PermittedAlphabet constraint"}}}); - {'BMPString',{_,_Sv}} -> - exit({error,{asn1,{'not implemented',"BMPString with PermittedAlphabet constraint"}}}); - _ -> - {NumBits,CharOutTab} = {get_NumBits(C,StringType),get_CharOutTab(C,StringType)}, - chars_encode2(Value,NumBits,CharOutTab) - end. - -chars_encode2([H|T],NumBits,{Min,Max,notab}) when H =< Max, H >= Min -> - [{bits,NumBits,H-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|T],NumBits,{Min,Max,Tab}) when H =< Max, H >= Min -> - [{bits,NumBits,element(H-Min+1,Tab)}|chars_encode2(T,NumBits,{Min,Max,Tab})]; -chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,notab}) -> - %% no value range check here (ought to be, but very expensive) - [{bits,NumBits,(A*B*C*D)-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> - %% no value range check here (ought to be, but very expensive) - [{bits,NumBits,element((A*B*C*D)-Min,Tab)}|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|_T],_NumBits,{_Min,_Max,_Tab}) -> - exit({error,{asn1,{illegal_char_value,H}}}); -chars_encode2([],_,_) -> - []. - - -get_NumBits(C,StringType) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} -> - charbits(length(Sv),aligned); - no -> - case StringType of - 'GeneralString' -> - exit({error,{asn1,{not implemented,'GeneralString'}}}); - 'GraphicString' -> - exit({error,{asn1,{not implemented,'GraphicString'}}}); - 'TeletexString' -> - exit({error,{asn1,{not implemented,'TeletexString'}}}); - 'VideotexString' -> - exit({error,{asn1,{not implemented,'VideotexString'}}}); - 'IA5String' -> - charbits(128,aligned); % 16#00..16#7F - 'VisibleString' -> - charbits(95,aligned); % 16#20..16#7E - 'PrintableString' -> - charbits(74,aligned); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z - 'NumericString' -> - charbits(11,aligned); % $ ,"0123456789" - 'UniversalString' -> - 32; - 'BMPString' -> - 16 - end - end. - -%%Maybe used later -%%get_MaxChar(C,StringType) -> -%% case get_constraint(C,'PermittedAlphabet') of -%% {'SingleValue',Sv} -> -%% lists:nth(length(Sv),Sv); -%% no -> -%% case StringType of -%% 'IA5String' -> -%% 16#7F; % 16#00..16#7F -%% 'VisibleString' -> -%% 16#7E; % 16#20..16#7E -%% 'PrintableString' -> -%% $z; % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z -%% 'NumericString' -> -%% $9; % $ ,"0123456789" -%% 'UniversalString' -> -%% 16#ffffffff; -%% 'BMPString' -> -%% 16#ffff -%% end -%% end. - -%%Maybe used later -%%get_MinChar(C,StringType) -> -%% case get_constraint(C,'PermittedAlphabet') of -%% {'SingleValue',Sv} -> -%% hd(Sv); -%% no -> -%% case StringType of -%% 'IA5String' -> -%% 16#00; % 16#00..16#7F -%% 'VisibleString' -> -%% 16#20; % 16#20..16#7E -%% 'PrintableString' -> -%% $\s; % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z -%% 'NumericString' -> -%% $\s; % $ ,"0123456789" -%% 'UniversalString' -> -%% 16#00; -%% 'BMPString' -> -%% 16#00 -%% end -%% end. - -get_CharOutTab(C,StringType) -> - get_CharTab(C,StringType,out). - -get_CharInTab(C,StringType) -> - get_CharTab(C,StringType,in). - -get_CharTab(C,StringType,InOut) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} -> - get_CharTab2(C,StringType,hd(Sv),lists:max(Sv),Sv,InOut); - no -> - case StringType of - 'IA5String' -> - {0,16#7F,notab}; - 'VisibleString' -> - get_CharTab2(C,StringType,16#20,16#7F,notab,InOut); - 'PrintableString' -> - Chars = lists:sort( - " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), - get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars,InOut); - 'NumericString' -> - get_CharTab2(C,StringType,16#20,$9," 0123456789",InOut); - 'UniversalString' -> - {0,16#FFFFFFFF,notab}; - 'BMPString' -> - {0,16#FFFF,notab} - end - end. - -get_CharTab2(C,StringType,Min,Max,Chars,InOut) -> - BitValMax = (1 bsl get_NumBits(C,StringType))-1, - if - Max =< BitValMax -> - {0,Max,notab}; - true -> - case InOut of - out -> - {Min,Max,create_char_tab(Min,Chars)}; - in -> - {Min,Max,list_to_tuple(Chars)} - end - end. - -create_char_tab(Min,L) -> - list_to_tuple(create_char_tab(Min,L,0)). -create_char_tab(Min,[Min|T],V) -> - [V|create_char_tab(Min+1,T,V+1)]; -create_char_tab(_Min,[],_V) -> - []; -create_char_tab(Min,L,V) -> - [false|create_char_tab(Min+1,L,V)]. - -%% This very inefficient and should be moved to compiletime -charbits(NumOfChars,aligned) -> - case charbits(NumOfChars) of - 1 -> 1; - 2 -> 2; - B when B > 2, B =< 4 -> 4; - B when B > 4, B =< 8 -> 8; - B when B > 8, B =< 16 -> 16; - B when B > 16, B =< 32 -> 32 - end. - -charbits(NumOfChars) when NumOfChars =< 2 -> 1; -charbits(NumOfChars) when NumOfChars =< 4 -> 2; -charbits(NumOfChars) when NumOfChars =< 8 -> 3; -charbits(NumOfChars) when NumOfChars =< 16 -> 4; -charbits(NumOfChars) when NumOfChars =< 32 -> 5; -charbits(NumOfChars) when NumOfChars =< 64 -> 6; -charbits(NumOfChars) when NumOfChars =< 128 -> 7; -charbits(NumOfChars) when NumOfChars =< 256 -> 8; -charbits(NumOfChars) when NumOfChars =< 512 -> 9; -charbits(NumOfChars) when NumOfChars =< 1024 -> 10; -charbits(NumOfChars) when NumOfChars =< 2048 -> 11; -charbits(NumOfChars) when NumOfChars =< 4096 -> 12; -charbits(NumOfChars) when NumOfChars =< 8192 -> 13; -charbits(NumOfChars) when NumOfChars =< 16384 -> 14; -charbits(NumOfChars) when NumOfChars =< 32768 -> 15; -charbits(NumOfChars) when NumOfChars =< 65536 -> 16; -charbits(NumOfChars) when integer(NumOfChars) -> - 16 + charbits1(NumOfChars bsr 16). - -charbits1(0) -> - 0; -charbits1(NumOfChars) -> - 1 + charbits1(NumOfChars bsr 1). - - -chars_decode(Bytes,_,'BMPString',C,Len) -> - case get_constraint(C,'PermittedAlphabet') of - no -> - getBMPChars(Bytes,Len); - _ -> - exit({error,{asn1, - {'not implemented', - "BMPString with PermittedAlphabet constraint"}}}) - end; -chars_decode(Bytes,NumBits,StringType,C,Len) -> - CharInTab = get_CharInTab(C,StringType), - chars_decode2(Bytes,CharInTab,NumBits,Len). - - -chars_decode2(Bytes,CharInTab,NumBits,Len) -> - chars_decode2(Bytes,CharInTab,NumBits,Len,[]). - -chars_decode2(Bytes,_CharInTab,_NumBits,0,Acc) -> - {lists:reverse(Acc),Bytes}; -chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) when NumBits > 8 -> - {Char,Bytes2} = getbits(Bytes,NumBits), - Result = case minimum_octets(Char+Min) of - [NewChar] -> NewChar; - [C1,C2] -> {0,0,C1,C2}; - [C1,C2,C3] -> {0,C1,C2,C3}; - [C1,C2,C3,C4] -> {C1,C2,C3,C4} - end, - chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Result|Acc]); -chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) -> - {Char,Bytes2} = getbits(Bytes,NumBits), - chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Char+Min|Acc]); - -%% BMPString and UniversalString with PermittedAlphabet is currently not supported -chars_decode2(Bytes,{Min,Max,CharInTab},NumBits,Len,Acc) -> - {Char,Bytes2} = getbits(Bytes,NumBits), - chars_decode2(Bytes2,{Min,Max,CharInTab},NumBits,Len -1,[element(Char+1,CharInTab)|Acc]). - - - % X.691:17 -encode_null({Name,Val}) when atom(Name) -> - encode_null(Val); -encode_null(_) -> []. % encodes to nothing - -decode_null(Bytes) -> - {'NULL',Bytes}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_object_identifier(Val) -> CompleteList -%% encode_object_identifier({Name,Val}) -> CompleteList -%% Val -> {Int1,Int2,...,IntN} % N >= 2 -%% Name -> atom() -%% Int1 -> integer(0..2) -%% Int2 -> integer(0..39) when Int1 (0..1) else integer() -%% Int3-N -> integer() -%% CompleteList -> [{bits,8,Val}|{octets,Ol}|align|...] -%% -encode_object_identifier(Val) -> - Octets = e_object_identifier(Val,notag), - [{debug,object_identifier},encode_length(undefined,length(Octets)),{octets,Octets}]. - -%% This code is copied from asn1_encode.erl (BER) and corrected and modified - -e_object_identifier({'OBJECT IDENTIFIER',V},DoTag) -> - e_object_identifier(V,DoTag); -e_object_identifier({Cname,V},DoTag) when atom(Cname),tuple(V) -> - e_object_identifier(tuple_to_list(V),DoTag); -e_object_identifier({Cname,V},DoTag) when atom(Cname),list(V) -> - e_object_identifier(V,DoTag); -e_object_identifier(V,DoTag) when tuple(V) -> - e_object_identifier(tuple_to_list(V),DoTag); - -% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) -e_object_identifier([E1,E2|Tail],_DoTag) when E1 =< 2 -> - Head = 40*E1 + E2, % weird - Res = e_object_elements([Head|Tail]), -% dotag(DoTag,[6],elength(length(Res)+1),[Head|Res]), - Res. - -e_object_elements([]) -> - []; -e_object_elements([H|T]) -> - lists:append(e_object_element(H),e_object_elements(T)). - -e_object_element(Num) when Num < 128 -> - [Num]; -% must be changed to handle more than 2 octets -e_object_element(Num) -> %% when Num < ??? - Left = ((Num band 2#11111110000000) bsr 7) bor 2#10000000, - Right = Num band 2#1111111 , - [Left,Right]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_object_identifier(Bytes) -> {ObjId,RemainingBytes} -%% ObjId -> {integer(),integer(),...} % at least 2 integers -%% RemainingBytes -> [integer()] when integer() (0..255) -decode_object_identifier(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - [First|Rest] = dec_subidentifiers(Octs,0,[]), - Idlist = if - First < 40 -> - [0,First|Rest]; - First < 80 -> - [1,First - 40|Rest]; - true -> - [2,First - 80|Rest] - end, - {list_to_tuple(Idlist),Bytes3}. - -dec_subidentifiers([H|T],Av,Al) when H >=16#80 -> - dec_subidentifiers(T,(Av bsl 7) + (H band 16#7F),Al); -dec_subidentifiers([H|T],Av,Al) -> - dec_subidentifiers(T,0,[(Av bsl 7) + H |Al]); -dec_subidentifiers([],_Av,Al) -> - lists:reverse(Al). - -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% complete(InList) -> ByteList -%% Takes a coded list with bits and bytes and converts it to a list of bytes -%% Should be applied as the last step at encode of a complete ASN.1 type -%% -complete(InList) when list(InList) -> - complete(InList,[],0); -complete(InList) -> - complete([InList],[],0). - -complete([{debug,_}|T], Acc, Acclen) -> - complete(T,Acc,Acclen); -complete([H|T],Acc,Acclen) when list(H) -> - complete(lists:concat([H,T]),Acc,Acclen); - - -complete([{octets,N,Val}|T],Acc,Acclen) when N =< 4 ,integer(Val) -> - Newval = case N of - 1 -> - Val4 = Val band 16#FF, - [Val4]; - 2 -> - Val3 = (Val bsr 8) band 16#FF, - Val4 = Val band 16#FF, - [Val3,Val4]; - 3 -> - Val2 = (Val bsr 16) band 16#FF, - Val3 = (Val bsr 8) band 16#FF, - Val4 = Val band 16#FF, - [Val2,Val3,Val4]; - 4 -> - Val1 = (Val bsr 24) band 16#FF, - Val2 = (Val bsr 16) band 16#FF, - Val3 = (Val bsr 8) band 16#FF, - Val4 = Val band 16#FF, - [Val1,Val2,Val3,Val4] - end, - complete([{octets,Newval}|T],Acc,Acclen); - -complete([{octets,Oct}|T],[],_Acclen) when list(Oct) -> - complete(T,lists:reverse(Oct),0); -complete([{octets,Oct}|T],[Hacc|Tacc],Acclen) when list(Oct) -> - Rest = 8 - Acclen, - if - Rest == 8 -> - complete(T,lists:concat([lists:reverse(Oct),[Hacc|Tacc]]),0); - true -> - complete(T,lists:concat([lists:reverse(Oct),[Hacc bsl Rest|Tacc]]),0) - end; - -complete([{bit,Val}|T], Acc, Acclen) -> - complete([{bits,1,Val}|T],Acc,Acclen); -complete([{octet,Val}|T], Acc, Acclen) -> - complete([{octets,1,Val}|T],Acc,Acclen); - -complete([{bits,N,Val}|T], Acc, 0) when N =< 8 -> - complete(T,[Val|Acc],N); -complete([{bits,N,Val}|T], [Hacc|Tacc], Acclen) when N =< 8 -> - Rest = 8 - Acclen, - if - Rest >= N -> - complete(T,[(Hacc bsl N) + Val|Tacc],(Acclen+N) rem 8); - true -> - Diff = N - Rest, - NewHacc = (Hacc bsl Rest) + (Val bsr Diff), - Mask = element(Diff,{1,3,7,15,31,63,127,255}), - complete(T,[(Val band Mask),NewHacc|Tacc],(Acclen+N) rem 8) - end; -complete([{bits,N,Val}|T], Acc, Acclen) -> % N > 8 - complete([{bits,N-8,Val bsr 8},{bits,8,Val band 255}|T],Acc,Acclen); - -complete([align|T],Acc,0) -> - complete(T,Acc,0); -complete([align|T],[Hacc|Tacc],Acclen) -> - Rest = 8 - Acclen, - complete(T,[Hacc bsl Rest|Tacc],0); -complete([{octets,_N,Val}|T],Acc,Acclen) when list(Val) -> % no security check here - complete([{octets,Val}|T],Acc,Acclen); -complete([],Acc,0) -> - lists:reverse(Acc); -complete([],[Hacc|Tacc],Acclen) when Acclen > 0-> - Rest = 8 - Acclen, - NewHacc = Hacc bsl Rest, - lists:reverse([NewHacc|Tacc]). - - - - - - - - - - - - - - - - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_per_bin.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_per_bin.erl deleted file mode 100644 index 08a78165a2..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_per_bin.erl +++ /dev/null @@ -1,2182 +0,0 @@ -%% ``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: asn1rt_per_bin.erl,v 1.1 2008/12/17 09:53:31 mikpe Exp $ -%% --module(asn1rt_per_bin). - -%% encoding / decoding of PER aligned - --include("asn1_records.hrl"). - --export([dec_fixup/3, cindex/3, list_to_record/2]). --export([setchoiceext/1, setext/1, fixoptionals/2, fixoptionals/3, - fixextensions/2, - getext/1, getextension/2, skipextensions/3, getbit/1, getchoice/3 ]). --export([getoptionals/2, getoptionals2/2, set_choice/3, encode_integer/2, encode_integer/3 ]). --export([decode_integer/2, decode_integer/3, encode_small_number/1, encode_boolean/1, - decode_boolean/1, encode_length/2, decode_length/1, decode_length/2, - encode_small_length/1, decode_small_length/1, - decode_compact_bit_string/3]). --export([decode_enumerated/3, - encode_bit_string/3, decode_bit_string/3 ]). --export([encode_octet_string/2, decode_octet_string/2, - encode_null/1, decode_null/1, - encode_object_identifier/1, decode_object_identifier/1, - complete/1]). - - --export([encode_open_type/2, decode_open_type/2]). - --export([encode_UniversalString/2, decode_UniversalString/2, - encode_PrintableString/2, decode_PrintableString/2, - encode_GeneralString/2, decode_GeneralString/2, - encode_GraphicString/2, decode_GraphicString/2, - encode_TeletexString/2, decode_TeletexString/2, - encode_VideotexString/2, decode_VideotexString/2, - encode_VisibleString/2, decode_VisibleString/2, - encode_BMPString/2, decode_BMPString/2, - encode_IA5String/2, decode_IA5String/2, - encode_NumericString/2, decode_NumericString/2, - encode_ObjectDescriptor/2, decode_ObjectDescriptor/1 - ]). --export([complete_bytes/1]). - --define('16K',16384). --define('32K',32768). --define('64K',65536). - -dec_fixup(Terms,Cnames,RemBytes) -> - dec_fixup(Terms,Cnames,RemBytes,[]). - -dec_fixup([novalue|T],[_Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,Acc); -dec_fixup([{_Name,novalue}|T],[_Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,Acc); -dec_fixup([H|T],[Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,[{Hc,H}|Acc]); -dec_fixup([],_Cnames,RemBytes,Acc) -> - {lists:reverse(Acc),RemBytes}. - -cindex(Ix,Val,Cname) -> - case element(Ix,Val) of - {Cname,Val2} -> Val2; - X -> X - end. - -%% converts a list to a record if necessary -list_to_record(_Name,Tuple) when tuple(Tuple) -> - Tuple; -list_to_record(Name,List) when list(List) -> - list_to_tuple([Name|List]). - -%%-------------------------------------------------------- -%% setchoiceext(InRootSet) -> [{bit,X}] -%% X is set to 1 when InRootSet==false -%% X is set to 0 when InRootSet==true -%% -setchoiceext(true) -> - [{debug,choiceext},{bits,1,0}]; -setchoiceext(false) -> - [{debug,choiceext},{bits,1,1}]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% setext(true|false) -> CompleteList -%% - -setext(false) -> - [{debug,ext},{bits,1,0}]; -setext(true) -> - [{debug,ext},{bits,1,1}]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% This version of fixoptionals/2 are left only because of -%% backward compatibility with older generates - -fixoptionals(OptList,Val) when tuple(Val) -> - fixoptionals1(OptList,Val,[]); - -fixoptionals(OptList,Val) when list(Val) -> - fixoptionals1(OptList,Val,1,[],[]). - -fixoptionals1([],Val,Acc) -> - %% return {Val,Opt} - {Val,lists:reverse(Acc)}; -fixoptionals1([{_,Pos}|Ot],Val,Acc) -> - case element(Pos+1,Val) of - asn1_NOVALUE -> fixoptionals1(Ot,Val,[0|Acc]); - asn1_DEFAULT -> fixoptionals1(Ot,Val,[0|Acc]); - _ -> fixoptionals1(Ot,Val,[1|Acc]) - end. - - -fixoptionals1([{Name,Pos}|Ot],[{Name,Val}|Vt],_Opt,Acc1,Acc2) -> - fixoptionals1(Ot,Vt,Pos+1,[1|Acc1],[{Name,Val}|Acc2]); -fixoptionals1([{_Name,Pos}|Ot],V,Pos,Acc1,Acc2) -> - fixoptionals1(Ot,V,Pos+1,[0|Acc1],[asn1_NOVALUE|Acc2]); -fixoptionals1(O,[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals1(O,Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals1([],[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals1([],Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals1([],[],_,Acc1,Acc2) -> - % return {Val,Opt} - {list_to_tuple([asn1_RECORDNAME|lists:reverse(Acc2)]),lists:reverse(Acc1)}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% This is the new fixoptionals/3 which is used by the new generates -%% -fixoptionals(OptList,OptLength,Val) when tuple(Val) -> - Bits = fixoptionals(OptList,Val,0), - {Val,{bits,OptLength,Bits}}; - -fixoptionals([],_Val,Acc) -> - %% Optbits - Acc; -fixoptionals([Pos|Ot],Val,Acc) -> - case element(Pos,Val) of - asn1_NOVALUE -> fixoptionals(Ot,Val,Acc bsl 1); - asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); - _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) - end. - - -getext(Bytes) when tuple(Bytes) -> - getbit(Bytes); -getext(Bytes) when binary(Bytes) -> - getbit({0,Bytes}); -getext(Bytes) when list(Bytes) -> - getbit({0,Bytes}). - -getextension(0, Bytes) -> - {{},Bytes}; -getextension(1, Bytes) -> - {Len,Bytes2} = decode_small_length(Bytes), - {Blist, Bytes3} = getbits_as_list(Len,Bytes2), - {list_to_tuple(Blist),Bytes3}. - -fixextensions({ext,ExtPos,ExtNum},Val) -> - case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of - 0 -> []; - ExtBits -> - [encode_small_length(ExtNum),{bits,ExtNum,ExtBits}] - end. - -fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> - Acc; -fixextensions(Pos,ExtPos,Val,Acc) -> - Bit = case catch(element(Pos+1,Val)) of - asn1_NOVALUE -> - 0; - asn1_NOEXTVALUE -> - 0; - {'EXIT',_} -> - 0; - _ -> - 1 - end, - fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). - -skipextensions(Bytes,Nr,ExtensionBitPattern) -> - case (catch element(Nr,ExtensionBitPattern)) of - 1 -> - {_,Bytes2} = decode_open_type(Bytes,[]), - skipextensions(Bytes2, Nr+1, ExtensionBitPattern); - 0 -> - skipextensions(Bytes, Nr+1, ExtensionBitPattern); - {'EXIT',_} -> % badarg, no more extensions - Bytes - end. - - -getchoice(Bytes,1,0) -> % only 1 alternative is not encoded - {0,Bytes}; -getchoice(Bytes,_,1) -> - decode_small_number(Bytes); -getchoice(Bytes,NumChoices,0) -> - decode_constrained_number(Bytes,{0,NumChoices-1}). - -%% old version kept for backward compatibility with generates from R7B -getoptionals(Bytes,NumOpt) -> - {Blist,Bytes1} = getbits_as_list(NumOpt,Bytes), - {list_to_tuple(Blist),Bytes1}. - -%% new version used in generates from r8b_patch/3 and later -getoptionals2(Bytes,NumOpt) -> - getbits(Bytes,NumOpt). - - -%% getbits_as_binary(Num,Bytes) -> {{Unused,BinBits},RestBytes}, -%% Num = integer(), -%% Bytes = list() | tuple(), -%% Unused = integer(), -%% BinBits = binary(), -%% RestBytes = tuple() -getbits_as_binary(Num,Bytes) when binary(Bytes) -> - getbits_as_binary(Num,{0,Bytes}); -getbits_as_binary(0,Buffer) -> - {{0,<<>>},Buffer}; -getbits_as_binary(Num,{0,Bin}) when Num > 16 -> - Used = Num rem 8, - Pad = (8 - Used) rem 8, -% Nbytes = Num div 8, - <<Bits:Num,_:Pad,RestBin/binary>> = Bin, - {{Pad,<<Bits:Num,0:Pad>>},RestBin}; -getbits_as_binary(Num,Buffer={_Used,_Bin}) -> % Unaligned buffer - %% Num =< 16, - {Bits2,Buffer2} = getbits(Buffer,Num), - Pad = (8 - (Num rem 8)) rem 8, - {{Pad,<<Bits2:Num,0:Pad>>},Buffer2}. - - -% integer_from_list(Int,[],BigInt) -> -% BigInt; -% integer_from_list(Int,[H|T],BigInt) when Int < 8 -> -% (BigInt bsl Int) bor (H bsr (8-Int)); -% integer_from_list(Int,[H|T],BigInt) -> -% integer_from_list(Int-8,T,(BigInt bsl 8) bor H). - -getbits_as_list(Num,Bytes) when binary(Bytes) -> - getbits_as_list(Num,{0,Bytes},[]); -getbits_as_list(Num,Bytes) -> - getbits_as_list(Num,Bytes,[]). - -%% If buffer is empty and nothing more will be picked. -getbits_as_list(0, B, Acc) -> - {lists:reverse(Acc),B}; -%% If first byte in buffer is full and at least one byte will be picked, -%% then pick one byte. -getbits_as_list(N,{0,Bin},Acc) when N >= 8 -> - <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,Rest/binary>> = Bin, - getbits_as_list(N-8,{0,Rest},[B0,B1,B2,B3,B4,B5,B6,B7|Acc]); -getbits_as_list(N,{Used,Bin},Acc) when N >= 4, Used =< 4 -> - NewUsed = Used + 4, - Rem = 8 - NewUsed, - <<_:Used,B3:1,B2:1,B1:1,B0:1,_:Rem, Rest/binary>> = Bin, - NewRest = case Rem of 0 -> Rest; _ -> Bin end, - getbits_as_list(N-4,{NewUsed rem 8,NewRest},[B0,B1,B2,B3|Acc]); -getbits_as_list(N,{Used,Bin},Acc) when N >= 2, Used =< 6 -> - NewUsed = Used + 2, - Rem = 8 - NewUsed, - <<_:Used,B1:1,B0:1,_:Rem, Rest/binary>> = Bin, - NewRest = case Rem of 0 -> Rest; _ -> Bin end, - getbits_as_list(N-2,{NewUsed rem 8,NewRest},[B0,B1|Acc]); -getbits_as_list(N,{Used,Bin},Acc) when Used =< 7 -> - NewUsed = Used + 1, - Rem = 8 - NewUsed, - <<_:Used,B0:1,_:Rem, Rest/binary>> = Bin, - NewRest = case Rem of 0 -> Rest; _ -> Bin end, - getbits_as_list(N-1,{NewUsed rem 8,NewRest},[B0|Acc]). - - -getbit({7,<<_:7,B:1,Rest/binary>>}) -> - {B,{0,Rest}}; -getbit({0,Buffer = <<B:1,_:7,_/binary>>}) -> - {B,{1,Buffer}}; -getbit({Used,Buffer}) -> - Unused = (8 - Used) - 1, - <<_:Used,B:1,_:Unused,_/binary>> = Buffer, - {B,{Used+1,Buffer}}; -getbit(Buffer) when binary(Buffer) -> - getbit({0,Buffer}). - - -getbits({0,Buffer},Num) when (Num rem 8) == 0 -> - <<Bits:Num,Rest/binary>> = Buffer, - {Bits,{0,Rest}}; -getbits({Used,Bin},Num) -> - NumPlusUsed = Num + Used, - NewUsed = NumPlusUsed rem 8, - Unused = (8-NewUsed) rem 8, - case Unused of - 0 -> - <<_:Used,Bits:Num,Rest/binary>> = Bin, - {Bits,{0,Rest}}; - _ -> - Bytes = NumPlusUsed div 8, - <<_:Used,Bits:Num,_UBits:Unused,_/binary>> = Bin, - <<_:Bytes/binary,Rest/binary>> = Bin, - {Bits,{NewUsed,Rest}} - end; -getbits(Bin,Num) when binary(Bin) -> - getbits({0,Bin},Num). - - - -% getoctet(Bytes) when list(Bytes) -> -% getoctet({0,Bytes}); -% getoctet(Bytes) -> -% %% io:format("getoctet:Buffer = ~p~n",[Bytes]), -% getoctet1(Bytes). - -% getoctet1({0,[H|T]}) -> -% {H,{0,T}}; -% getoctet1({Pos,[_,H|T]}) -> -% {H,{0,T}}. - -align({0,L}) -> - {0,L}; -align({_Pos,<<_H,T/binary>>}) -> - {0,T}; -align(Bytes) -> - {0,Bytes}. - -%% First align buffer, then pick the first Num octets. -%% Returns octets as an integer with bit significance as in buffer. -getoctets({0,Buffer},Num) -> - <<Val:Num/integer-unit:8,RestBin/binary>> = Buffer, - {Val,{0,RestBin}}; -getoctets({U,<<_Padding,Rest/binary>>},Num) when U /= 0 -> - getoctets({0,Rest},Num); -getoctets(Buffer,Num) when binary(Buffer) -> - getoctets({0,Buffer},Num). -% getoctets(Buffer,Num) -> -% %% io:format("getoctets:Buffer = ~p~nNum = ~p~n",[Buffer,Num]), -% getoctets(Buffer,Num,0). - -% getoctets(Buffer,0,Acc) -> -% {Acc,Buffer}; -% getoctets(Buffer,Num,Acc) -> -% {Oct,NewBuffer} = getoctet(Buffer), -% getoctets(NewBuffer,Num-1,(Acc bsl 8)+Oct). - -% getoctets_as_list(Buffer,Num) -> -% getoctets_as_list(Buffer,Num,[]). - -% getoctets_as_list(Buffer,0,Acc) -> -% {lists:reverse(Acc),Buffer}; -% getoctets_as_list(Buffer,Num,Acc) -> -% {Oct,NewBuffer} = getoctet(Buffer), -% getoctets_as_list(NewBuffer,Num-1,[Oct|Acc]). - -%% First align buffer, then pick the first Num octets. -%% Returns octets as a binary -getoctets_as_bin({0,Bin},Num)-> - <<Octets:Num/binary,RestBin/binary>> = Bin, - {Octets,{0,RestBin}}; -getoctets_as_bin({_U,Bin},Num) -> - <<_Padding,Octets:Num/binary,RestBin/binary>> = Bin, - {Octets,{0,RestBin}}; -getoctets_as_bin(Bin,Num) when binary(Bin) -> - getoctets_as_bin({0,Bin},Num). - -%% same as above but returns octets as a List -getoctets_as_list(Buffer,Num) -> - {Bin,Buffer2} = getoctets_as_bin(Buffer,Num), - {binary_to_list(Bin),Buffer2}. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings -%% Alt = atom() -%% Altnum = integer() | {integer(),integer()}% number of alternatives -%% Choices = [atom()] | {[atom()],[atom()]} -%% When Choices is a tuple the first list is the Rootset and the -%% second is the Extensions and then Altnum must also be a tuple with the -%% lengths of the 2 lists -%% -set_choice(Alt,{L1,L2},{Len1,_Len2}) -> - case set_choice_tag(Alt,L1) of - N when integer(N), Len1 > 1 -> - [{bits,1,0}, % the value is in the root set - encode_integer([{'ValueRange',{0,Len1-1}}],N)]; - N when integer(N) -> - [{bits,1,0}]; % no encoding if only 0 or 1 alternative - false -> - [{bits,1,1}, % extension value - case set_choice_tag(Alt,L2) of - N2 when integer(N2) -> - encode_small_number(N2); - false -> - unknown_choice_alt - end] - end; -set_choice(Alt,L,Len) -> - case set_choice_tag(Alt,L) of - N when integer(N), Len > 1 -> - encode_integer([{'ValueRange',{0,Len-1}}],N); - N when integer(N) -> - []; % no encoding if only 0 or 1 alternative - false -> - [unknown_choice_alt] - end. - -set_choice_tag(Alt,Choices) -> - set_choice_tag(Alt,Choices,0). - -set_choice_tag(Alt,[Alt|_Rest],Tag) -> - Tag; -set_choice_tag(Alt,[_H|Rest],Tag) -> - set_choice_tag(Alt,Rest,Tag+1); -set_choice_tag(_Alt,[],_Tag) -> - false. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_fragmented_XXX; decode of values encoded fragmented according -%% to ITU-T X.691 clause 10.9.3.8. The unit (XXX) is either bits, octets, -%% characters or number of components (in a choice,sequence or similar). -%% Buffer is a buffer {Used, Bin}. -%% C is the constrained length. -%% If the buffer is not aligned, this function does that. -decode_fragmented_bits({0,Buffer},C) -> - decode_fragmented_bits(Buffer,C,[]); -decode_fragmented_bits({_N,<<_,Bs/binary>>},C) -> - decode_fragmented_bits(Bs,C,[]). - -decode_fragmented_bits(<<3:2,Len:6,Bin/binary>>,C,Acc) -> - {Value,Bin2} = split_binary(Bin, Len * ?'16K'), - decode_fragmented_bits(Bin2,C,[Value,Acc]); -decode_fragmented_bits(<<0:1,0:7,Bin/binary>>,C,Acc) -> - BinBits = list_to_binary(lists:reverse(Acc)), - case C of - Int when integer(Int),C == size(BinBits) -> - {BinBits,{0,Bin}}; - Int when integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinBits}}}); - _ -> - {BinBits,{0,Bin}} - end; -decode_fragmented_bits(<<0:1,Len:7,Bin/binary>>,C,Acc) -> - Result = {BinBits,{Used,_Rest}} = - case (Len rem 8) of - 0 -> - <<Value:Len/binary-unit:1,Bin2/binary>> = Bin, - {list_to_binary(lists:reverse([Value|Acc])),{0,Bin2}}; - Rem -> - Bytes = Len div 8, - U = 8 - Rem, - <<Value:Bytes/binary-unit:8,Bits1:Rem,Bits2:U,Bin2/binary>> = Bin, - {list_to_binary(lists:reverse([Bits1 bsl U,Value|Acc])), - {Rem,<<Bits2,Bin2/binary>>}} - end, - case C of - Int when integer(Int),C == (size(BinBits) - ((8 - Used) rem 8)) -> - Result; - Int when integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinBits}}}); - _ -> - Result - end. - - -decode_fragmented_octets({0,Bin},C) -> - decode_fragmented_octets(Bin,C,[]); -decode_fragmented_octets({_N,<<_,Bs/binary>>},C) -> - decode_fragmented_octets(Bs,C,[]). - -decode_fragmented_octets(<<3:2,Len:6,Bin/binary>>,C,Acc) -> - {Value,Bin2} = split_binary(Bin,Len * ?'16K'), - decode_fragmented_octets(Bin2,C,[Value,Acc]); -decode_fragmented_octets(<<0:1,0:7,Bin/binary>>,C,Acc) -> - Octets = list_to_binary(lists:reverse(Acc)), - case C of - Int when integer(Int), C == size(Octets) -> - {Octets,{0,Bin}}; - Int when integer(Int) -> - exit({error,{asn1,{illegal_value,C,Octets}}}); - _ -> - {Octets,{0,Bin}} - end; -decode_fragmented_octets(<<0:1,Len:7,Bin/binary>>,C,Acc) -> - <<Value:Len/binary-unit:8,Bin2/binary>> = Bin, - BinOctets = list_to_binary(lists:reverse([Value|Acc])), - case C of - Int when integer(Int),size(BinOctets) == Int -> - {BinOctets,Bin2}; - Int when integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinOctets}}}); - _ -> - {BinOctets,Bin2} - end. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_open_type(Constraint, Value) -> CompleteList -%% Value = list of bytes of an already encoded value (the list must be flat) -%% | binary -%% Contraint = not used in this version -%% -encode_open_type(_C, Val) when list(Val) -> - Bin = list_to_binary(Val), - [encode_length(undefined,size(Bin)),{octets,Bin}]; % octets implies align -encode_open_type(_C, Val) when binary(Val) -> - [encode_length(undefined,size(Val)),{octets,Val}]. % octets implies align -%% the binary_to_list is not optimal but compatible with the current solution - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_open_type(Buffer,Constraint) -> Value -%% Constraint is not used in this version -%% Buffer = [byte] with PER encoded data -%% Value = [byte] with decoded data (which must be decoded again as some type) -%% -decode_open_type(Bytes, _C) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_bin(Bytes2,Len). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_integer(Constraint,Value,NamedNumberList) -> CompleteList -%% encode_integer(Constraint,Value) -> CompleteList -%% encode_integer(Constraint,{Name,Value}) -> CompleteList -%% -%% -encode_integer(C,V,NamedNumberList) when atom(V) -> - case lists:keysearch(V,1,NamedNumberList) of - {value,{_,NewV}} -> - encode_integer(C,NewV); - _ -> - exit({error,{asn1,{namednumber,V}}}) - end; -encode_integer(C,V,_NamedNumberList) when integer(V) -> - encode_integer(C,V); -encode_integer(C,{Name,V},NamedNumberList) when atom(Name) -> - encode_integer(C,V,NamedNumberList). - -encode_integer(C,{Name,Val}) when atom(Name) -> - encode_integer(C,Val); - -encode_integer([{Rc,_Ec}],Val) when tuple(Rc) -> % XXX when is this invoked? First argument most often a list,...Ok this is the extension case...but it doesn't work. - case (catch encode_integer([Rc],Val)) of - {'EXIT',{error,{asn1,_}}} -> - [{bits,1,1},encode_unconstrained_number(Val)]; - Encoded -> - [{bits,1,0},Encoded] - end; -encode_integer(C,Val ) when list(C) -> - case get_constraint(C,'SingleValue') of - no -> - encode_integer1(C,Val); - V when integer(V),V == Val -> - []; % a type restricted to a single value encodes to nothing - V when list(V) -> - case lists:member(Val,V) of - true -> - encode_integer1(C,Val); - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end; - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end. - -encode_integer1(C, Val) -> - case VR = get_constraint(C,'ValueRange') of - no -> - encode_unconstrained_number(Val); - {Lb,'MAX'} -> - encode_semi_constrained_number(Lb,Val); - %% positive with range - {Lb,Ub} when Val >= Lb, - Ub >= Val -> - encode_constrained_number(VR,Val); - _ -> - exit({error,{asn1,{illegal_value,VR,Val}}}) - end. - -decode_integer(Buffer,Range,NamedNumberList) -> - {Val,Buffer2} = decode_integer(Buffer,Range), - case lists:keysearch(Val,2,NamedNumberList) of - {value,{NewVal,_}} -> {NewVal,Buffer2}; - _ -> {Val,Buffer2} - end. - -decode_integer(Buffer,[{Rc,_Ec}]) when tuple(Rc) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> decode_integer(Buffer2,[Rc]); - 1 -> decode_unconstrained_number(Buffer2) - end; -decode_integer(Buffer,undefined) -> - decode_unconstrained_number(Buffer); -decode_integer(Buffer,C) -> - case get_constraint(C,'SingleValue') of - V when integer(V) -> - {V,Buffer}; - V when list(V) -> - {Val,Buffer2} = decode_integer1(Buffer,C), - case lists:member(Val,V) of - true -> - {Val,Buffer2}; - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end; - _ -> - decode_integer1(Buffer,C) - end. - -decode_integer1(Buffer,C) -> - case VR = get_constraint(C,'ValueRange') of - no -> - decode_unconstrained_number(Buffer); - {Lb, 'MAX'} -> - decode_semi_constrained_number(Buffer,Lb); - {_,_} -> - decode_constrained_number(Buffer,VR) - end. - - % X.691:10.6 Encoding of a normally small non-negative whole number - % Use this for encoding of CHOICE index if there is an extension marker in - % the CHOICE -encode_small_number({Name,Val}) when atom(Name) -> - encode_small_number(Val); -encode_small_number(Val) when Val =< 63 -> -% [{bits,1,0},{bits,6,Val}]; - [{bits,7,Val}]; % same as above but more efficient -encode_small_number(Val) -> - [{bits,1,1},encode_semi_constrained_number(0,Val)]. - -decode_small_number(Bytes) -> - {Bit,Bytes2} = getbit(Bytes), - case Bit of - 0 -> - getbits(Bytes2,6); - 1 -> - decode_semi_constrained_number(Bytes2,0) - end. - -%% X.691:10.7 Encoding of a semi-constrained whole number -%% might be an optimization encode_semi_constrained_number(0,Val) -> -encode_semi_constrained_number(C,{Name,Val}) when atom(Name) -> - encode_semi_constrained_number(C,Val); -encode_semi_constrained_number({Lb,'MAX'},Val) -> - encode_semi_constrained_number(Lb,Val); -encode_semi_constrained_number(Lb,Val) -> - Val2 = Val - Lb, - Oct = eint_positive(Val2), - Len = length(Oct), - if - Len < 128 -> - {octets,[Len|Oct]}; % equiv with encode_length(undefined,Len) but faster - true -> - [encode_length(undefined,Len),{octets,Oct}] - end. - -decode_semi_constrained_number(Bytes,{Lb,_}) -> - decode_semi_constrained_number(Bytes,Lb); -decode_semi_constrained_number(Bytes,Lb) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {V,Bytes3} = getoctets(Bytes2,Len), - {V+Lb,Bytes3}. - -encode_constrained_number(Range,{Name,Val}) when atom(Name) -> - encode_constrained_number(Range,Val); -encode_constrained_number({Lb,Ub},Val) when Val >= Lb, Ub >= Val -> - Range = Ub - Lb + 1, - Val2 = Val - Lb, - if - Range == 2 -> - {bits,1,Val2}; - Range =< 4 -> - {bits,2,Val2}; - Range =< 8 -> - {bits,3,Val2}; - Range =< 16 -> - {bits,4,Val2}; - Range =< 32 -> - {bits,5,Val2}; - Range =< 64 -> - {bits,6,Val2}; - Range =< 128 -> - {bits,7,Val2}; - Range =< 255 -> - {bits,8,Val2}; - Range =< 256 -> - {octets,[Val2]}; - Range =< 65536 -> - {octets,<<Val2:16>>}; - Range =< 16#1000000 -> - Octs = eint_positive(Val2), - [{bits,2,length(Octs)-1},{octets,Octs}]; - Range =< 16#100000000 -> - Octs = eint_positive(Val2), - [{bits,2,length(Octs)-1},{octets,Octs}]; - Range =< 16#10000000000 -> - Octs = eint_positive(Val2), - [{bits,3,length(Octs)-1},{octets,Octs}]; - true -> - exit({not_supported,{integer_range,Range}}) - end; -encode_constrained_number(Range,Val) -> - exit({error,{asn1,{integer_range,Range,value,Val}}}). - - -decode_constrained_number(Buffer,{Lb,Ub}) -> - Range = Ub - Lb + 1, - % Val2 = Val - Lb, - {Val,Remain} = - if - Range == 2 -> - getbits(Buffer,1); - Range =< 4 -> - getbits(Buffer,2); - Range =< 8 -> - getbits(Buffer,3); - Range =< 16 -> - getbits(Buffer,4); - Range =< 32 -> - getbits(Buffer,5); - Range =< 64 -> - getbits(Buffer,6); - Range =< 128 -> - getbits(Buffer,7); - Range =< 255 -> - getbits(Buffer,8); - Range =< 256 -> - getoctets(Buffer,1); - Range =< 65536 -> - getoctets(Buffer,2); - Range =< 16#1000000 -> - {Len,Bytes2} = decode_length(Buffer,{1,3}), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_pos_integer(Octs),Bytes3}; - Range =< 16#100000000 -> - {Len,Bytes2} = decode_length(Buffer,{1,4}), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_pos_integer(Octs),Bytes3}; - Range =< 16#10000000000 -> - {Len,Bytes2} = decode_length(Buffer,{1,5}), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_pos_integer(Octs),Bytes3}; - true -> - exit({not_supported,{integer_range,Range}}) - end, - {Val+Lb,Remain}. - -%% X.691:10.8 Encoding of an unconstrained whole number - -encode_unconstrained_number(Val) when Val >= 0 -> - Oct = eint(Val,[]), - Len = length(Oct), - if - Len < 128 -> - {octets,[Len|Oct]}; % equiv with encode_length(undefined,Len) but faster - true -> - [encode_length(undefined,Len),{octets,Oct}] - end; -encode_unconstrained_number(Val) -> % negative - Oct = enint(Val,[]), - Len = length(Oct), - if - Len < 128 -> - {octets,[Len|Oct]}; % equiv with encode_length(undefined,Len) but faster - true -> - [encode_length(undefined,Len),{octets,Oct}] - end. - - -%% used for positive Values which don't need a sign bit -%% returns a binary -eint_positive(Val) -> - case eint(Val,[]) of - [0,B1|T] -> - [B1|T]; - T -> - T - end. - - -eint(0, [B|Acc]) when B < 128 -> - [B|Acc]; -eint(N, Acc) -> - eint(N bsr 8, [N band 16#ff| Acc]). - -enint(-1, [B1|T]) when B1 > 127 -> - [B1|T]; -enint(N, Acc) -> - enint(N bsr 8, [N band 16#ff|Acc]). - -decode_unconstrained_number(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Ints,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_integer(Ints),Bytes3}. - -dec_pos_integer(Ints) -> - decpint(Ints, 8 * (length(Ints) - 1)). -dec_integer(Ints) when hd(Ints) band 255 =< 127 -> %% Positive number - decpint(Ints, 8 * (length(Ints) - 1)); -dec_integer(Ints) -> %% Negative - decnint(Ints, 8 * (length(Ints) - 1)). - -decpint([Byte|Tail], Shift) -> - (Byte bsl Shift) bor decpint(Tail, Shift-8); -decpint([], _) -> 0. - -decnint([Byte|Tail], Shift) -> - (-128 + (Byte band 127) bsl Shift) bor decpint(Tail, Shift-8). - -% minimum_octets(Val) -> -% minimum_octets(Val,[]). - -% minimum_octets(Val,Acc) when Val > 0 -> -% minimum_octets((Val bsr 8),[Val band 16#FF|Acc]); -% minimum_octets(0,Acc) -> -% Acc. - - -%% X.691:10.9 Encoding of a length determinant -%%encode_small_length(undefined,Len) -> % null means no UpperBound -%% encode_small_number(Len). - -%% X.691:10.9.3.5 -%% X.691:10.9.3.7 -encode_length(undefined,Len) -> % un-constrained - if - Len < 128 -> - {octets,[Len]}; - Len < 16384 -> - {octets,<<2:2,Len:14>>}; - true -> % should be able to endode length >= 16384 - exit({error,{asn1,{encode_length,{nyi,above_16k}}}}) - end; - -encode_length({0,'MAX'},Len) -> - encode_length(undefined,Len); -encode_length(Vr={Lb,Ub},Len) when Ub =< 65535 ,Lb >= 0 -> % constrained - encode_constrained_number(Vr,Len); -encode_length({Lb,_Ub},Len) when integer(Lb), Lb >= 0 -> % Ub > 65535 - encode_length(undefined,Len); -encode_length({Vr={Lb,Ub},[]},Len) when Ub =< 65535 ,Lb >= 0 -> - %% constrained extensible - [{bits,1,0},encode_constrained_number(Vr,Len)]; -encode_length(SingleValue,_Len) when integer(SingleValue) -> - []. - -%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension -%% additions in a sequence or set -encode_small_length(Len) when Len =< 64 -> -%% [{bits,1,0},{bits,6,Len-1}]; - {bits,7,Len-1}; % the same as above but more efficient -encode_small_length(Len) -> - [{bits,1,1},encode_length(undefined,Len)]. - -% decode_small_length({Used,<<_:Used,0:1,Num:6,_:((8-Used+1) rem 8),Rest/binary>>}) -> -% case Buffer of -% <<_:Used,0:1,Num:6,_:((8-Used+1) rem 8),Rest/binary>> -> -% {Num, -% case getbit(Buffer) of -% {0,Remain} -> -% {Bits,Remain2} = getbits(Remain,6), -% {Bits+1,Remain2}; -% {1,Remain} -> -% decode_length(Remain,undefined) -% end. - -decode_small_length(Buffer) -> - case getbit(Buffer) of - {0,Remain} -> - {Bits,Remain2} = getbits(Remain,6), - {Bits+1,Remain2}; - {1,Remain} -> - decode_length(Remain,undefined) - end. - -decode_length(Buffer) -> - decode_length(Buffer,undefined). - -decode_length(Buffer,undefined) -> % un-constrained - {0,Buffer2} = align(Buffer), - case Buffer2 of - <<0:1,Oct:7,Rest/binary>> -> - {Oct,{0,Rest}}; - <<2:2,Val:14,Rest/binary>> -> - {Val,{0,Rest}}; - <<3:2,_:14,_Rest/binary>> -> - %% this case should be fixed - exit({error,{asn1,{decode_length,{nyi,above_16k}}}}) - end; -%% {Bits,_} = getbits(Buffer2,2), -% case Bits of -% 2 -> -% {Val,Bytes3} = getoctets(Buffer2,2), -% {(Val band 16#3FFF),Bytes3}; -% 3 -> -% exit({error,{asn1,{decode_length,{nyi,above_16k}}}}); -% _ -> -% {Val,Bytes3} = getoctet(Buffer2), -% {Val band 16#7F,Bytes3} -% end; - -decode_length(Buffer,{Lb,Ub}) when Ub =< 65535 ,Lb >= 0 -> % constrained - decode_constrained_number(Buffer,{Lb,Ub}); -decode_length(_,{Lb,_}) when integer(Lb), Lb >= 0 -> % Ub > 65535 - exit({error,{asn1,{decode_length,{nyi,above_64K}}}}); -decode_length(Buffer,{{Lb,Ub},[]}) -> - case getbit(Buffer) of - {0,Buffer2} -> - decode_length(Buffer2, {Lb,Ub}) - end; - - -%When does this case occur with {_,_Lb,Ub} ?? -% X.691:10.9.3.5 -decode_length({Used,Bin},{_,_Lb,_Ub}) -> %when Len =< 127 -> % Unconstrained or large Ub NOTE! this case does not cover case when Ub > 65535 - Unused = (8-Used) rem 8, - case Bin of - <<_:Used,0:1,Val:7,R:Unused,Rest/binary>> -> - {Val,{Used,<<R,Rest/binary>>}}; - <<_:Used,_:Unused,2:2,Val:14,Rest/binary>> -> - {Val, {0,Rest}}; - <<_:Used,_:Unused,3:2,_:14,_Rest/binary>> -> - exit({error,{asn1,{decode_length,{nyi,length_above_64K}}}}) - end; -% decode_length(Buffer,{_,_Lb,Ub}) -> %when Len =< 127 -> % Unconstrained or large Ub -% case getbit(Buffer) of -% {0,Remain} -> -% getbits(Remain,7); -% {1,Remain} -> -% {Val,Remain2} = getoctets(Buffer,2), -% {Val band 2#0111111111111111, Remain2} -% end; -decode_length(Buffer,SingleValue) when integer(SingleValue) -> - {SingleValue,Buffer}. - - - % X.691:11 -encode_boolean(true) -> - {bits,1,1}; -encode_boolean(false) -> - {bits,1,0}; -encode_boolean({Name,Val}) when atom(Name) -> - encode_boolean(Val); -encode_boolean(Val) -> - exit({error,{asn1,{encode_boolean,Val}}}). - -decode_boolean(Buffer) -> %when record(Buffer,buffer) - case getbit(Buffer) of - {1,Remain} -> {true,Remain}; - {0,Remain} -> {false,Remain} - end. - - -%% ENUMERATED with extension marker -decode_enumerated(Buffer,C,{Ntup1,Ntup2}) when tuple(Ntup1), tuple(Ntup2) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> % not an extension value - {Val,Buffer3} = decode_integer(Buffer2,C), - case catch (element(Val+1,Ntup1)) of - NewVal when atom(NewVal) -> {NewVal,Buffer3}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,[Ntup1,Ntup2]}}}}) - end; - 1 -> % this an extension value - {Val,Buffer3} = decode_small_number(Buffer2), - case catch (element(Val+1,Ntup2)) of - NewVal when atom(NewVal) -> {NewVal,Buffer3}; - _ -> {{asn1_enum,Val},Buffer3} - end - end; - -decode_enumerated(Buffer,C,NamedNumberTup) when tuple(NamedNumberTup) -> - {Val,Buffer2} = decode_integer(Buffer,C), - case catch (element(Val+1,NamedNumberTup)) of - NewVal when atom(NewVal) -> {NewVal,Buffer2}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,NamedNumberTup}}}}) - end. - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Bitstring value, ITU_T X.690 Chapter 8.5 -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% encode bitstring value -%%=============================================================================== - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% bitstring NamedBitList -%% Val can be of: -%% - [identifiers] where only named identifers are set to one, -%% the Constraint must then have some information of the -%% bitlength. -%% - [list of ones and zeroes] all bits -%% - integer value representing the bitlist -%% C is constraint Len, only valid when identifiers - - -%% when the value is a list of {Unused,BinBits}, where -%% Unused = integer(), -%% BinBits = binary(). - -encode_bit_string(C,Bin={Unused,BinBits},NamedBitList) when integer(Unused), - binary(BinBits) -> - encode_bin_bit_string(C,Bin,NamedBitList); - -%% when the value is a list of named bits -encode_bit_string(C, LoNB=[FirstVal | _RestVal], NamedBitList) when atom(FirstVal) -> - ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string(C,BitList,NamedBitList); - -encode_bit_string(C, BL=[{bit,_No} | _RestVal], NamedBitList) -> - ToSetPos = get_all_bitposes(BL, NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string(C,BitList,NamedBitList); - -%% when the value is a list of ones and zeroes - -% encode_bit_string(C, BitListValue, NamedBitList) when list(BitListValue) -> -% Bl1 = -% case NamedBitList of -% [] -> % dont remove trailing zeroes -% BitListValue; -% _ -> % first remove any trailing zeroes -% lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, -% lists:reverse(BitListValue))) -% end, -% BitList = [{bit,X} || X <- Bl1], -% %% BListLen = length(BitList), -% case get_constraint(C,'SizeConstraint') of -% 0 -> % fixed length -% []; % nothing to encode -% V when integer(V),V=<16 -> % fixed length 16 bits or less -% pad_list(V,BitList); -% V when integer(V) -> % fixed length 16 bits or more -% [align,pad_list(V,BitList)]; % should be another case for V >= 65537 -% {Lb,Ub} when integer(Lb),integer(Ub) -> -% [encode_length({Lb,Ub},length(BitList)),align,BitList]; -% no -> -% [encode_length(undefined,length(BitList)),align,BitList]; -% Sc -> % extension marker -% [encode_length(Sc,length(BitList)),align,BitList] -% end; -encode_bit_string(C, BitListValue, NamedBitList) when list(BitListValue) -> - BitListToBinary = - %% fun that transforms a list of 1 and 0 to a tuple: - %% {UnusedBitsInLastByte, Binary} - fun([H|T],Acc,N,Fun) -> - Fun(T,(Acc bsl 1)+H,N+1,Fun); - ([],Acc,N,_) -> - Unused = (8 - (N rem 8)) rem 8, - {Unused,<<Acc:N,0:Unused>>} - end, - UnusedAndBin = - case NamedBitList of - [] -> % dont remove trailing zeroes - BitListToBinary(BitListValue,0,0,BitListToBinary); - _ -> - BitListToBinary(lists:reverse( - lists:dropwhile(fun(0)->true;(1)->false end, - lists:reverse(BitListValue))), - 0,0,BitListToBinary) - end, - encode_bin_bit_string(C,UnusedAndBin,NamedBitList); - -%% when the value is an integer -encode_bit_string(C, IntegerVal, NamedBitList) when integer(IntegerVal)-> - BitList = int_to_bitlist(IntegerVal), - encode_bit_string(C,BitList,NamedBitList); - -%% when the value is a tuple -encode_bit_string(C,{Name,Val}, NamedBitList) when atom(Name) -> - encode_bit_string(C,Val,NamedBitList). - - -%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. -%% Unused = integer(),i.e. number unused bits in least sign. byte of -%% BinBits = binary(). - - -encode_bin_bit_string(C,UnusedAndBin={_Unused,_BinBits},NamedBitList) -> - Constr = get_constraint(C,'SizeConstraint'), - UnusedAndBin1 = {Unused1,Bin1} = - remove_trailing_bin(NamedBitList,UnusedAndBin,lower_bound(Constr)), - case Constr of - 0 -> - []; - V when integer(V),V=<16 -> - {Unused2,Bin2} = pad_list(V,UnusedAndBin1), - <<BitVal:V,_:Unused2>> = Bin2, - {bits,V,BitVal}; - V when integer(V) -> - [align, pad_list(V, UnusedAndBin1)]; - {Lb,Ub} when integer(Lb),integer(Ub) -> - [encode_length({Lb,Ub},size(Bin1)*8 - Unused1), - align,UnusedAndBin1]; - no -> - [encode_length(undefined,size(Bin1)*8 - Unused1), - align,UnusedAndBin1]; - Sc -> - [encode_length(Sc,size(Bin1)*8 - Unused1), - align,UnusedAndBin1] - end. - -remove_trailing_bin([], {Unused,Bin},_) -> - {Unused,Bin}; -remove_trailing_bin(NamedNumberList, {_Unused,Bin},C) -> - Size = size(Bin)-1, - <<Bfront:Size/binary, LastByte:8>> = Bin, - %% clear the Unused bits to be sure -% LastByte1 = LastByte band (((1 bsl Unused) -1) bxor 255), - Unused1 = trailingZeroesInNibble(LastByte band 15), - Unused2 = - case Unused1 of - 4 -> - 4 + trailingZeroesInNibble(LastByte bsr 4); - _ -> Unused1 - end, - case Unused2 of - 8 -> - remove_trailing_bin(NamedNumberList,{0,Bfront},C); - _ -> - case C of - Int when integer(Int),Int > ((size(Bin)*8)-Unused2) -> - %% this padding see OTP-4353 - pad_list(Int,{Unused2,Bin}); - _ -> {Unused2,Bin} - end - end. - - -trailingZeroesInNibble(0) -> - 4; -trailingZeroesInNibble(1) -> - 0; -trailingZeroesInNibble(2) -> - 1; -trailingZeroesInNibble(3) -> - 0; -trailingZeroesInNibble(4) -> - 2; -trailingZeroesInNibble(5) -> - 0; -trailingZeroesInNibble(6) -> - 1; -trailingZeroesInNibble(7) -> - 0; -trailingZeroesInNibble(8) -> - 3; -trailingZeroesInNibble(9) -> - 0; -trailingZeroesInNibble(10) -> - 1; -trailingZeroesInNibble(11) -> - 0; -trailingZeroesInNibble(12) -> %#1100 - 2; -trailingZeroesInNibble(13) -> - 0; -trailingZeroesInNibble(14) -> - 1; -trailingZeroesInNibble(15) -> - 0. - -lower_bound({{Lb,_},_}) when integer(Lb) -> - Lb; -lower_bound({Lb,_}) when integer(Lb) -> - Lb; -lower_bound(C) -> - C. - -%%%%%%%%%%%%%%% -%% The result is presented as a list of named bits (if possible) -%% else as a tuple {Unused,Bits}. Unused is the number of unused -%% bits, least significant bits in the last byte of Bits. Bits is -%% the BIT STRING represented as a binary. -%% -decode_compact_bit_string(Buffer, C, NamedNumberList) -> - case get_constraint(C,'SizeConstraint') of - 0 -> % fixed length - {{8,0},Buffer}; - V when integer(V),V=<16 -> %fixed length 16 bits or less - compact_bit_string(Buffer,V,NamedNumberList); - V when integer(V),V=<65536 -> %fixed length > 16 bits - Bytes2 = align(Buffer), - compact_bit_string(Bytes2,V,NamedNumberList); - V when integer(V) -> % V > 65536 => fragmented value - {Bin,Buffer2} = decode_fragmented_bits(Buffer,V), - case Buffer2 of - {0,_} -> {{0,Bin},Buffer2}; - {U,_} -> {{8-U,Bin},Buffer2} - end; - {Lb,Ub} when integer(Lb),integer(Ub) -> - %% This case may demand decoding of fragmented length/value - {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList); - no -> - %% This case may demand decoding of fragmented length/value - {Len,Bytes2} = decode_length(Buffer,undefined), - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList); - Sc -> - {Len,Bytes2} = decode_length(Buffer,Sc), - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList) - end. - - -%%%%%%%%%%%%%%% -%% The result is presented as a list of named bits (if possible) -%% else as a list of 0 and 1. -%% -decode_bit_string(Buffer, C, NamedNumberList) -> - case get_constraint(C,'SizeConstraint') of - {Lb,Ub} when integer(Lb),integer(Ub) -> - {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), - Bytes3 = align(Bytes2), - bit_list_or_named(Bytes3,Len,NamedNumberList); - no -> - {Len,Bytes2} = decode_length(Buffer,undefined), - Bytes3 = align(Bytes2), - bit_list_or_named(Bytes3,Len,NamedNumberList); - 0 -> % fixed length - {[],Buffer}; % nothing to encode - V when integer(V),V=<16 -> % fixed length 16 bits or less - bit_list_or_named(Buffer,V,NamedNumberList); - V when integer(V),V=<65536 -> - Bytes2 = align(Buffer), - bit_list_or_named(Bytes2,V,NamedNumberList); - V when integer(V) -> - Bytes2 = align(Buffer), - {BinBits,_} = decode_fragmented_bits(Bytes2,V), - bit_list_or_named(BinBits,V,NamedNumberList); - Sc -> % extension marker - {Len,Bytes2} = decode_length(Buffer,Sc), - Bytes3 = align(Bytes2), - bit_list_or_named(Bytes3,Len,NamedNumberList) - end. - - -%% if no named bits are declared we will return a -%% {Unused,Bits}. Unused = integer(), -%% Bits = binary(). -compact_bit_string(Buffer,Len,[]) -> - getbits_as_binary(Len,Buffer); % {{Unused,BinBits},NewBuffer} -compact_bit_string(Buffer,Len,NamedNumberList) -> - bit_list_or_named(Buffer,Len,NamedNumberList). - - -%% if no named bits are declared we will return a -%% BitList = [0 | 1] - -bit_list_or_named(Buffer,Len,[]) -> - getbits_as_list(Len,Buffer); - -%% if there are named bits declared we will return a named -%% BitList where the names are atoms and unnamed bits represented -%% as {bit,Pos} -%% BitList = [atom() | {bit,Pos}] -%% Pos = integer() - -bit_list_or_named(Buffer,Len,NamedNumberList) -> - {BitList,Rest} = getbits_as_list(Len,Buffer), - {bit_list_or_named1(0,BitList,NamedNumberList,[]), Rest}. - -bit_list_or_named1(Pos,[0|Bt],Names,Acc) -> - bit_list_or_named1(Pos+1,Bt,Names,Acc); -bit_list_or_named1(Pos,[1|Bt],Names,Acc) -> - case lists:keysearch(Pos,2,Names) of - {value,{Name,_}} -> - bit_list_or_named1(Pos+1,Bt,Names,[Name|Acc]); - _ -> - bit_list_or_named1(Pos+1,Bt,Names,[{bit,Pos}|Acc]) - end; -bit_list_or_named1(_,[],_,Acc) -> - lists:reverse(Acc). - - - -%%%%%%%%%%%%%%% -%% - -int_to_bitlist(Int) when integer(Int), Int > 0 -> - [Int band 1 | int_to_bitlist(Int bsr 1)]; -int_to_bitlist(0) -> - []. - - -%%%%%%%%%%%%%%%%%% -%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> -%% [sorted_list_of_bitpositions_to_set] - -get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); - -get_all_bitposes([Val | Rest], NamedBitList, Ack) -> - case lists:keysearch(Val, 1, NamedBitList) of - {value, {_ValName, ValPos}} -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); - _ -> - exit({error,{asn1, {bitstring_namedbit, Val}}}) - end; -get_all_bitposes([], _NamedBitList, Ack) -> - lists:sort(Ack). - -%%%%%%%%%%%%%%%%%% -%% make_and_set_list([list of positions to set to 1])-> -%% returns list with all in SetPos set. -%% in positioning in list the first element is 0, the second 1 etc.., but -%% - -make_and_set_list([XPos|SetPos], XPos) -> - [1 | make_and_set_list(SetPos, XPos + 1)]; -make_and_set_list([Pos|SetPos], XPos) -> - [0 | make_and_set_list([Pos | SetPos], XPos + 1)]; -make_and_set_list([], _) -> - []. - -%%%%%%%%%%%%%%%%% -%% pad_list(N,BitList) -> PaddedList -%% returns a padded (with trailing {bit,0} elements) list of length N -%% if Bitlist contains more than N significant bits set an exit asn1_error -%% is generated - -pad_list(N,In={Unused,Bin}) -> - pad_list(N, size(Bin)*8 - Unused, In). - -pad_list(N,Size,In={_,_}) when N < Size -> - exit({error,{asn1,{range_error,{bit_string,In}}}}); -pad_list(N,Size,{Unused,Bin}) when N > Size, Unused > 0 -> - pad_list(N,Size+1,{Unused-1,Bin}); -pad_list(N,Size,{_Unused,Bin}) when N > Size -> - pad_list(N,Size+1,{7,<<Bin/binary,0>>}); -pad_list(N,N,In={_,_}) -> - In. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% X.691:16 -%% encode_octet_string(Constraint,ExtensionMarker,Val) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -encode_octet_string(C,Val) -> - encode_octet_string(C,false,Val). - -encode_octet_string(C,Bool,{_Name,Val}) -> - encode_octet_string(C,Bool,Val); -encode_octet_string(_,true,_) -> - exit({error,{asn1,{'not_supported',extensionmarker}}}); -encode_octet_string(C,false,Val) -> - case get_constraint(C,'SizeConstraint') of - 0 -> - []; - 1 -> - [V] = Val, - {bits,8,V}; - 2 -> - [V1,V2] = Val, - [{bits,8,V1},{bits,8,V2}]; - Sv when Sv =<65535, Sv == length(Val) -> % fixed length - {octets,Val}; - {Lb,Ub} -> - [encode_length({Lb,Ub},length(Val)),{octets,Val}]; - Sv when list(Sv) -> - [encode_length({hd(Sv),lists:max(Sv)},length(Val)),{octets,Val}]; - no -> - [encode_length(undefined,length(Val)),{octets,Val}] - end. - -decode_octet_string(Bytes,Range) -> - decode_octet_string(Bytes,Range,false). - -decode_octet_string(Bytes,C,false) -> - case get_constraint(C,'SizeConstraint') of - 0 -> - {[],Bytes}; - 1 -> - {B1,Bytes2} = getbits(Bytes,8), - {[B1],Bytes2}; - 2 -> - {Bs,Bytes2}= getbits(Bytes,16), - {binary_to_list(<<Bs:16>>),Bytes2}; - {_,0} -> - {[],Bytes}; - Sv when integer(Sv), Sv =<65535 -> % fixed length - getoctets_as_list(Bytes,Sv); - Sv when integer(Sv) -> % fragmented encoding - Bytes2 = align(Bytes), - decode_fragmented_octets(Bytes2,Sv); - {Lb,Ub} -> - {Len,Bytes2} = decode_length(Bytes,{Lb,Ub}), - getoctets_as_list(Bytes2,Len); - Sv when list(Sv) -> - {Len,Bytes2} = decode_length(Bytes,{hd(Sv),lists:max(Sv)}), - getoctets_as_list(Bytes2,Len); - no -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_list(Bytes2,Len) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Restricted char string types -%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) -%% X.691:26 and X.680:34-36 -%%encode_restricted_string(aligned,'BMPString',Constraints,Extension,Val) - - -encode_restricted_string(aligned,{Name,Val}) when atom(Name) -> - encode_restricted_string(aligned,Val); - -encode_restricted_string(aligned,Val) when list(Val)-> - [encode_length(undefined,length(Val)),{octets,Val}]. - -encode_known_multiplier_string(aligned,StringType,C,_Ext,{Name,Val}) when atom(Name) -> - encode_known_multiplier_string(aligned,StringType,C,false,Val); - -encode_known_multiplier_string(aligned,StringType,C,_Ext,Val) -> - Result = chars_encode(C,StringType,Val), - NumBits = get_NumBits(C,StringType), - case get_constraint(C,'SizeConstraint') of - Ub when integer(Ub), Ub*NumBits =< 16 -> - case {StringType,Result} of - {'BMPString',{octets,Ol}} -> - [{bits,8,Oct}||Oct <- Ol]; - _ -> - Result - end; - 0 -> - []; - Ub when integer(Ub),Ub =<65535 -> % fixed length - [align,Result]; - {Ub,Lb} -> - [encode_length({Ub,Lb},length(Val)),align,Result]; - Vl when list(Vl) -> - [encode_length({lists:min(Vl),lists:max(Vl)},length(Val)),align,Result]; - no -> - [encode_length(undefined,length(Val)),align,Result] - end. - -decode_restricted_string(Bytes,aligned) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_list(Bytes2,Len). - -decode_known_multiplier_string(Bytes,aligned,StringType,C,_Ext) -> - NumBits = get_NumBits(C,StringType), - case get_constraint(C,'SizeConstraint') of - Ub when integer(Ub), Ub*NumBits =< 16 -> - chars_decode(Bytes,NumBits,StringType,C,Ub); - Ub when integer(Ub),Ub =<65535 -> % fixed length - Bytes1 = align(Bytes), - chars_decode(Bytes1,NumBits,StringType,C,Ub); - 0 -> - {[],Bytes}; - Vl when list(Vl) -> - {Len,Bytes1} = decode_length(Bytes,{hd(Vl),lists:max(Vl)}), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,C,Len); - no -> - {Len,Bytes1} = decode_length(Bytes,undefined), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,C,Len); - {Lb,Ub}-> - {Len,Bytes1} = decode_length(Bytes,{Lb,Ub}), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,C,Len) - end. - - -encode_NumericString(C,Val) -> - encode_known_multiplier_string(aligned,'NumericString',C,false,Val). -decode_NumericString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'NumericString',C,false). - -encode_PrintableString(C,Val) -> - encode_known_multiplier_string(aligned,'PrintableString',C,false,Val). -decode_PrintableString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'PrintableString',C,false). - -encode_VisibleString(C,Val) -> % equivalent with ISO646String - encode_known_multiplier_string(aligned,'VisibleString',C,false,Val). -decode_VisibleString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'VisibleString',C,false). - -encode_IA5String(C,Val) -> - encode_known_multiplier_string(aligned,'IA5String',C,false,Val). -decode_IA5String(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'IA5String',C,false). - -encode_BMPString(C,Val) -> - encode_known_multiplier_string(aligned,'BMPString',C,false,Val). -decode_BMPString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'BMPString',C,false). - -encode_UniversalString(C,Val) -> - encode_known_multiplier_string(aligned,'UniversalString',C,false,Val). -decode_UniversalString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'UniversalString',C,false). - -%% end of known-multiplier strings for which PER visible constraints are -%% applied - -encode_GeneralString(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_GeneralString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - -encode_GraphicString(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_GraphicString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - -encode_ObjectDescriptor(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_ObjectDescriptor(Bytes) -> - decode_restricted_string(Bytes,aligned). - -encode_TeletexString(_C,Val) -> % equivalent with T61String - encode_restricted_string(aligned,Val). -decode_TeletexString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - -encode_VideotexString(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_VideotexString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% getBMPChars(Bytes,Len) ->{BMPcharList,RemainingBytes} -%% -getBMPChars(Bytes,1) -> - {O1,Bytes2} = getbits(Bytes,8), - {O2,Bytes3} = getbits(Bytes2,8), - if - O1 == 0 -> - {[O2],Bytes3}; - true -> - {[{0,0,O1,O2}],Bytes3} - end; -getBMPChars(Bytes,Len) -> - getBMPChars(Bytes,Len,[]). - -getBMPChars(Bytes,0,Acc) -> - {lists:reverse(Acc),Bytes}; -getBMPChars(Bytes,Len,Acc) -> - {Octs,Bytes1} = getoctets_as_list(Bytes,2), - case Octs of - [0,O2] -> - getBMPChars(Bytes1,Len-1,[O2|Acc]); - [O1,O2]-> - getBMPChars(Bytes1,Len-1,[{0,0,O1,O2}|Acc]) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% chars_encode(C,StringType,Value) -> ValueList -%% -%% encodes chars according to the per rules taking the constraint PermittedAlphabet -%% into account. -%% This function does only encode the value part and NOT the length - -chars_encode(C,StringType,Value) -> - case {StringType,get_constraint(C,'PermittedAlphabet')} of - {'UniversalString',{_,_Sv}} -> - exit({error,{asn1,{'not implemented',"UniversalString with PermittedAlphabet constraint"}}}); - {'BMPString',{_,_Sv}} -> - exit({error,{asn1,{'not implemented',"BMPString with PermittedAlphabet constraint"}}}); - _ -> - {NumBits,CharOutTab} = {get_NumBits(C,StringType),get_CharOutTab(C,StringType)}, - chars_encode2(Value,NumBits,CharOutTab) - end. - -chars_encode2([H|T],NumBits,{Min,Max,notab}) when H =< Max, H >= Min -> - [{bits,NumBits,H-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|T],NumBits,{Min,Max,Tab}) when H =< Max, H >= Min -> - [{bits,NumBits,exit_if_false(H,element(H-Min+1,Tab))}|chars_encode2(T,NumBits,{Min,Max,Tab})]; -chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,notab}) -> - %% no value range check here (ought to be, but very expensive) -% [{bits,NumBits,(A*B*C*D)-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; - [{bits,NumBits,((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> - %% no value range check here (ought to be, but very expensive) -% [{bits,NumBits,element((A*B*C*D)-Min,Tab)}|chars_encode2(T,NumBits,{Min,Max,notab})]; - [{bits,NumBits,exit_if_false({A,B,C,D},element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab))}|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|_T],_,{_,_,_}) -> - exit({error,{asn1,{illegal_char_value,H}}}); -chars_encode2([],_,_) -> - []. - -exit_if_false(V,false)-> - exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}}); -exit_if_false(_,V) ->V. - - -get_NumBits(C,StringType) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} -> - charbits(length(Sv),aligned); - no -> - case StringType of - 'IA5String' -> - charbits(128,aligned); % 16#00..16#7F - 'VisibleString' -> - charbits(95,aligned); % 16#20..16#7E - 'PrintableString' -> - charbits(74,aligned); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z - 'NumericString' -> - charbits(11,aligned); % $ ,"0123456789" - 'UniversalString' -> - 32; - 'BMPString' -> - 16 - end - end. - -%%Maybe used later -%%get_MaxChar(C,StringType) -> -%% case get_constraint(C,'PermittedAlphabet') of -%% {'SingleValue',Sv} -> -%% lists:nth(length(Sv),Sv); -%% no -> -%% case StringType of -%% 'IA5String' -> -%% 16#7F; % 16#00..16#7F -%% 'VisibleString' -> -%% 16#7E; % 16#20..16#7E -%% 'PrintableString' -> -%% $z; % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z -%% 'NumericString' -> -%% $9; % $ ,"0123456789" -%% 'UniversalString' -> -%% 16#ffffffff; -%% 'BMPString' -> -%% 16#ffff -%% end -%% end. - -%%Maybe used later -%%get_MinChar(C,StringType) -> -%% case get_constraint(C,'PermittedAlphabet') of -%% {'SingleValue',Sv} -> -%% hd(Sv); -%% no -> -%% case StringType of -%% 'IA5String' -> -%% 16#00; % 16#00..16#7F -%% 'VisibleString' -> -%% 16#20; % 16#20..16#7E -%% 'PrintableString' -> -%% $\s; % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z -%% 'NumericString' -> -%% $\s; % $ ,"0123456789" -%% 'UniversalString' -> -%% 16#00; -%% 'BMPString' -> -%% 16#00 -%% end -%% end. - -get_CharOutTab(C,StringType) -> - get_CharTab(C,StringType,out). - -get_CharInTab(C,StringType) -> - get_CharTab(C,StringType,in). - -get_CharTab(C,StringType,InOut) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} -> - get_CharTab2(C,StringType,hd(Sv),lists:max(Sv),Sv,InOut); - no -> - case StringType of - 'IA5String' -> - {0,16#7F,notab}; - 'VisibleString' -> - get_CharTab2(C,StringType,16#20,16#7F,notab,InOut); - 'PrintableString' -> - Chars = lists:sort( - " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), - get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars,InOut); - 'NumericString' -> - get_CharTab2(C,StringType,16#20,$9," 0123456789",InOut); - 'UniversalString' -> - {0,16#FFFFFFFF,notab}; - 'BMPString' -> - {0,16#FFFF,notab} - end - end. - -get_CharTab2(C,StringType,Min,Max,Chars,InOut) -> - BitValMax = (1 bsl get_NumBits(C,StringType))-1, - if - Max =< BitValMax -> - {0,Max,notab}; - true -> - case InOut of - out -> - {Min,Max,create_char_tab(Min,Chars)}; - in -> - {Min,Max,list_to_tuple(Chars)} - end - end. - -create_char_tab(Min,L) -> - list_to_tuple(create_char_tab(Min,L,0)). -create_char_tab(Min,[Min|T],V) -> - [V|create_char_tab(Min+1,T,V+1)]; -create_char_tab(_Min,[],_V) -> - []; -create_char_tab(Min,L,V) -> - [false|create_char_tab(Min+1,L,V)]. - -%% This very inefficient and should be moved to compiletime -charbits(NumOfChars,aligned) -> - case charbits(NumOfChars) of - 1 -> 1; - 2 -> 2; - B when B =< 4 -> 4; - B when B =< 8 -> 8; - B when B =< 16 -> 16; - B when B =< 32 -> 32 - end. - -charbits(NumOfChars) when NumOfChars =< 2 -> 1; -charbits(NumOfChars) when NumOfChars =< 4 -> 2; -charbits(NumOfChars) when NumOfChars =< 8 -> 3; -charbits(NumOfChars) when NumOfChars =< 16 -> 4; -charbits(NumOfChars) when NumOfChars =< 32 -> 5; -charbits(NumOfChars) when NumOfChars =< 64 -> 6; -charbits(NumOfChars) when NumOfChars =< 128 -> 7; -charbits(NumOfChars) when NumOfChars =< 256 -> 8; -charbits(NumOfChars) when NumOfChars =< 512 -> 9; -charbits(NumOfChars) when NumOfChars =< 1024 -> 10; -charbits(NumOfChars) when NumOfChars =< 2048 -> 11; -charbits(NumOfChars) when NumOfChars =< 4096 -> 12; -charbits(NumOfChars) when NumOfChars =< 8192 -> 13; -charbits(NumOfChars) when NumOfChars =< 16384 -> 14; -charbits(NumOfChars) when NumOfChars =< 32768 -> 15; -charbits(NumOfChars) when NumOfChars =< 65536 -> 16; -charbits(NumOfChars) when integer(NumOfChars) -> - 16 + charbits1(NumOfChars bsr 16). - -charbits1(0) -> - 0; -charbits1(NumOfChars) -> - 1 + charbits1(NumOfChars bsr 1). - - -chars_decode(Bytes,_,'BMPString',C,Len) -> - case get_constraint(C,'PermittedAlphabet') of - no -> - getBMPChars(Bytes,Len); - _ -> - exit({error,{asn1, - {'not implemented', - "BMPString with PermittedAlphabet constraint"}}}) - end; -chars_decode(Bytes,NumBits,StringType,C,Len) -> - CharInTab = get_CharInTab(C,StringType), - chars_decode2(Bytes,CharInTab,NumBits,Len). - - -chars_decode2(Bytes,CharInTab,NumBits,Len) -> - chars_decode2(Bytes,CharInTab,NumBits,Len,[]). - -chars_decode2(Bytes,_CharInTab,_NumBits,0,Acc) -> - {lists:reverse(Acc),Bytes}; -chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) when NumBits > 8 -> - {Char,Bytes2} = getbits(Bytes,NumBits), - Result = - if - Char < 256 -> Char; - true -> - list_to_tuple(binary_to_list(<<Char:32>>)) - end, - chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Result|Acc]); -% chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) when NumBits > 8 -> -% {Char,Bytes2} = getbits(Bytes,NumBits), -% Result = case minimum_octets(Char+Min) of -% [NewChar] -> NewChar; -% [C1,C2] -> {0,0,C1,C2}; -% [C1,C2,C3] -> {0,C1,C2,C3}; -% [C1,C2,C3,C4] -> {C1,C2,C3,C4} -% end, -% chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Result|Acc]); -chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) -> - {Char,Bytes2} = getbits(Bytes,NumBits), - chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Char+Min|Acc]); - -%% BMPString and UniversalString with PermittedAlphabet is currently not supported -chars_decode2(Bytes,{Min,Max,CharInTab},NumBits,Len,Acc) -> - {Char,Bytes2} = getbits(Bytes,NumBits), - chars_decode2(Bytes2,{Min,Max,CharInTab},NumBits,Len -1,[element(Char+1,CharInTab)|Acc]). - - - % X.691:17 -encode_null(_) -> []; % encodes to nothing -encode_null({Name,Val}) when atom(Name) -> - encode_null(Val). - -decode_null(Bytes) -> - {'NULL',Bytes}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_object_identifier(Val) -> CompleteList -%% encode_object_identifier({Name,Val}) -> CompleteList -%% Val -> {Int1,Int2,...,IntN} % N >= 2 -%% Name -> atom() -%% Int1 -> integer(0..2) -%% Int2 -> integer(0..39) when Int1 (0..1) else integer() -%% Int3-N -> integer() -%% CompleteList -> [{bits,8,Val}|{octets,Ol}|align|...] -%% -encode_object_identifier({Name,Val}) when atom(Name) -> - encode_object_identifier(Val); -encode_object_identifier(Val) -> - OctetList = e_object_identifier(Val), - Octets = list_to_binary(OctetList), % performs a flatten at the same time - [{debug,object_identifier},encode_length(undefined,size(Octets)),{octets,Octets}]. - -%% This code is copied from asn1_encode.erl (BER) and corrected and modified - -e_object_identifier({'OBJECT IDENTIFIER',V}) -> - e_object_identifier(V); -e_object_identifier({Cname,V}) when atom(Cname),tuple(V) -> - e_object_identifier(tuple_to_list(V)); -e_object_identifier({Cname,V}) when atom(Cname),list(V) -> - e_object_identifier(V); -e_object_identifier(V) when tuple(V) -> - e_object_identifier(tuple_to_list(V)); - -%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) -e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> - Head = 40*E1 + E2, % weird - e_object_elements([Head|Tail],[]); -e_object_identifier(Oid=[_,_|_Tail]) -> - exit({error,{asn1,{'illegal_value',Oid}}}). - -e_object_elements([],Acc) -> - lists:reverse(Acc); -e_object_elements([H|T],Acc) -> - e_object_elements(T,[e_object_element(H)|Acc]). - -e_object_element(Num) when Num < 128 -> - Num; -%% must be changed to handle more than 2 octets -e_object_element(Num) -> %% when Num < ??? - Left = ((Num band 2#11111110000000) bsr 7) bor 2#10000000, - Right = Num band 2#1111111 , - [Left,Right]. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_object_identifier(Bytes) -> {ObjId,RemainingBytes} -%% ObjId -> {integer(),integer(),...} % at least 2 integers -%% RemainingBytes -> [integer()] when integer() (0..255) -decode_object_identifier(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - [First|Rest] = dec_subidentifiers(Octs,0,[]), - Idlist = if - First < 40 -> - [0,First|Rest]; - First < 80 -> - [1,First - 40|Rest]; - true -> - [2,First - 80|Rest] - end, - {list_to_tuple(Idlist),Bytes3}. - -dec_subidentifiers([H|T],Av,Al) when H >=16#80 -> - dec_subidentifiers(T,(Av bsl 7) + (H band 16#7F),Al); -dec_subidentifiers([H|T],Av,Al) -> - dec_subidentifiers(T,0,[(Av bsl 7) + H |Al]); -dec_subidentifiers([],_Av,Al) -> - lists:reverse(Al). - -get_constraint([{Key,V}],Key) -> - V; -get_constraint([],_Key) -> - no; -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% complete(InList) -> ByteList -%% Takes a coded list with bits and bytes and converts it to a list of bytes -%% Should be applied as the last step at encode of a complete ASN.1 type -%% - -% complete(L) -> -% case complete1(L) of -% {[],0} -> -% <<0>>; -% {Acc,0} -> -% lists:reverse(Acc); -% {[Hacc|Tacc],Acclen} -> % Acclen >0 -% Rest = 8 - Acclen, -% NewHacc = Hacc bsl Rest, -% lists:reverse([NewHacc|Tacc]) -% end. - - -% complete1(InList) when list(InList) -> -% complete1(InList,[]); -% complete1(InList) -> -% complete1([InList],[]). - -% complete1([{debug,_}|T], Acc) -> -% complete1(T,Acc); -% complete1([H|T],Acc) when list(H) -> -% {NewH,NewAcclen} = complete1(H,Acc), -% complete1(T,NewH,NewAcclen); - -% complete1([{0,Bin}|T],Acc,0) when binary(Bin) -> -% complete1(T,[Bin|Acc],0); -% complete1([{Unused,Bin}|T],Acc,0) when integer(Unused),binary(Bin) -> -% Size = size(Bin)-1, -% <<Bs:Size/binary,B>> = Bin, -% complete1(T,[(B bsr Unused),Bs|Acc],8-Unused); -% complete1([{Unused,Bin}|T],[Hacc|Tacc],Acclen) when integer(Unused),binary(Bin) -> -% Rest = 8 - Acclen, -% Used = 8 - Unused, -% case size(Bin) of -% 1 -> -% if -% Rest >= Used -> -% <<B:Used,_:Unused>> = Bin, -% complete1(T,[(Hacc bsl Used) + B|Tacc], -% (Acclen+Used) rem 8); -% true -> -% LeftOver = 8 - Rest - Unused, -% <<Val2:Rest,Val1:LeftOver,_:Unused>> = Bin, -% complete1(T,[Val1,(Hacc bsl Rest) + Val2|Tacc], -% (Acclen+Used) rem 8) -% end; -% N -> -% if -% Rest == Used -> -% N1 = N - 1, -% <<B:Rest,Bs:N1/binary,_:Unused>> = Bin, -% complete1(T,[Bs,(Hacc bsl Rest) + B|Tacc],0); -% Rest > Used -> -% N1 = N - 2, -% N2 = (8 - Rest) + Used, -% <<B1:Rest,Bytes:N1/binary,B2:N2,_:Unused>> = Bin, -% complete1(T,[B2,Bytes,(Hacc bsl Rest) + B1|Tacc], -% (Acclen + Used) rem 8); -% true -> % Rest < Used -% N1 = N - 1, -% N2 = Used - Rest, -% <<B1:Rest,Bytes:N1/binary,B2:N2,_:Unused>> = Bin, -% complete1(T,[B2,Bytes,(Hacc bsl Rest) + B1|Tacc], -% (Acclen + Used) rem 8) -% end -% end; - -% %complete1([{octets,N,Val}|T],Acc,Acclen) when N =< 4 ,integer(Val) -> -% % complete1([{octets,<<Val:N/unit:8>>}|T],Acc,Acclen); -% complete1([{octets,N,Val}|T],Acc,Acclen) when N =< 4 ,integer(Val) -> -% Newval = case N of -% 1 -> -% Val4 = Val band 16#FF, -% [Val4]; -% 2 -> -% Val3 = (Val bsr 8) band 16#FF, -% Val4 = Val band 16#FF, -% [Val3,Val4]; -% 3 -> -% Val2 = (Val bsr 16) band 16#FF, -% Val3 = (Val bsr 8) band 16#FF, -% Val4 = Val band 16#FF, -% [Val2,Val3,Val4]; -% 4 -> -% Val1 = (Val bsr 24) band 16#FF, -% Val2 = (Val bsr 16) band 16#FF, -% Val3 = (Val bsr 8) band 16#FF, -% Val4 = Val band 16#FF, -% [Val1,Val2,Val3,Val4] -% end, -% complete1([{octets,Newval}|T],Acc,Acclen); - -% complete1([{octets,Bin}|T],Acc,Acclen) when binary(Bin) -> -% Rest = 8 - Acclen, -% if -% Rest == 8 -> -% complete1(T,[Bin|Acc],0); -% true -> -% [Hacc|Tacc]=Acc, -% complete1(T,[Bin, Hacc bsl Rest|Tacc],0) -% end; - -% complete1([{octets,Oct}|T],Acc,Acclen) when list(Oct) -> -% Rest = 8 - Acclen, -% if -% Rest == 8 -> -% complete1(T,[list_to_binary(Oct)|Acc],0); -% true -> -% [Hacc|Tacc]=Acc, -% complete1(T,[list_to_binary(Oct), Hacc bsl Rest|Tacc],0) -% end; - -% complete1([{bit,Val}|T], Acc, Acclen) -> -% complete1([{bits,1,Val}|T],Acc,Acclen); -% complete1([{octet,Val}|T], Acc, Acclen) -> -% complete1([{octets,1,Val}|T],Acc,Acclen); - -% complete1([{bits,N,Val}|T], Acc, 0) when N =< 8 -> -% complete1(T,[Val|Acc],N); -% complete1([{bits,N,Val}|T], [Hacc|Tacc], Acclen) when N =< 8 -> -% Rest = 8 - Acclen, -% if -% Rest >= N -> -% complete1(T,[(Hacc bsl N) + Val|Tacc],(Acclen+N) rem 8); -% true -> -% Diff = N - Rest, -% NewHacc = (Hacc bsl Rest) + (Val bsr Diff), -% Mask = element(Diff,{1,3,7,15,31,63,127,255}), -% complete1(T,[(Val band Mask),NewHacc|Tacc],(Acclen+N) rem 8) -% end; -% complete1([{bits,N,Val}|T], Acc, Acclen) -> % N > 8 -% complete1([{bits,N-8,Val bsr 8},{bits,8,Val band 255}|T],Acc,Acclen); - -% complete1([align|T],Acc,0) -> -% complete1(T,Acc,0); -% complete1([align|T],[Hacc|Tacc],Acclen) -> -% Rest = 8 - Acclen, -% complete1(T,[Hacc bsl Rest|Tacc],0); -% complete1([{octets,N,Val}|T],Acc,Acclen) when list(Val) -> % no security check here -% complete1([{octets,Val}|T],Acc,Acclen); - -% complete1([],Acc,Acclen) -> -% {Acc,Acclen}. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% complete(InList) -> ByteList -%% Takes a coded list with bits and bytes and converts it to a list of bytes -%% Should be applied as the last step at encode of a complete ASN.1 type -%% - -complete(L) -> - case complete1(L) of - {[],[]} -> - <<0>>; - {Acc,[]} -> - Acc; - {Acc,Bacc} -> - [Acc|complete_bytes(Bacc)] - end. - -%% this function builds the ugly form of lists [E1|E2] to avoid having to reverse it at the end. -%% this is done because it is efficient and that the result always will be sent on a port or -%% converted by means of list_to_binary/1 -complete1(InList) when list(InList) -> - complete1(InList,[],[]); -complete1(InList) -> - complete1([InList],[],[]). - -complete1([],Acc,Bacc) -> - {Acc,Bacc}; -complete1([H|T],Acc,Bacc) when list(H) -> - {NewH,NewBacc} = complete1(H,Acc,Bacc), - complete1(T,NewH,NewBacc); - -complete1([{octets,Bin}|T],Acc,[]) -> - complete1(T,[Acc|Bin],[]); - -complete1([{octets,Bin}|T],Acc,Bacc) -> - complete1(T,[Acc|[complete_bytes(Bacc),Bin]],[]); - -complete1([{debug,_}|T], Acc,Bacc) -> - complete1(T,Acc,Bacc); - -complete1([{bits,N,Val}|T],Acc,Bacc) -> - complete1(T,Acc,complete_update_byte(Bacc,Val,N)); - -complete1([{bit,Val}|T],Acc,Bacc) -> - complete1(T,Acc,complete_update_byte(Bacc,Val,1)); - -complete1([align|T],Acc,[]) -> - complete1(T,Acc,[]); -complete1([align|T],Acc,Bacc) -> - complete1(T,[Acc|complete_bytes(Bacc)],[]); -complete1([{0,Bin}|T],Acc,[]) when binary(Bin) -> - complete1(T,[Acc|Bin],[]); -complete1([{Unused,Bin}|T],Acc,[]) when integer(Unused),binary(Bin) -> - Size = size(Bin)-1, - <<Bs:Size/binary,B>> = Bin, - NumBits = 8-Unused, - complete1(T,[Acc|Bs],[[B bsr Unused]|NumBits]); -complete1([{Unused,Bin}|T],Acc,Bacc) when integer(Unused),binary(Bin) -> - Size = size(Bin)-1, - <<Bs:Size/binary,B>> = Bin, - NumBits = 8 - Unused, - Bf = complete_bytes(Bacc), - complete1(T,[Acc|[Bf,Bs]],[[B bsr Unused]|NumBits]). - - -complete_update_byte([],Val,Len) -> - complete_update_byte([[0]|0],Val,Len); -complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) when NumBits + Len == 8 -> - [[0,((Byte bsl Len) + Val) band 255|Bacc]|0]; -complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) when NumBits + Len > 8 -> - Rem = 8 - NumBits, - Rest = Len - Rem, - complete_update_byte([[0,((Byte bsl Rem) + (Val bsr Rest)) band 255 |Bacc]|0],Val,Rest); -complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) -> - [[((Byte bsl Len) + Val) band 255|Bacc]|NumBits+Len]. - - -complete_bytes([[_Byte|Bacc]|0]) -> - lists:reverse(Bacc); -complete_bytes([[Byte|Bacc]|NumBytes]) -> - lists:reverse([(Byte bsl (8-NumBytes)) band 255|Bacc]); -complete_bytes([]) -> - []. - -% complete_bytes(L) -> -% complete_bytes1(lists:reverse(L),[],[],0,0). - -% complete_bytes1([H={V,B}|T],Acc,ReplyAcc,NumBits,NumFields) when ((NumBits+B) rem 8) == 0 -> -% NewReplyAcc = [complete_bytes2([H|Acc],0)|ReplyAcc], -% complete_bytes1(T,[],NewReplyAcc,0,0); -% complete_bytes1([H={V,B}|T],Acc,ReplyAcc,NumBits,NumFields) when NumFields == 7; (NumBits+B) div 8 > 0 -> -% Rem = (NumBits+B) rem 8, -% NewReplyAcc = [complete_bytes2([{V bsr Rem,B - Rem}|Acc],0)|ReplyAcc], -% complete_bytes1([{V,Rem}|T],[],NewReplyAcc,0,0); -% complete_bytes1([H={V,B}|T],Acc,ReplyAcc,NumBits,NumFields) -> -% complete_bytes1(T,[H|Acc],ReplyAcc,NumBits+B,NumFields+1); -% complete_bytes1([],[],ReplyAcc,_,_) -> -% lists:reverse(ReplyAcc); -% complete_bytes1([],Acc,ReplyAcc,NumBits,_) -> -% PadBits = case NumBits rem 8 of -% 0 -> 0; -% Rem -> 8 - Rem -% end, -% lists:reverse([complete_bytes2(Acc,PadBits)|ReplyAcc]). - - -% complete_bytes2([{V1,B1}],PadBits) -> -% <<V1:B1,0:PadBits>>; -% complete_bytes2([{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,0:PadBits>>; -% complete_bytes2([{V3,B3},{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,V3:B3,0:PadBits>>; -% complete_bytes2([{V4,B4},{V3,B3},{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,V3:B3,V4:B4,0:PadBits>>; -% complete_bytes2([{V5,B5},{V4,B4},{V3,B3},{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,V3:B3,V4:B4,V5:B5,0:PadBits>>; -% complete_bytes2([{V6,B6},{V5,B5},{V4,B4},{V3,B3},{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,V3:B3,V4:B4,V5:B5,V6:B6,0:PadBits>>; -% complete_bytes2([{V7,B7},{V6,B6},{V5,B5},{V4,B4},{V3,B3},{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,V3:B3,V4:B4,V5:B5,V6:B6,V7:B7,0:PadBits>>; -% complete_bytes2([{V8,B8},{V7,B7},{V6,B6},{V5,B5},{V4,B4},{V3,B3},{V2,B2},{V1,B1}],PadBits) -> -% <<V1:B1,V2:B2,V3:B3,V4:B4,V5:B5,V6:B6,V7:B7,V8:B8,0:PadBits>>. - - - - - - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_per_bin_rt2ct.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_per_bin_rt2ct.erl deleted file mode 100644 index 0647650ea6..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_per_bin_rt2ct.erl +++ /dev/null @@ -1,2102 +0,0 @@ -%% ``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: asn1rt_per_bin_rt2ct.erl,v 1.1 2008/12/17 09:53:31 mikpe Exp $ -%% --module(asn1rt_per_bin_rt2ct). - -%% encoding / decoding of PER aligned - --include("asn1_records.hrl"). - --export([dec_fixup/3, cindex/3, list_to_record/2]). --export([setchoiceext/1, setext/1, fixoptionals/3, fixextensions/2, - getext/1, getextension/2, skipextensions/3, getbit/1, getchoice/3 ]). --export([getoptionals/2, getoptionals2/2, - set_choice/3, encode_integer/2, encode_integer/3 ]). --export([decode_integer/2, decode_integer/3, encode_small_number/1, - decode_boolean/1, encode_length/2, decode_length/1, decode_length/2, - encode_small_length/1, decode_small_length/1, - decode_compact_bit_string/3]). --export([decode_enumerated/3, - encode_bit_string/3, decode_bit_string/3 ]). --export([encode_octet_string/2, decode_octet_string/2, - encode_null/1, decode_null/1, - encode_object_identifier/1, decode_object_identifier/1, - complete/1]). - - --export([encode_open_type/2, decode_open_type/2]). - --export([%encode_UniversalString/2, decode_UniversalString/2, - %encode_PrintableString/2, decode_PrintableString/2, - encode_GeneralString/2, decode_GeneralString/2, - encode_GraphicString/2, decode_GraphicString/2, - encode_TeletexString/2, decode_TeletexString/2, - encode_VideotexString/2, decode_VideotexString/2, - %encode_VisibleString/2, decode_VisibleString/2, - %encode_BMPString/2, decode_BMPString/2, - %encode_IA5String/2, decode_IA5String/2, - %encode_NumericString/2, decode_NumericString/2, - encode_ObjectDescriptor/2, decode_ObjectDescriptor/1 - ]). - --export([decode_constrained_number/2, - decode_constrained_number/3, - decode_unconstrained_number/1, - decode_semi_constrained_number/2, - encode_unconstrained_number/1, - decode_constrained_number/4, - encode_octet_string/3, - decode_octet_string/3, - encode_known_multiplier_string/5, - decode_known_multiplier_string/5, - getoctets/2, getbits/2 -% start_drv/1,start_drv2/1,init_drv/1 - ]). - - --export([eint_positive/1]). --export([pre_complete_bits/2]). - --define('16K',16384). --define('32K',32768). --define('64K',65536). - -%%-define(nodriver,true). - -dec_fixup(Terms,Cnames,RemBytes) -> - dec_fixup(Terms,Cnames,RemBytes,[]). - -dec_fixup([novalue|T],[_Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,Acc); -dec_fixup([{_Name,novalue}|T],[_Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,Acc); -dec_fixup([H|T],[Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,[{Hc,H}|Acc]); -dec_fixup([],_Cnames,RemBytes,Acc) -> - {lists:reverse(Acc),RemBytes}. - -cindex(Ix,Val,Cname) -> - case element(Ix,Val) of - {Cname,Val2} -> Val2; - X -> X - end. - -%% converts a list to a record if necessary -list_to_record(_,Tuple) when tuple(Tuple) -> - Tuple; -list_to_record(Name,List) when list(List) -> - list_to_tuple([Name|List]). - -%%-------------------------------------------------------- -%% setchoiceext(InRootSet) -> [{bit,X}] -%% X is set to 1 when InRootSet==false -%% X is set to 0 when InRootSet==true -%% -setchoiceext(true) -> -% [{debug,choiceext},{bits,1,0}]; - [0]; -setchoiceext(false) -> -% [{debug,choiceext},{bits,1,1}]. - [1]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% setext(true|false) -> CompleteList -%% - -setext(false) -> -% [{debug,ext},{bits,1,0}]; - [0]; -setext(true) -> -% [{debug,ext},{bits,1,1}]; - [1]. - -fixoptionals(OptList,_OptLength,Val) when tuple(Val) -> -% Bits = fixoptionals(OptList,Val,0), -% {Val,{bits,OptLength,Bits}}; -% {Val,[10,OptLength,Bits]}; - {Val,fixoptionals(OptList,Val,[])}; - -fixoptionals([],_,Acc) -> - %% Optbits - lists:reverse(Acc); -fixoptionals([Pos|Ot],Val,Acc) -> - case element(Pos,Val) of -% asn1_NOVALUE -> fixoptionals(Ot,Val,Acc bsl 1); -% asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); -% _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) - asn1_NOVALUE -> fixoptionals(Ot,Val,[0|Acc]); - asn1_DEFAULT -> fixoptionals(Ot,Val,[0|Acc]); - _ -> fixoptionals(Ot,Val,[1|Acc]) - end. - - -getext(Bytes) when tuple(Bytes) -> - getbit(Bytes); -getext(Bytes) when binary(Bytes) -> - getbit({0,Bytes}); -getext(Bytes) when list(Bytes) -> - getbit({0,Bytes}). - -getextension(0, Bytes) -> - {{},Bytes}; -getextension(1, Bytes) -> - {Len,Bytes2} = decode_small_length(Bytes), - {Blist, Bytes3} = getbits_as_list(Len,Bytes2), - {list_to_tuple(Blist),Bytes3}. - -fixextensions({ext,ExtPos,ExtNum},Val) -> - case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of - 0 -> []; - ExtBits -> -% [encode_small_length(ExtNum),{bits,ExtNum,ExtBits}] -% [encode_small_length(ExtNum),[10,ExtNum,ExtBits]] - [encode_small_length(ExtNum),pre_complete_bits(ExtNum,ExtBits)] - end. - -fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> - Acc; -fixextensions(Pos,ExtPos,Val,Acc) -> - Bit = case catch(element(Pos+1,Val)) of - asn1_NOVALUE -> - 0; - asn1_NOEXTVALUE -> - 0; - {'EXIT',_} -> - 0; - _ -> - 1 - end, - fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). - -skipextensions(Bytes,Nr,ExtensionBitPattern) -> - case (catch element(Nr,ExtensionBitPattern)) of - 1 -> - {_,Bytes2} = decode_open_type(Bytes,[]), - skipextensions(Bytes2, Nr+1, ExtensionBitPattern); - 0 -> - skipextensions(Bytes, Nr+1, ExtensionBitPattern); - {'EXIT',_} -> % badarg, no more extensions - Bytes - end. - - -getchoice(Bytes,1,0) -> % only 1 alternative is not encoded - {0,Bytes}; -getchoice(Bytes,_,1) -> - decode_small_number(Bytes); -getchoice(Bytes,NumChoices,0) -> - decode_constrained_number(Bytes,{0,NumChoices-1}). - -%% old version kept for backward compatibility with generates from R7B01 -getoptionals(Bytes,NumOpt) -> - {Blist,Bytes1} = getbits_as_list(NumOpt,Bytes), - {list_to_tuple(Blist),Bytes1}. - -%% new version used in generates from r8b_patch/3 and later -getoptionals2(Bytes,NumOpt) -> - {_,_} = getbits(Bytes,NumOpt). - - -%% getbits_as_binary(Num,Bytes) -> {{Unused,BinBits},RestBytes}, -%% Num = integer(), -%% Bytes = list() | tuple(), -%% Unused = integer(), -%% BinBits = binary(), -%% RestBytes = tuple() -getbits_as_binary(Num,Bytes) when binary(Bytes) -> - getbits_as_binary(Num,{0,Bytes}); -getbits_as_binary(0,Buffer) -> - {{0,<<>>},Buffer}; -getbits_as_binary(Num,{0,Bin}) when Num > 16 -> - Used = Num rem 8, - Pad = (8 - Used) rem 8, -%% Nbytes = Num div 8, - <<Bits:Num,_:Pad,RestBin/binary>> = Bin, - {{Pad,<<Bits:Num,0:Pad>>},RestBin}; -getbits_as_binary(Num,Buffer={_Used,_Bin}) -> % Unaligned buffer - %% Num =< 16, - {Bits2,Buffer2} = getbits(Buffer,Num), - Pad = (8 - (Num rem 8)) rem 8, - {{Pad,<<Bits2:Num,0:Pad>>},Buffer2}. - - -% integer_from_list(Int,[],BigInt) -> -% BigInt; -% integer_from_list(Int,[H|T],BigInt) when Int < 8 -> -% (BigInt bsl Int) bor (H bsr (8-Int)); -% integer_from_list(Int,[H|T],BigInt) -> -% integer_from_list(Int-8,T,(BigInt bsl 8) bor H). - -getbits_as_list(Num,Bytes) when binary(Bytes) -> - getbits_as_list(Num,{0,Bytes},[]); -getbits_as_list(Num,Bytes) -> - getbits_as_list(Num,Bytes,[]). - -%% If buffer is empty and nothing more will be picked. -getbits_as_list(0, B, Acc) -> - {lists:reverse(Acc),B}; -%% If first byte in buffer is full and at least one byte will be picked, -%% then pick one byte. -getbits_as_list(N,{0,Bin},Acc) when N >= 8 -> - <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1,Rest/binary>> = Bin, - getbits_as_list(N-8,{0,Rest},[B0,B1,B2,B3,B4,B5,B6,B7|Acc]); -getbits_as_list(N,{Used,Bin},Acc) when N >= 4, Used =< 4 -> - NewUsed = Used + 4, - Rem = 8 - NewUsed, - <<_:Used,B3:1,B2:1,B1:1,B0:1,_:Rem, Rest/binary>> = Bin, - NewRest = case Rem of 0 -> Rest; _ -> Bin end, - getbits_as_list(N-4,{NewUsed rem 8,NewRest},[B0,B1,B2,B3|Acc]); -getbits_as_list(N,{Used,Bin},Acc) when N >= 2, Used =< 6 -> - NewUsed = Used + 2, - Rem = 8 - NewUsed, - <<_:Used,B1:1,B0:1,_:Rem, Rest/binary>> = Bin, - NewRest = case Rem of 0 -> Rest; _ -> Bin end, - getbits_as_list(N-2,{NewUsed rem 8,NewRest},[B0,B1|Acc]); -getbits_as_list(N,{Used,Bin},Acc) when Used =< 7 -> - NewUsed = Used + 1, - Rem = 8 - NewUsed, - <<_:Used,B0:1,_:Rem, Rest/binary>> = Bin, - NewRest = case Rem of 0 -> Rest; _ -> Bin end, - getbits_as_list(N-1,{NewUsed rem 8,NewRest},[B0|Acc]). - - -getbit({7,<<_:7,B:1,Rest/binary>>}) -> - {B,{0,Rest}}; -getbit({0,Buffer = <<B:1,_:7,_/binary>>}) -> - {B,{1,Buffer}}; -getbit({Used,Buffer}) -> - Unused = (8 - Used) - 1, - <<_:Used,B:1,_:Unused,_/binary>> = Buffer, - {B,{Used+1,Buffer}}; -getbit(Buffer) when binary(Buffer) -> - getbit({0,Buffer}). - - -getbits({0,Buffer},Num) when (Num rem 8) == 0 -> - <<Bits:Num,Rest/binary>> = Buffer, - {Bits,{0,Rest}}; -getbits({Used,Bin},Num) -> - NumPlusUsed = Num + Used, - NewUsed = NumPlusUsed rem 8, - Unused = (8-NewUsed) rem 8, - case Unused of - 0 -> - <<_:Used,Bits:Num,Rest/binary>> = Bin, - {Bits,{0,Rest}}; - _ -> - Bytes = NumPlusUsed div 8, - <<_:Used,Bits:Num,_:Unused,_/binary>> = Bin, - <<_:Bytes/binary,Rest/binary>> = Bin, - {Bits,{NewUsed,Rest}} - end; -getbits(Bin,Num) when binary(Bin) -> - getbits({0,Bin},Num). - - - -% getoctet(Bytes) when list(Bytes) -> -% getoctet({0,Bytes}); -% getoctet(Bytes) -> -% %% io:format("getoctet:Buffer = ~p~n",[Bytes]), -% getoctet1(Bytes). - -% getoctet1({0,[H|T]}) -> -% {H,{0,T}}; -% getoctet1({Pos,[_,H|T]}) -> -% {H,{0,T}}. - -align({0,L}) -> - {0,L}; -align({_Pos,<<_H,T/binary>>}) -> - {0,T}; -align(Bytes) -> - {0,Bytes}. - -%% First align buffer, then pick the first Num octets. -%% Returns octets as an integer with bit significance as in buffer. -getoctets({0,Buffer},Num) -> - <<Val:Num/integer-unit:8,RestBin/binary>> = Buffer, - {Val,{0,RestBin}}; -getoctets({U,<<_Padding,Rest/binary>>},Num) when U /= 0 -> - getoctets({0,Rest},Num); -getoctets(Buffer,Num) when binary(Buffer) -> - getoctets({0,Buffer},Num). -% getoctets(Buffer,Num) -> -% %% io:format("getoctets:Buffer = ~p~nNum = ~p~n",[Buffer,Num]), -% getoctets(Buffer,Num,0). - -% getoctets(Buffer,0,Acc) -> -% {Acc,Buffer}; -% getoctets(Buffer,Num,Acc) -> -% {Oct,NewBuffer} = getoctet(Buffer), -% getoctets(NewBuffer,Num-1,(Acc bsl 8)+Oct). - -% getoctets_as_list(Buffer,Num) -> -% getoctets_as_list(Buffer,Num,[]). - -% getoctets_as_list(Buffer,0,Acc) -> -% {lists:reverse(Acc),Buffer}; -% getoctets_as_list(Buffer,Num,Acc) -> -% {Oct,NewBuffer} = getoctet(Buffer), -% getoctets_as_list(NewBuffer,Num-1,[Oct|Acc]). - -%% First align buffer, then pick the first Num octets. -%% Returns octets as a binary -getoctets_as_bin({0,Bin},Num)-> - <<Octets:Num/binary,RestBin/binary>> = Bin, - {Octets,{0,RestBin}}; -getoctets_as_bin({_U,Bin},Num) -> - <<_Padding,Octets:Num/binary,RestBin/binary>> = Bin, - {Octets,{0,RestBin}}; -getoctets_as_bin(Bin,Num) when binary(Bin) -> - getoctets_as_bin({0,Bin},Num). - -%% same as above but returns octets as a List -getoctets_as_list(Buffer,Num) -> - {Bin,Buffer2} = getoctets_as_bin(Buffer,Num), - {binary_to_list(Bin),Buffer2}. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings -%% Alt = atom() -%% Altnum = integer() | {integer(),integer()}% number of alternatives -%% Choices = [atom()] | {[atom()],[atom()]} -%% When Choices is a tuple the first list is the Rootset and the -%% second is the Extensions and then Altnum must also be a tuple with the -%% lengths of the 2 lists -%% -set_choice(Alt,{L1,L2},{Len1,_Len2}) -> - case set_choice_tag(Alt,L1) of - N when integer(N), Len1 > 1 -> -% [{bits,1,0}, % the value is in the root set -% encode_constrained_number({0,Len1-1},N)]; - [0, % the value is in the root set - encode_constrained_number({0,Len1-1},N)]; - N when integer(N) -> -% [{bits,1,0}]; % no encoding if only 0 or 1 alternative - [0]; % no encoding if only 0 or 1 alternative - false -> -% [{bits,1,1}, % extension value - [1, % extension value - case set_choice_tag(Alt,L2) of - N2 when integer(N2) -> - encode_small_number(N2); - false -> - unknown_choice_alt - end] - end; -set_choice(Alt,L,Len) -> - case set_choice_tag(Alt,L) of - N when integer(N), Len > 1 -> - encode_constrained_number({0,Len-1},N); - N when integer(N) -> - []; % no encoding if only 0 or 1 alternative - false -> - [unknown_choice_alt] - end. - -set_choice_tag(Alt,Choices) -> - set_choice_tag(Alt,Choices,0). - -set_choice_tag(Alt,[Alt|_Rest],Tag) -> - Tag; -set_choice_tag(Alt,[_H|Rest],Tag) -> - set_choice_tag(Alt,Rest,Tag+1); -set_choice_tag(_Alt,[],_Tag) -> - false. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_fragmented_XXX; decode of values encoded fragmented according -%% to ITU-T X.691 clause 10.9.3.8. The unit (XXX) is either bits, octets, -%% characters or number of components (in a choice,sequence or similar). -%% Buffer is a buffer {Used, Bin}. -%% C is the constrained length. -%% If the buffer is not aligned, this function does that. -decode_fragmented_bits({0,Buffer},C) -> - decode_fragmented_bits(Buffer,C,[]); -decode_fragmented_bits({_N,<<_B,Bs/binary>>},C) -> - decode_fragmented_bits(Bs,C,[]). - -decode_fragmented_bits(<<3:2,Len:6,Bin/binary>>,C,Acc) -> - {Value,Bin2} = split_binary(Bin, Len * ?'16K'), - decode_fragmented_bits(Bin2,C,[Value,Acc]); -decode_fragmented_bits(<<0:1,0:7,Bin/binary>>,C,Acc) -> - BinBits = list_to_binary(lists:reverse(Acc)), - case C of - Int when integer(Int),C == size(BinBits) -> - {BinBits,{0,Bin}}; - Int when integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinBits}}}); - _ -> - {BinBits,{0,Bin}} - end; -decode_fragmented_bits(<<0:1,Len:7,Bin/binary>>,C,Acc) -> - Result = {BinBits,{Used,_Rest}} = - case (Len rem 8) of - 0 -> - <<Value:Len/binary-unit:1,Bin2/binary>> = Bin, - {list_to_binary(lists:reverse([Value|Acc])),{0,Bin2}}; - Rem -> - Bytes = Len div 8, - U = 8 - Rem, - <<Value:Bytes/binary-unit:8,Bits1:Rem,Bits2:U,Bin2/binary>> = Bin, - {list_to_binary(lists:reverse([Bits1 bsl U,Value|Acc])), - {Rem,<<Bits2,Bin2/binary>>}} - end, - case C of - Int when integer(Int),C == (size(BinBits) - ((8 - Used) rem 8)) -> - Result; - Int when integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinBits}}}); - _ -> - Result - end. - - -decode_fragmented_octets({0,Bin},C) -> - decode_fragmented_octets(Bin,C,[]); -decode_fragmented_octets({_N,<<_B,Bs/binary>>},C) -> - decode_fragmented_octets(Bs,C,[]). - -decode_fragmented_octets(<<3:2,Len:6,Bin/binary>>,C,Acc) -> - {Value,Bin2} = split_binary(Bin,Len * ?'16K'), - decode_fragmented_octets(Bin2,C,[Value,Acc]); -decode_fragmented_octets(<<0:1,0:7,Bin/binary>>,C,Acc) -> - Octets = list_to_binary(lists:reverse(Acc)), - case C of - Int when integer(Int), C == size(Octets) -> - {Octets,{0,Bin}}; - Int when integer(Int) -> - exit({error,{asn1,{illegal_value,C,Octets}}}); - _ -> - {Octets,{0,Bin}} - end; -decode_fragmented_octets(<<0:1,Len:7,Bin/binary>>,C,Acc) -> - <<Value:Len/binary-unit:8,Bin2/binary>> = Bin, - BinOctets = list_to_binary(lists:reverse([Value|Acc])), - case C of - Int when integer(Int),size(BinOctets) == Int -> - {BinOctets,Bin2}; - Int when integer(Int) -> - exit({error,{asn1,{illegal_value,C,BinOctets}}}); - _ -> - {BinOctets,Bin2} - end. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_open_type(Constraint, Value) -> CompleteList -%% Value = list of bytes of an already encoded value (the list must be flat) -%% | binary -%% Contraint = not used in this version -%% -encode_open_type(_Constraint, Val) when list(Val) -> - Bin = list_to_binary(Val), - case size(Bin) of - Size when Size>255 -> - [encode_length(undefined,Size),[21,<<Size:16>>,Bin]]; - Size -> - [encode_length(undefined,Size),[20,Size,Bin]] - end; -% [encode_length(undefined,size(Bin)),{octets,Bin}]; % octets implies align -encode_open_type(_Constraint, Val) when binary(Val) -> -% [encode_length(undefined,size(Val)),{octets,Val}]. % octets implies align - case size(Val) of - Size when Size>255 -> - [encode_length(undefined,size(Val)),[21,<<Size:16>>,Val]]; % octets implies align - Size -> - [encode_length(undefined,Size),[20,Size,Val]] - end. -%% the binary_to_list is not optimal but compatible with the current solution - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_open_type(Buffer,Constraint) -> Value -%% Constraint is not used in this version -%% Buffer = [byte] with PER encoded data -%% Value = [byte] with decoded data (which must be decoded again as some type) -%% -decode_open_type(Bytes, _Constraint) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_bin(Bytes2,Len). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_integer(Constraint,Value,NamedNumberList) -> CompleteList -%% encode_integer(Constraint,Value) -> CompleteList -%% encode_integer(Constraint,{Name,Value}) -> CompleteList -%% -%% -encode_integer(C,V,NamedNumberList) when atom(V) -> - case lists:keysearch(V,1,NamedNumberList) of - {value,{_,NewV}} -> - encode_integer(C,NewV); - _ -> - exit({error,{asn1,{namednumber,V}}}) - end; -encode_integer(C,V,_NamedNumberList) when integer(V) -> - encode_integer(C,V); -encode_integer(C,{Name,V},NamedNumberList) when atom(Name) -> - encode_integer(C,V,NamedNumberList). - -encode_integer(C,{Name,Val}) when atom(Name) -> - encode_integer(C,Val); - -encode_integer([{Rc,_Ec}],Val) when tuple(Rc) -> % XXX when is this invoked? First argument most often a list,...Ok this is the extension case...but it doesn't work. - case (catch encode_integer([Rc],Val)) of - {'EXIT',{error,{asn1,_}}} -> -% [{bits,1,1},encode_unconstrained_number(Val)]; - [1,encode_unconstrained_number(Val)]; - Encoded -> -% [{bits,1,0},Encoded] - [0,Encoded] - end; - -encode_integer([],Val) -> - encode_unconstrained_number(Val); -%% The constraint is the effective constraint, and in this case is a number -encode_integer([{'SingleValue',V}],V) -> - []; -encode_integer([{'ValueRange',VR={Lb,Ub},Range,PreEnc}],Val) when Val >= Lb, - Ub >= Val -> - %% this case when NamedNumberList - encode_constrained_number(VR,Range,PreEnc,Val); -encode_integer([{'ValueRange',{Lb,'MAX'}}],Val) -> - encode_semi_constrained_number(Lb,Val); -encode_integer([{'ValueRange',{'MIN',_}}],Val) -> - encode_unconstrained_number(Val); -encode_integer([{'ValueRange',VR={_Lb,_Ub}}],Val) -> - encode_constrained_number(VR,Val); -encode_integer(_,Val) -> - exit({error,{asn1,{illegal_value,Val}}}). - - - -decode_integer(Buffer,Range,NamedNumberList) -> - {Val,Buffer2} = decode_integer(Buffer,Range), - case lists:keysearch(Val,2,NamedNumberList) of - {value,{NewVal,_}} -> {NewVal,Buffer2}; - _ -> {Val,Buffer2} - end. - -decode_integer(Buffer,[{Rc,_Ec}]) when tuple(Rc) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> decode_integer(Buffer2,[Rc]); - 1 -> decode_unconstrained_number(Buffer2) - end; -decode_integer(Buffer,undefined) -> - decode_unconstrained_number(Buffer); -decode_integer(Buffer,C) -> - case get_constraint(C,'SingleValue') of - V when integer(V) -> - {V,Buffer}; - _ -> - decode_integer1(Buffer,C) - end. - -decode_integer1(Buffer,C) -> - case VR = get_constraint(C,'ValueRange') of - no -> - decode_unconstrained_number(Buffer); - {Lb, 'MAX'} -> - decode_semi_constrained_number(Buffer,Lb); - {_Lb,_Ub} -> - decode_constrained_number(Buffer,VR) - end. - -%% X.691:10.6 Encoding of a normally small non-negative whole number -%% Use this for encoding of CHOICE index if there is an extension marker in -%% the CHOICE -encode_small_number({Name,Val}) when atom(Name) -> - encode_small_number(Val); -encode_small_number(Val) when Val =< 63 -> -% [{bits,1,0},{bits,6,Val}]; -% [{bits,7,Val}]; % same as above but more efficient - [10,7,Val]; % same as above but more efficient -encode_small_number(Val) -> -% [{bits,1,1},encode_semi_constrained_number(0,Val)]. - [1,encode_semi_constrained_number(0,Val)]. - -decode_small_number(Bytes) -> - {Bit,Bytes2} = getbit(Bytes), - case Bit of - 0 -> - getbits(Bytes2,6); - 1 -> - decode_semi_constrained_number(Bytes2,0) - end. - -%% X.691:10.7 Encoding of a semi-constrained whole number -%% might be an optimization encode_semi_constrained_number(0,Val) -> -encode_semi_constrained_number(C,{Name,Val}) when atom(Name) -> - encode_semi_constrained_number(C,Val); -encode_semi_constrained_number({Lb,'MAX'},Val) -> - encode_semi_constrained_number(Lb,Val); -encode_semi_constrained_number(Lb,Val) -> - Val2 = Val - Lb, - Oct = eint_positive(Val2), - Len = length(Oct), - if - Len < 128 -> - %{octets,[Len|Oct]}; % equiv with encode_length(undefined,Len) but faster - [20,Len+1,[Len|Oct]]; - Len < 256 -> - [encode_length(undefined,Len),[20,Len,Oct]]; - true -> - [encode_length(undefined,Len),[21,<<Len:16>>,Oct]] - end. - -decode_semi_constrained_number(Bytes,{Lb,_}) -> - decode_semi_constrained_number(Bytes,Lb); -decode_semi_constrained_number(Bytes,Lb) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {V,Bytes3} = getoctets(Bytes2,Len), - {V+Lb,Bytes3}. - -encode_constrained_number({Lb,_Ub},_Range,{bits,N},Val) -> - Val2 = Val-Lb, -% {bits,N,Val2}; - [10,N,Val2]; -encode_constrained_number({Lb,_Ub},_Range,{octets,N},Val) when N < 256-> - %% N is 8 or 16 (1 or 2 octets) - Val2 = Val-Lb, -% {octets,<<Val2:N/unit:8>>}; - [20,N,Val2]; -encode_constrained_number({Lb,_Ub},_Range,{octets,N},Val) -> % N>255 - %% N is 8 or 16 (1 or 2 octets) - Val2 = Val-Lb, -% {octets,<<Val2:N/unit:8>>}; - [21,<<N:16>>,Val2]; -encode_constrained_number({Lb,_Ub},Range,_,Val) -> - Val2 = Val-Lb, - if - Range =< 16#1000000 -> % max 3 octets - Octs = eint_positive(Val2), -% [encode_length({1,3},size(Octs)),{octets,Octs}]; - L = length(Octs), - [encode_length({1,3},L),[20,L,Octs]]; - Range =< 16#100000000 -> % max 4 octets - Octs = eint_positive(Val2), -% [encode_length({1,4},size(Octs)),{octets,Octs}]; - L = length(Octs), - [encode_length({1,4},L),[20,L,Octs]]; - Range =< 16#10000000000 -> % max 5 octets - Octs = eint_positive(Val2), -% [encode_length({1,5},size(Octs)),{octets,Octs}]; - L = length(Octs), - [encode_length({1,5},L),[20,L,Octs]]; - true -> - exit({not_supported,{integer_range,Range}}) - end. - -encode_constrained_number(Range,{Name,Val}) when atom(Name) -> - encode_constrained_number(Range,Val); -encode_constrained_number({Lb,Ub},Val) when Val >= Lb, Ub >= Val -> - Range = Ub - Lb + 1, - Val2 = Val - Lb, - if - Range == 2 -> -% Size = {bits,1,Val2}; - [Val2]; - Range =< 4 -> -% Size = {bits,2,Val2}; - [10,2,Val2]; - Range =< 8 -> - [10,3,Val2]; - Range =< 16 -> - [10,4,Val2]; - Range =< 32 -> - [10,5,Val2]; - Range =< 64 -> - [10,6,Val2]; - Range =< 128 -> - [10,7,Val2]; - Range =< 255 -> - [10,8,Val2]; - Range =< 256 -> -% Size = {octets,[Val2]}; - [20,1,Val2]; - Range =< 65536 -> -% Size = {octets,<<Val2:16>>}; - [20,2,<<Val2:16>>]; - Range =< 16#1000000 -> - Octs = eint_positive(Val2), -% [{bits,2,length(Octs)-1},{octets,Octs}]; - Len = length(Octs), - [10,2,Len-1,20,Len,Octs]; - Range =< 16#100000000 -> - Octs = eint_positive(Val2), - Len = length(Octs), - [10,2,Len-1,20,Len,Octs]; - Range =< 16#10000000000 -> - Octs = eint_positive(Val2), - Len = length(Octs), - [10,3,Len-1,20,Len,Octs]; - true -> - exit({not_supported,{integer_range,Range}}) - end; -encode_constrained_number({_,_},Val) -> - exit({error,{asn1,{illegal_value,Val}}}). - -decode_constrained_number(Buffer,VR={Lb,Ub}) -> - Range = Ub - Lb + 1, - decode_constrained_number(Buffer,VR,Range). - -decode_constrained_number(Buffer,{Lb,_Ub},_Range,{bits,N}) -> - {Val,Remain} = getbits(Buffer,N), - {Val+Lb,Remain}; -decode_constrained_number(Buffer,{Lb,_Ub},_Range,{octets,N}) -> - {Val,Remain} = getoctets(Buffer,N), - {Val+Lb,Remain}. - -decode_constrained_number(Buffer,{Lb,_Ub},Range) -> - % Val2 = Val - Lb, - {Val,Remain} = - if - Range == 2 -> - getbits(Buffer,1); - Range =< 4 -> - getbits(Buffer,2); - Range =< 8 -> - getbits(Buffer,3); - Range =< 16 -> - getbits(Buffer,4); - Range =< 32 -> - getbits(Buffer,5); - Range =< 64 -> - getbits(Buffer,6); - Range =< 128 -> - getbits(Buffer,7); - Range =< 255 -> - getbits(Buffer,8); - Range =< 256 -> - getoctets(Buffer,1); - Range =< 65536 -> - getoctets(Buffer,2); - Range =< 16#1000000 -> - {Len,Bytes2} = decode_length(Buffer,{1,3}), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_pos_integer(Octs),Bytes3}; - Range =< 16#100000000 -> - {Len,Bytes2} = decode_length(Buffer,{1,4}), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_pos_integer(Octs),Bytes3}; - Range =< 16#10000000000 -> - {Len,Bytes2} = decode_length(Buffer,{1,5}), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_pos_integer(Octs),Bytes3}; - true -> - exit({not_supported,{integer_range,Range}}) - end, - {Val+Lb,Remain}. - -%% X.691:10.8 Encoding of an unconstrained whole number - -encode_unconstrained_number(Val) when Val >= 0 -> - Oct = eint(Val,[]), - Len = length(Oct), - if - Len < 128 -> - %{octets,[Len|Oct]}; % equiv with encode_length(undefined,Len) but faster - [20,Len+1,[Len|Oct]]; - Len < 256 -> -% [encode_length(undefined,Len),20,Len,Oct]; - [20,Len+2,<<2:2,Len:14>>,Oct];% equiv with encode_length(undefined,Len) but faster - true -> -% [encode_length(undefined,Len),{octets,Oct}] - [encode_length(undefined,Len),[21,<<Len:16>>,Oct]] - end; -encode_unconstrained_number(Val) -> % negative - Oct = enint(Val,[]), - Len = length(Oct), - if - Len < 128 -> -% {octets,[Len|Oct]}; % equiv with encode_length(undefined,Len) but faster - [20,Len+1,[Len|Oct]];% equiv with encode_length(undefined,Len) but faster - Len < 256 -> -% [encode_length(undefined,Len),20,Len,Oct]; - [20,Len+2,<<2:2,Len:14>>,Oct];% equiv with encode_length(undefined,Len) but faster - true -> - %[encode_length(undefined,Len),{octets,Oct}] - [encode_length(undefined,Len),[21,<<Len:16>>,Oct]] - end. - - -%% used for positive Values which don't need a sign bit -%% returns a list -eint_positive(Val) -> - case eint(Val,[]) of - [0,B1|T] -> - [B1|T]; - T -> - T - end. - - -eint(0, [B|Acc]) when B < 128 -> - [B|Acc]; -eint(N, Acc) -> - eint(N bsr 8, [N band 16#ff| Acc]). - -enint(-1, [B1|T]) when B1 > 127 -> - [B1|T]; -enint(N, Acc) -> - enint(N bsr 8, [N band 16#ff|Acc]). - -decode_unconstrained_number(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Ints,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_integer(Ints),Bytes3}. - -dec_pos_integer(Ints) -> - decpint(Ints, 8 * (length(Ints) - 1)). -dec_integer(Ints) when hd(Ints) band 255 =< 127 -> %% Positive number - decpint(Ints, 8 * (length(Ints) - 1)); -dec_integer(Ints) -> %% Negative - decnint(Ints, 8 * (length(Ints) - 1)). - -decpint([Byte|Tail], Shift) -> - (Byte bsl Shift) bor decpint(Tail, Shift-8); -decpint([], _) -> 0. - -decnint([Byte|Tail], Shift) -> - (-128 + (Byte band 127) bsl Shift) bor decpint(Tail, Shift-8). - -% minimum_octets(Val) -> -% minimum_octets(Val,[]). - -% minimum_octets(Val,Acc) when Val > 0 -> -% minimum_octets((Val bsr 8),[Val band 16#FF|Acc]); -% minimum_octets(0,Acc) -> -% Acc. - - -%% X.691:10.9 Encoding of a length determinant -%%encode_small_length(undefined,Len) -> % null means no UpperBound -%% encode_small_number(Len). - -%% X.691:10.9.3.5 -%% X.691:10.9.3.7 -encode_length(undefined,Len) -> % un-constrained - if - Len < 128 -> -% {octets,[Len]}; - [20,1,Len]; - Len < 16384 -> - %{octets,<<2:2,Len:14>>}; - [20,2,<<2:2,Len:14>>]; - true -> % should be able to endode length >= 16384 i.e. fragmented length - exit({error,{asn1,{encode_length,{nyi,above_16k}}}}) - end; - -encode_length({0,'MAX'},Len) -> - encode_length(undefined,Len); -encode_length(Vr={Lb,Ub},Len) when Ub =< 65535 ,Lb >= 0 -> % constrained - encode_constrained_number(Vr,Len); -encode_length({Lb,_Ub},Len) when integer(Lb), Lb >= 0 -> % Ub > 65535 - encode_length(undefined,Len); -encode_length({Vr={Lb,Ub},[]},Len) when Ub =< 65535 ,Lb >= 0,Len=<Ub -> - %% constrained extensible -% [{bits,1,0},encode_constrained_number(Vr,Len)]; - [0,encode_constrained_number(Vr,Len)]; -encode_length({{Lb,_},[]},Len) -> - [1,encode_semi_constrained_number(Lb,Len)]; -encode_length(SingleValue,_Len) when integer(SingleValue) -> - []. - -%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension -%% additions in a sequence or set -encode_small_length(Len) when Len =< 64 -> -%% [{bits,1,0},{bits,6,Len-1}]; -% {bits,7,Len-1}; % the same as above but more efficient - [10,7,Len-1]; -encode_small_length(Len) -> -% [{bits,1,1},encode_length(undefined,Len)]. - [1,encode_length(undefined,Len)]. - -% decode_small_length({Used,<<_:Used,0:1,Num:6,_:((8-Used+1) rem 8),Rest/binary>>}) -> -% case Buffer of -% <<_:Used,0:1,Num:6,_:((8-Used+1) rem 8),Rest/binary>> -> -% {Num, -% case getbit(Buffer) of -% {0,Remain} -> -% {Bits,Remain2} = getbits(Remain,6), -% {Bits+1,Remain2}; -% {1,Remain} -> -% decode_length(Remain,undefined) -% end. - -decode_small_length(Buffer) -> - case getbit(Buffer) of - {0,Remain} -> - {Bits,Remain2} = getbits(Remain,6), - {Bits+1,Remain2}; - {1,Remain} -> - decode_length(Remain,undefined) - end. - -decode_length(Buffer) -> - decode_length(Buffer,undefined). - -decode_length(Buffer,undefined) -> % un-constrained - {0,Buffer2} = align(Buffer), - case Buffer2 of - <<0:1,Oct:7,Rest/binary>> -> - {Oct,{0,Rest}}; - <<2:2,Val:14,Rest/binary>> -> - {Val,{0,Rest}}; - <<3:2,_Val:14,_Rest/binary>> -> - %% this case should be fixed - exit({error,{asn1,{decode_length,{nyi,above_16k}}}}) - end; -%% {Bits,_} = getbits(Buffer2,2), -% case Bits of -% 2 -> -% {Val,Bytes3} = getoctets(Buffer2,2), -% {(Val band 16#3FFF),Bytes3}; -% 3 -> -% exit({error,{asn1,{decode_length,{nyi,above_16k}}}}); -% _ -> -% {Val,Bytes3} = getoctet(Buffer2), -% {Val band 16#7F,Bytes3} -% end; - -decode_length(Buffer,{Lb,Ub}) when Ub =< 65535 ,Lb >= 0 -> % constrained - decode_constrained_number(Buffer,{Lb,Ub}); -decode_length(_Buffer,{Lb,_Ub}) when integer(Lb), Lb >= 0 -> % Ub > 65535 - exit({error,{asn1,{decode_length,{nyi,above_64K}}}}); -decode_length(Buffer,{{Lb,Ub},[]}) -> - case getbit(Buffer) of - {0,Buffer2} -> - decode_length(Buffer2, {Lb,Ub}) - end; - - -%When does this case occur with {_,_Lb,Ub} ?? -% X.691:10.9.3.5 -decode_length({Used,Bin},{_,_Lb,_Ub}) -> %when Len =< 127 -> % Unconstrained or large Ub NOTE! this case does not cover case when Ub > 65535 - Unused = (8-Used) rem 8, - case Bin of - <<_:Used,0:1,Val:7,R:Unused,Rest/binary>> -> - {Val,{Used,<<R,Rest/binary>>}}; - <<_:Used,_:Unused,2:2,Val:14,Rest/binary>> -> - {Val, {0,Rest}}; - <<_:Used,_:Unused,3:2,_:14,_Rest/binary>> -> - exit({error,{asn1,{decode_length,{nyi,length_above_64K}}}}) - end; -% decode_length(Buffer,{_,_Lb,Ub}) -> %when Len =< 127 -> % Unconstrained or large Ub -% case getbit(Buffer) of -% {0,Remain} -> -% getbits(Remain,7); -% {1,Remain} -> -% {Val,Remain2} = getoctets(Buffer,2), -% {Val band 2#0111111111111111, Remain2} -% end; -decode_length(Buffer,SingleValue) when integer(SingleValue) -> - {SingleValue,Buffer}. - - - % X.691:11 -decode_boolean(Buffer) -> %when record(Buffer,buffer) - case getbit(Buffer) of - {1,Remain} -> {true,Remain}; - {0,Remain} -> {false,Remain} - end. - - -%% ENUMERATED with extension marker -decode_enumerated(Buffer,C,{Ntup1,Ntup2}) when tuple(Ntup1), tuple(Ntup2) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> % not an extension value - {Val,Buffer3} = decode_integer(Buffer2,C), - case catch (element(Val+1,Ntup1)) of - NewVal when atom(NewVal) -> {NewVal,Buffer3}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,[Ntup1,Ntup2]}}}}) - end; - 1 -> % this an extension value - {Val,Buffer3} = decode_small_number(Buffer2), - case catch (element(Val+1,Ntup2)) of - NewVal when atom(NewVal) -> {NewVal,Buffer3}; - _ -> {{asn1_enum,Val},Buffer3} - end - end; - -decode_enumerated(Buffer,C,NamedNumberTup) when tuple(NamedNumberTup) -> - {Val,Buffer2} = decode_integer(Buffer,C), - case catch (element(Val+1,NamedNumberTup)) of - NewVal when atom(NewVal) -> {NewVal,Buffer2}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,NamedNumberTup}}}}) - end. - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Bitstring value, ITU_T X.690 Chapter 8.5 -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% encode bitstring value -%%=============================================================================== - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% bitstring NamedBitList -%% Val can be of: -%% - [identifiers] where only named identifers are set to one, -%% the Constraint must then have some information of the -%% bitlength. -%% - [list of ones and zeroes] all bits -%% - integer value representing the bitlist -%% C is constraint Len, only valid when identifiers - - -%% when the value is a list of {Unused,BinBits}, where -%% Unused = integer(), -%% BinBits = binary(). - -encode_bit_string(C,Bin={Unused,BinBits},NamedBitList) when integer(Unused), - binary(BinBits) -> - encode_bin_bit_string(C,Bin,NamedBitList); - -%% when the value is a list of named bits - -encode_bit_string(C, LoNB=[FirstVal | _RestVal], NamedBitList) when atom(FirstVal) -> - ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string(C,BitList,NamedBitList);% consider the constraint - -encode_bit_string(C, BL=[{bit,_} | _RestVal], NamedBitList) -> - ToSetPos = get_all_bitposes(BL, NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string(C,BitList,NamedBitList); - -%% when the value is a list of ones and zeroes -encode_bit_string(Int, BitListValue, _) - when list(BitListValue),integer(Int) -> - %% The type is constrained by a single value size constraint - [40,Int,length(BitListValue),BitListValue]; -% encode_bit_string(C, BitListValue,NamedBitList) -% when list(BitListValue) -> -% [encode_bit_str_length(C,BitListValue), -% 2,45,BitListValue]; -encode_bit_string(no, BitListValue,[]) - when list(BitListValue) -> - [encode_length(undefined,length(BitListValue)), - 2,BitListValue]; -encode_bit_string(C, BitListValue,[]) - when list(BitListValue) -> - [encode_length(C,length(BitListValue)), - 2,BitListValue]; -encode_bit_string(no, BitListValue,_NamedBitList) - when list(BitListValue) -> - %% this case with an unconstrained BIT STRING can be made more efficient - %% if the complete driver can take a special code so the length field - %% is encoded there. - NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, - lists:reverse(BitListValue))), - [encode_length(undefined,length(NewBitLVal)), - 2,NewBitLVal]; -encode_bit_string(C,BitListValue,_NamedBitList) - when list(BitListValue) ->% C = {_,'MAX'} -% NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, -% lists:reverse(BitListValue))), - NewBitLVal = bit_string_trailing_zeros(BitListValue,C), - [encode_length(C,length(NewBitLVal)), - 2,NewBitLVal]; - -% encode_bit_string(C, BitListValue, NamedBitList) when list(BitListValue) -> -% BitListToBinary = -% %% fun that transforms a list of 1 and 0 to a tuple: -% %% {UnusedBitsInLastByte, Binary} -% fun([H|T],Acc,N,Fun) -> -% Fun(T,(Acc bsl 1)+H,N+1,Fun); -% ([],Acc,N,_) -> % length fits in one byte -% Unused = (8 - (N rem 8)) rem 8, -% % case N/8 of -% % _Len =< 255 -> -% % [30,Unused,(Unused+N)/8,<<Acc:N,0:Unused>>]; -% % _Len -> -% % Len = (Unused+N)/8, -% % [31,Unused,<<Len:16>>,<<Acc:N,0:Unused>>] -% % end -% {Unused,<<Acc:N,0:Unused>>} -% end, -% UnusedAndBin = -% case NamedBitList of -% [] -> % dont remove trailing zeroes -% BitListToBinary(BitListValue,0,0,BitListToBinary); -% _ -> -% BitListToBinary(lists:reverse( -% lists:dropwhile(fun(0)->true;(1)->false end, -% lists:reverse(BitListValue))), -% 0,0,BitListToBinary) -% end, -% encode_bin_bit_string(C,UnusedAndBin,NamedBitList); - -%% when the value is an integer -encode_bit_string(C, IntegerVal, NamedBitList) when integer(IntegerVal)-> - BitList = int_to_bitlist(IntegerVal), - encode_bit_string(C,BitList,NamedBitList); - -%% when the value is a tuple -encode_bit_string(C,{Name,Val}, NamedBitList) when atom(Name) -> - encode_bit_string(C,Val,NamedBitList). - -bit_string_trailing_zeros(BitList,C) when integer(C) -> - bit_string_trailing_zeros1(BitList,C,C); -bit_string_trailing_zeros(BitList,{Lb,Ub}) when integer(Lb) -> - bit_string_trailing_zeros1(BitList,Lb,Ub); -bit_string_trailing_zeros(BitList,{{Lb,Ub},_}) when integer(Lb) -> - bit_string_trailing_zeros1(BitList,Lb,Ub); -bit_string_trailing_zeros(BitList,_) -> - BitList. - -bit_string_trailing_zeros1(BitList,Lb,Ub) -> - case length(BitList) of - Lb -> BitList; - B when B<Lb -> BitList++lists:duplicate(Lb-B,0); - D -> F = fun(L,LB,LB,_,_)->lists:reverse(L); - ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun); - (L,L1,_,UB,_)when L1 =< UB -> lists:reverse(L); - (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING, - BitList}}) end, - F(lists:reverse(BitList),D,Lb,Ub,F) - end. - -%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. -%% Unused = integer(),i.e. number unused bits in least sign. byte of -%% BinBits = binary(). -encode_bin_bit_string(C,{_,BinBits},_NamedBitList) - when integer(C),C=<16 -> - [45,C,size(BinBits),BinBits]; -encode_bin_bit_string(C,{_Unused,BinBits},_NamedBitList) - when integer(C) -> - [2,45,C,size(BinBits),BinBits]; -encode_bin_bit_string(C,UnusedAndBin={_,_},NamedBitList) -> -% UnusedAndBin1 = {Unused1,Bin1} = - {Unused1,Bin1} = - %% removes all trailing bits if NamedBitList is not empty - remove_trailing_bin(NamedBitList,UnusedAndBin), - case C of -% case get_constraint(C,'SizeConstraint') of - -% 0 -> -% []; % borde avg�ras i compile-time -% V when integer(V),V=<16 -> -% {Unused2,Bin2} = pad_list(V,UnusedAndBin1), -% <<BitVal:V,_:Unused2>> = Bin2, -% % {bits,V,BitVal}; -% [10,V,BitVal]; -% V when integer(V) -> -% %[align, pad_list(V, UnusedAndBin1)]; -% {Unused2,Bin2} = pad_list(V, UnusedAndBin1), -% <<BitVal:V,_:Unused2>> = Bin2, -% [2,octets_unused_to_complete(Unused2,size(Bin2),Bin2)]; - - {Lb,Ub} when integer(Lb),integer(Ub) -> -% [encode_length({Lb,Ub},size(Bin1)*8 - Unused1), -% align,UnusedAndBin1]; - Size=size(Bin1), - [encode_length({Lb,Ub},Size*8 - Unused1), - 2,octets_unused_to_complete(Unused1,Size,Bin1)]; - no -> - Size=size(Bin1), - [encode_length(undefined,Size*8 - Unused1), - 2,octets_unused_to_complete(Unused1,Size,Bin1)]; - Sc -> - Size=size(Bin1), - [encode_length(Sc,Size*8 - Unused1), - 2,octets_unused_to_complete(Unused1,Size,Bin1)] - end. - -remove_trailing_bin([], {Unused,Bin}) -> - {Unused,Bin}; -remove_trailing_bin(NamedNumberList, {_Unused,Bin}) -> - Size = size(Bin)-1, - <<Bfront:Size/binary, LastByte:8>> = Bin, - %% clear the Unused bits to be sure -% LastByte1 = LastByte band (((1 bsl Unused) -1) bxor 255),% why this??? - Unused1 = trailingZeroesInNibble(LastByte band 15), - Unused2 = - case Unused1 of - 4 -> - 4 + trailingZeroesInNibble(LastByte bsr 4); - _ -> Unused1 - end, - case Unused2 of - 8 -> - remove_trailing_bin(NamedNumberList,{0,Bfront}); - _ -> - {Unused2,Bin} - end. - - -trailingZeroesInNibble(0) -> - 4; -trailingZeroesInNibble(1) -> - 0; -trailingZeroesInNibble(2) -> - 1; -trailingZeroesInNibble(3) -> - 0; -trailingZeroesInNibble(4) -> - 2; -trailingZeroesInNibble(5) -> - 0; -trailingZeroesInNibble(6) -> - 1; -trailingZeroesInNibble(7) -> - 0; -trailingZeroesInNibble(8) -> - 3; -trailingZeroesInNibble(9) -> - 0; -trailingZeroesInNibble(10) -> - 1; -trailingZeroesInNibble(11) -> - 0; -trailingZeroesInNibble(12) -> %#1100 - 2; -trailingZeroesInNibble(13) -> - 0; -trailingZeroesInNibble(14) -> - 1; -trailingZeroesInNibble(15) -> - 0. - -%%%%%%%%%%%%%%% -%% The result is presented as a list of named bits (if possible) -%% else as a tuple {Unused,Bits}. Unused is the number of unused -%% bits, least significant bits in the last byte of Bits. Bits is -%% the BIT STRING represented as a binary. -%% -decode_compact_bit_string(Buffer, C, NamedNumberList) -> - case get_constraint(C,'SizeConstraint') of - 0 -> % fixed length - {{8,0},Buffer}; - V when integer(V),V=<16 -> %fixed length 16 bits or less - compact_bit_string(Buffer,V,NamedNumberList); - V when integer(V),V=<65536 -> %fixed length > 16 bits - Bytes2 = align(Buffer), - compact_bit_string(Bytes2,V,NamedNumberList); - V when integer(V) -> % V > 65536 => fragmented value - {Bin,Buffer2} = decode_fragmented_bits(Buffer,V), - case Buffer2 of - {0,_} -> {{0,Bin},Buffer2}; - {U,_} -> {{8-U,Bin},Buffer2} - end; - {Lb,Ub} when integer(Lb),integer(Ub) -> - %% This case may demand decoding of fragmented length/value - {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList); - no -> - %% This case may demand decoding of fragmented length/value - {Len,Bytes2} = decode_length(Buffer,undefined), - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList); - Sc -> - {Len,Bytes2} = decode_length(Buffer,Sc), - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList) - end. - - -%%%%%%%%%%%%%%% -%% The result is presented as a list of named bits (if possible) -%% else as a list of 0 and 1. -%% -decode_bit_string(Buffer, C, NamedNumberList) -> - case get_constraint(C,'SizeConstraint') of - {Lb,Ub} when integer(Lb),integer(Ub) -> - {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), - Bytes3 = align(Bytes2), - bit_list_or_named(Bytes3,Len,NamedNumberList); - no -> - {Len,Bytes2} = decode_length(Buffer,undefined), - Bytes3 = align(Bytes2), - bit_list_or_named(Bytes3,Len,NamedNumberList); - 0 -> % fixed length - {[],Buffer}; % nothing to encode - V when integer(V),V=<16 -> % fixed length 16 bits or less - bit_list_or_named(Buffer,V,NamedNumberList); - V when integer(V),V=<65536 -> - Bytes2 = align(Buffer), - bit_list_or_named(Bytes2,V,NamedNumberList); - V when integer(V) -> - Bytes2 = align(Buffer), - {BinBits,_Bytes3} = decode_fragmented_bits(Bytes2,V), - bit_list_or_named(BinBits,V,NamedNumberList); - Sc -> % extension marker - {Len,Bytes2} = decode_length(Buffer,Sc), - Bytes3 = align(Bytes2), - bit_list_or_named(Bytes3,Len,NamedNumberList) - end. - - -%% if no named bits are declared we will return a -%% {Unused,Bits}. Unused = integer(), -%% Bits = binary(). -compact_bit_string(Buffer,Len,[]) -> - getbits_as_binary(Len,Buffer); % {{Unused,BinBits},NewBuffer} -compact_bit_string(Buffer,Len,NamedNumberList) -> - bit_list_or_named(Buffer,Len,NamedNumberList). - - -%% if no named bits are declared we will return a -%% BitList = [0 | 1] - -bit_list_or_named(Buffer,Len,[]) -> - getbits_as_list(Len,Buffer); - -%% if there are named bits declared we will return a named -%% BitList where the names are atoms and unnamed bits represented -%% as {bit,Pos} -%% BitList = [atom() | {bit,Pos}] -%% Pos = integer() - -bit_list_or_named(Buffer,Len,NamedNumberList) -> - {BitList,Rest} = getbits_as_list(Len,Buffer), - {bit_list_or_named1(0,BitList,NamedNumberList,[]), Rest}. - -bit_list_or_named1(Pos,[0|Bt],Names,Acc) -> - bit_list_or_named1(Pos+1,Bt,Names,Acc); -bit_list_or_named1(Pos,[1|Bt],Names,Acc) -> - case lists:keysearch(Pos,2,Names) of - {value,{Name,_}} -> - bit_list_or_named1(Pos+1,Bt,Names,[Name|Acc]); - _ -> - bit_list_or_named1(Pos+1,Bt,Names,[{bit,Pos}|Acc]) - end; -bit_list_or_named1(_Pos,[],_Names,Acc) -> - lists:reverse(Acc). - - - -%%%%%%%%%%%%%%% -%% - -int_to_bitlist(Int) when integer(Int), Int > 0 -> - [Int band 1 | int_to_bitlist(Int bsr 1)]; -int_to_bitlist(0) -> - []. - - -%%%%%%%%%%%%%%%%%% -%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> -%% [sorted_list_of_bitpositions_to_set] - -get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); - -get_all_bitposes([Val | Rest], NamedBitList, Ack) -> - case lists:keysearch(Val, 1, NamedBitList) of - {value, {_ValName, ValPos}} -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); - _ -> - exit({error,{asn1, {bitstring_namedbit, Val}}}) - end; -get_all_bitposes([], _NamedBitList, Ack) -> - lists:sort(Ack). - -%%%%%%%%%%%%%%%%%% -%% make_and_set_list([list of positions to set to 1])-> -%% returns list with all in SetPos set. -%% in positioning in list the first element is 0, the second 1 etc.., but -%% - -make_and_set_list([XPos|SetPos], XPos) -> - [1 | make_and_set_list(SetPos, XPos + 1)]; -make_and_set_list([Pos|SetPos], XPos) -> - [0 | make_and_set_list([Pos | SetPos], XPos + 1)]; -make_and_set_list([], _) -> - []. - -%%%%%%%%%%%%%%%%% -%% pad_list(N,BitList) -> PaddedList -%% returns a padded (with trailing {bit,0} elements) list of length N -%% if Bitlist contains more than N significant bits set an exit asn1_error -%% is generated - -% pad_list(N,In={Unused,Bin}) -> -% pad_list(N, size(Bin)*8 - Unused, In). - -% pad_list(N,Size,In={Unused,Bin}) when N < Size -> -% exit({error,{asn1,{range_error,{bit_string,In}}}}); -% pad_list(N,Size,{Unused,Bin}) when N > Size, Unused > 0 -> -% pad_list(N,Size+1,{Unused-1,Bin}); -% pad_list(N,Size,{Unused,Bin}) when N > Size -> -% pad_list(N,Size+1,{7,<<Bin/binary,0>>}); -% pad_list(N,N,In={Unused,Bin}) -> -% In. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% X.691:16 -%% encode_octet_string(Constraint,ExtensionMarker,Val) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -encode_octet_string(C,Val) -> - encode_octet_string(C,false,Val). - -encode_octet_string(C,Bool,{_Name,Val}) -> - encode_octet_string(C,Bool,Val); -encode_octet_string(_C,true,_Val) -> - exit({error,{asn1,{'not_supported',extensionmarker}}}); -encode_octet_string(SZ={_,_},false,Val) -> -% [encode_length(SZ,length(Val)),align, -% {octets,Val}]; - Len = length(Val), - [encode_length(SZ,Len),2, - octets_to_complete(Len,Val)]; -encode_octet_string(SZ,false,Val) when list(SZ) -> - Len = length(Val), - [encode_length({hd(SZ),lists:max(SZ)},Len),2, - octets_to_complete(Len,Val)]; -encode_octet_string(no,false,Val) -> - Len = length(Val), - [encode_length(undefined,Len),2, - octets_to_complete(Len,Val)]; -encode_octet_string(C,_,_) -> - exit({error,{not_implemented,C}}). - - -decode_octet_string(Bytes,Range) -> - decode_octet_string(Bytes,Range,false). - -decode_octet_string(Bytes,1,false) -> - {B1,Bytes2} = getbits(Bytes,8), - {[B1],Bytes2}; -decode_octet_string(Bytes,2,false) -> - {Bs,Bytes2}= getbits(Bytes,16), - {binary_to_list(<<Bs:16>>),Bytes2}; -decode_octet_string(Bytes,Sv,false) when integer(Sv),Sv=<65535 -> - Bytes2 = align(Bytes), - getoctets_as_list(Bytes2,Sv); -decode_octet_string(Bytes,Sv,false) when integer(Sv) -> - Bytes2 = align(Bytes), - decode_fragmented_octets(Bytes2,Sv); -decode_octet_string(Bytes,{Lb,Ub},false) -> - {Len,Bytes2} = decode_length(Bytes,{Lb,Ub}), - Bytes3 = align(Bytes2), - getoctets_as_list(Bytes3,Len); -decode_octet_string(Bytes,Sv,false) when list(Sv) -> - {Len,Bytes2} = decode_length(Bytes,{hd(Sv),lists:max(Sv)}), - Bytes3 = align(Bytes2), - getoctets_as_list(Bytes3,Len); -decode_octet_string(Bytes,no,false) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - Bytes3 = align(Bytes2), - getoctets_as_list(Bytes3,Len). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Restricted char string types -%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) -%% X.691:26 and X.680:34-36 -%%encode_restricted_string(aligned,'BMPString',Constraints,Extension,Val) - - -encode_restricted_string(aligned,{Name,Val}) when atom(Name) -> - encode_restricted_string(aligned,Val); - -encode_restricted_string(aligned,Val) when list(Val)-> - Len = length(Val), -% [encode_length(undefined,length(Val)),{octets,Val}]. - [encode_length(undefined,Len),octets_to_complete(Len,Val)]. - - -encode_known_multiplier_string(StringType,SizeC,NumBits,CharOutTab,{Name,Val}) when atom(Name) -> - encode_known_multiplier_string(StringType,SizeC,NumBits,CharOutTab,Val); -encode_known_multiplier_string(StringType,SizeC,NumBits,CharOutTab,Val) -> - Result = chars_encode2(Val,NumBits,CharOutTab), - case SizeC of - Ub when integer(Ub), Ub*NumBits =< 16 -> - case {StringType,Result} of - {'BMPString',{octets,Ol}} -> %% this case cannot happen !!?? - [{bits,8,Oct}||Oct <- Ol]; - _ -> - Result - end; - Ub when integer(Ub),Ub =<65535 -> % fixed length -%% [align,Result]; - [2,Result]; - {Ub,Lb} -> -% [encode_length({Ub,Lb},length(Val)),align,Result]; - [encode_length({Ub,Lb},length(Val)),2,Result]; - no -> -% [encode_length(undefined,length(Val)),align,Result] - [encode_length(undefined,length(Val)),2,Result] - end. - -decode_restricted_string(Bytes,aligned) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - getoctets_as_list(Bytes2,Len). - -decode_known_multiplier_string(StringType,SizeC,NumBits,CharInTab,Bytes) -> - case SizeC of - Ub when integer(Ub), Ub*NumBits =< 16 -> - chars_decode(Bytes,NumBits,StringType,CharInTab,Ub); - Ub when integer(Ub),Ub =<65535 -> % fixed length - Bytes1 = align(Bytes), - chars_decode(Bytes1,NumBits,StringType,CharInTab,Ub); - Vl when list(Vl) -> - {Len,Bytes1} = decode_length(Bytes,{hd(Vl),lists:max(Vl)}), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,CharInTab,Len); - no -> - {Len,Bytes1} = decode_length(Bytes,undefined), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,CharInTab,Len); - {Lb,Ub}-> - {Len,Bytes1} = decode_length(Bytes,{Lb,Ub}), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,CharInTab,Len) - end. - -encode_GeneralString(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_GeneralString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - -encode_GraphicString(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_GraphicString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - -encode_ObjectDescriptor(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_ObjectDescriptor(Bytes) -> - decode_restricted_string(Bytes,aligned). - -encode_TeletexString(_C,Val) -> % equivalent with T61String - encode_restricted_string(aligned,Val). -decode_TeletexString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - -encode_VideotexString(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_VideotexString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% getBMPChars(Bytes,Len) ->{BMPcharList,RemainingBytes} -%% -getBMPChars(Bytes,1) -> - {O1,Bytes2} = getbits(Bytes,8), - {O2,Bytes3} = getbits(Bytes2,8), - if - O1 == 0 -> - {[O2],Bytes3}; - true -> - {[{0,0,O1,O2}],Bytes3} - end; -getBMPChars(Bytes,Len) -> - getBMPChars(Bytes,Len,[]). - -getBMPChars(Bytes,0,Acc) -> - {lists:reverse(Acc),Bytes}; -getBMPChars(Bytes,Len,Acc) -> - {Octs,Bytes1} = getoctets_as_list(Bytes,2), - case Octs of - [0,O2] -> - getBMPChars(Bytes1,Len-1,[O2|Acc]); - [O1,O2]-> - getBMPChars(Bytes1,Len-1,[{0,0,O1,O2}|Acc]) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% chars_encode(C,StringType,Value) -> ValueList -%% -%% encodes chars according to the per rules taking the constraint PermittedAlphabet -%% into account. -%% This function does only encode the value part and NOT the length - -% chars_encode(C,StringType,Value) -> -% case {StringType,get_constraint(C,'PermittedAlphabet')} of -% {'UniversalString',{_,Sv}} -> -% exit({error,{asn1,{'not implemented',"UniversalString with PermittedAlphabet constraint"}}}); -% {'BMPString',{_,Sv}} -> -% exit({error,{asn1,{'not implemented',"BMPString with PermittedAlphabet constraint"}}}); -% _ -> -% {NumBits,CharOutTab} = {get_NumBits(C,StringType),get_CharOutTab(C,StringType)}, -% chars_encode2(Value,NumBits,CharOutTab) -% end. - - -chars_encode2([H|T],NumBits,T1={Min,Max,notab}) when H =< Max, H >= Min -> -% [[10,NumBits,H-Min]|chars_encode2(T,NumBits,T1)]; - [pre_complete_bits(NumBits,H-Min)|chars_encode2(T,NumBits,T1)]; -chars_encode2([H|T],NumBits,T1={Min,Max,Tab}) when H =< Max, H >= Min -> -% [[10,NumBits,element(H-Min+1,Tab)]|chars_encode2(T,NumBits,T1)]; - [pre_complete_bits(NumBits,exit_if_false(H,element(H-Min+1,Tab)))| - chars_encode2(T,NumBits,T1)]; -chars_encode2([{A,B,C,D}|T],NumBits,T1={Min,_Max,notab}) -> - %% no value range check here (ought to be, but very expensive) -% [{bits,NumBits,(A*B*C*D)-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; -% [[10,NumBits,((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min]|chars_encode2(T,NumBits,T1)]; - [pre_complete_bits(NumBits, - ((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min)| - chars_encode2(T,NumBits,T1)]; -chars_encode2([H={A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> - %% no value range check here (ought to be, but very expensive) - [pre_complete_bits(NumBits,exit_if_false(H,element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)))|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|_T],_NumBits,{_Min,_Max,_Tab}) -> - exit({error,{asn1,{illegal_char_value,H}}}); -chars_encode2([],_,_) -> - []. - -exit_if_false(V,false)-> - exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}}); -exit_if_false(_,V) ->V. - -pre_complete_bits(NumBits,Val) when NumBits =< 8 -> - [10,NumBits,Val]; -pre_complete_bits(NumBits,Val) when NumBits =< 16 -> - [10,NumBits-8,Val bsr 8,10,8,(Val band 255)]; -pre_complete_bits(NumBits,Val) when NumBits =< 2040 -> % 255 * 8 -% LBUsed = NumBits rem 8, -% {Unused,Len} = case (8 - LBUsed) of -% 8 -> {0,NumBits div 8}; -% U -> {U,(NumBits div 8) + 1} -% end, -% NewVal = Val bsr LBUsed, -% [30,Unused,Len,<<NewVal:Len/unit:8,Val:LBUsed,0:Unused>>]. - Unused = (8 - (NumBits rem 8)) rem 8, - Len = NumBits + Unused, - [30,Unused,Len div 8,<<(Val bsl Unused):Len>>]. - -% get_NumBits(C,StringType) -> -% case get_constraint(C,'PermittedAlphabet') of -% {'SingleValue',Sv} -> -% charbits(length(Sv),aligned); -% no -> -% case StringType of -% 'IA5String' -> -% charbits(128,aligned); % 16#00..16#7F -% 'VisibleString' -> -% charbits(95,aligned); % 16#20..16#7E -% 'PrintableString' -> -% charbits(74,aligned); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z -% 'NumericString' -> -% charbits(11,aligned); % $ ,"0123456789" -% 'UniversalString' -> -% 32; -% 'BMPString' -> -% 16 -% end -% end. - -%%Maybe used later -%%get_MaxChar(C,StringType) -> -%% case get_constraint(C,'PermittedAlphabet') of -%% {'SingleValue',Sv} -> -%% lists:nth(length(Sv),Sv); -%% no -> -%% case StringType of -%% 'IA5String' -> -%% 16#7F; % 16#00..16#7F -%% 'VisibleString' -> -%% 16#7E; % 16#20..16#7E -%% 'PrintableString' -> -%% $z; % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z -%% 'NumericString' -> -%% $9; % $ ,"0123456789" -%% 'UniversalString' -> -%% 16#ffffffff; -%% 'BMPString' -> -%% 16#ffff -%% end -%% end. - -%%Maybe used later -%%get_MinChar(C,StringType) -> -%% case get_constraint(C,'PermittedAlphabet') of -%% {'SingleValue',Sv} -> -%% hd(Sv); -%% no -> -%% case StringType of -%% 'IA5String' -> -%% 16#00; % 16#00..16#7F -%% 'VisibleString' -> -%% 16#20; % 16#20..16#7E -%% 'PrintableString' -> -%% $\s; % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z -%% 'NumericString' -> -%% $\s; % $ ,"0123456789" -%% 'UniversalString' -> -%% 16#00; -%% 'BMPString' -> -%% 16#00 -%% end -%% end. - -% get_CharOutTab(C,StringType) -> -% get_CharTab(C,StringType,out). - -% get_CharInTab(C,StringType) -> -% get_CharTab(C,StringType,in). - -% get_CharTab(C,StringType,InOut) -> -% case get_constraint(C,'PermittedAlphabet') of -% {'SingleValue',Sv} -> -% get_CharTab2(C,StringType,hd(Sv),lists:max(Sv),Sv,InOut); -% no -> -% case StringType of -% 'IA5String' -> -% {0,16#7F,notab}; -% 'VisibleString' -> -% get_CharTab2(C,StringType,16#20,16#7F,notab,InOut); -% 'PrintableString' -> -% Chars = lists:sort( -% " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), -% get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars,InOut); -% 'NumericString' -> -% get_CharTab2(C,StringType,16#20,$9," 0123456789",InOut); -% 'UniversalString' -> -% {0,16#FFFFFFFF,notab}; -% 'BMPString' -> -% {0,16#FFFF,notab} -% end -% end. - -% get_CharTab2(C,StringType,Min,Max,Chars,InOut) -> -% BitValMax = (1 bsl get_NumBits(C,StringType))-1, -% if -% Max =< BitValMax -> -% {0,Max,notab}; -% true -> -% case InOut of -% out -> -% {Min,Max,create_char_tab(Min,Chars)}; -% in -> -% {Min,Max,list_to_tuple(Chars)} -% end -% end. - -% create_char_tab(Min,L) -> -% list_to_tuple(create_char_tab(Min,L,0)). -% create_char_tab(Min,[Min|T],V) -> -% [V|create_char_tab(Min+1,T,V+1)]; -% create_char_tab(_Min,[],_V) -> -% []; -% create_char_tab(Min,L,V) -> -% [false|create_char_tab(Min+1,L,V)]. - -%% This very inefficient and should be moved to compiletime -% charbits(NumOfChars,aligned) -> -% case charbits(NumOfChars) of -% 1 -> 1; -% 2 -> 2; -% B when B =< 4 -> 4; -% B when B =< 8 -> 8; -% B when B =< 16 -> 16; -% B when B =< 32 -> 32 -% end. - -% charbits(NumOfChars) when NumOfChars =< 2 -> 1; -% charbits(NumOfChars) when NumOfChars =< 4 -> 2; -% charbits(NumOfChars) when NumOfChars =< 8 -> 3; -% charbits(NumOfChars) when NumOfChars =< 16 -> 4; -% charbits(NumOfChars) when NumOfChars =< 32 -> 5; -% charbits(NumOfChars) when NumOfChars =< 64 -> 6; -% charbits(NumOfChars) when NumOfChars =< 128 -> 7; -% charbits(NumOfChars) when NumOfChars =< 256 -> 8; -% charbits(NumOfChars) when NumOfChars =< 512 -> 9; -% charbits(NumOfChars) when NumOfChars =< 1024 -> 10; -% charbits(NumOfChars) when NumOfChars =< 2048 -> 11; -% charbits(NumOfChars) when NumOfChars =< 4096 -> 12; -% charbits(NumOfChars) when NumOfChars =< 8192 -> 13; -% charbits(NumOfChars) when NumOfChars =< 16384 -> 14; -% charbits(NumOfChars) when NumOfChars =< 32768 -> 15; -% charbits(NumOfChars) when NumOfChars =< 65536 -> 16; -% charbits(NumOfChars) when integer(NumOfChars) -> -% 16 + charbits1(NumOfChars bsr 16). - -% charbits1(0) -> -% 0; -% charbits1(NumOfChars) -> -% 1 + charbits1(NumOfChars bsr 1). - - -chars_decode(Bytes,_,'BMPString',_,Len) -> - getBMPChars(Bytes,Len); -chars_decode(Bytes,NumBits,_StringType,CharInTab,Len) -> - chars_decode2(Bytes,CharInTab,NumBits,Len). - - -chars_decode2(Bytes,CharInTab,NumBits,Len) -> - chars_decode2(Bytes,CharInTab,NumBits,Len,[]). - -chars_decode2(Bytes,_CharInTab,_NumBits,0,Acc) -> - {lists:reverse(Acc),Bytes}; -chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) when NumBits > 8 -> - {Char,Bytes2} = getbits(Bytes,NumBits), - Result = - if - Char < 256 -> Char; - true -> - list_to_tuple(binary_to_list(<<Char:32>>)) - end, - chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Result|Acc]); -chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) -> - {Char,Bytes2} = getbits(Bytes,NumBits), - chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Char+Min|Acc]); - -%% BMPString and UniversalString with PermittedAlphabet is currently not supported -chars_decode2(Bytes,{Min,Max,CharInTab},NumBits,Len,Acc) -> - {Char,Bytes2} = getbits(Bytes,NumBits), - chars_decode2(Bytes2,{Min,Max,CharInTab},NumBits,Len -1,[element(Char+1,CharInTab)|Acc]). - - - % X.691:17 -encode_null(_Val) -> []; % encodes to nothing -encode_null({Name,Val}) when atom(Name) -> - encode_null(Val). - -decode_null(Bytes) -> - {'NULL',Bytes}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_object_identifier(Val) -> CompleteList -%% encode_object_identifier({Name,Val}) -> CompleteList -%% Val -> {Int1,Int2,...,IntN} % N >= 2 -%% Name -> atom() -%% Int1 -> integer(0..2) -%% Int2 -> integer(0..39) when Int1 (0..1) else integer() -%% Int3-N -> integer() -%% CompleteList -> [{bits,8,Val}|{octets,Ol}|align|...] -%% -encode_object_identifier({Name,Val}) when atom(Name) -> - encode_object_identifier(Val); -encode_object_identifier(Val) -> - OctetList = e_object_identifier(Val), - Octets = list_to_binary(OctetList), % performs a flatten at the same time -% [{debug,object_identifier},encode_length(undefined,size(Octets)),{octets,Octets}]. - [encode_length(undefined,size(Octets)), - octets_to_complete(size(Octets),Octets)]. - -%% This code is copied from asn1_encode.erl (BER) and corrected and modified - -e_object_identifier({'OBJECT IDENTIFIER',V}) -> - e_object_identifier(V); -e_object_identifier({Cname,V}) when atom(Cname),tuple(V) -> - e_object_identifier(tuple_to_list(V)); -e_object_identifier({Cname,V}) when atom(Cname),list(V) -> - e_object_identifier(V); -e_object_identifier(V) when tuple(V) -> - e_object_identifier(tuple_to_list(V)); - -%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) -e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> - Head = 40*E1 + E2, % weird - e_object_elements([Head|Tail],[]); -e_object_identifier(Oid=[_,_|_Tail]) -> - exit({error,{asn1,{'illegal_value',Oid}}}). - -e_object_elements([],Acc) -> - lists:reverse(Acc); -e_object_elements([H|T],Acc) -> - e_object_elements(T,[e_object_element(H)|Acc]). - -e_object_element(Num) when Num < 128 -> - Num; -%% must be changed to handle more than 2 octets -e_object_element(Num) -> %% when Num < ??? - Left = ((Num band 2#11111110000000) bsr 7) bor 2#10000000, - Right = Num band 2#1111111 , - [Left,Right]. - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_object_identifier(Bytes) -> {ObjId,RemainingBytes} -%% ObjId -> {integer(),integer(),...} % at least 2 integers -%% RemainingBytes -> [integer()] when integer() (0..255) -decode_object_identifier(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - [First|Rest] = dec_subidentifiers(Octs,0,[]), - Idlist = if - First < 40 -> - [0,First|Rest]; - First < 80 -> - [1,First - 40|Rest]; - true -> - [2,First - 80|Rest] - end, - {list_to_tuple(Idlist),Bytes3}. - -dec_subidentifiers([H|T],Av,Al) when H >=16#80 -> - dec_subidentifiers(T,(Av bsl 7) + (H band 16#7F),Al); -dec_subidentifiers([H|T],Av,Al) -> - dec_subidentifiers(T,0,[(Av bsl 7) + H |Al]); -dec_subidentifiers([],_Av,Al) -> - lists:reverse(Al). - -get_constraint([{Key,V}],Key) -> - V; -get_constraint([],_) -> - no; -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% complete(InList) -> ByteList -%% Takes a coded list with bits and bytes and converts it to a list of bytes -%% Should be applied as the last step at encode of a complete ASN.1 type -%% - --ifdef(nodriver). - -complete(L) -> - case complete1(L) of - {[],[]} -> - <<0>>; - {Acc,[]} -> - Acc; - {Acc,Bacc} -> - [Acc|complete_bytes(Bacc)] - end. - - -% this function builds the ugly form of lists [E1|E2] to avoid having to reverse it at the end. -% this is done because it is efficient and that the result always will be sent on a port or -% converted by means of list_to_binary/1 - complete1(InList) when list(InList) -> - complete1(InList,[],[]); - complete1(InList) -> - complete1([InList],[],[]). - - complete1([],Acc,Bacc) -> - {Acc,Bacc}; - complete1([H|T],Acc,Bacc) when list(H) -> - {NewH,NewBacc} = complete1(H,Acc,Bacc), - complete1(T,NewH,NewBacc); - - complete1([{octets,Bin}|T],Acc,[]) -> - complete1(T,[Acc|Bin],[]); - - complete1([{octets,Bin}|T],Acc,Bacc) -> - complete1(T,[Acc|[complete_bytes(Bacc),Bin]],[]); - - complete1([{debug,_}|T], Acc,Bacc) -> - complete1(T,Acc,Bacc); - - complete1([{bits,N,Val}|T],Acc,Bacc) -> - complete1(T,Acc,complete_update_byte(Bacc,Val,N)); - - complete1([{bit,Val}|T],Acc,Bacc) -> - complete1(T,Acc,complete_update_byte(Bacc,Val,1)); - - complete1([align|T],Acc,[]) -> - complete1(T,Acc,[]); - complete1([align|T],Acc,Bacc) -> - complete1(T,[Acc|complete_bytes(Bacc)],[]); - complete1([{0,Bin}|T],Acc,[]) when binary(Bin) -> - complete1(T,[Acc|Bin],[]); - complete1([{Unused,Bin}|T],Acc,[]) when integer(Unused),binary(Bin) -> - Size = size(Bin)-1, - <<Bs:Size/binary,B>> = Bin, - NumBits = 8-Unused, - complete1(T,[Acc|Bs],[[B bsr Unused]|NumBits]); - complete1([{Unused,Bin}|T],Acc,Bacc) when integer(Unused),binary(Bin) -> - Size = size(Bin)-1, - <<Bs:Size/binary,B>> = Bin, - NumBits = 8 - Unused, - Bf = complete_bytes(Bacc), - complete1(T,[Acc|[Bf,Bs]],[[B bsr Unused]|NumBits]). - - - complete_update_byte([],Val,Len) -> - complete_update_byte([[0]|0],Val,Len); - complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) when NumBits + Len == 8 -> - [[0,((Byte bsl Len) + Val) band 255|Bacc]|0]; - complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) when NumBits + Len > 8 -> - Rem = 8 - NumBits, - Rest = Len - Rem, - complete_update_byte([[0,((Byte bsl Rem) + (Val bsr Rest)) band 255 |Bacc]|0],Val,Rest); - complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) -> - [[((Byte bsl Len) + Val) band 255|Bacc]|NumBits+Len]. - - - complete_bytes([[Byte|Bacc]|0]) -> - lists:reverse(Bacc); - complete_bytes([[Byte|Bacc]|NumBytes]) -> - lists:reverse([(Byte bsl (8-NumBytes)) band 255|Bacc]); - complete_bytes([]) -> - []. - --else. - - - complete(L) -> - case catch port_control(drv_complete,1,L) of - Bin when binary(Bin) -> - Bin; - List when list(List) -> handle_error(List,L); - {'EXIT',{badarg,Reason}} -> - asn1rt_driver_handler:load_driver(), - receive - driver_ready -> - case catch port_control(drv_complete,1,L) of - Bin2 when binary(Bin2) -> Bin2; - List when list(List) -> handle_error(List,L); - Error -> exit(Error) - end; - {error,Error} -> % error when loading driver - %% the driver could not be loaded - exit(Error); - Error={port_error,Reason} -> - exit(Error) - end; - {'EXIT',Reason} -> - exit(Reason) - end. - -handle_error([],_)-> - exit({error,{"memory allocation problem"}}); -handle_error("1",L) -> % error in complete in driver - exit({error,{asn1_error,L}}); -handle_error(ErrL,L) -> - exit({error,{unknown_error,ErrL,L}}). - --endif. - - -octets_to_complete(Len,Val) when Len < 256 -> - [20,Len,Val]; -octets_to_complete(Len,Val) -> - [21,<<Len:16>>,Val]. - -octets_unused_to_complete(Unused,Len,Val) when Len < 256 -> - [30,Unused,Len,Val]; -octets_unused_to_complete(Unused,Len,Val) -> - [31,Unused,<<Len:16>>,Val]. diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_per_v1.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_per_v1.erl deleted file mode 100644 index ebab269f5d..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1rt_per_v1.erl +++ /dev/null @@ -1,1843 +0,0 @@ -%% ``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: asn1rt_per_v1.erl,v 1.1 2008/12/17 09:53:31 mikpe Exp $ -%% --module(asn1rt_per_v1). - -%% encoding / decoding of PER aligned - --include("asn1_records.hrl"). - --export([dec_fixup/3, cindex/3, list_to_record/2]). --export([setchoiceext/1, setext/1, fixoptionals/2, fixextensions/2, - setoptionals/1, fixoptionals2/3, getext/1, getextension/2, - skipextensions/3, getbit/1, getchoice/3 ]). --export([getoptionals/2, getoptionals/3, set_choice/3, - getoptionals2/2, - encode_integer/2, encode_integer/3 ]). --export([decode_integer/2, decode_integer/3, encode_small_number/1, - encode_boolean/1, decode_boolean/1, encode_length/2, - decode_length/1, decode_length/2, - encode_small_length/1, decode_small_length/1, - decode_compact_bit_string/3]). --export([encode_enumerated/3, decode_enumerated/3, - encode_bit_string/3, decode_bit_string/3 ]). --export([encode_octet_string/2, decode_octet_string/2, - encode_null/1, decode_null/1, - encode_object_identifier/1, decode_object_identifier/1, - complete/1]). - --export([encode_open_type/2, decode_open_type/2]). - --export([encode_UniversalString/2, decode_UniversalString/2, - encode_PrintableString/2, decode_PrintableString/2, - encode_GeneralString/2, decode_GeneralString/2, - encode_GraphicString/2, decode_GraphicString/2, - encode_TeletexString/2, decode_TeletexString/2, - encode_VideotexString/2, decode_VideotexString/2, - encode_VisibleString/2, decode_VisibleString/2, - encode_BMPString/2, decode_BMPString/2, - encode_IA5String/2, decode_IA5String/2, - encode_NumericString/2, decode_NumericString/2, - encode_ObjectDescriptor/2, decode_ObjectDescriptor/1 - ]). - - -dec_fixup(Terms,Cnames,RemBytes) -> - dec_fixup(Terms,Cnames,RemBytes,[]). - -dec_fixup([novalue|T],[_Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,Acc); -dec_fixup([{_Name,novalue}|T],[_Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,Acc); -dec_fixup([H|T],[Hc|Tc],RemBytes,Acc) -> - dec_fixup(T,Tc,RemBytes,[{Hc,H}|Acc]); -dec_fixup([],_Cnames,RemBytes,Acc) -> - {lists:reverse(Acc),RemBytes}. - -cindex(Ix,Val,Cname) -> - case element(Ix,Val) of - {Cname,Val2} -> Val2; - X -> X - end. - -% converts a list to a record if necessary -list_to_record(Name,List) when list(List) -> - list_to_tuple([Name|List]); -list_to_record(_Name,Tuple) when tuple(Tuple) -> - Tuple. - -%%-------------------------------------------------------- -%% setchoiceext(InRootSet) -> [{bit,X}] -%% X is set to 1 when InRootSet==false -%% X is set to 0 when InRootSet==true -%% -setchoiceext(true) -> - [{debug,choiceext},{bit,0}]; -setchoiceext(false) -> - [{debug,choiceext},{bit,1}]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% setext(true|false) -> CompleteList -%% - -setext(true) -> - [{debug,ext},{bit,1}]; -setext(false) -> - [{debug,ext},{bit,0}]. - -%% - -fixoptionals2(OptList,OptLength,Val) when tuple(Val) -> - Bits = fixoptionals2(OptList,Val,0), - {Val,{bits,OptLength,Bits}}; - -fixoptionals2([],_Val,Acc) -> - %% Optbits - Acc; -fixoptionals2([Pos|Ot],Val,Acc) -> - case element(Pos,Val) of - asn1_NOVALUE -> fixoptionals2(Ot,Val,Acc bsl 1); - asn1_DEFAULT -> fixoptionals2(Ot,Val,Acc bsl 1); - _ -> fixoptionals2(Ot,Val,(Acc bsl 1) + 1) - end. - - -%% -%% fixoptionals remains only for backward compatibility purpose -fixoptionals(OptList,Val) when tuple(Val) -> - fixoptionals(OptList,Val,[]); - -fixoptionals(OptList,Val) when list(Val) -> - fixoptionals(OptList,Val,1,[],[]). - -fixoptionals([],Val,Acc) -> - % return {Val,Opt} - {Val,lists:reverse(Acc)}; -fixoptionals([{_,Pos}|Ot],Val,Acc) -> - case element(Pos+1,Val) of - asn1_NOVALUE -> fixoptionals(Ot,Val,[0|Acc]); - asn1_DEFAULT -> fixoptionals(Ot,Val,[0|Acc]); - _ -> fixoptionals(Ot,Val,[1|Acc]) - end. - - -%setoptionals(OptList,Val) -> -% Vlist = tuple_to_list(Val), -% setoptionals(OptList,Vlist,1,[]). - -fixoptionals([{Name,Pos}|Ot],[{Name,Val}|Vt],_Opt,Acc1,Acc2) -> - fixoptionals(Ot,Vt,Pos+1,[1|Acc1],[{Name,Val}|Acc2]); -fixoptionals([{_Name,Pos}|Ot],V,Pos,Acc1,Acc2) -> - fixoptionals(Ot,V,Pos+1,[0|Acc1],[asn1_NOVALUE|Acc2]); -fixoptionals(O,[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals(O,Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals([],[Vh|Vt],Pos,Acc1,Acc2) -> - fixoptionals([],Vt,Pos+1,Acc1,[Vh|Acc2]); -fixoptionals([],[],_,Acc1,Acc2) -> - % return {Val,Opt} - {list_to_tuple([asn1_RECORDNAME|lists:reverse(Acc2)]),lists:reverse(Acc1)}. - -setoptionals([H|T]) -> - [{bit,H}|setoptionals(T)]; -setoptionals([]) -> - [{debug,optionals}]. - -getext(Bytes) when tuple(Bytes) -> - getbit(Bytes); -getext(Bytes) when list(Bytes) -> - getbit({0,Bytes}). - -getextension(0, Bytes) -> - {{},Bytes}; -getextension(1, Bytes) -> - {Len,Bytes2} = decode_small_length(Bytes), - {Blist, Bytes3} = getbits_as_list(Len,Bytes2), - {list_to_tuple(Blist),Bytes3}. - -fixextensions({ext,ExtPos,ExtNum},Val) -> - case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of - 0 -> []; - ExtBits -> - [encode_small_length(ExtNum),{bits,ExtNum,ExtBits}] - end. - -fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> - Acc; -fixextensions(Pos,ExtPos,Val,Acc) -> - Bit = case catch(element(Pos+1,Val)) of - asn1_NOVALUE -> - 0; - asn1_NOEXTVALUE -> - 0; - {'EXIT',_} -> - 0; - _ -> - 1 - end, - fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). - -skipextensions(Bytes,Nr,ExtensionBitPattern) -> - case (catch element(Nr,ExtensionBitPattern)) of - 1 -> - {_,Bytes2} = decode_open_type(Bytes,[]), - skipextensions(Bytes2, Nr+1, ExtensionBitPattern); - 0 -> - skipextensions(Bytes, Nr+1, ExtensionBitPattern); - {'EXIT',_} -> % badarg, no more extensions - Bytes - end. - - -getchoice(Bytes,1,0) -> % only 1 alternative is not encoded - {0,Bytes}; -getchoice(Bytes,_NumChoices,1) -> - decode_small_number(Bytes); -getchoice(Bytes,NumChoices,0) -> - decode_integer(Bytes,[{'ValueRange',{0,NumChoices-1}}]). - -getoptionals2(Bytes,NumOpt) -> - getbits(Bytes,NumOpt). - -%% getoptionals is kept only for bakwards compatibility -getoptionals(Bytes,NumOpt) -> - {Blist,Bytes1} = getbits_as_list(NumOpt,Bytes), - {list_to_tuple(Blist),Bytes1}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% getoptionals/3 is only here for compatibility from 1.3.2 -%% the codegenerator uses getoptionals/2 - -getoptionals(Bytes,L,NumComp) when list(L) -> - {Blist,Bytes1} = getbits_as_list(length(L),Bytes), - {list_to_tuple(comptuple(Blist,L,NumComp,1)),Bytes1}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% comptuple is only here for compatibility not used from 1.3.2 -comptuple([Bh|Bt],[{_Name,Nr}|T],NumComp,Nr) -> - [Bh|comptuple(Bt,T,NumComp-1,Nr+1)]; -comptuple(Bl,[{Name,Tnr}|Tl],NumComp,Nr) -> - [0|comptuple(Bl,[{Name,Tnr}|Tl],NumComp-1,Nr+1)]; -comptuple(_B,_L,0,_Nr) -> - []; -comptuple(B,O,N,Nr) -> - [0|comptuple(B,O,N-1,Nr+1)]. - -%% getbits_as_binary(Num,Bytes) -> {{Unused,BinBits},RestBytes}, -%% Num = integer(), -%% Bytes = list() | tuple(), -%% Unused = integer(), -%% BinBits = binary(), -%% RestBytes = tuple() -getbits_as_binary(Num,Bytes) when list(Bytes) -> - getbits_as_binary(Num,{0,Bytes}); -getbits_as_binary(_Num,{Used,[]}) -> - {{0,<<>>},{Used,[]}}; -getbits_as_binary(Num,{Used,Bits=[H|T]}) -> - B1 = case (Num+Used) =< 8 of - true -> Num; - _ -> 8-Used - end, - B2 = Num - B1, - Pad = (8 - ((B1+B2) rem 8)) rem 8,% Pad /= 8 - RestBits = lists:nthtail((B1+B2) div 8,Bits), - Int = integer_from_list(B2,T,0), - NewUsed = (Used + Num) rem 8, - {{Pad,<<(H bsr (8-(Used+B1))):B1,Int:B2,0:Pad>>},{NewUsed,RestBits}}. - -integer_from_list(_Int,[],BigInt) -> - BigInt; -integer_from_list(Int,[H|_T],BigInt) when Int < 8 -> - (BigInt bsl Int) bor (H bsr (8-Int)); -integer_from_list(Int,[H|T],BigInt) -> - integer_from_list(Int-8,T,(BigInt bsl 8) bor H). - -getbits_as_list(Num,Bytes) -> - getbits_as_list(Num,Bytes,[]). - -getbits_as_list(0,Bytes,Acc) -> - {lists:reverse(Acc),Bytes}; -getbits_as_list(Num,Bytes,Acc) -> - {Bit,NewBytes} = getbit(Bytes), - getbits_as_list(Num-1,NewBytes,[Bit|Acc]). - -getbit(Bytes) -> -% io:format("getbit:~p~n",[Bytes]), - getbit1(Bytes). - -getbit1({7,[H|T]}) -> - {H band 1,{0,T}}; -getbit1({Pos,[H|T]}) -> - {(H bsr (7-Pos)) band 1,{(Pos+1) rem 8,[H|T]}}; -getbit1(Bytes) when list(Bytes) -> - getbit1({0,Bytes}). - -%% This could be optimized -getbits(Buffer,Num) -> -% io:format("getbits:Buffer = ~p~nNum=~p~n",[Buffer,Num]), - getbits(Buffer,Num,0). - -getbits(Buffer,0,Acc) -> - {Acc,Buffer}; -getbits(Buffer,Num,Acc) -> - {B,NewBuffer} = getbit(Buffer), - getbits(NewBuffer,Num-1,B + (Acc bsl 1)). - - -getoctet(Bytes) when list(Bytes) -> - getoctet({0,Bytes}); -getoctet(Bytes) -> -% io:format("getoctet:Buffer = ~p~n",[Bytes]), - getoctet1(Bytes). - -getoctet1({0,[H|T]}) -> - {H,{0,T}}; -getoctet1({_Pos,[_,H|T]}) -> - {H,{0,T}}. - -align({0,L}) -> - {0,L}; -align({_Pos,[_H|T]}) -> - {0,T}; -align(Bytes) -> - {0,Bytes}. - -getoctets(Buffer,Num) -> -% io:format("getoctets:Buffer = ~p~nNum = ~p~n",[Buffer,Num]), - getoctets(Buffer,Num,0). - -getoctets(Buffer,0,Acc) -> - {Acc,Buffer}; -getoctets(Buffer,Num,Acc) -> - {Oct,NewBuffer} = getoctet(Buffer), - getoctets(NewBuffer,Num-1,(Acc bsl 8)+Oct). - -getoctets_as_list(Buffer,Num) -> - getoctets_as_list(Buffer,Num,[]). - -getoctets_as_list(Buffer,0,Acc) -> - {lists:reverse(Acc),Buffer}; -getoctets_as_list(Buffer,Num,Acc) -> - {Oct,NewBuffer} = getoctet(Buffer), - getoctets_as_list(NewBuffer,Num-1,[Oct|Acc]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings -%% Alt = atom() -%% Altnum = integer() | {integer(),integer()}% number of alternatives -%% Choices = [atom()] | {[atom()],[atom()]} -%% When Choices is a tuple the first list is the Rootset and the -%% second is the Extensions and then Altnum must also be a tuple with the -%% lengths of the 2 lists -%% -set_choice(Alt,{L1,L2},{Len1,_Len2}) -> - case set_choice_tag(Alt,L1) of - N when integer(N), Len1 > 1 -> - [{bit,0}, % the value is in the root set - encode_integer([{'ValueRange',{0,Len1-1}}],N)]; - N when integer(N) -> - [{bit,0}]; % no encoding if only 0 or 1 alternative - false -> - [{bit,1}, % extension value - case set_choice_tag(Alt,L2) of - N2 when integer(N2) -> - encode_small_number(N2); - false -> - unknown_choice_alt - end] - end; -set_choice(Alt,L,Len) -> - case set_choice_tag(Alt,L) of - N when integer(N), Len > 1 -> - encode_integer([{'ValueRange',{0,Len-1}}],N); - N when integer(N) -> - []; % no encoding if only 0 or 1 alternative - false -> - [unknown_choice_alt] - end. - -set_choice_tag(Alt,Choices) -> - set_choice_tag(Alt,Choices,0). - -set_choice_tag(Alt,[Alt|_Rest],Tag) -> - Tag; -set_choice_tag(Alt,[_H|Rest],Tag) -> - set_choice_tag(Alt,Rest,Tag+1); -set_choice_tag(_Alt,[],_Tag) -> - false. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_open_type(Constraint, Value) -> CompleteList -%% Value = list of bytes of an already encoded value (the list must be flat) -%% | binary -%% Contraint = not used in this version -%% -encode_open_type(_Constraint, Val) when list(Val) -> - [encode_length(undefined,length(Val)),align, - {octets,Val}]; -encode_open_type(_Constraint, Val) when binary(Val) -> - [encode_length(undefined,size(Val)),align, - {octets,binary_to_list(Val)}]. -%% the binary_to_list is not optimal but compatible with the current solution - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_open_type(Buffer,Constraint) -> Value -%% Constraint is not used in this version -%% Buffer = [byte] with PER encoded data -%% Value = [byte] with decoded data (which must be decoded again as some type) -%% -decode_open_type(Bytes, _Constraint) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - Bytes3 = align(Bytes2), - getoctets_as_list(Bytes3,Len). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_integer(Constraint,Value,NamedNumberList) -> CompleteList -%% encode_integer(Constraint,Value) -> CompleteList -%% encode_integer(Constraint,{Name,Value}) -> CompleteList -%% -%% -encode_integer(C,V,NamedNumberList) when atom(V) -> - case lists:keysearch(V,1,NamedNumberList) of - {value,{_,NewV}} -> - encode_integer(C,NewV); - _ -> - exit({error,{asn1,{namednumber,V}}}) - end; -encode_integer(C,V,_) when integer(V) -> - encode_integer(C,V); -encode_integer(C,{Name,V},NamedNumberList) when atom(Name) -> - encode_integer(C,V,NamedNumberList). - -encode_integer(C,{Name,Val}) when atom(Name) -> - encode_integer(C,Val); - -encode_integer({Rc,_Ec},Val) -> - case (catch encode_integer(Rc,Val)) of - {'EXIT',{error,{asn1,_}}} -> - [{bit,1},encode_unconstrained_number(Val)]; - Encoded -> - [{bit,0},Encoded] - end; -encode_integer(C,Val ) when list(C) -> - case get_constraint(C,'SingleValue') of - no -> - encode_integer1(C,Val); - V when integer(V),V == Val -> - []; % a type restricted to a single value encodes to nothing - V when list(V) -> - case lists:member(Val,V) of - true -> - encode_integer1(C,Val); - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end; - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end. - -encode_integer1(C, Val) -> - case VR = get_constraint(C,'ValueRange') of - no -> - encode_unconstrained_number(Val); - {Lb,'MAX'} -> - encode_semi_constrained_number(Lb,Val); - %% positive with range - {Lb,Ub} when Val >= Lb, - Ub >= Val -> - encode_constrained_number(VR,Val); - _ -> - exit({error,{asn1,{illegal_value,VR,Val}}}) - end. - -decode_integer(Buffer,Range,NamedNumberList) -> - {Val,Buffer2} = decode_integer(Buffer,Range), - case lists:keysearch(Val,2,NamedNumberList) of - {value,{NewVal,_}} -> {NewVal,Buffer2}; - _ -> {Val,Buffer2} - end. - -decode_integer(Buffer,{Rc,_Ec}) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> decode_integer(Buffer2,Rc); - 1 -> decode_unconstrained_number(Buffer2) - end; -decode_integer(Buffer,undefined) -> - decode_unconstrained_number(Buffer); -decode_integer(Buffer,C) -> - case get_constraint(C,'SingleValue') of - V when integer(V) -> - {V,Buffer}; - V when list(V) -> - {Val,Buffer2} = decode_integer1(Buffer,C), - case lists:member(Val,V) of - true -> - {Val,Buffer2}; - _ -> - exit({error,{asn1,{illegal_value,Val}}}) - end; - _ -> - decode_integer1(Buffer,C) - end. - -decode_integer1(Buffer,C) -> - case VR = get_constraint(C,'ValueRange') of - no -> - decode_unconstrained_number(Buffer); - {Lb, 'MAX'} -> - decode_semi_constrained_number(Buffer,Lb); - {_,_} -> - decode_constrained_number(Buffer,VR) - end. - -% X.691:10.6 Encoding of a normally small non-negative whole number -% Use this for encoding of CHOICE index if there is an extension marker in -% the CHOICE -encode_small_number({Name,Val}) when atom(Name) -> - encode_small_number(Val); -encode_small_number(Val) when Val =< 63 -> - [{bit,0},{bits,6,Val}]; -encode_small_number(Val) -> - [{bit,1},encode_semi_constrained_number(0,Val)]. - -decode_small_number(Bytes) -> - {Bit,Bytes2} = getbit(Bytes), - case Bit of - 0 -> - getbits(Bytes2,6); - 1 -> - decode_semi_constrained_number(Bytes2,{0,'MAX'}) - end. - -% X.691:10.7 Encoding of a semi-constrained whole number -%% might be an optimization encode_semi_constrained_number(0,Val) -> -encode_semi_constrained_number(C,{Name,Val}) when atom(Name) -> - encode_semi_constrained_number(C,Val); -encode_semi_constrained_number({Lb,'MAX'},Val) -> - encode_semi_constrained_number(Lb,Val); -encode_semi_constrained_number(Lb,Val) -> - Val2 = Val - Lb, - Octs = eint_positive(Val2), - [encode_length(undefined,length(Octs)),{octets,Octs}]. - -decode_semi_constrained_number(Bytes,{Lb,_}) -> - decode_semi_constrained_number(Bytes,Lb); -decode_semi_constrained_number(Bytes,Lb) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {V,Bytes3} = getoctets(Bytes2,Len), - {V+Lb,Bytes3}. - -encode_constrained_number(Range,{Name,Val}) when atom(Name) -> - encode_constrained_number(Range,Val); -encode_constrained_number({Lb,Ub},Val) when Val >= Lb, Ub >= Val -> - Range = Ub - Lb + 1, - Val2 = Val - Lb, - if - Range == 2 -> - {bits,1,Val2}; - Range =< 4 -> - {bits,2,Val2}; - Range =< 8 -> - {bits,3,Val2}; - Range =< 16 -> - {bits,4,Val2}; - Range =< 32 -> - {bits,5,Val2}; - Range =< 64 -> - {bits,6,Val2}; - Range =< 128 -> - {bits,7,Val2}; - Range =< 255 -> - {bits,8,Val2}; - Range =< 256 -> - {octets,1,Val2}; - Range =< 65536 -> - {octets,2,Val2}; - Range =< 16#1000000 -> - Octs = eint_positive(Val2), - [encode_length({1,3},length(Octs)),{octets,Octs}]; - Range =< 16#100000000 -> - Octs = eint_positive(Val2), - [encode_length({1,4},length(Octs)),{octets,Octs}]; - Range =< 16#10000000000 -> - Octs = eint_positive(Val2), - [encode_length({1,5},length(Octs)),{octets,Octs}]; - true -> - exit({not_supported,{integer_range,Range}}) - end. - -decode_constrained_number(Buffer,{Lb,Ub}) -> - Range = Ub - Lb + 1, -% Val2 = Val - Lb, - {Val,Remain} = - if - Range == 2 -> - getbits(Buffer,1); - Range =< 4 -> - getbits(Buffer,2); - Range =< 8 -> - getbits(Buffer,3); - Range =< 16 -> - getbits(Buffer,4); - Range =< 32 -> - getbits(Buffer,5); - Range =< 64 -> - getbits(Buffer,6); - Range =< 128 -> - getbits(Buffer,7); - Range =< 255 -> - getbits(Buffer,8); - Range =< 256 -> - getoctets(Buffer,1); - Range =< 65536 -> - getoctets(Buffer,2); - Range =< 16#1000000 -> - {Len,Bytes2} = decode_length(Buffer,{1,3}), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_pos_integer(Octs),Bytes3}; - Range =< 16#100000000 -> - {Len,Bytes2} = decode_length(Buffer,{1,4}), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_pos_integer(Octs),Bytes3}; - Range =< 16#10000000000 -> - {Len,Bytes2} = decode_length(Buffer,{1,5}), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_pos_integer(Octs),Bytes3}; - true -> - exit({not_supported,{integer_range,Range}}) - end, - {Val+Lb,Remain}. - -% X.691:10.8 Encoding of an unconstrained whole number - -encode_unconstrained_number(Val) when Val >= 0 -> - Oct = eint(Val,[]), - [{debug,unconstrained_number}, - encode_length({0,'MAX'},length(Oct)), - {octets,Oct}]; -encode_unconstrained_number(Val) -> % negative - Oct = enint(Val,[]), - [{debug,unconstrained_number}, - encode_length({0,'MAX'},length(Oct)), - {octets,Oct}]. - -%% used for positive Values which don't need a sign bit -eint_positive(Val) -> - case eint(Val,[]) of - [0,B1|T] -> - [B1|T]; - T -> - T - end. - -eint(0, [B|Acc]) when B < 128 -> - [B|Acc]; -eint(N, Acc) -> - eint(N bsr 8, [N band 16#ff| Acc]). - -enint(-1, [B1|T]) when B1 > 127 -> - [B1|T]; -enint(N, Acc) -> - enint(N bsr 8, [N band 16#ff|Acc]). - -%% used for signed positive values - -%eint(Val, Ack) -> -% X = Val band 255, -% Next = Val bsr 8, -% if -% Next == 0, X >= 127 -> -% [0,X|Ack]; -% Next == 0 -> -% [X|Ack]; -% true -> -% eint(Next,[X|Ack]) -% end. - -%%% used for signed negative values -%enint(Val, Acc) -> -% NumOctets = if -% -Val < 16#80 -> 1; -% -Val < 16#8000 ->2; -% -Val < 16#800000 ->3; -% -Val < 16#80000000 ->4; -% -Val < 16#8000000000 ->5; -% -Val < 16#800000000000 ->6; -% -Val < 16#80000000000000 ->7; -% -Val < 16#8000000000000000 ->8; -% -Val < 16#800000000000000000 ->9 -% end, -% enint(Val,Acc,NumOctets). - -%enint(Val, Acc,0) -> -% Acc; -%enint(Val, Acc,NumOctets) -> -% enint(Val bsr 8,[Val band 255|Acc],NumOctets-1). - - -decode_unconstrained_number(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Ints,Bytes3} = getoctets_as_list(Bytes2,Len), - {dec_integer(Ints),Bytes3}. - -dec_pos_integer(Ints) -> - decpint(Ints, 8 * (length(Ints) - 1)). -dec_integer(Ints) when hd(Ints) band 255 =< 127 -> %% Positive number - decpint(Ints, 8 * (length(Ints) - 1)); -dec_integer(Ints) -> %% Negative - decnint(Ints, 8 * (length(Ints) - 1)). - -decpint([Byte|Tail], Shift) -> - (Byte bsl Shift) bor decpint(Tail, Shift-8); -decpint([], _) -> 0. - -decnint([Byte|Tail], Shift) -> - (-128 + (Byte band 127) bsl Shift) bor decpint(Tail, Shift-8). - -minimum_octets(Val) -> - minimum_octets(Val,[]). - -minimum_octets(Val,Acc) when Val > 0 -> - minimum_octets((Val bsr 8),[Val band 16#FF|Acc]); -minimum_octets(0,Acc) -> - Acc. - - -%% X.691:10.9 Encoding of a length determinant -%%encode_small_length(undefined,Len) -> % null means no UpperBound -%% encode_small_number(Len). - -%% X.691:10.9.3.5 -%% X.691:10.9.3.7 -encode_length(undefined,Len) -> % un-constrained - if - Len < 128 -> - {octet,Len band 16#7F}; - Len < 16384 -> - {octets,2,2#1000000000000000 bor Len}; - true -> - exit({error,{asn1,{encode_length,{nyi,above_16k}}}}) - end; - -encode_length({0,'MAX'},Len) -> - encode_length(undefined,Len); -encode_length({Lb,Ub},Len) when Ub =< 65535 ,Lb >= 0 -> % constrained - encode_constrained_number({Lb,Ub},Len); -encode_length({{Lb,Ub},[]},Len) when Ub =< 65535 ,Lb >= 0 -> - %% constrained extensible - [{bit,0},encode_constrained_number({Lb,Ub},Len)]; -encode_length(SingleValue,_) when integer(SingleValue) -> - []. - -encode_small_length(Len) when Len =< 64 -> - [{bit,0},{bits,6,Len-1}]; -encode_small_length(Len) -> - [{bit,1},encode_length(undefined,Len)]. - -decode_small_length(Buffer) -> - case getbit(Buffer) of - {0,Remain} -> - {Bits,Remain2} = getbits(Remain,6), - {Bits+1,Remain2}; - {1,Remain} -> - decode_length(Remain,undefined) - end. - -decode_length(Buffer) -> - decode_length(Buffer,undefined). - -decode_length(Buffer,undefined) -> % un-constrained - Buffer2 = align(Buffer), - {Bits,_} = getbits(Buffer2,2), - case Bits of - 2 -> - {Val,Bytes3} = getoctets(Buffer2,2), - {(Val band 16#3FFF),Bytes3}; - 3 -> - exit({error,{asn1,{decode_length,{nyi,above_16k}}}}); - _ -> - {Val,Bytes3} = getoctet(Buffer2), - {Val band 16#7F,Bytes3} - end; - -decode_length(Buffer,{Lb,Ub}) when Ub =< 65535 ,Lb >= 0 -> % constrained - decode_constrained_number(Buffer,{Lb,Ub}); - -decode_length(Buffer,{{Lb,Ub},[]}) -> - case getbit(Buffer) of - {0,Buffer2} -> - decode_length(Buffer2, {Lb,Ub}) - end; - % X.691:10.9.3.5 -decode_length(Buffer,{_,_Lb,_Ub}) -> %when Len =< 127 -> % Unconstrained or large Ub - case getbit(Buffer) of - {0,Remain} -> - getbits(Remain,7); - {1,_Remain} -> - {Val,Remain2} = getoctets(Buffer,2), - {Val band 2#0111111111111111, Remain2} - end; -decode_length(Buffer,SingleValue) when integer(SingleValue) -> - {SingleValue,Buffer}. - - -% X.691:11 -encode_boolean({Name,Val}) when atom(Name) -> - encode_boolean(Val); -encode_boolean(true) -> - {bit,1}; -encode_boolean(false) -> - {bit,0}; -encode_boolean(Val) -> - exit({error,{asn1,{encode_boolean,Val}}}). - - -decode_boolean(Buffer) -> %when record(Buffer,buffer) - case getbit(Buffer) of - {1,Remain} -> {true,Remain}; - {0,Remain} -> {false,Remain} - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% X.691:12 -%% ENUMERATED -%% -%% encode_enumerated(C,Value,NamedNumberTup) -> CompleteList -%% -%% - -encode_enumerated(C,{Name,Value},NamedNumberList) when - atom(Name),list(NamedNumberList) -> - encode_enumerated(C,Value,NamedNumberList); - -%% ENUMERATED with extension mark -encode_enumerated(_C,{asn1_enum,Value},{_Nlist1,Nlist2}) when Value >= length(Nlist2) -> - [{bit,1},encode_small_number(Value)]; -encode_enumerated(C,Value,{Nlist1,Nlist2}) -> - case enum_search(Value,Nlist1,0) of - NewV when integer(NewV) -> - [{bit,0},encode_integer(C,NewV)]; - false -> - case enum_search(Value,Nlist2,0) of - ExtV when integer(ExtV) -> - [{bit,1},encode_small_number(ExtV)]; - false -> - exit({error,{asn1,{encode_enumerated,Value}}}) - end - end; - -encode_enumerated(C,Value,NamedNumberList) when list(NamedNumberList) -> - case enum_search(Value,NamedNumberList,0) of - NewV when integer(NewV) -> - encode_integer(C,NewV); - false -> - exit({error,{asn1,{encode_enumerated,Value}}}) - end. - -%% returns the ordinal number from 0 ,1 ... in the list where Name is found -%% or false if not found -%% -enum_search(Name,[Name|_NamedNumberList],Acc) -> - Acc; -enum_search(Name,[_H|T],Acc) -> - enum_search(Name,T,Acc+1); -enum_search(_,[],_) -> - false. % name not found !error - -%% ENUMERATED with extension marker -decode_enumerated(Buffer,C,{Ntup1,Ntup2}) when tuple(Ntup1), tuple(Ntup2) -> - {Ext,Buffer2} = getext(Buffer), - case Ext of - 0 -> % not an extension value - {Val,Buffer3} = decode_integer(Buffer2,C), - case catch (element(Val+1,Ntup1)) of - NewVal when atom(NewVal) -> {NewVal,Buffer3}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,[Ntup1,Ntup2]}}}}) - end; - 1 -> % this an extension value - {Val,Buffer3} = decode_small_number(Buffer2), - case catch (element(Val+1,Ntup2)) of - NewVal when atom(NewVal) -> {NewVal,Buffer3}; - _ -> {{asn1_enum,Val},Buffer3} - end - end; - -decode_enumerated(Buffer,C,NamedNumberTup) when tuple(NamedNumberTup) -> - {Val,Buffer2} = decode_integer(Buffer,C), - case catch (element(Val+1,NamedNumberTup)) of - NewVal when atom(NewVal) -> {NewVal,Buffer2}; - _Error -> exit({error,{asn1,{decode_enumerated,{Val,NamedNumberTup}}}}) - end. - -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== -%% Bitstring value, ITU_T X.690 Chapter 8.5 -%%=============================================================================== -%%=============================================================================== -%%=============================================================================== - -%%=============================================================================== -%% encode bitstring value -%%=============================================================================== - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% bitstring NamedBitList -%% Val can be of: -%% - [identifiers] where only named identifers are set to one, -%% the Constraint must then have some information of the -%% bitlength. -%% - [list of ones and zeroes] all bits -%% - integer value representing the bitlist -%% C is constraint Len, only valid when identifiers - - -%% when the value is a list of {Unused,BinBits}, where -%% Unused = integer(), -%% BinBits = binary(). -encode_bit_string(C,Bin={Unused,BinBits},NamedBitList) when integer(Unused), - binary(BinBits) -> - encode_bin_bit_string(C,Bin,NamedBitList); - -%% when the value is a list of named bits -encode_bit_string(C, [FirstVal | RestVal], NamedBitList) when atom(FirstVal) -> - ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string(C,BitList,NamedBitList); - -encode_bit_string(C, [{bit,No} | RestVal], NamedBitList) -> - ToSetPos = get_all_bitposes([{bit,No} | RestVal], NamedBitList, []), - BitList = make_and_set_list(ToSetPos,0), - encode_bit_string(C,BitList,NamedBitList); - -%% when the value is a list of ones and zeroes - -encode_bit_string(C, BitListValue, NamedBitList) when list(BitListValue) -> - Bl1 = - case NamedBitList of - [] -> % dont remove trailing zeroes - BitListValue; - _ -> % first remove any trailing zeroes - lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, - lists:reverse(BitListValue))) - end, - BitList = [{bit,X} || X <- Bl1], - BListLen = length(BitList), - case get_constraint(C,'SizeConstraint') of - 0 -> % fixed length - []; % nothing to encode - V when integer(V),V=<16 -> % fixed length 16 bits or less - pad_list(V,BitList); - V when integer(V) -> % fixed length 16 bits or less - [align,pad_list(V,BitList)]; - {Lb,Ub} when integer(Lb),integer(Ub),BListLen<Lb -> - %% padding due to OTP-4353 - [encode_length({Lb,Ub},Lb),align,pad_list(Lb,BitList)]; - {Lb,Ub} when integer(Lb),integer(Ub) -> - [encode_length({Lb,Ub},length(BitList)),align,BitList]; - no -> - [encode_length(undefined,length(BitList)),align,BitList]; - Sc={{Lb,Ub},_} when integer(Lb),integer(Ub),BListLen<Lb -> - %% padding due to OTP-4353 - [encode_length(Sc,Lb),align,pad_list(Lb,BitList)]; - Sc -> % extension marker - [encode_length(Sc,length(BitList)),align,BitList] - end; - -%% when the value is an integer -encode_bit_string(C, IntegerVal, NamedBitList) when integer(IntegerVal)-> - BitList = int_to_bitlist(IntegerVal), - encode_bit_string(C,BitList,NamedBitList); - -%% when the value is a tuple -encode_bit_string(C,{Name,Val}, NamedBitList) when atom(Name) -> - encode_bit_string(C,Val,NamedBitList). - - -%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. -%% Unused = integer(), -%% BinBits = binary(). - -encode_bin_bit_string(C,{Unused,BinBits},NamedBitList) -> - RemoveZerosIfNNL = - fun({NNL,BitList}) -> - case NNL of - [] -> BitList; - _ -> - lists:reverse( - lists:dropwhile(fun(0)->true;(1)->false end, - lists:reverse(BitList))) - end - end, - {OctetList,OLSize,LastBits} = - case size(BinBits) of - N when N>1 -> - IntList = binary_to_list(BinBits), - [H|T] = lists:reverse(IntList), - Bl1 = RemoveZerosIfNNL({NamedBitList,lists:reverse(int_to_bitlist(H,8-Unused))}),% lists:sublist obsolete if trailing bits are zero ! - {[{octet,X} || X <- lists:reverse(T)],size(BinBits)-1, - [{bit,X} || X <- Bl1]}; - 1 -> - <<B7:1,B6:1,B5:1,B4:1,B3:1,B2:1,B1:1,B0:1>> = BinBits, - {[],0,[{bit,X} || X <- lists:sublist([B7,B6,B5,B4,B3,B2,B1,B0],8-Unused)]}; - _ -> - {[],0,[]} - end, - case get_constraint(C,'SizeConstraint') of - 0 -> - []; - V when integer(V),V=<16 -> - [OctetList, pad_list(V,LastBits)]; - V when integer(V) -> -% [OctetList, align, pad_list(V rem 8,LastBits)]; - [align,OctetList, pad_list(V rem 8,LastBits)]; - {Lb,Ub} when integer(Lb),integer(Ub) -> - NewLastBits = maybe_pad(Lb,length(LastBits)+(OLSize*8),LastBits,NamedBitList), - [encode_length({Lb,Ub},length(NewLastBits)+(OLSize*8)), -% OctetList,align,LastBits]; - align,OctetList,NewLastBits]; - no -> - [encode_length(undefined,length(LastBits)+(OLSize*8)), -% OctetList,align,LastBits]; - align,OctetList,LastBits]; - Sc={{Lb,_},_} when integer(Lb) -> - NewLastBits = maybe_pad(Lb,length(LastBits)+(OLSize*8),LastBits,NamedBitList), - [encode_length(Sc,length(NewLastBits)+(OLSize*8)), - align,OctetList,NewLastBits]; - Sc -> - [encode_length(Sc,length(LastBits)+(OLSize*8)), -% OctetList,align,LastBits] - align,OctetList,LastBits] - end. - -maybe_pad(_,_,Bits,[]) -> - Bits; -maybe_pad(Lb,LenBits,Bits,_) when Lb>LenBits -> - pad_list(Lb,Bits); -maybe_pad(_,_,Bits,_) -> - Bits. - -%%%%%%%%%%%%%%% -%% The result is presented as a list of named bits (if possible) -%% else as a tuple {Unused,Bits}. Unused is the number of unused -%% bits, least significant bits in the last byte of Bits. Bits is -%% the BIT STRING represented as a binary. -%% -decode_compact_bit_string(Buffer, C, NamedNumberList) -> - case get_constraint(C,'SizeConstraint') of - 0 -> % fixed length - {{0,<<>>},Buffer}; - V when integer(V),V=<16 -> %fixed length 16 bits or less - compact_bit_string(Buffer,V,NamedNumberList); - V when integer(V) -> %fixed length > 16 bits - Bytes2 = align(Buffer), - compact_bit_string(Bytes2,V,NamedNumberList); - {Lb,Ub} when integer(Lb),integer(Ub) -> - {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList); - no -> - {Len,Bytes2} = decode_length(Buffer,undefined), - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList); - Sc -> - {Len,Bytes2} = decode_length(Buffer,Sc), - Bytes3 = align(Bytes2), - compact_bit_string(Bytes3,Len,NamedNumberList) - end. - - -%%%%%%%%%%%%%%% -%% The result is presented as a list of named bits (if possible) -%% else as a list of 0 and 1. -%% -decode_bit_string(Buffer, C, NamedNumberList) -> - case get_constraint(C,'SizeConstraint') of - 0 -> % fixed length - {[],Buffer}; % nothing to encode - V when integer(V),V=<16 -> % fixed length 16 bits or less - bit_list_to_named(Buffer,V,NamedNumberList); - V when integer(V) -> % fixed length 16 bits or less - Bytes2 = align(Buffer), - bit_list_to_named(Bytes2,V,NamedNumberList); - {Lb,Ub} when integer(Lb),integer(Ub) -> - {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), - Bytes3 = align(Bytes2), - bit_list_to_named(Bytes3,Len,NamedNumberList); - no -> - {Len,Bytes2} = decode_length(Buffer,undefined), - Bytes3 = align(Bytes2), - bit_list_to_named(Bytes3,Len,NamedNumberList); - Sc -> % extension marker - {Len,Bytes2} = decode_length(Buffer,Sc), - Bytes3 = align(Bytes2), - bit_list_to_named(Bytes3,Len,NamedNumberList) - end. - - -%% if no named bits are declared we will return a -%% {Unused,Bits}. Unused = integer(), -%% Bits = binary(). -compact_bit_string(Buffer,Len,[]) -> - getbits_as_binary(Len,Buffer); % {{Unused,BinBits},NewBuffer} -compact_bit_string(Buffer,Len,NamedNumberList) -> - bit_list_to_named(Buffer,Len,NamedNumberList). - - -%% if no named bits are declared we will return a -%% BitList = [0 | 1] - -bit_list_to_named(Buffer,Len,[]) -> - getbits_as_list(Len,Buffer); - -%% if there are named bits declared we will return a named -%% BitList where the names are atoms and unnamed bits represented -%% as {bit,Pos} -%% BitList = [atom() | {bit,Pos}] -%% Pos = integer() - -bit_list_to_named(Buffer,Len,NamedNumberList) -> - {BitList,Rest} = getbits_as_list(Len,Buffer), - {bit_list_to_named1(0,BitList,NamedNumberList,[]), Rest}. - -bit_list_to_named1(Pos,[0|Bt],Names,Acc) -> - bit_list_to_named1(Pos+1,Bt,Names,Acc); -bit_list_to_named1(Pos,[1|Bt],Names,Acc) -> - case lists:keysearch(Pos,2,Names) of - {value,{Name,_}} -> - bit_list_to_named1(Pos+1,Bt,Names,[Name|Acc]); - _ -> - bit_list_to_named1(Pos+1,Bt,Names,[{bit,Pos}|Acc]) - end; -bit_list_to_named1(_Pos,[],_Names,Acc) -> - lists:reverse(Acc). - - - -%%%%%%%%%%%%%%% -%% - -int_to_bitlist(0) -> - []; -int_to_bitlist(Int) when integer(Int), Int >= 0 -> - [Int band 1 | int_to_bitlist(Int bsr 1)]. - -int_to_bitlist(_Int,0) -> - []; -int_to_bitlist(0,N) -> - [0|int_to_bitlist(0,N-1)]; -int_to_bitlist(Int,N) -> - [Int band 1 | int_to_bitlist(Int bsr 1, N-1)]. - - -%%%%%%%%%%%%%%%%%% -%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> -%% [sorted_list_of_bitpositions_to_set] - -get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); - -get_all_bitposes([Val | Rest], NamedBitList, Ack) -> - case lists:keysearch(Val, 1, NamedBitList) of - {value, {_ValName, ValPos}} -> - get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]); - _ -> - exit({error,{asn1, {bitstring_namedbit, Val}}}) - end; -get_all_bitposes([], _NamedBitList, Ack) -> - lists:sort(Ack). - -%%%%%%%%%%%%%%%%%% -%% make_and_set_list([list of positions to set to 1])-> -%% returns list with all in SetPos set. -%% in positioning in list the first element is 0, the second 1 etc.., but -%% - -make_and_set_list([XPos|SetPos], XPos) -> - [1 | make_and_set_list(SetPos, XPos + 1)]; -make_and_set_list([Pos|SetPos], XPos) -> - [0 | make_and_set_list([Pos | SetPos], XPos + 1)]; -make_and_set_list([], _XPos) -> - []. - -%%%%%%%%%%%%%%%%% -%% pad_list(N,BitList) -> PaddedList -%% returns a padded (with trailing {bit,0} elements) list of length N -%% if Bitlist contains more than N significant bits set an exit asn1_error -%% is generated - -pad_list(0,BitList) -> - case BitList of - [] -> []; - _ -> exit({error,{asn1,{range_error,{bit_string,BitList}}}}) - end; -pad_list(N,[Bh|Bt]) -> - [Bh|pad_list(N-1,Bt)]; -pad_list(N,[]) -> - [{bit,0},pad_list(N-1,[])]. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% X.691:16 -%% encode_octet_string(Constraint,ExtensionMarker,Val) -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -encode_octet_string(C,{Name,Val}) when atom(Name) -> - encode_octet_string(C,false,Val); -encode_octet_string(C,Val) -> - encode_octet_string(C,false,Val). - -encode_octet_string(C,Bool,{_Name,Val}) -> - encode_octet_string(C,Bool,Val); -encode_octet_string(_,true,_) -> - exit({error,{asn1,{'not_supported',extensionmarker}}}); -encode_octet_string(C,false,Val) -> - case get_constraint(C,'SizeConstraint') of - 0 -> - []; - 1 -> - [V] = Val, - {bits,8,V}; - 2 -> - [V1,V2] = Val, - [{bits,8,V1},{bits,8,V2}]; - Sv when Sv =<65535, Sv == length(Val) -> % fixed length - [align,{octets,Val}]; - {Lb,Ub} -> - [encode_length({Lb,Ub},length(Val)),align, - {octets,Val}]; - Sv when list(Sv) -> - [encode_length({hd(Sv),lists:max(Sv)},length(Val)),align, - {octets,Val}]; - no -> - [encode_length(undefined,length(Val)),align, - {octets,Val}] - end. - -decode_octet_string(Bytes,Range) -> - decode_octet_string(Bytes,Range,false). - -decode_octet_string(Bytes,C,false) -> - case get_constraint(C,'SizeConstraint') of - 0 -> - {[],Bytes}; - 1 -> - {B1,Bytes2} = getbits(Bytes,8), - {[B1],Bytes2}; - 2 -> - {B1,Bytes2}= getbits(Bytes,8), - {B2,Bytes3}= getbits(Bytes2,8), - {[B1,B2],Bytes3}; - {_,0} -> - {[],Bytes}; - Sv when integer(Sv), Sv =<65535 -> % fixed length - Bytes2 = align(Bytes), - getoctets_as_list(Bytes2,Sv); - {Lb,Ub} -> - {Len,Bytes2} = decode_length(Bytes,{Lb,Ub}), - Bytes3 = align(Bytes2), - getoctets_as_list(Bytes3,Len); - Sv when list(Sv) -> - {Len,Bytes2} = decode_length(Bytes,{hd(Sv),lists:max(Sv)}), - Bytes3 = align(Bytes2), - getoctets_as_list(Bytes3,Len); - no -> - {Len,Bytes2} = decode_length(Bytes,undefined), - Bytes3 = align(Bytes2), - getoctets_as_list(Bytes3,Len) - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Restricted char string types -%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) -%% X.691:26 and X.680:34-36 -%%encode_restricted_string(aligned,'BMPString',Constraints,Extension,Val) - - -encode_restricted_string(aligned,{Name,Val}) when atom(Name) -> - encode_restricted_string(aligned,Val); - -encode_restricted_string(aligned,Val) when list(Val)-> - [encode_length(undefined,length(Val)),align, - {octets,Val}]. - -encode_known_multiplier_string(aligned,StringType,C,_Ext,{Name,Val}) when atom(Name) -> - encode_known_multiplier_string(aligned,StringType,C,false,Val); - -encode_known_multiplier_string(aligned,StringType,C,_Ext,Val) -> - Result = chars_encode(C,StringType,Val), - NumBits = get_NumBits(C,StringType), - case get_constraint(C,'SizeConstraint') of - Ub when integer(Ub), Ub*NumBits =< 16 -> - case {StringType,Result} of - {'BMPString',{octets,Ol}} -> - [{bits,8,Oct}||Oct <- Ol]; - _ -> - Result - end; - 0 -> - []; - Ub when integer(Ub),Ub =<65535 -> % fixed length - [align,Result]; - {Ub,Lb} -> - [encode_length({Ub,Lb},length(Val)),align,Result]; - Vl when list(Vl) -> - [encode_length({lists:min(Vl),lists:max(Vl)},length(Val)),align,Result]; - no -> - [encode_length(undefined,length(Val)),align,Result] - end. - -decode_restricted_string(Bytes,aligned) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - Bytes3 = align(Bytes2), - getoctets_as_list(Bytes3,Len). - -decode_known_multiplier_string(Bytes,aligned,StringType,C,_Ext) -> - NumBits = get_NumBits(C,StringType), - case get_constraint(C,'SizeConstraint') of - Ub when integer(Ub), Ub*NumBits =< 16 -> - chars_decode(Bytes,NumBits,StringType,C,Ub); - Ub when integer(Ub),Ub =<65535 -> % fixed length - Bytes1 = align(Bytes), - chars_decode(Bytes1,NumBits,StringType,C,Ub); - 0 -> - {[],Bytes}; - Vl when list(Vl) -> - {Len,Bytes1} = decode_length(Bytes,{hd(Vl),lists:max(Vl)}), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,C,Len); - no -> - {Len,Bytes1} = decode_length(Bytes,undefined), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,C,Len); - {Lb,Ub}-> - {Len,Bytes1} = decode_length(Bytes,{Lb,Ub}), - Bytes2 = align(Bytes1), - chars_decode(Bytes2,NumBits,StringType,C,Len) - end. - - -encode_NumericString(C,Val) -> - encode_known_multiplier_string(aligned,'NumericString',C,false,Val). -decode_NumericString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'NumericString',C,false). - -encode_PrintableString(C,Val) -> - encode_known_multiplier_string(aligned,'PrintableString',C,false,Val). -decode_PrintableString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'PrintableString',C,false). - -encode_VisibleString(C,Val) -> % equivalent with ISO646String - encode_known_multiplier_string(aligned,'VisibleString',C,false,Val). -decode_VisibleString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'VisibleString',C,false). - -encode_IA5String(C,Val) -> - encode_known_multiplier_string(aligned,'IA5String',C,false,Val). -decode_IA5String(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'IA5String',C,false). - -encode_BMPString(C,Val) -> - encode_known_multiplier_string(aligned,'BMPString',C,false,Val). -decode_BMPString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'BMPString',C,false). - -encode_UniversalString(C,Val) -> - encode_known_multiplier_string(aligned,'UniversalString',C,false,Val). -decode_UniversalString(Bytes,C) -> - decode_known_multiplier_string(Bytes,aligned,'UniversalString',C,false). - -%% end of known-multiplier strings for which PER visible constraints are -%% applied - -encode_GeneralString(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_GeneralString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - -encode_GraphicString(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_GraphicString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - -encode_ObjectDescriptor(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_ObjectDescriptor(Bytes) -> - decode_restricted_string(Bytes,aligned). - -encode_TeletexString(_C,Val) -> % equivalent with T61String - encode_restricted_string(aligned,Val). -decode_TeletexString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - -encode_VideotexString(_C,Val) -> - encode_restricted_string(aligned,Val). -decode_VideotexString(Bytes,_C) -> - decode_restricted_string(Bytes,aligned). - - - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% getBMPChars(Bytes,Len) ->{BMPcharList,RemainingBytes} -%% -getBMPChars(Bytes,1) -> - {O1,Bytes2} = getbits(Bytes,8), - {O2,Bytes3} = getbits(Bytes2,8), - if - O1 == 0 -> - {[O2],Bytes3}; - true -> - {[{0,0,O1,O2}],Bytes3} - end; -getBMPChars(Bytes,Len) -> - getBMPChars(Bytes,Len,[]). - -getBMPChars(Bytes,0,Acc) -> - {lists:reverse(Acc),Bytes}; -getBMPChars(Bytes,Len,Acc) -> - {Octs,Bytes1} = getoctets_as_list(Bytes,2), - case Octs of - [0,O2] -> - getBMPChars(Bytes1,Len-1,[O2|Acc]); - [O1,O2]-> - getBMPChars(Bytes1,Len-1,[{0,0,O1,O2}|Acc]) - end. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% chars_encode(C,StringType,Value) -> ValueList -%% -%% encodes chars according to the per rules taking the constraint PermittedAlphabet -%% into account. -%% This function does only encode the value part and NOT the length - -chars_encode(C,StringType,Value) -> - case {StringType,get_constraint(C,'PermittedAlphabet')} of - {'UniversalString',{_,_Sv}} -> - exit({error,{asn1,{'not implemented',"UniversalString with PermittedAlphabet constraint"}}}); - {'BMPString',{_,_Sv}} -> - exit({error,{asn1,{'not implemented',"BMPString with PermittedAlphabet constraint"}}}); - _ -> - {NumBits,CharOutTab} = {get_NumBits(C,StringType),get_CharOutTab(C,StringType)}, - chars_encode2(Value,NumBits,CharOutTab) - end. - -chars_encode2([H|T],NumBits,{Min,Max,notab}) when H =< Max, H >= Min -> - [{bits,NumBits,H-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|T],NumBits,{Min,Max,Tab}) when H =< Max, H >= Min -> - [{bits,NumBits,element(H-Min+1,Tab)}|chars_encode2(T,NumBits,{Min,Max,Tab})]; -chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,notab}) -> - %% no value range check here (ought to be, but very expensive) -% [{bits,NumBits,(A*B*C*D)-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; - [{bits,NumBits,((((((A bsl 8) + B) bsl 8) + C) bsl 8) + D)-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> - %% no value range check here (ought to be, but very expensive) -% [{bits,NumBits,element((A*B*C*D)-Min,Tab)}|chars_encode2(T,NumBits,{Min,Max,notab})]; - [{bits,NumBits,element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)}|chars_encode2(T,NumBits,{Min,Max,notab})]; -chars_encode2([H|_T],_,{_,_,_}) -> - exit({error,{asn1,{illegal_char_value,H}}}); -chars_encode2([],_,_) -> - []. - - -get_NumBits(C,StringType) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} -> - charbits(length(Sv),aligned); - no -> - case StringType of - 'IA5String' -> - charbits(128,aligned); % 16#00..16#7F - 'VisibleString' -> - charbits(95,aligned); % 16#20..16#7E - 'PrintableString' -> - charbits(74,aligned); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z - 'NumericString' -> - charbits(11,aligned); % $ ,"0123456789" - 'UniversalString' -> - 32; - 'BMPString' -> - 16 - end - end. - -%%Maybe used later -%%get_MaxChar(C,StringType) -> -%% case get_constraint(C,'PermittedAlphabet') of -%% {'SingleValue',Sv} -> -%% lists:nth(length(Sv),Sv); -%% no -> -%% case StringType of -%% 'IA5String' -> -%% 16#7F; % 16#00..16#7F -%% 'VisibleString' -> -%% 16#7E; % 16#20..16#7E -%% 'PrintableString' -> -%% $z; % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z -%% 'NumericString' -> -%% $9; % $ ,"0123456789" -%% 'UniversalString' -> -%% 16#ffffffff; -%% 'BMPString' -> -%% 16#ffff -%% end -%% end. - -%%Maybe used later -%%get_MinChar(C,StringType) -> -%% case get_constraint(C,'PermittedAlphabet') of -%% {'SingleValue',Sv} -> -%% hd(Sv); -%% no -> -%% case StringType of -%% 'IA5String' -> -%% 16#00; % 16#00..16#7F -%% 'VisibleString' -> -%% 16#20; % 16#20..16#7E -%% 'PrintableString' -> -%% $\s; % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z -%% 'NumericString' -> -%% $\s; % $ ,"0123456789" -%% 'UniversalString' -> -%% 16#00; -%% 'BMPString' -> -%% 16#00 -%% end -%% end. - -get_CharOutTab(C,StringType) -> - get_CharTab(C,StringType,out). - -get_CharInTab(C,StringType) -> - get_CharTab(C,StringType,in). - -get_CharTab(C,StringType,InOut) -> - case get_constraint(C,'PermittedAlphabet') of - {'SingleValue',Sv} -> - get_CharTab2(C,StringType,hd(Sv),lists:max(Sv),Sv,InOut); - no -> - case StringType of - 'IA5String' -> - {0,16#7F,notab}; - 'VisibleString' -> - get_CharTab2(C,StringType,16#20,16#7F,notab,InOut); - 'PrintableString' -> - Chars = lists:sort( - " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), - get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars,InOut); - 'NumericString' -> - get_CharTab2(C,StringType,16#20,$9," 0123456789",InOut); - 'UniversalString' -> - {0,16#FFFFFFFF,notab}; - 'BMPString' -> - {0,16#FFFF,notab} - end - end. - -get_CharTab2(C,StringType,Min,Max,Chars,InOut) -> - BitValMax = (1 bsl get_NumBits(C,StringType))-1, - if - Max =< BitValMax -> - {0,Max,notab}; - true -> - case InOut of - out -> - {Min,Max,create_char_tab(Min,Chars)}; - in -> - {Min,Max,list_to_tuple(Chars)} - end - end. - -create_char_tab(Min,L) -> - list_to_tuple(create_char_tab(Min,L,0)). -create_char_tab(Min,[Min|T],V) -> - [V|create_char_tab(Min+1,T,V+1)]; -create_char_tab(_Min,[],_V) -> - []; -create_char_tab(Min,L,V) -> - [false|create_char_tab(Min+1,L,V)]. - -%% This very inefficient and should be moved to compiletime -charbits(NumOfChars,aligned) -> - case charbits(NumOfChars) of - 1 -> 1; - 2 -> 2; - B when B > 2, B =< 4 -> 4; - B when B > 4, B =< 8 -> 8; - B when B > 8, B =< 16 -> 16; - B when B > 16, B =< 32 -> 32 - end. - -charbits(NumOfChars) when NumOfChars =< 2 -> 1; -charbits(NumOfChars) when NumOfChars =< 4 -> 2; -charbits(NumOfChars) when NumOfChars =< 8 -> 3; -charbits(NumOfChars) when NumOfChars =< 16 -> 4; -charbits(NumOfChars) when NumOfChars =< 32 -> 5; -charbits(NumOfChars) when NumOfChars =< 64 -> 6; -charbits(NumOfChars) when NumOfChars =< 128 -> 7; -charbits(NumOfChars) when NumOfChars =< 256 -> 8; -charbits(NumOfChars) when NumOfChars =< 512 -> 9; -charbits(NumOfChars) when NumOfChars =< 1024 -> 10; -charbits(NumOfChars) when NumOfChars =< 2048 -> 11; -charbits(NumOfChars) when NumOfChars =< 4096 -> 12; -charbits(NumOfChars) when NumOfChars =< 8192 -> 13; -charbits(NumOfChars) when NumOfChars =< 16384 -> 14; -charbits(NumOfChars) when NumOfChars =< 32768 -> 15; -charbits(NumOfChars) when NumOfChars =< 65536 -> 16; -charbits(NumOfChars) when integer(NumOfChars) -> - 16 + charbits1(NumOfChars bsr 16). - -charbits1(0) -> - 0; -charbits1(NumOfChars) -> - 1 + charbits1(NumOfChars bsr 1). - - -chars_decode(Bytes,_,'BMPString',C,Len) -> - case get_constraint(C,'PermittedAlphabet') of - no -> - getBMPChars(Bytes,Len); - _ -> - exit({error,{asn1, - {'not implemented', - "BMPString with PermittedAlphabet constraint"}}}) - end; -chars_decode(Bytes,NumBits,StringType,C,Len) -> - CharInTab = get_CharInTab(C,StringType), - chars_decode2(Bytes,CharInTab,NumBits,Len). - - -chars_decode2(Bytes,CharInTab,NumBits,Len) -> - chars_decode2(Bytes,CharInTab,NumBits,Len,[]). - -chars_decode2(Bytes,_CharInTab,_NumBits,0,Acc) -> - {lists:reverse(Acc),Bytes}; -chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) when NumBits > 8 -> - {Char,Bytes2} = getbits(Bytes,NumBits), - Result = case minimum_octets(Char+Min) of - [NewChar] -> NewChar; - [C1,C2] -> {0,0,C1,C2}; - [C1,C2,C3] -> {0,C1,C2,C3}; - [C1,C2,C3,C4] -> {C1,C2,C3,C4} - end, - chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Result|Acc]); -chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) -> - {Char,Bytes2} = getbits(Bytes,NumBits), - chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Char+Min|Acc]); - -%% BMPString and UniversalString with PermittedAlphabet is currently not supported -chars_decode2(Bytes,{Min,Max,CharInTab},NumBits,Len,Acc) -> - {Char,Bytes2} = getbits(Bytes,NumBits), - chars_decode2(Bytes2,{Min,Max,CharInTab},NumBits,Len -1,[element(Char+1,CharInTab)|Acc]). - - - % X.691:17 -encode_null({Name,Val}) when atom(Name) -> - encode_null(Val); -encode_null(_) -> []. % encodes to nothing - -decode_null(Bytes) -> - {'NULL',Bytes}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% encode_object_identifier(Val) -> CompleteList -%% encode_object_identifier({Name,Val}) -> CompleteList -%% Val -> {Int1,Int2,...,IntN} % N >= 2 -%% Name -> atom() -%% Int1 -> integer(0..2) -%% Int2 -> integer(0..39) when Int1 (0..1) else integer() -%% Int3-N -> integer() -%% CompleteList -> [{bits,8,Val}|{octets,Ol}|align|...] -%% -encode_object_identifier({Name,Val}) when atom(Name) -> - encode_object_identifier(Val); -encode_object_identifier(Val) -> - Octets = e_object_identifier(Val,notag), - [{debug,object_identifier},encode_length(undefined,length(Octets)),{octets,Octets}]. - -%% This code is copied from asn1_encode.erl (BER) and corrected and modified - -e_object_identifier({'OBJECT IDENTIFIER',V},DoTag) -> - e_object_identifier(V,DoTag); -e_object_identifier({Cname,V},DoTag) when atom(Cname),tuple(V) -> - e_object_identifier(tuple_to_list(V),DoTag); -e_object_identifier({Cname,V},DoTag) when atom(Cname),list(V) -> - e_object_identifier(V,DoTag); -e_object_identifier(V,DoTag) when tuple(V) -> - e_object_identifier(tuple_to_list(V),DoTag); - -% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) -e_object_identifier([E1,E2|Tail],_DoTag) when E1 =< 2 -> - Head = 40*E1 + E2, % weird - Res = e_object_elements([Head|Tail]), -% dotag(DoTag,[6],elength(length(Res)+1),[Head|Res]), - Res. - -e_object_elements([]) -> - []; -e_object_elements([H|T]) -> - lists:append(e_object_element(H),e_object_elements(T)). - -e_object_element(Num) when Num < 128 -> - [Num]; -% must be changed to handle more than 2 octets -e_object_element(Num) -> %% when Num < ??? - Left = ((Num band 2#11111110000000) bsr 7) bor 2#10000000, - Right = Num band 2#1111111 , - [Left,Right]. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% decode_object_identifier(Bytes) -> {ObjId,RemainingBytes} -%% ObjId -> {integer(),integer(),...} % at least 2 integers -%% RemainingBytes -> [integer()] when integer() (0..255) -decode_object_identifier(Bytes) -> - {Len,Bytes2} = decode_length(Bytes,undefined), - {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), - [First|Rest] = dec_subidentifiers(Octs,0,[]), - Idlist = if - First < 40 -> - [0,First|Rest]; - First < 80 -> - [1,First - 40|Rest]; - true -> - [2,First - 80|Rest] - end, - {list_to_tuple(Idlist),Bytes3}. - -dec_subidentifiers([H|T],Av,Al) when H >=16#80 -> - dec_subidentifiers(T,(Av bsl 7) + (H band 16#7F),Al); -dec_subidentifiers([H|T],Av,Al) -> - dec_subidentifiers(T,0,[(Av bsl 7) + H |Al]); -dec_subidentifiers([],_Av,Al) -> - lists:reverse(Al). - -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% complete(InList) -> ByteList -%% Takes a coded list with bits and bytes and converts it to a list of bytes -%% Should be applied as the last step at encode of a complete ASN.1 type -%% -complete(InList) when list(InList) -> - complete(InList,[],0); -complete(InList) -> - complete([InList],[],0). - -complete([{debug,_}|T], Acc, Acclen) -> - complete(T,Acc,Acclen); -complete([H|T],Acc,Acclen) when list(H) -> - complete(lists:concat([H,T]),Acc,Acclen); - - -complete([{octets,N,Val}|T],Acc,Acclen) when N =< 4 ,integer(Val) -> - Newval = case N of - 1 -> - Val4 = Val band 16#FF, - [Val4]; - 2 -> - Val3 = (Val bsr 8) band 16#FF, - Val4 = Val band 16#FF, - [Val3,Val4]; - 3 -> - Val2 = (Val bsr 16) band 16#FF, - Val3 = (Val bsr 8) band 16#FF, - Val4 = Val band 16#FF, - [Val2,Val3,Val4]; - 4 -> - Val1 = (Val bsr 24) band 16#FF, - Val2 = (Val bsr 16) band 16#FF, - Val3 = (Val bsr 8) band 16#FF, - Val4 = Val band 16#FF, - [Val1,Val2,Val3,Val4] - end, - complete([{octets,Newval}|T],Acc,Acclen); - -complete([{octets,Oct}|T],[],_Acclen) when list(Oct) -> - complete(T,lists:reverse(Oct),0); -complete([{octets,Oct}|T],[Hacc|Tacc],Acclen) when list(Oct) -> - Rest = 8 - Acclen, - if - Rest == 8 -> - complete(T,lists:concat([lists:reverse(Oct),[Hacc|Tacc]]),0); - true -> - complete(T,lists:concat([lists:reverse(Oct),[Hacc bsl Rest|Tacc]]),0) - end; - -complete([{bit,Val}|T], Acc, Acclen) -> - complete([{bits,1,Val}|T],Acc,Acclen); -complete([{octet,Val}|T], Acc, Acclen) -> - complete([{octets,1,Val}|T],Acc,Acclen); - -complete([{bits,N,Val}|T], Acc, 0) when N =< 8 -> - complete(T,[Val|Acc],N); -complete([{bits,N,Val}|T], [Hacc|Tacc], Acclen) when N =< 8 -> - Rest = 8 - Acclen, - if - Rest >= N -> - complete(T,[(Hacc bsl N) + Val|Tacc],(Acclen+N) rem 8); - true -> - Diff = N - Rest, - NewHacc = (Hacc bsl Rest) + (Val bsr Diff), - Mask = element(Diff,{1,3,7,15,31,63,127,255}), - complete(T,[(Val band Mask),NewHacc|Tacc],(Acclen+N) rem 8) - end; -complete([{bits,N,Val}|T], Acc, Acclen) -> % N > 8 - complete([{bits,N-8,Val bsr 8},{bits,8,Val band 255}|T],Acc,Acclen); - -complete([align|T],Acc,0) -> - complete(T,Acc,0); -complete([align|T],[Hacc|Tacc],Acclen) -> - Rest = 8 - Acclen, - complete(T,[Hacc bsl Rest|Tacc],0); -complete([{octets,_N,Val}|T],Acc,Acclen) when list(Val) -> % no security check here - complete([{octets,Val}|T],Acc,Acclen); - -complete([],[],0) -> - [0]; % a complete encoding must always be at least 1 byte -complete([],Acc,0) -> - lists:reverse(Acc); -complete([],[Hacc|Tacc],Acclen) when Acclen > 0-> - Rest = 8 - Acclen, - NewHacc = Hacc bsl Rest, - lists:reverse([NewHacc|Tacc]). - - - - - - - - - - - - - - - - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/notes_history.sgml b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/notes_history.sgml deleted file mode 100644 index f63b3360eb..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/notes_history.sgml +++ /dev/null @@ -1,100 +0,0 @@ -<!doctype chapter PUBLIC "-//Stork//DTD chapter//EN"> -<!-- - ``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: notes_history.sgml,v 1.1 2008/12/17 09:53:31 mikpe Exp $ ---> -<chapter> - <header> - <title>ASN1 Release Notes (Old)</title> - <prepared>Kenneth Lundin</prepared> - <responsible>Kenneth Lundin</responsible> - <docno></docno> - <approved>Kenneth Lundin</approved> - <checked>Kenneth Lundin</checked> - <date>98-02-02</date> - <rev>A</rev> - <file>notes_history.sgml</file> - </header> - - <p>This document describes the changes made to old versions of the <c>asn1</c> application. - - <section> - <title>ASN1 0.8.1</title> - <p>This is the first release of the ASN1 application. This version is released - for beta-testing. Some functionality will be added until the 1.0 version is - released. A list of missing features and restrictions can be found in the - chapter below. - - <section> - <title>Missing features and other restrictions</title> - <list> - <item> - <p>The encoding rules BER and PER (aligned) is supported. <em>PER (unaligned) - IS NOT SUPPORTED</em>. - <item> - <p>NOT SUPPORTED types <c>ANY</c> and <c>ANY DEFINED BY</c> - (is not in the standard any more). - <item> - <p>NOT SUPPORTED types <c>EXTERNAL</c> and <c>EMBEDDED-PDV</c>. - <item> - <p>NOT SUPPORTED type <c>REAL</c> (planned to be implemented). - <item> - <p>The code generation support for value definitions in the ASN.1 notation is very limited - (planned to be enhanced). - <item> - <p>The support for constraints is limited to: - <list> - <item><p> - SizeConstraint SIZE(X) - <item><p> - SingleValue (1) - <item><p> - ValueRange (X..Y) - <item><p> - PermittedAlpabet FROM (but not for BMPString and UniversalString when generating PER). - </list> - <p>Complex expressions in constraints is not supported (planned to be extended). - <item> - <p>The current version of the compiler has very limited error checking: - <list> - <item><p>Stops at first syntax error. - <item><p>Does not stop when a reference to an undefined type is found , - but prints an error message. Compilation of the generated - Erlang module will then fail. - <item><p>A whole number of other semantical controls is currently missing. This - means that the compiler will give little or bad help to detect what's wrong - with an ASN.1 specification, but will mostly work very well when the - ASN.1 specification is correct. - </list> - <item> - <p>The maximum INTEGER supported in this version is a signed 64 bit integer. This - limitation is probably quite reasonable. (Planned to be extended). - <item> - <p>Only AUTOMATIC TAGS supported for PER. - <item> - <p>Only EXPLICIT and IMPLICIT TAGS supported for BER. - <item> - <p>The compiler supports decoding of BER-data with indefinite length but it is - not possible to produce data with indefinite length with the encoder. - </list> - </section> - - </section> -</chapter> - - - diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/notes_latest.sgml b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/notes_latest.sgml deleted file mode 100644 index 7accc797a6..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/notes_latest.sgml +++ /dev/null @@ -1,100 +0,0 @@ -<!doctype chapter PUBLIC "-//Stork//DTD chapter//EN"> -<!-- - ``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: notes_latest.sgml,v 1.1 2008/12/17 09:53:31 mikpe Exp $ ---> -<chapter> - <header> - <title>ASN1 Release Notes</title> - <prepared>Kenneth Lundin</prepared> - <responsible>Kenneth Lundin</responsible> - <docno></docno> - <approved>Kenneth Lundin</approved> - <checked>Kenneth Lundin</checked> - <date>97-10-07</date> - <rev>A</rev> - <file>notes_latest.sgml</file> - </header> - - <p>This document describes the changes made to the asn1 application. - - <section> - <title>ASN1 0.8.1</title> - <p>This is the first release of the ASN1 application. This version is released - for beta-testing. Some functionality will be added until the 1.0 version is - released. A list of missing features and restrictions can be found in the - chapter below. - - <section> - <title>Missing features and other restrictions</title> - <list> - <item> - <p>The encoding rules BER and PER (aligned) is supported. <em>PER (unaligned) - IS NOT SUPPORTED</em>. - <item> - <p>NOT SUPPORTED types <c>ANY</c> and <c>ANY DEFINED BY</c> - (is not in the standard any more). - <item> - <p>NOT SUPPORTED types <c>EXTERNAL</c> and <c>EMBEDDED-PDV</c>. - <item> - <p>NOT SUPPORTED type <c>REAL</c> (planned to be implemented). - <item> - <p>The code generation support for value definitions in the ASN.1 notation is very limited - (planned to be enhanced). - <item> - <p>The support for constraints is limited to: - <list> - <item><p> - SizeConstraint SIZE(X) - <item><p> - SingleValue (1) - <item><p> - ValueRange (X..Y) - <item><p> - PermittedAlpabet FROM (but not for BMPString and UniversalString when generating PER). - </list> - <p>Complex expressions in constraints is not supported (planned to be extended). - <item> - <p>The current version of the compiler has very limited error checking: - <list> - <item><p>Stops at first syntax error. - <item><p>Does not stop when a reference to an undefined type is found , - but prints an error message. Compilation of the generated - Erlang module will then fail. - <item><p>A whole number of other semantical controls is currently missing. This - means that the compiler will give little or bad help to detect what's wrong - with an ASN.1 specification, but will mostly work very well when the - ASN.1 specification is correct. - </list> - <item> - <p>The maximum INTEGER supported in this version is a signed 64 bit integer. This - limitation is probably quite reasonable. (Planned to be extended). - <item> - <p>Only AUTOMATIC TAGS supported for PER. - <item> - <p>Only EXPLICIT and IMPLICIT TAGS supported for BER. - <item> - <p>The compiler supports decoding of BER-data with indefinite length but it is - not possible to produce data with indefinite length with the encoder. - </list> - </section> - - </section> -</chapter> - - - |